Index: /utils/tools_ticket2413/ABL_TOOLS/Makefile
===================================================================
--- /utils/tools_ticket2413/ABL_TOOLS/Makefile	(revision 12863)
+++ /utils/tools_ticket2413/ABL_TOOLS/Makefile	(revision 12863)
@@ -0,0 +1,62 @@
+SHELL = /bin/bash
+#-------------------------------------------------------------------------------------------------------------
+EXEC_BIN   = vinterp_abl_frc.exe
+EXEC_BIN2  = uvg_hpg_abl_frc.exe 
+EXEC_BIN3  = drown_abl_frc.exe
+
+NETCDF     := $(NETCDF_DIR)
+NETCDF_LIB := -L$(NETCDF)/lib -lnetcdf -lnetcdff
+NETCDF_INC := -I$(NETCDF)/include
+
+#FC         := gfortran
+#FFLAGS     := -fdefault-real-8 -fdefault-double-8 -O3 $(NETCDF_INC)
+#FFLAGS     := -g -O0 -fcheck=bounds -Wall -Wextra -fbacktrace -finit-real=snan -finit-integer=8888 -finit-character=90 $(NETCDF_INC)
+
+FC         := ifort
+FFLAGS     := -check noarg_temp_created -autodouble -O3 $(NETCDF_INC)
+#FFLAGS     := -check noarg_temp_created -autodouble -O0 -g -traceback -check all $(NETCDF_INC)
+
+#---------------------------------------------------------------------  
+SRC_DIR        =  $(PWD)
+OBJ_DIR        =  $(PWD)
+FINAL_OBJS     =  $(OBJ_DIR)/main_vinterp.o $(OBJ_DIR)/module_io.o $(OBJ_DIR)/module_interp.o $(OBJ_DIR)/module_grid.o
+FINAL_OBJS2    =  $(OBJ_DIR)/main_uvg_hpg.o $(OBJ_DIR)/module_io.o $(OBJ_DIR)/module_grid.o
+FINAL_OBJS3    =  $(OBJ_DIR)/main_drown.o $(OBJ_DIR)/module_io.o  $(OBJ_DIR)/module_grid.o
+#---------------------------------------------------------------------
+
+all: | $(EXEC_BIN) $(EXEC_BIN2) $(EXEC_BIN3)
+	@echo 
+	@echo ===================================================
+	@echo     ABL Preprocessing tools for ECMWF data: OK
+	@echo ===================================================
+	@echo
+
+clean:
+	$(RM)    $(OBJ_DIR)/*.o   *.mod 
+	$(RM)    $(EXEC_BIN) $(EXEC_BIN2) $(EXEC_BIN3)
+	
+$(EXEC_BIN): $(FINAL_OBJS) 
+	$(FC) -o $(EXEC_BIN) $(FINAL_OBJS) $(NETCDF_LIB)
+
+$(EXEC_BIN2): $(FINAL_OBJS2) 
+	$(FC) -o $(EXEC_BIN2) $(FINAL_OBJS2) $(NETCDF_LIB)
+
+$(EXEC_BIN3): $(FINAL_OBJS3) 
+	$(FC) -o $(EXEC_BIN3) $(FINAL_OBJS3) $(NETCDF_LIB)
+
+# Rules
+.DEFAULT:
+
+.SUFFIXES:
+
+.PRECIOUS: $(SRC_DIR)/%.F90
+	
+$(OBJ_DIR)/%.o : $(SRC_DIR)/%.F90
+	$(FC) $(FFLAGS) -o $@ -c $<
+
+$(OBJ_DIR)/main_vinterp.o:	$(OBJ_DIR)/module_grid.o $(OBJ_DIR)/module_io.o $(OBJ_DIR)/module_interp.o
+$(OBJ_DIR)/main_uvg_hpg.o:	$(OBJ_DIR)/module_grid.o $(OBJ_DIR)/module_io.o
+$(OBJ_DIR)/main_drown.o:	$(OBJ_DIR)/module_grid.o $(OBJ_DIR)/module_io.o
+$(OBJ_DIR)/module_io.o:
+$(OBJ_DIR)/module_interp.o:
+$(OBJ_DIR)/module_grid.o: $(OBJ_DIR)/module_io.o
Index: /utils/tools_ticket2413/ABL_TOOLS/main_drown.F90
===================================================================
--- /utils/tools_ticket2413/ABL_TOOLS/main_drown.F90	(revision 12863)
+++ /utils/tools_ticket2413/ABL_TOOLS/main_drown.F90	(revision 12863)
@@ -0,0 +1,347 @@
+PROGRAM main
+   !!======================================================================
+   !!                     ***  PROGRAM main  ***
+   !!
+   !! ** Purpose : horizontal extrapolation ("drowning") of ECMWF dataset
+   !!
+   !! 
+   !!======================================================================
+   !! History : 2016-10  (F. Lemarié)  Original code largely inspired by SOSIE (L. Brodeau & J.M. Molines)
+   !!   
+   !!----------------------------------------------------------------------
+   USE module_io       ! I/O routines
+   USE module_grid     ! compute input and output grids 
+   !!
+   IMPLICIT NONE
+   !!----------------------------------------------------------------------
+   !! 
+   !!  
+   !! 
+   !!----------------------------------------------------------------------
+   !
+   INTEGER                                  :: ji,jj,jk,kt,kv,jjp1,jjm1,jip1,jim1
+   INTEGER                                  :: jpka,jpvar            ! number of vertical levels for input and target grids 
+   INTEGER                                  :: jpi , jpj             ! number of grid points in x and y directions                 
+   INTEGER                                  :: jptime,ctrl,niter,status,ncid
+   INTEGER                                  :: ioerr
+   INTEGER, PARAMETER                       :: stdout   = 6
+   INTEGER, PARAMETER                       :: max_iter = 50
+   !!
+   REAL(8)                                  :: cff,cff1,cff2
+   !!  
+   REAL(8), ALLOCATABLE, DIMENSION(:,:,:,:) :: varin
+   REAL(8), ALLOCATABLE, DIMENSION(:,:    ) :: tmask, tmask2, ff_t
+   REAL(8), ALLOCATABLE, DIMENSION(:,:    ) :: mask_coast, maskv              ! land-sea mask   
+   REAL(8), ALLOCATABLE, DIMENSION(:,:    ) :: varold,varnew   
+   REAL(8), ALLOCATABLE, DIMENSION(:      ) :: tmp1d, lat
+   !!
+   CHARACTER(len=500)                       :: file_u,file_v,file_hpg,file_geos ! ERAi files containing wind components 
+   CHARACTER(len=500)                       :: file_t,file_q, file_m   ! ERAi files containing tracers and mask 
+   CHARACTER(len=500)                       :: file_z,file_p,cn_dir    ! ERAi files containing surface geopot and pressure
+   CHARACTER(len=500)                       :: abl_file, grd_file, drwn_file, out_file
+   CHARACTER(len=500)                       :: namelistf              
+   CHARACTER(len=500)                       :: argument   
+   CHARACTER(len= 20), DIMENSION(4)         :: dimnames
+   CHARACTER(:), ALLOCATABLE, DIMENSION(:)  :: varnames
+   CHARACTER(6)                             :: mask_var            ! name of mask variable in file_m file  
+   CHARACTER(6)                             :: var_name
+   !!
+   LOGICAL                                  :: ln_read_zsurf      ! read surface geopotential or not
+   LOGICAL                                  :: ln_read_mask       ! read land-sea mask or not
+   LOGICAL                                  :: ln_perio_latbc     ! use periodic BC along the domain latitudinal edges (for global data) or use zero-gradient BC (for regional data)
+   LOGICAL                                  :: ln_c1d             ! output only a single column in output file
+   LOGICAL                                  :: ln_hpg_frc         ! compute horizontal pressure gradient
+   LOGICAL                                  :: ln_geo_wnd         ! compute goestrophic wind components 
+   LOGICAL                                  :: ln_slp_smth        ! apply gibbs oscillation filetring on mean sea level pressure
+   LOGICAL                                  :: ln_drw_smth        ! apply gibbs oscillation filetring on mean sea level pressure
+   LOGICAL                                  :: ln_slp_log         ! log(sea-level pressure) or sea-level pressure
+   LOGICAL                                  :: ln_lsm_land        ! if T mask is 1 over land and 0 over ocean if F it is the other way around
+   INTEGER                                  :: ptemp_method       ! way to compute potential temperature 
+   !!
+   REAL(8), PARAMETER     :: omega =   7.292116e-05
+   REAL(8), PARAMETER     :: rad   =   3.141592653589793 / 180.
+
+
+   !!---------------------------------------------------------------------
+   !! List of variables read in the namelist file 
+   NAMELIST/nml_out/    grd_file, abl_file, drwn_file, var_name
+   NAMELIST/nml_opt/    ptemp_method, ln_slp_log, ln_slp_smth, ln_read_mask, ln_perio_latbc, &
+      &                 ln_hpg_frc, ln_geo_wnd, ln_c1d, ln_read_zsurf, ln_lsm_land, ln_drw_smth
+   NAMELIST/nml_fld/    cn_dir, file_u, file_v, file_t,              &
+      &                 file_q, file_z, file_p, file_hpg, file_geos, &
+      &                 file_m, mask_var
+   !!
+   !! get the namelist file name
+   CALL get_command_argument(1, argument, ctrl, status)
+   !
+   SELECT CASE(status)
+   CASE(0)
+      namelistf = trim(argument)
+   CASE(-1)
+      WRITE(stdout,*) "### Error: file name too long"
+      STOP
+   CASE DEFAULT
+      namelistf = 'namelist_abl_tools'
+   END SELECT
+   !!---------------------------------------------------------------------
+
+
+   !!---------------------------------------------------------------------   
+   !! read namelist variables
+   ctrl = 0
+   OPEN(50, file=namelistf, status='old', form='formatted', access='sequential', iostat=ioerr)
+   IF (ioerr /= 0) ctrl = ctrl + 1   
+   READ(50,nml_opt, iostat=ioerr); IF (ioerr /= 0) ctrl = ctrl + 1
+   READ(50,nml_fld, iostat=ioerr); IF (ioerr /= 0) ctrl = ctrl + 1
+   READ(50,nml_out, iostat=ioerr); IF (ioerr /= 0) ctrl = ctrl + 1
+   
+   IF (ctrl > 0) then
+      WRITE(stdout,*) "### E R R O R while reading namelist file '",trim(namelistf),"'"
+      WRITE(stdout,*) " ctrl = ",ctrl
+      STOP
+   ELSE 
+      WRITE(stdout,*) " Namelist file ",trim(namelistf)," OK "    
+   END IF
+   !!-------------------------------------------------------------------------------------   
+   !! list of variables to treat
+   !!
+   !! get the variable name
+   CALL get_command_argument( 2, argument, ctrl, status)
+   SELECT CASE(status)
+   CASE(0)
+      var_name = trim(argument)
+   CASE(-1)
+      WRITE(stdout,*) "### Error: file name too long"
+      STOP
+   END SELECT
+   WRITE(stdout,*) "var_name: ", trim(var_name), Len_Trim(var_name)
+   !
+   IF (Len_Trim(var_name) == 0) THEN
+     jpvar    = 7
+     allocate(character(len=20) :: varnames(jpvar) )
+     varnames(1:5) = [character(len=4) :: 'slp', 'uwnd', 'vwnd', 'tair', 'humi' ]
+     IF (ln_hpg_frc) varnames(6:7) = [character(len=4) :: 'uhpg', 'vhpg' ]
+     IF (ln_geo_wnd) varnames(6:7) = [character(len=4) :: 'ugeo', 'vgeo' ]
+     IF( .NOT. Var_Existence( varnames(5), trim(cn_dir)//'/'//trim(abl_file) ) ) jpvar = jpvar - 1
+     IF( .NOT. Var_Existence( varnames(6), trim(cn_dir)//'/'//trim(abl_file) ) ) jpvar = jpvar - 1 
+   ELSE
+     jpvar     = 1 
+     allocate(character(len=20) :: varnames(jpvar) )
+     varnames  = var_name
+     abl_file  = trim(var_name)//'_'//trim( abl_file)
+     drwn_file = trim(var_name)//'_'//trim(drwn_file)
+   END IF 
+   WRITE(stdout,*) "Number of variables to treat : ",jpvar    
+   !!-------------------------------------------------------------------------------------    
+   !! read the dimensions for the input files
+   CALL Read_Ncdf_dim ( 'jpka' , trim(cn_dir)//'/'//trim(abl_file), jpka    ) 
+   CALL Read_Ncdf_dim ( 'time' , trim(cn_dir)//'/'//trim(abl_file), jptime  ) 
+   CALL Read_Ncdf_dim ( 'lon'  , trim(cn_dir)//'/'//trim(abl_file), jpi     )     
+   CALL Read_Ncdf_dim ( 'lat'  , trim(cn_dir)//'/'//trim(abl_file), jpj     )        
+   WRITE(stdout,*) "jpka, jptime, jpi, jpj: ", jpka, jptime, jpi, jpj
+   !
+   !!---------------------------------------------------------------------
+
+
+   !!---------------------------------------------------------------------
+   !! allocate arrays  
+   ALLOCATE(varin (1:jpi,1:jpj,1:jpka,1))
+   ALLOCATE(tmask (1:jpi,1:jpj    ))
+   ALLOCATE(tmask2(1:jpi,1:jpj    ))
+   ALLOCATE(maskv      (1:jpi,1:jpj )) 
+   ALLOCATE(mask_coast (1:jpi,1:jpj ))      
+   ALLOCATE(varold     (1:jpi,1:jpj ))  
+   ALLOCATE(varnew     (1:jpi,1:jpj ))     
+
+   !!---------------------------------------------------------------------
+   !! Read the mask and remove some closed seas 
+   IF (ln_read_mask) THEN
+     CALL init_atm_mask(jpi,jpj,trim(cn_dir)//'/'//trim(file_m),trim(mask_var),ln_lsm_land, tmask )
+     CALL Read_Ncdf_var ( 'tmask' , trim(cn_dir)//'/'//trim(abl_file), tmask2(:,:) )
+   ELSE
+     tmask(:,:)  = 1.
+     tmask2(:,:) = 1.
+   END IF
+   !!   
+
+
+
+   !!---------------------------------------------------------------------   
+   !! create output file
+   !!
+   out_file = trim(cn_dir)//'/'//trim(drwn_file)
+   CALL Init_output_File ( jpi, jpj, jpka-1, trim(cn_dir)//'/'//trim(abl_file), out_file, tmask(:,:) )
+
+   !!---------------------------------------------------------------------   
+   !! Initialize the name of the dimensions for the result of the drowning
+   !!
+   dimnames(1) = 'lon'
+   dimnames(2) = 'lat'       
+   dimnames(3) = 'jpka'
+   dimnames(4) = 'time'  
+
+   CALL Write_Ncdf_var( 'tmask', dimnames(1:2), trim(out_file), tmask2, 'float' )
+
+   !!---------------------------------------------------------------------
+   ! Read time variable
+   ALLOCATE(tmp1d (1:jptime))    
+   ALLOCATE(lat   (1:jpj))    
+   CALL Read_Ncdf_var ( 'time', trim(cn_dir)//'/'//trim(file_t), tmp1d )    
+   CALL Read_Ncdf_var ( 'lat' , trim(cn_dir)//'/'//trim(file_t), lat )      !<-- latitude  
+   !!---------------------------------------------------------------------     
+
+   ! force drowning in the equatorial band with geo wind
+   IF (ln_geo_wnd) THEN
+     ALLOCATE( ff_t(1:jpi,1:jpj) )
+     DO jj = 1, jpj
+        DO ji = 1, jpi
+           ff_t(ji,jj) = 2. * omega * SIN( rad * lat(jj) )
+           IF (abs(ff_t(ji,jj)) < 2.5e-5) tmask2(ji,jj) = 0. 
+        END DO
+     END DO   
+   END IF
+
+   !===========
+   DO kv = 1,jpvar
+   !===========
+      DO kt = 1,jptime
+      !===========
+
+         IF( kv == 1 ) THEN
+           CALL Write_Ncdf_var( 'time', dimnames(4:4), trim(out_file), tmp1d(kt:kt), kt, 'double' )
+         ENDIF
+
+         ! Read variable to treat
+         print*,'Treat variable ',trim(varnames(kv)),' at time level ',kt
+         IF (trim(varnames(kv)).EQ."slp") THEN
+           CALL Read_Ncdf_var ( trim(varnames(kv)), trim(cn_dir)//'/'//trim(file_hpg), varin(:,:,1,1),  kt )
+         ELSE
+           CALL Read_Ncdf_var ( trim(varnames(kv)), trim(cn_dir)//'/'//trim(abl_file), varin,  kt )
+         END IF
+
+
+         !===========
+         DO jk = 1,jpka
+         !===========
+
+            IF ( (trim(varnames(kv))=="uwnd").OR.(trim(varnames(kv))=="vwnd").OR. &
+               & (trim(varnames(kv))=="ugeo").OR.(trim(varnames(kv))=="vgeo").OR. &
+               & (trim(varnames(kv))=="uhpg").OR.(trim(varnames(kv))=="vhpg") ) THEN
+                 maskv (1:jpi,1:jpj     ) = tmask2(1:jpi,1:jpj )
+            ELSE
+                 maskv (1:jpi,1:jpj     ) = tmask(1:jpi,1:jpj )
+            END IF
+
+
+            varold (1:jpi,1:jpj) = varin(1:jpi,1:jpj,jk,1)
+            varnew (1:jpi,1:jpj) = varin(1:jpi,1:jpj,jk,1)            
+            mask_coast(1:jpi,1:jpj) = 0.
+
+            !$$$$$$$$$$$$$$$$
+            DO niter = 1, max_iter
+            !$$$$$$$$$$$$$$$$                 
+
+               varold(1:jpi,1:jpj) = varnew (1:jpi,1:jpj)
+
+               IF ( .NOT. (ANY(maskv == 0))  ) THEN
+                  EXIT
+               END IF
+
+               !+++++++++++++++++++++++++++++++++++
+               ! Build mask_coast
+               DO jj = 1,jpj
+                  DO ji = 1,jpi
+
+                     IF (ln_perio_latbc) THEN
+                       jip1 = ji + 1; if(ji==jpi) jip1 = 1
+                       jim1 = ji - 1; if(ji==  1) jim1 = jpi
+                     ELSE
+                       jip1 = ji + 1; if(ji==jpi) jip1 = jpi-1
+                       jim1 = ji - 1; if(ji==  1) jim1 = 2
+                     END IF
+                     jjp1 = jj + 1; if(jj==jpj) jjp1 = jpj-1
+                     jjm1 = jj - 1; if(jj==  1) jjm1 = 2
+
+                     cff  = (1.-maskv(ji,jj))
+                     cff1 = maskv(ji,jjp1)+maskv(jip1,jj)+maskv(jim1,jj)+maskv(ji,jjm1) 
+                     mask_coast(ji,jj) = cff * cff1 
+                     IF( mask_coast(ji,jj) > 0. ) mask_coast(ji,jj) = 1.
+
+                  END DO
+               END DO   
+               !+++++++++++++++++++++++++++++++++++          
+
+               DO jj=1,jpj
+                  DO ji=1,jpi
+
+                     IF ( mask_coast(ji,jj) == 1. ) THEN
+
+                        IF (ln_perio_latbc) THEN
+                          jip1 = ji + 1; if(ji==jpi) jip1 = 1
+                          jim1 = ji - 1; if(ji==  1) jim1 = jpi
+                        ELSE
+                          jip1 = ji + 1; if(ji==jpi) jip1 = jpi-1
+                          jim1 = ji - 1; if(ji==  1) jim1 = 2
+                        END IF
+                        jjp1 = jj + 1; if(jj==jpj) jjp1 = jpj-1
+                        jjm1 = jj - 1; if(jj==  1) jjm1 = 2
+
+                        cff  = maskv(jim1,jjm1)+maskv(jim1,jj)+maskv(jim1,jjp1) &
+                           & + maskv(ji  ,jjm1)+               maskv(ji  ,jjp1) &
+                           & + maskv(jip1,jjm1)+maskv(jip1,jj)+maskv(jip1,jjp1)
+
+                        varnew(ji,jj) = (1./cff)*(                                   &
+                           &                    varold(jim1,jjm1)*maskv(jim1,jjm1)   &
+                           &              +     varold(jim1,jj  )*maskv(jim1,jj  )   &
+                           &              +     varold(jim1,jjp1)*maskv(jim1,jjp1)   &
+                           &              +     varold(ji  ,jjm1)*maskv(ji  ,jjm1)   &
+                           &              +     varold(ji  ,jjp1)*maskv(ji  ,jjp1)   &                
+                           &              +     varold(jip1,jjm1)*maskv(jip1,jjm1)   &
+                           &              +     varold(jip1,jj  )*maskv(jip1,jj  )   &
+                           &              +     varold(jip1,jjp1)*maskv(jip1,jjp1)   )
+
+                     END IF
+
+                  END DO
+               END DO   
+               !+++++++++++++++++++++++++++++++++++
+               maskv(1:jpi,1:jpj) = maskv(1:jpi,1:jpj) + mask_coast(1:jpi,1:jpj)
+               !+++++++++++++++++++++++++++++++++++                   
+           !$$$$$$$$$$$$$$$$
+           END DO
+           !$$$$$$$$$$$$$$$$
+
+           ! SMOOTHING AFTER DROWNING
+           IF (ln_drw_smth) THEN
+             maskv (1:jpi,1:jpj     ) = 1.
+           ELSE
+             !!only over continent
+             maskv (1:jpi,1:jpj     ) = 1. - tmask(1:jpi,1:jpj  )
+           END IF        
+
+           CALL smooth_field( jpi, jpj, varnew, maskv, 3 )
+           varin(1:jpi,1:jpj,jk,1) = varnew(1:jpi,1:jpj)
+
+           IF (trim(varnames(kv)).EQ."slp") EXIT
+
+        !===========
+        END DO ! jk
+        !===========
+
+        IF (trim(varnames(kv)).EQ."slp") THEN
+          CALL Write_Ncdf_var ( trim(varnames(kv)), dimnames(1:4), trim(cn_dir)//'/'//drwn_file, varin(:,:,1,1), kt, 'float' )
+        ELSE
+          CALL Write_Ncdf_var ( trim(varnames(kv)), dimnames(1:4), trim(cn_dir)//'/'//drwn_file, varin(:,:,:,:), kt, 'float' )
+        END IF
+
+      !===========
+      END DO ! time
+      !===========
+
+   !===========
+   END DO ! variable
+   !===========
+
+   STOP
+   !
+END PROGRAM main
Index: /utils/tools_ticket2413/ABL_TOOLS/main_uvg_hpg.F90
===================================================================
--- /utils/tools_ticket2413/ABL_TOOLS/main_uvg_hpg.F90	(revision 12863)
+++ /utils/tools_ticket2413/ABL_TOOLS/main_uvg_hpg.F90	(revision 12863)
@@ -0,0 +1,647 @@
+PROGRAM main
+   !!======================================================================
+   !!                     ***  PROGRAM main  ***
+   !!
+   !! ** Purpose : compute geostrophic wind or horizontal pressure gradient
+   !!              from ECMWF atmospheric model vertical levels altitude, 
+   !!              temperature and humidity 3D fields
+   !! 
+   !!======================================================================
+   !! History : 2016-10  (F. Lemarié)  Original code
+   !!   
+   !!----------------------------------------------------------------------
+   USE module_io       ! I/O routines
+   USE module_grid     ! compute input and output grids 
+   !!
+   IMPLICIT NONE
+   !!----------------------------------------------------------------------
+   !! 
+   !!  
+   !! 
+   !!----------------------------------------------------------------------
+   !
+   INTEGER                                  :: ji,jj,jk,kt, nhym, nhyi
+   INTEGER                                  :: jpka                  ! number of vertical levels for input and target grids 
+   INTEGER                                  :: jpi , jpj             ! number of grid points in x and y directions     
+   INTEGER                                  :: status             
+   INTEGER                                  :: jptime,ctrl
+   INTEGER                                  :: ioerr,ncid
+   INTEGER, ALLOCATABLE, DIMENSION(:,:  )   :: ind  
+   INTEGER, PARAMETER                       :: stdout  = 6
+   !!
+   REAL(8)                                  :: cff,tv
+   !!  
+   REAL(8), ALLOCATABLE, DIMENSION(:      ) :: lev                ! A coefficients to reconstruct ECMWF grid
+   REAL(8), ALLOCATABLE, DIMENSION(:      ) :: A_w                ! A coefficients to reconstruct ECMWF grid
+   REAL(8), ALLOCATABLE, DIMENSION(:      ) :: B_w                ! B coefficients to reconstruct ECMWF grid
+   REAL(8), ALLOCATABLE, DIMENSION(:      ) :: B_r                ! B coefficients to reconstruct ECMWF grid   
+   REAL(8), ALLOCATABLE, DIMENSION(:      ) :: A_r                ! A coefficients to reconstruct ECMWF grid
+   REAL(8), ALLOCATABLE, DIMENSION(:      ) :: ph,lon,lat   
+   REAL(8), ALLOCATABLE, DIMENSION(:,:,:  ) :: e3t,ghw                ! thickness of vertical layers in target grid
+   REAL(8), ALLOCATABLE, DIMENSION(:      ) :: tmp1d, tmp_fullw, tmp_fullm ! temporary/working 1D arrays
+   REAL(8), ALLOCATABLE, DIMENSION(:,:,:,:) :: humi
+   REAL(8), ALLOCATABLE, DIMENSION(:,:,:,:) :: temp
+   REAL(8), ALLOCATABLE, DIMENSION(:,:,:,:) :: uhpg
+   REAL(8), ALLOCATABLE, DIMENSION(:,:,:,:) :: vhpg
+   REAL(8), ALLOCATABLE, DIMENSION(:,:    ) :: slp, zsurf, zsurf_smth, slp_smth, ghw_smth !, slp_mask, ghw_mask
+   REAL(8), ALLOCATABLE, DIMENSION(:,:    ) :: dx,dy,ff_t,tmask, tmask2
+   REAL(8), ALLOCATABLE, DIMENSION(:,:    ) :: FX,FE,wrkx,wrke
+   REAL(8), ALLOCATABLE, DIMENSION(:,:    ) :: dZx,dZe
+   !!
+   CHARACTER(len=500)                       :: file_u,file_v,file_hpg, file_geos ! ECMWF files containing wind components 
+   CHARACTER(len=500)                       :: file_t,file_q, file_m             ! ECMWF files containing tracers and mask 
+   CHARACTER(len=500)                       :: file_z,file_p,cn_dir              ! ECMWF files containing surface geopot and pressure
+   CHARACTER(len=500)                       :: out_file      
+   CHARACTER(len=500)                       :: namelistf
+   CHARACTER(len=500)                       :: argument   
+   CHARACTER(len= 20),DIMENSION(4)          :: dimnames
+   CHARACTER(len= 20),DIMENSION(4)          :: varnames
+   CHARACTER(6)                             :: mask_var           ! name of mask variable in file_m file  
+   !!
+   LOGICAL                                  :: ln_read_zsurf      ! read surface geopotential or not
+   LOGICAL                                  :: ln_read_mask       ! read land-sea mask or not
+   LOGICAL                                  :: ln_perio_latbc     ! use periodic BC along the domain latitudinal edges (for global data) or use zero-gradient BC (for regional data)
+   LOGICAL                                  :: ln_c1d             ! output only a single column in output file
+   LOGICAL                                  :: ln_hpg_frc         ! compute horizontal pressure gradient
+   LOGICAL                                  :: ln_geo_wnd         ! compute goestrophic wind components 
+   LOGICAL                                  :: ln_slp_smth        ! apply gibbs oscillation filetring on mean sea level pressure
+   LOGICAL                                  :: ln_drw_smth        ! apply gibbs oscillation filetring on mean sea level pressure
+   LOGICAL                                  :: ln_slp_log         ! log(sea-level pressure) or sea-level pressure
+   LOGICAL                                  :: ln_lsm_land        ! if T mask is 1 over land and 0 over ocean if F it is the other way around
+   LOGICAL                                  :: ln_impose_z1       ! impose the altitude of the first level in target grid
+   INTEGER                                  :: ptemp_method       ! way to compute potential temperature 
+                                                                  ! = 0  (absolute temperature)
+                                                                  ! = 1  (potential temperature with local ref pressure)
+                                                                  ! = 2  (potential temperature with global ref pressure on temperature perturbation)
+                                                                  ! = 3  (potential temperature with global ref pressure)
+   !!   
+   REAL(8), PARAMETER     :: grav  =   9.80665
+   REAL(8), PARAMETER     :: Rd    = 287.058   
+   REAL(8), PARAMETER     :: zvir  =   0.609133 
+   REAL(8), PARAMETER     :: omega =   7.292116e-05
+   REAL(8), PARAMETER     :: rad   =   3.141592653589793 / 180.
+   REAL(8), PARAMETER     :: rt    = 6371229.
+   REAL(8), PARAMETER     :: lat_smth = 0. !65.   !!GS: possibility to smooth only above a selected latitude
+
+
+   !!---------------------------------------------------------------------
+   !! List of variables read in the namelist file 
+   NAMELIST/nml_opt/    ptemp_method, ln_slp_log, ln_slp_smth, ln_read_mask, ln_perio_latbc, & 
+      &                 ln_hpg_frc, ln_geo_wnd, ln_c1d, ln_read_zsurf, ln_lsm_land, ln_drw_smth
+   NAMELIST/nml_fld/    cn_dir, file_u, file_v, file_t,               &
+      &                 file_q, file_z, file_p, file_hpg, file_geos,  &
+      &                 file_m, mask_var
+   !!
+   !! get the namelist file name
+   CALL get_command_argument( 1, argument, ctrl, status)
+   !
+   SELECT CASE(status)
+   CASE(0)
+      namelistf = trim(argument)
+   CASE(-1)
+      WRITE(stdout,*) "### Error: file name too long"
+      STOP
+   CASE DEFAULT
+      namelistf = 'namelist_abl_tools'
+   END SELECT
+   !!---------------------------------------------------------------------
+
+
+   !!---------------------------------------------------------------------
+   !! read namelist variables
+   ctrl = 0
+   OPEN(50, file=namelistf, status='old', form='formatted', access='sequential', iostat=ioerr)
+   IF (ioerr /= 0) ctrl = ctrl + 1   
+   READ(50,nml_opt, iostat=ioerr); IF (ioerr /= 0) ctrl = ctrl + 1   
+   READ(50,nml_fld, iostat=ioerr); IF (ioerr /= 0) ctrl = ctrl + 1
+   
+   IF (ctrl > 0) then
+      WRITE(stdout,*) "### E R R O R while reading namelist file '",trim(namelistf),"'"
+      WRITE(stdout,*) " ctrl = ",ctrl
+      STOP
+   ELSE 
+      WRITE(stdout,*) " Namelist file ",trim(namelistf), " OK "    
+   END IF
+
+   IF(ln_hpg_frc) THEN
+      out_file = trim(cn_dir)//'/'//trim(file_hpg)
+   ELSE IF(ln_geo_wnd) THEN
+      out_file = trim(cn_dir)//'/'//trim(file_geos)   
+   ELSE
+      WRITE(stdout,*) "### E R R O R in namelist variable "
+      WRITE(stdout,*) "either ln_hpg_frc or ln_geo_wnd should be set to True"
+      STOP       
+   END IF
+   !!---------------------------------------------------------------------   
+       
+       
+   !!---------------------------------------------------------------------
+   ! check files content
+   CALL Read_Ncdf_dim('lev',trim(cn_dir)//'/'//trim(file_t),jpka)   
+   !                          geop_surf  temp  humi  pressure
+   varnames = [ character(len=3) :: 'Z', 'T', 'Q', 'MSL' ]
+   IF (ln_read_zsurf) varnames(4) = "SP"
+   IF (ln_slp_log)    varnames(4) = "LNSP"
+
+   ctrl = 0
+   IF (ln_read_zsurf) THEN
+     IF( .not. VAR_EXISTENCE( trim(varnames(1)) , trim(cn_dir)//'/'//trim(file_z) ) ) ctrl = ctrl + 1 
+   END IF
+   IF ( .not. VAR_EXISTENCE( trim(varnames(2)) , trim(cn_dir)//'/'//trim(file_t) ) ) ctrl = ctrl + 1 
+   IF ( .not. VAR_EXISTENCE( trim(varnames(3)) , trim(cn_dir)//'/'//trim(file_q) ) ) ctrl = ctrl + 1   
+   IF ( .not. VAR_EXISTENCE( trim(varnames(4)) , trim(cn_dir)//'/'//trim(file_p) ) ) ctrl = ctrl + 1
+   WRITE(*,*) " pressure variable name: ", varnames(4)
+ 
+   IF ( ctrl > 0 ) THEN  
+      WRITE(stdout,*) "### E R R O R while reading ECMWF atmospheric files "
+      STOP
+   ELSE
+      WRITE(stdout,*) " ECMWF atmospheric files OK "        
+   END IF
+   !!---------------------------------------------------------------------
+   
+
+   !!---------------------------------------------------------------------
+   !! read the dimensions for the input files
+   CALL Read_Ncdf_dim ( 'time', trim(cn_dir)//'/'//trim(file_t), jptime  ) 
+   CALL Read_Ncdf_dim ( 'lon' , trim(cn_dir)//'/'//trim(file_t), jpi     )     
+   CALL Read_Ncdf_dim ( 'lat' , trim(cn_dir)//'/'//trim(file_t), jpj     )     
+   CALL Read_Ncdf_dim ( 'nhym' , trim(cn_dir)//'/'//trim(file_t), nhym   )
+   CALL Read_Ncdf_dim ( 'nhyi' , trim(cn_dir)//'/'//trim(file_t), nhyi   )
+   !
+   !!---------------------------------------------------------------------
+
+
+   !!---------------------------------------------------------------------
+   !! allocate arrays  
+   ALLOCATE( A_w    (               0:jpka   ) )         
+   ALLOCATE( B_w    (               0:jpka   ) )     
+   ALLOCATE( B_r    (               1:jpka   ) )
+   ALLOCATE( A_r    (               1:jpka   ) )   
+
+   ALLOCATE( e3t    ( 1:jpi, 1:jpj, 1:jpka   ) )
+   ALLOCATE( ghw    ( 1:jpi, 1:jpj, 0:jpka   ) ) 
+   ALLOCATE( slp_smth(1:jpi, 1:jpj           ) )
+   ALLOCATE( ghw_smth(1:jpi, 1:jpj           ) )
+   ALLOCATE( slp    ( 1:jpi, 1:jpj           ) )
+   ALLOCATE( zsurf  ( 1:jpi, 1:jpj           ) )
+   ALLOCATE( zsurf_smth  ( 1:jpi, 1:jpj           ) )
+   ALLOCATE( temp   ( 1:jpi, 1:jpj, 1:jpka, 1) )
+   ALLOCATE( humi   ( 1:jpi, 1:jpj, 1:jpka, 1) )   
+   ALLOCATE( uhpg   ( 1:jpi, 1:jpj, 1:jpka, 1) )
+   ALLOCATE( vhpg   ( 1:jpi, 1:jpj, 1:jpka, 1) )   
+   ALLOCATE( ph     (               0:jpka   ) ) 
+   ALLOCATE( dx     ( 1:jpi, 1:jpj           ) ) 
+   ALLOCATE( dy     ( 1:jpi, 1:jpj           ) )         
+   ALLOCATE( FX     ( 1:jpi, 1:jpj           ) ) 
+   ALLOCATE( FE     ( 1:jpi, 1:jpj           ) ) 
+   ALLOCATE( dzx    ( 0:jpi, 1:jpj           ) ) 
+   ALLOCATE( dze    ( 1:jpi, 0:jpj           ) ) 
+   ALLOCATE( wrkx   ( 1:jpi, 1:jpj           ) )      
+   ALLOCATE( wrke   ( 1:jpi, 1:jpj           ) )  
+   ALLOCATE( tmask  ( 1:jpi, 1:jpj           ) ) 
+   ALLOCATE( tmask2 ( 1:jpi, 1:jpj           ) ) 
+   IF (jpka.NE.nhym) THEN
+     ALLOCATE( tmp_fullw(1:nhyi) )
+     ALLOCATE( tmp_fullm(1:nhym) )
+   END IF
+
+   !!---------------------------------------------------------------------
+   !! Read the mask and remove some closed seas 
+   IF (ln_read_mask) THEN
+     CALL init_atm_mask( jpi, jpj, trim(cn_dir)//'/'//trim(file_m), trim(mask_var), ln_lsm_land, tmask)
+   ELSE
+     tmask(:,:) = 1.
+   END IF
+   tmask2 = tmask
+   !!   
+   
+   !! Read the static A and B coefficients for the ECMWF vertical grid
+   IF (jpka.EQ.nhym) THEN
+     CALL Read_Ncdf_var    ( 'hyai', trim(cn_dir)//'/'//trim(file_t), A_w )
+     CALL Read_Ncdf_var    ( 'hybi', trim(cn_dir)//'/'//trim(file_t), B_w )   
+     CALL Read_Ncdf_var    ( 'hyam', trim(cn_dir)//'/'//trim(file_t), A_r ) 
+     CALL Read_Ncdf_var    ( 'hybm', trim(cn_dir)//'/'//trim(file_t), B_r ) 
+   ELSE
+     CALL Read_Ncdf_var    ( 'hyai', trim(cn_dir)//'/'//trim(file_t), tmp_fullw )
+     A_w(0:jpka) = tmp_fullw(nhyi-(jpka+1)+1:nhyi)
+     CALL Read_Ncdf_var    ( 'hybi', trim(cn_dir)//'/'//trim(file_t), tmp_fullw )
+     B_w(0:jpka) = tmp_fullw(nhyi-(jpka+1)+1:nhyi)
+     CALL Read_Ncdf_var    ( 'hyam', trim(cn_dir)//'/'//trim(file_t), tmp_fullm )
+     A_r(1:jpka) = tmp_fullm(nhym-jpka+1:nhym)
+     CALL Read_Ncdf_var    ( 'hybm', trim(cn_dir)//'/'//trim(file_t), tmp_fullm )
+     B_r(1:jpka) = tmp_fullm(nhym-jpka+1:nhym)
+   END IF
+
+   ALLOCATE(lat(1:jpj),lon(1:jpi),ff_t(1:jpi,1:jpj),lev(1:jpka))            
+   CALL Read_Ncdf_var ( 'lon' , trim(cn_dir)//'/'//trim(file_t), lon )      !<-- longitude
+   CALL Read_Ncdf_var ( 'lat' , trim(cn_dir)//'/'//trim(file_t), lat )      !<-- latitude  
+   CALL Read_Ncdf_var ( 'lev' , trim(cn_dir)//'/'//trim(file_t), lev )    
+
+
+   !!---------------------------------------------------------------------
+   !++ Compute Coriolis frequency at cell centers
+   !    
+   DO jj = 1, jpj
+      DO ji = 1, jpi
+         ff_t(ji,jj) = 2. * omega * SIN( rad * lat(jj) )
+      END DO
+   END DO   
+
+
+   !!---------------------------------------------------------------------
+   !++ Compute dx and dy at cell centers
+   !
+   dx(:,:) = 0.
+   dy(:,:) = 0.
+   DO jj = 2, jpj-1
+      DO ji = 1, jpi-1
+         dx(ji,jj) = rt * rad * abs( lon(ji+1) - lon(ji) ) * COS( rad * lat(jj) )
+      END DO
+   END DO 
+   dx(  jpi,1:jpj) = dx(  jpi-1,1:jpj  )
+   dx(1:jpi,  jpj) = dx(1:jpi  ,  jpj-1)
+   dx(1:jpi,1    ) = dx(1:jpi  ,2      )
+   !++ 
+   DO jj = 1, jpj-1
+      DO ji = 1, jpi   
+         dy(ji,jj) = rt * rad * abs( lat(jj+1) - lat(jj) )
+      END DO
+   END DO   
+   dy(1:jpi,jpj) = dy(1:jpi,jpj-1) 
+
+
+   !!---------------------------------------------------------------------   
+   !! create output file
+   !!
+   status   = nf90_create( trim(out_file), NF90_WRITE, ncid )
+   status   = nf90_close ( ncid )      
+
+   CALL Write_Ncdf_dim ( 'lon'    , trim(out_file), jpi    )
+   CALL Write_Ncdf_dim ( 'lat'    , trim(out_file), jpj    )
+   CALL Write_Ncdf_dim ( 'lev'    , trim(out_file), jpka   )
+   CALL Write_Ncdf_dim ( 'nhym'   , trim(out_file), jpka   )  
+   CALL Write_Ncdf_dim ( 'nhyi'   , trim(out_file), jpka+1 )  
+   CALL Write_Ncdf_dim ( 'time'   , trim(out_file), 0      )    
+
+
+   !!---------------------------------------------------------------------   
+   !! Initialize the name of the dimensions for geostrophic winds in the output file
+   !!
+   dimnames(1) = 'lon'
+   dimnames(2) = 'lat'       
+   dimnames(3) = 'lev'
+   dimnames(4) = 'time'
+
+   CALL Write_Ncdf_var(  'lon',  'lon', trim(out_file), lon, 'double' ) 
+   CALL Write_Ncdf_var(  'lat',  'lat', trim(out_file), lat, 'double' ) 
+   CALL Write_Ncdf_var(  'lev',  'lev', trim(out_file), lev, 'double' )
+   CALL Write_Ncdf_var( 'hyai', 'nhyi', trim(out_file), A_w, 'double' ) 
+   CALL Write_Ncdf_var( 'hybi', 'nhyi', trim(out_file), B_w, 'double' ) 
+   CALL Write_Ncdf_var( 'hyam', 'nhym', trim(out_file), A_r, 'double' )
+   CALL Write_Ncdf_var( 'hybm', 'nhym', trim(out_file), B_r, 'double' )
+
+   CALL Write_Ncdf_var( 'tmask', dimnames(1:2), trim(out_file), tmask, 'float' )
+
+
+   !!---------------------------------------------------------------------
+   ! Read time variable
+   ALLOCATE(tmp1d (1:jptime))    
+   CALL Read_Ncdf_var ( 'time', trim(cn_dir)//'/'//trim(file_t), tmp1d )    
+   !!---------------------------------------------------------------------     
+
+
+   DO kt=1,jptime  
+   !
+      WRITE(stdout,*) '======================'
+      WRITE(stdout,*) 'time = ',kt,'/',jptime   
+      !
+      CALL Write_Ncdf_var( 'time', dimnames(4:4), trim(out_file), tmp1d(kt:kt), kt, 'double' )
+      !
+      IF( kt == 1 ) THEN
+         CALL Duplicate_lon_lat_time( trim(cn_dir)//'/'//trim(file_t), out_file )
+         CALL Duplicate_lev_hyb     ( trim(cn_dir)//'/'//trim(file_t), out_file ) 
+      ENDIF      
+      !
+      IF ( varnames(4) == "LNSP" ) THEN
+         CALL Read_Ncdf_var( varnames(4) , trim(cn_dir)//'/'//trim(file_p), slp(:,:),  kt, 1 )      !<-- log of surface pressure
+      ELSE
+         CALL Read_Ncdf_var( varnames(4) , trim(cn_dir)//'/'//trim(file_p), slp(:,:),  kt )
+      END IF
+      !
+      IF (ln_slp_log) THEN
+        DO jj = 1, jpj
+           DO ji = 1, jpi      
+             slp(ji,jj) = exp( slp(ji,jj) )
+           END DO
+        END DO
+      ENDIF
+      !
+      IF (ln_read_zsurf) THEN
+        CALL Read_Ncdf_var( varnames(1) , trim(cn_dir)//'/'//trim(file_z), zsurf(:,:),  kt, 1 )      !<-- surface geopotential 
+      ELSE
+        zsurf(:,:) = 0.
+      END IF
+      !    
+      CALL Read_Ncdf_var ( varnames(2), trim(cn_dir)//'/'//trim(file_t), temp(:,:,:,:), kt )      !<-- temperature   
+      CALL Read_Ncdf_var ( varnames(3), trim(cn_dir)//'/'//trim(file_q), humi(:,:,:,:), kt )      !<-- humidity        
+      WHERE(humi.LT.1.E-08) humi = 1.E-08 !<-- negative values in ECMWF
+      !
+      ! Smoothing of surface fields to remove gibbs oscillations (must be done on both fields or none of them)
+      !IF( ln_slp_smth ) CALL smooth_field( jpi, jpj, slp  (:,:), tmask(:,:), 3 )
+      !IF (ln_read_zsurf.AND.ln_slp_smth) CALL smooth_field( jpi, jpj, zsurf(:,:), tmask(:,:), 3 )
+      !IF( ln_slp_smth ) CALL DTV_Filter( jpi, jpj, slp(:,:), tmask(:,:,1), 25, kt )  !<-- not yet robust enough
+
+      !!GS: DO NOT USE SMOOTH + LAND MASK FOR NOW (BUG) 
+      IF( ln_slp_smth ) THEN
+        slp_smth(:,:) = slp(:,:)
+        wrke(:,:) = 1.
+        CALL smooth_field( jpi, jpj, slp_smth(:,1:jpj),  wrke(:,1:jpj), 3 )
+        IF (ln_read_zsurf) THEN
+          zsurf_smth(:,:) = zsurf(:,:)
+          CALL smooth_field( jpi, jpj, zsurf_smth(:,:), wrke(:,:), 3 )
+        END IF
+        IF( ABS(lat_smth).GT.0.1) THEN
+          DO jj = 1, jpj
+             DO ji = 1, jpi
+               IF ((lat(jj).GE.lat_smth).OR.(lat(jj).LE.-1.*lat_smth)) THEN
+                 slp(ji,jj) = slp_smth(ji,jj)
+                 IF (ln_read_zsurf) zsurf(ji,jj) = zsurf_smth(ji,jj)
+               END IF
+             END DO
+          END DO
+        ELSE
+          slp(:,:) = slp_smth(:,:)
+          IF (ln_read_zsurf) zsurf(:,:) = zsurf_smth(:,:)
+        END IF
+      END IF
+      CALL Write_Ncdf_var( 'slp', dimnames(1:2), trim(out_file), slp(:,:), kt, 'float' )
+      IF (ln_read_zsurf) CALL Write_Ncdf_var( 'zsurf', dimnames(1:2), trim(out_file), zsurf(:,:), kt, 'float' )
+
+      !
+      ! Compute the altitude at layer interfaces
+      ghw(:,:,1:jpka)  = 0.
+      ghw(:,:,  jpka)  = zsurf(:,:) * (1. / grav) ! * tmask(:,:)
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 0, jpka
+               ph(jk) = A_w( jk ) + B_w( jk ) * slp( ji, jj )    !<-- Pa
+            END DO
+            !ph(0) = 0.1
+            IF ( nhym .EQ. jpka) ph(0) = 1.
+            DO jk = jpka,1,-1
+               tv      = temp( ji, jj, jk, 1 ) * ( 1. + zvir*humi( ji, jj, jk, 1 ) )  !<-- Virtual temperature
+               e3t ( ji, jj, jk   ) =  (1./grav)*( Rd * tv * log( ph( jk ) / ph( jk-1 ) ) ) !* tmask(ji, jj)
+               ghw ( ji, jj, jk-1 ) =  e3t( ji, jj, jk ) + ghw( ji, jj, jk ) 
+            END DO  
+         END DO
+      END DO
+
+      IF( ln_slp_smth ) THEN
+        wrke(:,:) = 1.
+        DO jk = 0, jpka
+          ghw_smth(:,:) = ghw(:,:,jk)
+          CALL smooth_field( jpi, jpj, ghw_smth(:,1:jpj),  wrke(:,1:jpj), 3 )
+          IF( ABS(lat_smth).GT.0.1) THEN
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                 IF ((lat(jj).GE.lat_smth).OR.(lat(jj).LE.-1.*lat_smth)) ghw(ji,jj,jk) = ghw_smth(ji,jj)
+               END DO
+            END DO
+          ELSE
+            ghw(:,:,jk) = ghw_smth(:,:)
+          END IF
+        END DO
+      END IF
+
+      !
+      ! Compute horizontal gradient of slp in x-direction (FX = dslp / dx)
+      FX(:,:) = 0.
+      DO jj = 1, jpj
+         DO ji = 1, jpi-1     
+            IF ((tmask(ji,jj) .gt. 0.5).AND.(tmask(ji+1,jj) .gt. 0.5)) THEN
+              cff            =  2. / (  dx( ji+1,jj ) +  dx( ji,jj ) )
+              FX( ji ,jj )   = cff * ( slp( ji+1,jj ) - slp( ji,jj ) )
+            ELSE
+              tmask2(ji:ji+1,jj) = 0.
+            END IF
+         END DO
+      END DO
+
+      IF (ln_perio_latbc) THEN
+         ! apply periodicity       
+         DO jj = 1, jpj
+            IF ((tmask(1,jj) .gt. 0.5).AND.(tmask(jpi,jj) .gt. 0.5)) THEN
+               cff              =  2. / (  dx( 1, jj) +  dx( jpi, jj) )
+               FX( jpi , jj)    = cff * ( slp( 1, jj) - slp( jpi, jj) )
+            ELSE
+               tmask2(   1, jj) = 0.
+               tmask2( jpi, jj) = 0.
+            END IF
+         END DO
+      ELSE
+         ! apply no-gradient
+         DO jj = 1, jpj
+            FX( jpi ,jj )   = FX( jpi-1 ,jj )
+         END DO
+      ENDIF    
+
+      !
+      ! Compute horizontal gradient of slp in y-direction (FE = dslp / dy)
+      FE(:,:) = 0.
+      DO jj = 1, jpj-1
+         DO ji = 1, jpi     
+            IF ((tmask(ji,jj) .gt. 0.5).AND.(tmask(ji,jj+1) .gt. 0.5)) THEN
+               cff            =  2. / (  dy( ji,jj+1 ) +  dy( ji,jj ) )
+               FE( ji ,jj )   = cff * ( slp( ji,jj+1 ) - slp( ji,jj ) )
+            ELSE
+               tmask2(ji,jj:jj+1) = 0.
+            END IF
+         END DO
+      END DO
+
+      ! apply no-gradient
+      DO ji = 1, jpi
+         FE( ji ,jpj ) = FE( ji ,jpj-1 )          
+      END DO              
+
+      !
+      !++ Compute the geostrophic winds
+      !
+      dZx(:,:)  = 0.
+      dZe(:,:)  = 0.
+      wrkX(:,:) = 0.
+      wrkE(:,:) = 0.
+      !////////////   
+      DO jk=1,jpka
+      !////////////           
+
+         !
+         ! Compute horizontal gradient of altitude in x-direction along the coordinate dZx = (dz / dx)s
+         DO jj = 1, jpj
+            DO ji = 1, jpi-1
+               IF ((tmask(ji,jj) .gt. 0.5).AND.(tmask(ji+1,jj) .gt. 0.5)) THEN
+                  cff          = 1. / (dx(ji+1,jj)+dx(ji,jj))
+                  dZx(ji,jj)   = cff * (  (ghw( ji+1, jj, jk-1) - ghw( ji, jj, jk-1))   &
+                     &                   +(ghw( ji+1, jj, jk  ) - ghw( ji, jj, jk  )) )
+               ELSE
+                 tmask2(ji:ji+1,jj) = 0.
+               END IF
+            END DO
+         END DO   
+
+         IF (ln_perio_latbc) THEN
+           ! apply periodicity
+           DO jj = 1, jpj
+              IF ((tmask(1,jj) .gt. 0.5).AND.(tmask(jpi,jj) .gt. 0.5)) THEN
+                 cff          = 1. / (dx(1,jj)+dx(jpi,jj)) 
+                 dZx(jpi,jj)  = cff * ( (ghw( 1, jj, jk-1) - ghw( jpi, jj, jk-1))   &
+                    &                  +(ghw( 1, jj, jk  ) - ghw( jpi, jj, jk  )) )
+                 dZx(  0,jj)  = dZx(jpi,jj)
+              ELSE
+                 tmask2(  1, jj) = 0.
+                 tmask2(jpi, jj) = 0.
+              END IF
+           END DO 
+         ELSE
+           ! apply no-gradient
+           DO jj = 1, jpj
+              dZx(jpi,jj)     = dZx(jpi-1,jj)
+              dZx(  0,jj)     = dZx(    1,jj)            
+           END DO         
+         END IF
+
+         !
+         ! Compute horizontal gradient of altitude in y-direction along the coordinate dZy = (dz / dy)s
+         DO jj = 1, jpj-1
+            DO ji = 1, jpi
+               IF ((tmask(ji,jj) .gt. 0.5).AND.(tmask(ji,jj+1) .gt. 0.5)) THEN
+                  cff          = 1. / (dy(ji,jj)+dy(ji,jj+1))
+                  dZe(ji,jj)   = cff * (  (ghw( ji, jj+1, jk-1) - ghw( ji, jj, jk-1))  &
+                     &                   +(ghw( ji, jj+1, jk  ) - ghw( ji, jj, jk  )) )   
+               ELSE
+                  tmask2(ji,jj:jj+1) = 0.
+               END IF
+            END DO
+         END DO 
+
+         ! apply no-gradient 
+         DO ji = 1, jpi
+            dZe(ji,jpj)     = dZe(ji,jpj-1)
+            dZe(ji,  0)     = dZe(ji,    1)            
+         END DO              
+
+         
+         ! Compute horizontal pressure gradient in x-direction along the coordinate wrkX = (dp/dx)s
+         DO jj = 1, jpj
+            DO ji = 2, jpi
+               IF ((tmask(ji,jj) .gt. 0.5).AND.(tmask(ji-1,jj) .gt. 0.5)) THEN
+                  cff = slp(ji,jj) * (B_w(jk)-B_w(jk-1)) + (A_w(jk)-A_w(jk-1))
+                  wrkX(ji,jj) = B_r(jk) * 0.5 * (FX(ji,jj)+FX(ji-1,jj))  &
+                     &               * (ghw(ji,jj,jk)-ghw(ji,jj,jk-1)) / cff
+               ELSE
+                  tmask2(ji-1:ji,jj) = 0.
+               END IF
+            END DO
+         END DO
+
+         IF (ln_perio_latbc) THEN
+           ! apply periodicity
+           ji = 1
+           DO jj = 1, jpj
+              IF ((tmask(1,jj) .gt. 0.5).AND.(tmask(jpi,jj) .gt. 0.5)) THEN
+                 cff = slp(ji,jj) * (B_w(jk)-B_w(jk-1)) + (A_w(jk)-A_w(jk-1))
+                 wrkX(ji,jj) = B_r(jk) * 0.5 * (FX(ji,jj)+FX(jpi,jj))  &
+                    &               * (ghw(ji,jj,jk)-ghw(ji,jj,jk-1)) / cff            
+              ELSE
+                 tmask2(  1,jj) = 0.
+                 tmask2(jpi,jj) = 0.
+              END IF
+           END DO
+         ELSE
+           ! apply no gradient  
+           DO jj = 1, jpj
+              wrkX(1,jj) = wrkX(2,jj)
+           END DO     
+         END IF 
+
+
+         ! Compute horizontal pressure gradient in y-direction along the coordinate wrkE = (dp/dy)s
+         DO jj = 2, jpj
+            DO ji = 1, jpi
+               IF ((tmask(ji,jj) .gt. 0.5).AND.(tmask(ji,jj-1) .gt. 0.5)) THEN
+                  cff = slp(ji,jj) * (B_w(jk)-B_w(jk-1)) + (A_w(jk)-A_w(jk-1))
+                  wrkE(ji,jj) = B_r(jk) * 0.5 * (FE(ji,jj)+FE(ji,jj-1))  &
+                     &               * (ghw(ji,jj,jk)-ghw(ji,jj,jk-1)) / cff
+               ELSE
+                  tmask2(ji,jj-1:jj) = 0.
+               END IF
+            END DO
+         END DO    
+
+         ! apply no gradient  
+         jj = 1
+         DO ji = 1, jpi       
+            wrkE(ji,1) = wrkE(ji,2) 
+         END DO   
+
+
+         !+++ Finalize pressure gradient/geostrophic wind computation
+         IF(ln_hpg_frc) THEN
+            DO jj=1,jpj
+               DO ji=1,jpi                     
+                 IF (tmask2(ji,jj).GT.0.5) THEN
+                   uhpg(ji,jj,jk,1) = - grav*( wrkX(ji,jj) - 0.5*( dZx(ji,jj)+dZx(ji-1,jj  ) ) ) 
+                   if (lat(1).GT.0.) vhpg(ji,jj,jk,1) =   grav*( wrkE(ji,jj) - 0.5*( dZe(ji,jj)+dZe(ji  ,jj-1) ) )
+                   if (lat(1).LT.0.) vhpg(ji,jj,jk,1) = - grav*( wrkE(ji,jj) - 0.5*( dZe(ji,jj)+dZe(ji  ,jj-1) ) )
+                 ELSE
+                   uhpg(ji,jj,jk,1) = 0.
+                   vhpg(ji,jj,jk,1) = 0.
+                 END IF
+               END DO   
+            END DO   
+         ELSE
+            DO jj=1,jpj               
+               DO ji=1,jpi    
+                 IF (tmask2(ji,jj).GT.0.5) THEN
+                   cff = grav / ff_t(ji,jj)
+                   ! geostrophic wind computed only where Coriolis .ge. 3.e-5 (~12deg)
+                   if(abs(ff_t(ji,jj)) < 2.5e-5) cff = 0.    
+                   ! minus sign for uhpg because y-derivatives are inverted
+                   vhpg(ji,jj,jk,1) = - cff*( wrkX(ji,jj) - 0.5*( dZx(ji,jj)+dZx(ji-1,jj  ) ) ) 
+                   if (lat(1).GT.0.) uhpg(ji,jj,jk,1) = - cff*( wrkE(ji,jj) - 0.5*( dZe(ji,jj)+dZe(ji  ,jj-1) ) )
+                   if (lat(1).LT.0.) uhpg(ji,jj,jk,1) =   cff*( wrkE(ji,jj) - 0.5*( dZe(ji,jj)+dZe(ji  ,jj-1) ) )
+                 ELSE
+                   uhpg(ji,jj,jk,1) = 0.
+                   vhpg(ji,jj,jk,1) = 0.
+                 END IF
+               END DO   
+            END DO          
+         ENDIF
+
+      !////////////        
+      END DO ! jk
+      !////////////        
+
+      IF (ln_geo_wnd) THEN
+        CALL Write_Ncdf_var ( 'ugeo', dimnames(1:4), trim(out_file), uhpg, kt, 'float' )
+        CALL Write_Ncdf_var ( 'vgeo', dimnames(1:4), trim(out_file), vhpg, kt, 'float' )
+      ELSE
+        CALL Write_Ncdf_var ( 'uhpg', dimnames(1:4), trim(out_file), uhpg, kt, 'float' )
+        CALL Write_Ncdf_var ( 'vhpg', dimnames(1:4), trim(out_file), vhpg, kt, 'float' )
+      END IF
+
+      IF (kt .EQ. 1) THEN
+        tmask2(:,1)   = 0. ! force northern v line drowning
+        tmask2(:,jpj) = 0. ! force northern v line drowning
+        CALL Write_Ncdf_var( 'tmask', dimnames(1:2), trim(out_file), tmask2, 'float' )
+      END IF
+
+   END DO ! kt
+   !
+   DEALLOCATE( zsurf, zsurf_smth, slp, slp_smth, temp,humi,uhpg,vhpg)     
+   IF (jpka.NE.nhym) DEALLOCATE(tmp_fullw,tmp_fullm)
+   !
+   STOP
+   !
+END PROGRAM main
Index: /utils/tools_ticket2413/ABL_TOOLS/main_vinterp.F90
===================================================================
--- /utils/tools_ticket2413/ABL_TOOLS/main_vinterp.F90	(revision 12863)
+++ /utils/tools_ticket2413/ABL_TOOLS/main_vinterp.F90	(revision 12863)
@@ -0,0 +1,590 @@
+PROGRAM main
+   !!======================================================================
+   !!                     ***  PROGRAM main  ***
+   !!
+   !! ** Purpose : Vertical interpolation of ECMWF dataset on a given fixed 
+   !!              vertical grid
+   !! 
+   !!======================================================================
+   !! History : 2016-10  (F. Lemarié)  Original code
+   !!   
+   !!----------------------------------------------------------------------
+   USE module_io       ! I/O routines
+   USE module_interp   ! vertical interpolation routines
+   USE module_grid     ! compute input and output grids 
+   !!
+   IMPLICIT NONE
+   !!----------------------------------------------------------------------
+   !! 
+   !!  
+   !! 
+   !!----------------------------------------------------------------------
+   !
+   INTEGER                                  :: ji,jj,jk,kt, jk_in, nhym, nhyi
+   INTEGER                                  :: jpka_in, jpka      ! number of vertical levels for input and target grids 
+   INTEGER                                  :: jpi , jpj          ! number of grid points in x and y directions     
+   INTEGER                                  :: iloc, jloc         ! grid indexes for c1d case
+   INTEGER                                  :: status             
+   INTEGER                                  :: jptime,ctrl
+   INTEGER                                  :: ioerr
+   INTEGER, ALLOCATABLE, DIMENSION(:,:  )   :: ind  
+   INTEGER, PARAMETER                       :: stdout  = 6
+   INTEGER, PARAMETER                       :: jp_weno = 1
+   INTEGER, PARAMETER                       :: jp_spln = 2   
+   !!
+   REAL(8)                                  :: hc,hmax,theta_s,z1 ! parameters related to the target vertical grid
+   REAL(8)                                  :: cff
+   !!  
+   REAL(8), ALLOCATABLE, DIMENSION(:      ) :: A_w                ! A coefficients to reconstruct ECMWF grid
+   REAL(8), ALLOCATABLE, DIMENSION(:      ) :: A_wa               ! A coefficients to reconstruct ECMWF grid
+   REAL(8), ALLOCATABLE, DIMENSION(:      ) :: B_w                ! B coefficients to reconstruct ECMWF grid
+   REAL(8), ALLOCATABLE, DIMENSION(:      ) :: B_wa               ! B coefficients to reconstruct ECMWF grid
+   REAL(8), ALLOCATABLE, DIMENSION(:      ) :: tmp1d, tmp_fullw, tmp_fullm ! temporary/working 1D arrays
+   REAL(8), ALLOCATABLE, DIMENSION(:      ) :: e3t,e3w            ! thickness of vertical layers in target grid
+   REAL(8), ALLOCATABLE, DIMENSION(:      ) :: ght,ghw            ! altitude of vertical grid points 
+   REAL(8), ALLOCATABLE, DIMENSION(:,:    ) :: e3_bak
+   REAL(8), ALLOCATABLE, DIMENSION(:,:,:  ) :: ghw_in             ! altitude of cell interfaces  of ECMWF grid
+   REAL(8), ALLOCATABLE, DIMENSION(:,:,:  ) :: e3t_in             ! thickness of vertical layers in ECMWF grid
+   REAL(8), ALLOCATABLE, DIMENSION(:,:,:,:) :: humi
+   REAL(8), ALLOCATABLE, DIMENSION(:,:,:,:) :: tair, tpot
+   REAL(8), ALLOCATABLE, DIMENSION(:,:,:,:) :: varout, varc1d 
+   REAL(8), ALLOCATABLE, DIMENSION(:,:    ) :: slp, zsurf
+   REAL(8), ALLOCATABLE, DIMENSION(:,:    ) :: tmask, tmask2      ! land-sea mask  
+   !!
+   CHARACTER(len=500)                       :: file_u,file_v,file_hpg,file_geos  ! ECMWF files containing wind components 
+   CHARACTER(len=500)                       :: file_t,file_q, file_m             ! ECMWF files containing tracers and mask 
+   CHARACTER(len=500)                       :: file_z,file_p,cn_dir,file_in      ! ECMWF files containing surface geopot and pressure
+   CHARACTER(len=500)                       :: grd_file, abl_file, drwn_file, out_file
+   CHARACTER(len=500)                       :: namelistf,stmp
+   CHARACTER(len=500)                       :: argument, var_file
+   CHARACTER(len= 20),DIMENSION(4)          :: dimnames
+   CHARACTER(len= 20),DIMENSION(11)         :: varnames, outnames
+   CHARACTER(len=500),DIMENSION(11)         :: filnames
+   CHARACTER(6)                             :: mask_var           ! name of mask variable in file_m file            
+   CHARACTER(6)                             :: var_name
+   !!
+   LOGICAL                                  :: ln_read_zsurf      ! read surface geopotential or not
+   LOGICAL                                  :: ln_read_mask       ! read land-sea mask or not
+   LOGICAL                                  :: ln_perio_latbc     ! use periodic BC along the domain latitudinal edges (for global data) or use zero-gradient BC (for regional data)
+   LOGICAL                                  :: ln_c1d             ! output only a single column in output file
+   LOGICAL                                  :: ln_hpg_frc         ! compute horizontal pressure gradient
+   LOGICAL                                  :: ln_geo_wnd         ! compute goestrophic wind components 
+   LOGICAL                                  :: ln_slp_smth        ! apply gibbs oscillation filetring on mean sea level pressure
+   LOGICAL                                  :: ln_drw_smth        ! apply gibbs oscillation filetring on mean sea level pressure
+   LOGICAL                                  :: ln_slp_log         ! log(sea-level pressure) or sea-level pressure
+   LOGICAL                                  :: ln_lsm_land        ! if T mask is 1 over land and 0 over ocean if F it is the other way around
+   LOGICAL                                  :: ln_impose_z1       ! impose the altitude of the first level in target grid
+   INTEGER                                  :: ptemp_method       ! way to compute potential temperature 
+                                                                  ! = 0  (absolute temperature)
+                                                                  ! = 1  (potential temperature with local ref pressure)
+                                                                  ! = 2  (potential temperature with global ref pressure on temperature perturbation)
+                                                                  ! = 3  (potential temperature with global ref pressure)
+   !!   
+   REAL(8), PARAMETER     :: grav  =   9.80665
+
+   !!---------------------------------------------------------------------
+   !! List of variables read in the namelist file 
+   NAMELIST/nml_dom/    jpka, hmax, theta_s, hc, ln_impose_z1, z1   
+   NAMELIST/nml_opt/    ptemp_method, ln_slp_log, ln_slp_smth, ln_read_mask, ln_perio_latbc, &
+      &                 ln_hpg_frc, ln_geo_wnd, ln_c1d, ln_read_zsurf, ln_lsm_land, ln_drw_smth
+   NAMELIST/nml_fld/    cn_dir, file_u, file_v, file_t,               &
+      &                 file_q, file_z, file_p, file_hpg, file_geos,  &
+      &                 file_m, mask_var
+   NAMELIST/nml_out/    grd_file, abl_file, drwn_file, var_name
+   NAMELIST/nml_c1d/    iloc, jloc
+   !!
+   !! get the namelist file name
+   CALL get_command_argument( 1, argument, ctrl, status)
+   !
+   SELECT CASE(status)
+   CASE(0)
+      namelistf = trim(argument)
+   CASE(-1)
+      WRITE(stdout,*) "### Error: file name too long"
+      STOP
+   CASE DEFAULT
+      namelistf = 'namelist_abl_tools'
+   END SELECT
+   !!---------------------------------------------------------------------
+
+
+   !!---------------------------------------------------------------------
+   !! read namelist variables
+   ctrl = 0
+   OPEN(50, file=namelistf, status='old', form='formatted', access='sequential', iostat=ioerr)
+   IF (ioerr /= 0) ctrl = ctrl + 1   
+   READ(50,nml_dom, iostat=ioerr); IF (ioerr /= 0) ctrl = ctrl + 1   
+   READ(50,nml_opt, iostat=ioerr); IF (ioerr /= 0) ctrl = ctrl + 1
+   READ(50,nml_fld, iostat=ioerr); IF (ioerr /= 0) ctrl = ctrl + 1
+   READ(50,nml_out, iostat=ioerr); IF (ioerr /= 0) ctrl = ctrl + 1  
+   IF( ln_c1d ) THEN
+      print*,'c1d is activated'
+      READ(50,nml_c1d, iostat=ioerr); IF (ioerr /= 0) ctrl = ctrl + 1
+   ENDIF
+
+   IF (ctrl > 0) THEN
+      WRITE(stdout,*) "### E R R O R while reading namelist file '",trim(namelistf),"'"
+      WRITE(stdout,*) " ctrl = ",ctrl
+      STOP
+   ELSE 
+      WRITE(stdout,*) " Namelist file ",trim(namelistf)," OK "    
+   ENDIF
+   IF( ln_hpg_frc .AND. ln_geo_wnd ) THEN
+      WRITE(stdout,*) "### E R R O R conflicting options "
+      WRITE(stdout,*) "ln_hpg_frc and ln_geo_wnd can not both be set to True"
+      STOP   
+   ENDIF
+   
+   SELECT CASE (ptemp_method) 
+   CASE(0)
+      WRITE(stdout,*) "Absolute temperature option is activated"
+   CASE(1)   
+      WRITE(stdout,*) "Potential temperature option with  local reference pressure is activated"   
+   CASE(2)    
+      WRITE(stdout,*) "Potential temperature option with global reference pressure on temperature perturbation is activated"   
+   CASE(3)    
+      WRITE(stdout,*) "Potential temperature option with global reference pressure is activated"  
+   END SELECT
+   
+   IF(ln_slp_smth) WRITE(stdout,*) "MSLP smoothing option is activated" 
+   IF(ln_hpg_frc ) WRITE(stdout,*) "Large-scale pressure gradient will be interpolated"      
+   IF(ln_geo_wnd ) WRITE(stdout,*) "Geostrophic winds will be interpolated" 
+   !!---------------------------------------------------------------------   
+       
+   !!-------------------------------------------------------------------------------------   
+   !! list of variables to treat
+   !!
+   !! get the variable name
+   CALL get_command_argument( 2, argument, ctrl, status)
+   SELECT CASE(status)
+   CASE(0)
+      var_name = trim(argument)
+   CASE(-1)
+      WRITE(stdout,*) "### Error: file name too long"
+      STOP
+   END SELECT
+   WRITE(stdout,*) "var_name: ", trim(var_name), "lenght: ", Len_Trim(var_name)
+   !!
+   IF( ln_hpg_frc ) THEN 
+      file_in = trim(file_hpg )
+   ELSE
+      file_in = trim(file_geos)
+   ENDIF
+   varnames = [character(len=4  ) :: 'Z'    ,    'T',    'Q',    'U',    'V', 'MSL', 'LSM', 'uhpg', 'vhpg', 'ugeo', 'vgeo' ]
+   outnames = [character(len=5  ) :: 'zsurf', 'tair', 'humi', 'uwnd', 'vwnd', 'slp',    '', 'uhpg', 'vhpg', 'ugeo', 'vgeo' ]
+   filnames = [character(len=500) ::  file_z, file_t, file_q, file_u, file_v, file_p, file_m, file_in, file_in, file_in, file_in ]
+   IF( ln_slp_log ) varnames(6) = 'LNSP'
+ 
+   !!---------------------------------------------------------------------
+   ! check files content
+   ctrl = 0
+   CALL Read_Ncdf_dim('lev',trim(cn_dir)//'/'//trim(file_t),jpka_in)   
+   !
+   IF (ln_read_zsurf) THEN
+     IF( .not. VAR_EXISTENCE( trim(varnames(1)) , trim(cn_dir)//'/'//trim(file_z) )      &
+        & .or. jpka_in == 1 ) ctrl = ctrl + 1 
+   ENDIF
+   WRITE(stdout,*) trim(varnames(1)), ctrl
+   IF ( .not. VAR_EXISTENCE( trim(varnames(2)) , trim(cn_dir)//'/'//trim(file_t) ) ) ctrl = ctrl + 1 
+   WRITE(stdout,*) trim(varnames(2)), ctrl
+   IF ( .not. VAR_EXISTENCE( trim(varnames(3)) , trim(cn_dir)//'/'//trim(file_q) ) ) ctrl = ctrl + 1   
+   WRITE(stdout,*) trim(varnames(3)), ctrl
+   IF ( .not. VAR_EXISTENCE( trim(varnames(4)) , trim(cn_dir)//'/'//trim(file_u) ) ) ctrl = ctrl + 1
+   WRITE(stdout,*) trim(varnames(4)), ctrl
+   IF ( .not. VAR_EXISTENCE( trim(varnames(5)) , trim(cn_dir)//'/'//trim(file_v) ) ) ctrl = ctrl + 1 
+   WRITE(stdout,*) trim(varnames(5)), ctrl
+   IF ( .not. VAR_EXISTENCE( trim(varnames(6)) , trim(cn_dir)//'/'//trim(file_p) ) ) ctrl = ctrl + 1 
+   WRITE(stdout,*) trim(varnames(6)), ctrl
+   IF (ln_read_mask) THEN
+     IF ( .not. VAR_EXISTENCE( trim(varnames(7)) , trim(cn_dir)//'/'//trim(file_m) ) ) ctrl = ctrl + 1 
+     WRITE(stdout,*) trim(varnames(7)), ctrl
+     varnames(7) = TRIM(mask_var)
+   ENDIF
+   IF (ln_hpg_frc) THEN
+      IF ( .not. VAR_EXISTENCE( trim(varnames(8)) , trim(cn_dir)//'/'//trim(file_hpg) ) ) ctrl = ctrl + 1 
+      WRITE(stdout,*) trim(varnames(8)), ctrl
+      IF ( .not. VAR_EXISTENCE( trim(varnames(9)) , trim(cn_dir)//'/'//trim(file_hpg) ) ) ctrl = ctrl + 1    
+      WRITE(stdout,*) trim(varnames(9)), ctrl
+   ENDIF
+   IF (ln_geo_wnd) THEN
+      IF ( .not. VAR_EXISTENCE( trim(varnames(10)) , trim(cn_dir)//'/'//trim(file_geos) ) ) ctrl = ctrl + 1 
+      WRITE(stdout,*) trim(varnames(10)), ctrl
+      IF ( .not. VAR_EXISTENCE( trim(varnames(11)) , trim(cn_dir)//'/'//trim(file_geos) ) ) ctrl = ctrl + 1    
+      WRITE(stdout,*) trim(varnames(11)), ctrl
+   ENDIF
+          
+   IF ( ctrl > 0 ) THEN  
+      WRITE(stdout,*) "### E R R O R while reading ECMWF atmospheric files "
+      STOP
+   ELSE
+      WRITE(stdout,*) " ECMWF atmospheric files OK "        
+   ENDIF
+   !!---------------------------------------------------------------------
+
+
+   !!---------------------------------------------------------------------
+   !! read the dimensions for the input files
+   CALL Read_Ncdf_dim ( 'time', trim(cn_dir)//'/'//trim(file_t), jptime  ) 
+   CALL Read_Ncdf_dim ( 'lon' , trim(cn_dir)//'/'//trim(file_t), jpi     )     
+   CALL Read_Ncdf_dim ( 'lat' , trim(cn_dir)//'/'//trim(file_t), jpj     )     
+   CALL Read_Ncdf_dim ( 'nhym' , trim(cn_dir)//'/'//trim(file_t), nhym   )
+   CALL Read_Ncdf_dim ( 'nhyi' , trim(cn_dir)//'/'//trim(file_t), nhyi   )
+   !WRITE(stdout,*) "jpka_in, jptime, jpi, jpj, nhym, nhyi: ", jpka_in, jptime, jpi, jpj, nhym, nhyi
+   !
+   !!---------------------------------------------------------------------
+
+
+   !!---------------------------------------------------------------------
+   !! allocate arrays  
+   ALLOCATE( A_w    (               0:jpka_in) )         
+   ALLOCATE( B_w    (               0:jpka_in) )
+   ALLOCATE( e3t_in ( 1:jpi, 1:jpj, 1:jpka_in) )
+   ALLOCATE( ghw_in ( 1:jpi, 1:jpj, 0:jpka_in) ) 
+   ALLOCATE( slp    ( 1:jpi, 1:jpj              ) )
+   ALLOCATE( zsurf  ( 1:jpi, 1:jpj              ) )
+   ALLOCATE( tair   ( 1:jpi, 1:jpj, 1:jpka_in, 1) )
+   ALLOCATE( tpot   ( 1:jpi, 1:jpj, 1:jpka_in, 1) )
+   ALLOCATE( humi   ( 1:jpi, 1:jpj, 1:jpka_in, 1) )       
+   ALLOCATE( varout ( 1:jpi, 1:jpj, 1:jpka+1 , 1) )
+   ALLOCATE( ind    ( 1:jpi, 1:jpj              ) )
+   ALLOCATE( e3_bak ( 1:jpi, 1:jpj              ) )  
+   ALLOCATE( ght    (               1:jpka+1    ) )
+   ALLOCATE( ghw    (               1:jpka+1    ) )   
+   ALLOCATE( e3t    (               1:jpka+1    ) )
+   ALLOCATE( e3w    (               1:jpka+1    ) )      
+   ALLOCATE( tmask  ( 1:jpi, 1:jpj              ) )
+   ALLOCATE( tmask2 ( 1:jpi, 1:jpj              ) )
+   IF( ln_c1d ) ALLOCATE( varc1d( 1:3, 1:3, 1:jpka+1 , 1 ) )
+   IF( ln_c1d ) varc1d( 1:3, 1:3, 1:jpka+1 , 1 ) = 0.
+   IF (jpka_in.NE.nhym) THEN
+     ALLOCATE( tmp_fullw(1:nhyi) )
+     ALLOCATE( tmp_fullm(1:nhym) )
+   ENDIF
+   !
+   varout(:,:,:,1)    = 0.
+      
+   !!---------------------------------------------------------------------
+   !! Read the mask and remove some closed seas 
+   IF (ln_read_mask) THEN
+     CALL init_atm_mask(jpi,jpj,trim(cn_dir)//'/'//trim(file_m),trim(mask_var),ln_lsm_land,tmask)
+     IF (ln_geo_wnd) CALL Read_Ncdf_var ( 'tmask' , trim(cn_dir)//'/'//trim(file_geos), tmask2(:,:) )
+     IF (ln_hpg_frc) CALL Read_Ncdf_var ( 'tmask' , trim(cn_dir)//'/'//trim(file_hpg) , tmask2(:,:) )
+   ELSE
+     tmask(:,:)  = 1.
+     tmask2(:,:) = 1.
+   ENDIF
+   !!   
+   
+   !!---------------------------------------------------------------------
+   !! Compute the altitude and layer thickness of the target grid
+   CALL init_target_grid ( jpka, ght, ghw, e3t, e3w, hmax, hc, theta_s,   &
+      &                                              ln_impose_z1, z1  )
+
+   !! Write the grid file for the target grid
+   CALL Write_Grid_File  ( jpka, ght, ghw, e3t, e3w, trim(cn_dir)//'/'//trim(grd_file) )
+
+   
+   !! Read the static A and B coefficients for the ECMWF vertical grid
+   IF (jpka_in.EQ.nhym) THEN
+     CALL Read_Ncdf_var    ( 'hyai', trim(cn_dir)//'/'//trim(file_t), A_w )
+     CALL Read_Ncdf_var    ( 'hybi', trim(cn_dir)//'/'//trim(file_t), B_w )   
+   ELSE
+     CALL Read_Ncdf_var    ( 'hyai', trim(cn_dir)//'/'//trim(file_t), tmp_fullw )
+     A_w(0:jpka_in) = tmp_fullw(nhyi-(jpka_in+1)+1:nhyi)
+     CALL Read_Ncdf_var    ( 'hybi', trim(cn_dir)//'/'//trim(file_t), tmp_fullw )
+     B_w(0:jpka_in) = tmp_fullw(nhyi-(jpka_in+1)+1:nhyi)
+   ENDIF
+
+
+   !!---------------------------------------------------------------------   
+   !! create output file
+   !!
+   IF (Len_Trim(var_name) == 0) THEN
+      out_file = trim(cn_dir)//'/'//trim(abl_file)
+   ELSE
+      out_file = trim(cn_dir)//'/'//trim(var_name)//'_'//trim(abl_file)
+   ENDIF
+
+   IF(ln_c1d) THEN
+      CALL Init_output_File_c1d ( jpi, jpj, jpka, trim(cn_dir)//'/'//trim(file_t), out_file, tmask(:,:), iloc, jloc )
+   ELSE 
+      CALL Init_output_File ( jpi, jpj, jpka, trim(cn_dir)//'/'//trim(file_t), out_file, tmask(:,:) )
+   ENDIF
+
+   !!---------------------------------------------------------------------   
+   !! Initialize the name of the dimensions for the result of the interpolation
+   !!
+   dimnames(1) = 'lon'
+   dimnames(2) = 'lat'       
+   dimnames(3) = 'jpka'
+   dimnames(4) = 'time'
+   CALL Write_Ncdf_var( 'tmask', dimnames(1:2), trim(out_file), tmask2, 'float' )
+
+   !!---------------------------------------------------------------------
+   ! Read time variable
+   ALLOCATE(tmp1d (1:jptime))    
+   CALL Read_Ncdf_var ( 'time', trim(cn_dir)//'/'//trim(file_t), tmp1d )    
+   !!---------------------------------------------------------------------     
+ 
+   DO kt=1,jptime
+   !
+      WRITE(stdout,*) '======================'
+      WRITE(stdout,*) 'time = ',kt,'/',jptime   
+      !
+      CALL Write_Ncdf_var( 'time', dimnames(4:4), trim(out_file), tmp1d(kt:kt), kt, 'double' )
+      !
+      IF( kt == 1 ) THEN
+         CALL Duplicate_lon_lat_time( trim(cn_dir)//'/'//trim(file_t), out_file ) 
+         CALL add_globatt_real( out_file, "jpka"   , REAL(jpka) )
+         CALL add_globatt_real( out_file, "hmax"   , hmax       )
+         CALL add_globatt_real( out_file, "theta_s", theta_s    )
+         CALL add_globatt_real( out_file, "hc"     , hc         )
+         IF (ln_impose_z1) CALL add_globatt_real( out_file, "z1", z1 )
+      ENDIF
+      !
+      ! read SLP
+      !CALL Read_Ncdf_var ( varnames(6) , trim(cn_dir)//'/'//trim(file_p), slp,  kt )      !<-- (log of) surface pressure
+      !IF (ln_slp_log) THEN
+      !  DO jj = 1, jpj
+      !     DO ji = 1, jpi      
+      !       slp( ji ,jj )   = exp( slp(ji ,jj ) )
+      !     END DO
+      !  END DO
+      !ENDIF
+      CALL Read_Ncdf_var ( outnames(6) , trim(cn_dir)//'/'//trim(file_in), slp,  kt )      !<-- (log of) surface pressure
+      !
+      ! read ZSURF
+      IF (ln_read_zsurf) THEN
+        !CALL Read_Ncdf_var ( varnames(1) , trim(cn_dir)//'/'//trim(file_z), zsurf,  kt )      !<-- surface geopotential 
+        CALL Read_Ncdf_var ( outnames(1) , trim(cn_dir)//'/'//trim(file_in), zsurf,  kt )      !<-- surface geopotential 
+      ELSE
+        zsurf(:,:) = 0.
+      ENDIF
+      !    
+      ! Smoothing of SLP and ZSURF to remove gibbs oscillations (must be done on both fields or none of them)
+      !IF( ln_slp_smth ) CALL smooth_field( jpi, jpj, slp(:,:), tmask(:,:), 3 )
+      !IF (ln_read_zsurf.AND.ln_slp_smth) CALL smooth_field( jpi, jpj, zsurf(:,:), tmask(:,:), 3 )
+      !IF( ln_slp_smth ) CALL DTV_Filter( jpi, jpj, slp(:,:), tmask(:,:), 25, kt )  !<-- not yet robust enough
+      !
+      ! read tair and HUMI
+      CALL Read_Ncdf_var ( varnames(2) , trim(cn_dir)//'/'//trim(file_t), tair, kt    )      !<-- temperature   
+      CALL Read_Ncdf_var ( varnames(3) , trim(cn_dir)//'/'//trim(file_q), humi, kt    )      !<-- humidity        
+      WHERE(humi.LT.1.E-08) varout = 1.E-08 !<-- negative values in ECMWF
+      !
+      ! Reconstruct the ERA-Interim vertical grid in terms of altitude 
+      ghw_in(:,:,1:jpka_in)  = 0.
+      ghw_in(:,:,  jpka_in)  = zsurf(:,:) * (1. / grav)
+      CALL get_atm_grid( jpi, jpj, jpka_in, slp, tair,  &
+         &                          humi, A_w, B_w, e3t_in, ghw_in )
+      !
+      ! Compute potential temperature
+      tpot = tair ! save tpot
+      CALL get_pot_temp    ( jpi, jpj, jpka_in, slp, tpot, A_w, B_w,   &
+         &                   tmask(:,:), ptemp_method, humi(:,:,jpka_in,1), 0.5*ghw_in(:,:,jpka_in-1) )
+
+      ! Flip the vertical axis to go from k=0 at the bottom to k=N_in at the top of the atmosphere
+      CALL flip_vert_dim ( 1, jpka_in, jpi, jpj, e3t_in          )       
+      CALL flip_vert_dim ( 0, jpka_in, jpi, jpj, ghw_in          ) 
+      CALL flip_vert_dim ( 1, jpka_in, jpi, jpj, tpot(:,:,:,1)   )       
+      CALL flip_vert_dim ( 1, jpka_in, jpi, jpj, humi(:,:,:,1)   ) 
+      
+      ! Correct the layer thickness to match hmax  
+      DO jj = 1, jpj
+         DO ji = 1, jpi          
+            cff = 0.
+            DO jk=1,jpka_in
+               cff = cff + e3t_in( ji, jj, jk )
+               IF ( cff > hmax ) THEN
+                  jk_in = jk
+                  EXIT
+               ENDIF 
+            END DO  
+            ind    ( ji, jj       ) = jk_in    
+            e3_bak ( ji, jj       ) = e3t_in ( ji, jj, jk_in )  ! store the value of the original layer thickness 
+            e3t_in ( ji, jj, jk_in) = e3t_in ( ji, jj, jk_in ) - ( cff - hmax )
+         END DO  
+      END DO 
+      !
+      IF (Len_Trim(var_name) == 0) THEN
+        !/
+        ! Interpolation of potential temperature TPOT
+        CALL zinterp ( jpi, jpj, jpka, jpka_in, ind,  &
+            &                         tpot, e3t_in, e3_bak, e3t, varout, jp_weno )  
+
+        varout(:,:,1,1) = varout(:,:,2,1)
+
+        IF (ln_c1d) THEN
+           DO jj=1,3
+              DO ji=1,3
+                 varc1d( ji, jj , 1:jpka+1 , 1 ) = varout(iloc,jloc, 1:jpka+1 , 1 )
+              END DO
+           END DO
+           CALL Write_Ncdf_var ('tair', dimnames(1:4), out_file, varc1d, kt, 'float' )
+        ELSE
+           CALL Write_Ncdf_var ('tair', dimnames(1:4), out_file, varout, kt, 'float' ) 
+        ENDIF
+        !
+        ! Interpolation of HUMI
+        CALL zinterp ( jpi, jpj, jpka, jpka_in, ind,  &
+            &                        humi, e3t_in, e3_bak, e3t, varout, jp_weno  )
+
+        !FL: dirty loop (possible issue in boundary conditions for WENO scheme)
+        DO jj = 1, jpj
+           DO ji = 1, jpi
+              DO jk = 2, jpka+1
+                 varout(ji,jj,jk,1) = MAX(varout(ji,jj,jk,1),1.E-08)                       !<-- negative values in ECMWF
+              END DO
+           END DO
+        END DO
+
+        varout(:,:,1,1) = varout(:,:,2,1) 
+
+        IF (ln_c1d) THEN
+           DO jj=1,3
+              DO ji=1,3
+                 varc1d( ji, jj , 1:jpka+1 , 1 ) = varout(iloc,jloc, 1:jpka+1 , 1 )
+              END DO
+           END DO
+           CALL Write_Ncdf_var  ('humi', dimnames(1:4), out_file, varc1d, kt, 'float' )
+        ELSE
+           CALL Write_Ncdf_var ('humi', dimnames(1:4), out_file, varout, kt, 'float' )  
+        ENDIF
+
+        !
+        ! Interpolate large-scale HPG or geostrophic wind
+        !
+        ! Read HPG
+        IF (ln_hpg_frc) THEN
+           CALL Read_Ncdf_var ( varnames(8) , trim(cn_dir)//'/'//trim(file_in), tair, kt )        
+           CALL Read_Ncdf_var ( varnames(9) , trim(cn_dir)//'/'//trim(file_in), humi, kt ) 
+        ENDIF
+        ! Read geostrophic wind
+        IF (ln_geo_wnd) THEN
+           CALL Read_Ncdf_var ( varnames(10) , trim(cn_dir)//'/'//trim(file_in), tair, kt )        
+           CALL Read_Ncdf_var ( varnames(11) , trim(cn_dir)//'/'//trim(file_in), humi, kt ) 
+        ENDIF
+        !
+        CALL flip_vert_dim ( 1, jpka_in, jpi, jpj, tair( :,:,:,1 ) )       
+        CALL flip_vert_dim ( 1, jpka_in, jpi, jpj, humi( :,:,:,1 ) ) 
+        !      
+        ! Interpolation of geostrophic U
+        CALL zinterp ( jpi, jpj, jpka, jpka_in, ind,  &
+            &                         tair, e3t_in, e3_bak, e3t, varout, jp_spln  )      
+        varout(:,:,1,1) = varout(:,:,2,1)
+           
+           IF (ln_c1d) THEN
+              DO jj=1,3
+                 DO ji=1,3
+                    varc1d( ji, jj , 1:jpka+1 , 1 ) = varout(iloc,jloc, 1:jpka+1 , 1 )
+                 END DO
+              END DO
+              CALL Write_Ncdf_var ( 'uhpg', dimnames(1:4), out_file, varc1d, kt, 'float' )
+           ELSE
+              IF (ln_hpg_frc) CALL Write_Ncdf_var ( varnames( 8), dimnames(1:4), out_file, varout, kt, 'float' )
+              IF (ln_geo_wnd) CALL Write_Ncdf_var ( varnames(10), dimnames(1:4), out_file, varout, kt, 'float' )
+           ENDIF
+           !
+           ! Interpolation of geostrophic V
+           CALL zinterp ( jpi, jpj, jpka, jpka_in, ind,  &
+               &                         humi, e3t_in, e3_bak, e3t, varout, jp_spln  )       
+           varout(:,:,1,1) = varout(:,:,2,1)
+
+           IF (ln_c1d) THEN
+              DO jj=1,3
+                 DO ji=1,3
+                    varc1d( ji, jj , 1:jpka+1 , 1 ) = varout(iloc,jloc, 1:jpka+1 , 1 )
+                 END DO
+              END DO
+              CALL Write_Ncdf_var ( 'vhpg', dimnames(1:4), out_file, varc1d, kt, 'float' )
+           ELSE
+              IF (ln_hpg_frc) CALL Write_Ncdf_var ( varnames( 9), dimnames(1:4), out_file, varout, kt, 'float' )
+              IF (ln_geo_wnd) CALL Write_Ncdf_var ( varnames(11), dimnames(1:4), out_file, varout, kt, 'float' )
+           ENDIF
+        !
+        ! Interpolation of total winds
+        !      
+        ! Read wind
+        CALL Read_Ncdf_var ( varnames(4) , trim(cn_dir)//'/'//trim(file_u), tair, kt )        
+        CALL Read_Ncdf_var ( varnames(5) , trim(cn_dir)//'/'//trim(file_v), humi, kt ) 
+        CALL flip_vert_dim ( 1, jpka_in, jpi, jpj, tair( :,:,:,1 ) )       
+        CALL flip_vert_dim ( 1, jpka_in, jpi, jpj, humi( :,:,:,1 ) ) 
+        !      
+        ! Interpolation of total U
+        CALL zinterp ( jpi, jpj, jpka, jpka_in, ind,  &
+            &                         tair, e3t_in, e3_bak, e3t, varout, jp_spln  )      
+        varout(:,:,1,1) = varout(:,:,2,1)
+
+        IF(ln_c1d) THEN
+           DO jj=1,3
+              DO ji=1,3
+                 varc1d( ji, jj , 1:jpka+1 , 1 ) = varout(iloc,jloc, 1:jpka+1 , 1 )
+              END DO
+           END DO
+           CALL Write_Ncdf_var ( 'uwnd', dimnames(1:4), out_file, varc1d, kt, 'float' )
+        ELSE
+           CALL Write_Ncdf_var ( 'uwnd', dimnames(1:4), out_file, varout, kt, 'float' )
+        ENDIF
+        !
+        ! Interpolation of total V
+        CALL zinterp ( jpi, jpj, jpka, jpka_in, ind,  &
+            &                         humi, e3t_in, e3_bak, e3t, varout, jp_spln  )       
+        varout(:,:,1,1) = varout(:,:,2,1)
+
+        IF(ln_c1d) THEN
+           DO jj=1,3
+              DO ji=1,3
+                 varc1d( ji, jj , 1:jpka+1 , 1 ) = varout(iloc,jloc, 1:jpka+1 , 1 )
+              END DO
+           END DO
+           CALL Write_Ncdf_var ( 'vwnd', dimnames(1:4), out_file, varc1d, kt, 'float' )
+        ELSE
+           CALL Write_Ncdf_var ( 'vwnd', dimnames(1:4), out_file, varout, kt, 'float' )
+        ENDIF
+
+      ELSE ! var_name
+        !
+        ctrl     =  minval(pack([(ji,ji=1,size(outnames))],outnames==var_name))
+        var_file = filnames(ctrl)
+        !
+        !
+        ! Interpolation of var_name
+        !      
+        IF ( (var_name.NE."tair").AND.(var_name.NE."humi") ) THEN
+          ! Read var_name
+          CALL Read_Ncdf_var ( varnames(ctrl) , trim(cn_dir)//'/'//trim(var_file), tair, kt )
+          CALL flip_vert_dim ( 1, jpka_in, jpi, jpj, tair( :,:,:,1 ) )       
+          ! Interpolation of var_name
+          CALL zinterp ( jpi, jpj, jpka, jpka_in, ind,  &
+              &                         tair, e3t_in, e3_bak, e3t, varout, jp_spln  )
+        ELSE
+          ! humi and tpot already read     
+          IF (var_name.EQ."humi") tair = humi
+          IF (var_name.EQ."tair") tair = tpot
+          ! Interpolation of var_name
+          CALL zinterp ( jpi, jpj, jpka, jpka_in, ind,  &
+              &                         tair, e3t_in, e3_bak, e3t, varout, jp_weno )
+        END IF
+
+        varout(:,:,1,1) = varout(:,:,2,1)
+
+        IF(ln_c1d) THEN
+           DO jj=1,3
+              DO ji=1,3
+                 varc1d( ji, jj , 1:jpka+1 , 1 ) = varout(iloc,jloc, 1:jpka+1 , 1 )
+              END DO
+           END DO
+           CALL Write_Ncdf_var ( outnames(ctrl), dimnames(1:4), out_file, varc1d, kt, 'float' )
+        ELSE
+           CALL Write_Ncdf_var ( outnames(ctrl), dimnames(1:4), out_file, varout, kt, 'float' )
+        ENDIF
+        !
+      ENDIF ! var_name
+   !
+   END DO ! kt
+   !
+   DEALLOCATE(zsurf,slp,tair,humi,varout)     
+   IF (jpka_in.NE.nhym) DEALLOCATE(tmp_fullw,tmp_fullm)
+   !
+   STOP
+   !
+END PROGRAM main
Index: /utils/tools_ticket2413/ABL_TOOLS/module_grid.F90
===================================================================
--- /utils/tools_ticket2413/ABL_TOOLS/module_grid.F90	(revision 12863)
+++ /utils/tools_ticket2413/ABL_TOOLS/module_grid.F90	(revision 12863)
@@ -0,0 +1,904 @@
+MODULE module_grid
+   !!======================================================================
+   !!                   ***  MODULE  module_grid  ***
+   !! ABL utilities to define and store vertical grids 
+   !!=====================================================================
+   !! History : 2016-10  (F. Lemarié)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   FUNCTIONS   : None    
+   !!   SUBROUTINES : get_atm_grid, init_atm_mask, get_pot_temp
+   !!                 Write_Grid_File, Init_output_File, init_target_grid
+   !!                 flip_vert_dim, smooth_field
+   !!----------------------------------------------------------------------
+   IMPLICIT NONE
+
+CONTAINS
+
+   SUBROUTINE get_atm_grid( jpi, jpj, jpka, slp, temp, humi, Aw, Bw, &   ! in
+      &                                                      e3t, ghw )   ! out
+      !!--------------------------------------------------------------------------
+      !!                    ***  ROUTINE get_atm_grid  ***
+      !!                   
+      !! ** Purpose : compute layer thickness and altitude of interfaces   
+      !!              of the ECMWF atmospheric grid
+      !!
+      !! ** Method  : 
+      !!        (1) recompute the pressure levels thanks to the sea-level pressure
+      !!        (2) use the hydrostatic relation to convert pressure into altitudes
+      !!
+      !!---------------------------------------------------------------------------      
+      INTEGER, INTENT(in   ) ::   jpi, jpj
+      INTEGER, INTENT(in   ) ::   jpka
+      REAL(8), INTENT(in   ) ::   slp   ( 1:jpi, 1:jpj         )
+      REAL(8), INTENT(in   ) ::   temp  ( 1:jpi, 1:jpj, 1:jpka )      
+      REAL(8), INTENT(in   ) ::   humi  ( 1:jpi, 1:jpj, 1:jpka ) 
+      REAL(8), INTENT(in   ) ::   Aw    (               0:jpka )
+      REAL(8), INTENT(in   ) ::   Bw    (               0:jpka )                 
+      REAL(8), INTENT(  out) ::   e3t   ( 1:jpi, 1:jpj, 1:jpka )  
+      REAL(8)                ::   ghw   ( 1:jpi, 1:jpj, 0:jpka )                           
+      REAL(8), PARAMETER     ::   g    =   9.80665
+      REAL(8), PARAMETER     ::   Rd   = 287.058   
+      REAL(8), PARAMETER     ::   zvir =   0.609133 
+      REAL(8), PARAMETER     ::   ig   =   1./g
+      !!
+      INTEGER                :: ji,jj,jk
+      REAL(8)                :: tv,ph(0:jpka)
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+
+            DO jk=0,jpka
+               ph(jk) = Aw( jk ) + Bw( jk ) * slp( ji, jj )    !<-- Pa
+            END DO
+            
+            DO jk=jpka,1,-1
+              tv      = temp( ji, jj, jk ) * ( 1. + zvir*humi( ji, jj, jk ) )  !<-- Virtual temperature
+              e3t ( ji, jj, jk   ) =  ig*( Rd * tv * log( ph( jk ) / ph( jk-1 ) ) )
+              ghw ( ji, jj, jk-1 ) =  e3t( ji, jj, jk ) + ghw( ji, jj, jk )
+            END DO  
+
+         END DO
+      END DO
+      !
+   END SUBROUTINE get_atm_grid
+
+
+
+
+   SUBROUTINE init_atm_mask( jpi, jpj, mask_file, mask_name, ln_lsm_land, tmask )
+      USE module_io
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE INIT_atm_MASK  ***
+      !!                   
+      !! ** Purpose : extract the land/sea mask and remove isolated sea points 
+      !!
+      !! ** Method  : mask is 1 over the ocean and 0 over land 
+      !!
+      !!----------------------------------------------------------------------         
+      INTEGER, INTENT(in   ) ::   jpi, jpj 
+      LOGICAL, INTENT(in   ) ::   ln_lsm_land
+      REAL(8)                ::   tmask  ( 1:jpi, 1:jpj, 1 ) 
+      INTEGER                ::   jj, ji        
+      INTEGER                ::   status,ncid,varid  
+      CHARACTER(len = *  )   ::   mask_file, mask_name
+      REAL(8)                ::   cff
+        
+      ! Read land-sea mask variable
+      status    = nf90_open(trim(mask_file),NF90_NOWRITE,ncid)      
+      status    = nf90_inq_varid(ncid,mask_name,varid)        
+      status    = nf90_get_var(ncid,varid,tmask,start=(/1,1,1/))                                             
+      status    = nf90_close(ncid)  
+      ! invert the mask (1 over the ocean, 0 over land if ln_lsm_land)
+      IF(ln_lsm_land) THEN
+         DO jj=1,jpj
+            DO ji=1,jpi
+               IF( tmask(ji,jj,1) <= 0. ) THEN
+                  tmask(ji,jj,1) = 1.     !! Ocean points
+               ELSE
+                  tmask(ji,jj,1) = 0.     !! Land points     
+               END IF
+            END DO
+         END DO  
+      ENDIF
+      ! remove some closed seas
+      DO jj=2,jpj-1
+         DO ji=2,jpi-1
+            cff = MAX( tmask(ji+1,jj  ,1),tmask(ji-1,jj  ,1), &
+               &       tmask(ji  ,jj+1,1),tmask(ji  ,jj-1,1), &
+               &       tmask(ji+1,jj+1,1),tmask(ji-1,jj-1,1), &
+               &       tmask(ji+1,jj-1,1),tmask(ji-1,jj+1,1) )     
+            IF( tmask( ji, jj, 1 ) .gt. 0.5 .and. cff .lt. 0.5 ) THEN
+               tmask( ji, jj, 1 ) = 0.
+            END IF
+         END DO
+      END DO
+      WRITE(*,*)' init_atm_mask: ',mask_name,' in ',mask_file, ' OK'
+      !!---------------------------------------------------------------------- 
+      !
+   END SUBROUTINE init_atm_mask
+
+
+       
+   SUBROUTINE get_pot_temp( jpi, jpj, jpka, slp, temp, Aw, Bw, tmask, method, hum1, z1 )         
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE get_pot_temp  ***
+      !!                   
+      !! ** Purpose :  compute the potential temperature based on the 
+      !!               absolute temperature and the sea level pressure
+      !!
+      !! ** Method  : five different ways are implemented depending on the 
+      !!              value of 'method'
+      !!       (0) potential temperature = absolute temperature (not recommended)
+      !!       (1) potential temperature is computed using a local reference 
+      !!                                pressure equal to the sea-level-pressure
+      !!       (2) potential temperature is computed only on a perturbation of 
+      !!                                  the absolute temperature around t0
+      !!       (3) a local reference pressure is used consistently with AEROBULK gamma_moist
+      !!       (4) a constant global reference pressure is used
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in   ) ::   jpi, jpj
+      INTEGER, INTENT(in   ) ::   jpka, method
+      REAL(8), INTENT(in   ) ::   slp   ( 1:jpi, 1:jpj         )
+      REAL(8), INTENT(in   ) ::   tmask ( 1:jpi, 1:jpj         )   
+      REAL(8), INTENT(in   ) ::   z1    ( 1:jpi, 1:jpj         )            
+      REAL(8), INTENT(inout) ::   temp  ( 1:jpi, 1:jpj, 1:jpka ) 
+      REAL(8), INTENT(in   ) ::   hum1  ( 1:jpi, 1:jpj         )       
+      REAL(8), INTENT(in   ) ::   Aw    (               0:jpka )
+      REAL(8), INTENT(in   ) ::   Bw    (               0:jpka )                         
+      REAL(8), PARAMETER     ::   grav   =   9.80665
+      REAL(8), PARAMETER     ::   R_dry  =   287.058 
+      REAL(8), PARAMETER     ::   R_vap  =   461.495
+      REAL(8), PARAMETER     ::   Cp_dry =   1005.             
+      REAL(8), PARAMETER     ::   cevap  =   2.5E+06       
+      REAL(8), PARAMETER     ::   reps0  =   R_dry / R_vap        
+      REAL(8), PARAMETER     ::   gamma  =   2./7.
+      REAL(8)                ::   pres0, gamma_moist, zrv, zirt     
+      REAL(8), PARAMETER     ::   t0     =      288.     !<-- K
+      !!
+      INTEGER                :: ji,jj,jk
+      REAL(8)                :: pres,ph(0:jpka), cff         
+      !!
+      SELECT CASE ( method ) 
+      CASE(0) 
+         RETURN
+      CASE(1)         
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+
+               IF( tmask(ji,jj) .gt. 0.5 ) THEN
+                  DO jk=0,jpka
+                     ph(jk) = Aw( jk ) + Bw( jk ) * slp( ji, jj )
+                  END DO            
+
+                  pres0 = 0.5*(ph(jpka)+ph(jpka-1))
+            
+                  DO jk=1,jpka
+                     pres = 0.5*(ph(jk)+ph(jk-1))
+                     cff  = ( pres0/pres )**gamma
+                     temp( ji, jj, jk ) = cff * temp( ji, jj, jk )
+                  END DO
+               ELSE
+                  temp( ji, jj, 1:jpka ) = 273.15
+               END IF
+            END DO
+         END DO        
+      CASE(2)
+         pres0 =   100900.      
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( tmask(ji,jj) .gt. 0.5 ) THEN
+                  DO jk=0,jpka
+                     ph(jk) = Aw( jk ) + Bw( jk ) * slp( ji, jj )
+                  END DO            
+            
+                  DO jk=1,jpka
+                     pres = 0.5*(ph(jk)+ph(jk-1))
+                     cff  = ( pres0/pres )**gamma
+                     temp( ji, jj, jk ) = cff * ( temp( ji, jj, jk ) - t0 ) + t0
+                  END DO
+               ELSE
+                  temp( ji, jj, 1:jpka ) = 273.15
+               END IF
+            END DO
+         END DO  
+      CASE(3)
+         DO jj = 1, jpj
+            DO ji = 1, jpi      
+               IF( tmask(ji,jj) .gt. 0.5 ) THEN
+                  DO jk=0,jpka
+                     ph(jk) = Aw( jk ) + Bw( jk ) * slp( ji, jj )
+                  END DO 
+                  !! compute gamma_moist consistently with AEROBULK
+                  zrv         = hum1( ji, jj ) / ( 1. - hum1( ji, jj ) )
+                  zirt        = 1. / ( R_dry * temp( ji, jj, jpka ) )
+                  gamma_moist = grav * ( 1. + cevap*zrv*ziRT )   & 
+                     &     / ( Cp_dry + cevap*cevap*zrv*reps0*ziRT/temp( ji, jj, jpka ) )       
+                  !! pressure at z = z1
+                  pres        = 0.5*(ph(jpka)+ph(jpka-1))                  
+                  pres0       = pres * ( 1. + gamma_moist * z1(ji,jj) / temp( ji, jj, jpka ) )**(1./gamma)
+                  DO jk=1,jpka
+                     pres = 0.5*(ph(jk)+ph(jk-1))
+                     cff  = ( pres0/pres )**gamma
+                     temp( ji, jj, jk ) = cff * temp( ji, jj, jk )
+                  END DO
+               ELSE
+                  temp( ji, jj, 1:jpka ) = 273.15
+               END IF
+            END DO
+         END DO            
+      CASE(4)
+         pres0 =   100900.      
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( tmask(ji,jj) .gt. 0.5 ) THEN
+                  DO jk=0,jpka
+                     ph(jk) = Aw( jk ) + Bw( jk ) * slp( ji, jj )
+                  END DO            
+            
+                  DO jk=1,jpka
+                     pres = 0.5*(ph(jk)+ph(jk-1))
+                     cff  = ( pres0/pres )**gamma
+                     temp( ji, jj, jk ) = cff * temp( ji, jj, jk )
+                  END DO
+               ELSE
+                  temp( ji, jj, 1:jpka ) = 273.15
+               END IF
+            END DO
+         END DO       
+      END SELECT
+      !
+   END SUBROUTINE get_pot_temp
+
+
+   SUBROUTINE Write_Grid_File( jpka, ght, ghw, e3t, e3w, grd_file  )  
+      !!
+      USE module_io
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE write_Grid_File  ***
+      !!                   
+      !! ** Purpose : write the ABL grid file  
+      !!
+      !! ** Method  : store the layer thickness and altitude of grid points 
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER,      INTENT(in   )  ::   jpka
+      REAL(8),      INTENT(in   )  ::   ght ( 1:jpka+1 )
+      REAL(8),      INTENT(in   )  ::   ghw ( 1:jpka+1 )      
+      REAL(8),      INTENT(in   )  ::   e3t ( 1:jpka+1 )
+      REAL(8),      INTENT(in   )  ::   e3w ( 1:jpka+1 )            
+      CHARACTER(*), INTENT(in   )  ::   grd_file
+      !!
+      INTEGER                      :: status, ncid
+      !!
+      status   = nf90_create( grd_file, NF90_WRITE, ncid )
+      status   = nf90_close ( ncid )    
+      !!  
+      Call Write_Ncdf_dim ( 'jpka' , grd_file, jpka+1 )       
+      Call Write_Ncdf_var ( 'ghw', 'jpka', grd_file, ghw, 'double' ) 
+      Call Write_Ncdf_var ( 'ght', 'jpka', grd_file, ght, 'double' )
+      Call Write_Ncdf_var ( 'e3t', 'jpka', grd_file, e3t, 'double' )
+      Call Write_Ncdf_var ( 'e3w', 'jpka', grd_file, e3w, 'double' )
+      !
+   END SUBROUTINE Write_Grid_File
+
+       
+
+
+
+   SUBROUTINE Init_output_File ( jpi, jpj, jpka, atm_file, abl_file, tmask  )  
+      !!
+      USE module_io
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE Init_output_File  ***
+      !!                   
+      !! ** Purpose :  write longitude, latitude and mask in the output file
+      !!
+      !! ** Method  : define dimensions in the netcdf file
+      !!----------------------------------------------------------------------
+      INTEGER,                    INTENT(in   )  ::   jpi,jpj,jpka
+      CHARACTER(*),               INTENT(in   )  ::   atm_file      
+      CHARACTER(*),               INTENT(in   )  ::   abl_file
+      REAL(8)                                    ::   tmask(1:jpi,1:jpj)
+      !!
+      REAL(8), ALLOCATABLE, DIMENSION(:      )   ::   tmp1d
+      INTEGER                                    ::   status, ncid
+      CHARACTER(len= 20),DIMENSION(4)            :: dimnames
+      !!
+      status   = nf90_create( abl_file, NF90_WRITE, ncid )
+      status   = nf90_close ( ncid )    
+      !!     
+      CALL Write_Ncdf_dim ( 'lon'    , abl_file, jpi     )
+      CALL Write_Ncdf_dim ( 'lat'    , abl_file, jpj     )
+      CALL Write_Ncdf_dim ( 'jpka'   , abl_file, jpka+1  )         
+      CALL Write_Ncdf_dim ( 'time'   , abl_file, 0       )     
+      !
+      ALLOCATE( tmp1d( 1:jpi ) )
+      !
+      CALL Read_Ncdf_var  ( 'lon', atm_file, tmp1d )
+      CALL Write_Ncdf_var ( 'lon', 'lon', abl_file, tmp1d, 'double' ) 
+      !
+      DEALLOCATE( tmp1d )
+      !
+      ALLOCATE( tmp1d( 1:jpj ) )           
+      !
+      CALL Read_Ncdf_var ( 'lat', atm_file, tmp1d )   
+      CALL Write_Ncdf_var( 'lat', 'lat', abl_file, tmp1d, 'double' )     
+      !
+      DEALLOCATE( tmp1d )   
+      !
+      dimnames(1) = 'lon'
+      dimnames(2) = 'lat'
+      CALL Write_Ncdf_var( 'lsm', dimnames , abl_file, tmask, 'float' )
+      !
+   END SUBROUTINE Init_output_File
+       
+       
+   SUBROUTINE Init_output_File_c1d ( jpi, jpj, jpka, atm_file, abl_file, tmask, iloc, jloc )
+      !!
+      USE module_io
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE Init_output_File  ***
+      !!
+      !! ** Purpose :  write longitude, latitude and mask in the output file
+      !!
+      !! ** Method  : define dimensions in the netcdf file
+      !!----------------------------------------------------------------------
+      INTEGER,                    INTENT(in   )  ::   iloc,jloc,jpi,jpj,jpka
+      CHARACTER(*),               INTENT(in   )  ::   atm_file
+      CHARACTER(*),               INTENT(in   )  ::   abl_file
+      REAL(8)                                    ::   tmask(1:jpi,1:jpj)
+      !!
+      REAL(8), ALLOCATABLE, DIMENSION(:      )   ::   tmp1d
+      REAL(8)                                    ::   tmp1d_loc(3),tmp2d_loc(3,3)
+      INTEGER                                    ::   status, ncid
+      CHARACTER(len= 20),DIMENSION(4)            :: dimnames
+      !!
+      status   = nf90_create( abl_file, NF90_WRITE, ncid )
+      status   = nf90_close ( ncid )
+      !!
+      CALL Write_Ncdf_dim ( 'lon'    , abl_file, 3       )
+      CALL Write_Ncdf_dim ( 'lat'    , abl_file, 3       )
+      CALL Write_Ncdf_dim ( 'jpka'   , abl_file, jpka+1  )
+      CALL Write_Ncdf_dim ( 'time'   , abl_file, 0       )
+      !
+      ALLOCATE( tmp1d    ( 1:jpi ) )
+      !
+      CALL Read_Ncdf_var  ( 'lon', atm_file, tmp1d )
+      tmp1d_loc( 1 ) = tmp1d(iloc)
+      tmp1d_loc( 2 ) = tmp1d(iloc)
+      tmp1d_loc( 3 ) = tmp1d(iloc)
+      CALL Write_Ncdf_var ( 'lon', 'lon', abl_file, tmp1d_loc, 'double' )
+      print*,'1D column located at : '
+      print*,'longitude = ',tmp1d(iloc),' degree_east'
+      !
+      DEALLOCATE( tmp1d )
+      !
+      ALLOCATE( tmp1d( 1:jpj ) )
+      !
+      CALL Read_Ncdf_var ( 'lat', atm_file, tmp1d )
+      tmp1d_loc( 1 ) = tmp1d(jloc)
+      tmp1d_loc( 2 ) = tmp1d(jloc)
+      tmp1d_loc( 3 ) = tmp1d(jloc)
+      CALL Write_Ncdf_var( 'lat', 'lat', abl_file, tmp1d_loc, 'double' )
+      print*,'latitude = ',tmp1d(jloc),' degree_north'
+      !
+      DEALLOCATE( tmp1d )
+      !
+      tmp2d_loc(:,:) = tmask(iloc,jloc)       
+      dimnames(1) = 'lon'
+      dimnames(2) = 'lat'
+      CALL Write_Ncdf_var( 'lsm', dimnames , abl_file, tmp2d_loc, 'float' )
+      !
+   END SUBROUTINE Init_output_File_c1d       
+       
+
+   SUBROUTINE init_target_grid( jpka, ght, ghw, e3t, e3w, hmax, hc, theta_s,  &
+      &                                                        force_z1, z1 )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE init_target_grid  ***
+      !!                   
+      !! ** Purpose : compute the layer thickness and altitude of grid points 
+      !!              for the ABL model based on the namelist parameter values  
+      !!
+      !! ** Method  : depending on the logical 'force_z1' two methods are used
+      !!              (1) true -> the user chooses the value of the first vertical
+      !!                  grid point. A few Newton iterations are used to correct  
+      !!                  the value of the parameter theta_s to satisfy this constraint
+      !!              (2) false -> use the parameter values in the namelist to 
+      !!                  compute the vertical grid
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, intent(in   )    :: jpka
+      REAL(8), intent(in   )    :: hmax,hc
+      REAL(8), intent(inout)    :: theta_s      
+      LOGICAL, intent(in   )    :: force_z1
+      REAL(8), intent(in   )    :: z1
+      !!
+      REAL(8), intent(  out)    :: ghw( 1:jpka+1 )
+      REAL(8), intent(  out)    :: ght( 1:jpka+1 )      
+      REAL(8), intent(  out)    :: e3w( 1:jpka+1 )
+      REAL(8), intent(  out)    :: e3t( 1:jpka+1 ) 
+      !! 
+      REAL(8)                   ::  ds,cff,sc_w,sc_r,alpha,x
+      REAL(8)                   ::  fx,fxp
+      INTEGER                   ::  jk,maxiter,jiter
+      REAL(8), PARAMETER        :: tol = 1.E-12
+      !!
+      IF(force_z1) THEN
+        IF(z1.LT.10.) THEN
+          WRITE(*,*) " ERROR: z1 < 1st ECMWF level height (~10m)"
+          STOP
+        ELSE
+          !! Newton iterations to find the appropriate value of theta_s
+          maxiter = 1000
+          x       = theta_s
+          sc_r    = (float(1)-0.5)/float(jpka)
+          alpha   = (z1 - hc*sc_r) / (hmax - hc)
+          !
+          DO jiter=1,maxiter
+             fx   = (sinh(sc_r*x)/sinh(x))-alpha
+             fxp  = (sc_r*cosh(sc_r*x)-sinh(sc_r*x)*cosh(x)/sinh(x))/sinh(x)
+             IF( abs(fx) .lt. tol ) THEN
+                   exit
+             ENDIF
+             cff  = fx / fxp
+             x    = x - cff      
+          ENDDO
+          !
+          theta_s = x
+        END IF
+        !   
+      ENDIF
+      !
+      ds =1./float(jpka)
+      cff=(hmax-hc)/sinh(theta_s)
+      !
+      DO jk = jpka,1,-1
+        sc_w      = ds*float(jk)
+        ghw(jk+1) = hc*sc_w + cff*sinh(theta_s*sc_w)
+        sc_r      = ds*(float(jk)-0.5)
+        ght(jk+1) = hc*sc_r + cff*sinh(theta_s*sc_r)
+      END DO
+      !
+      ghw(1) = 0.
+      e3t(1) = 0.
+      ght(1) = 0.
+      !
+      DO jk = 2,jpka+1
+        e3t(jk) = ghw(jk)-ghw(jk-1)
+      END DO
+      !
+      DO jk=1,jpka
+        e3w(jk)  = ght(jk+1)-ght(jk)
+      END DO
+      !
+      e3w(jpka+1) = ghw(jpka+1) - ght(jpka+1)          
+      !
+      IF(force_z1) THEN   !++ print the new parameter values
+         print*,'*** Updated grid parameters'
+         print*,'theta_s = ',theta_s
+         print*,'hc      = ',hc      
+         print*,'hmax    = ',hmax         
+         print*,'ght(2)  = ',ght(2)
+      ENDIF      
+      !
+   END SUBROUTINE init_target_grid
+   
+   
+   
+   
+   
+
+   SUBROUTINE flip_vert_dim( kstr, kend, jpi, jpj, tabin )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE flip_vert_dim  ***
+      !!                   
+      !! ** Purpose : flip the vertical axis of the array tabin so that    
+      !!              the vertical grid goes from k=kstr at the bottom 
+      !!              of the ABL to k=kend at the top
+      !!----------------------------------------------------------------------
+      INTEGER, intent(in   )   :: kstr,kend
+      INTEGER, intent(in   )   :: jpi, jpj 
+      REAL(8), intent(inout)   :: tabin( 1:jpi, 1:jpj, kstr:kend )
+      !!
+      INTEGER                  :: ji,jj,jk,ks
+      REAL(8)                  :: tabfl(kstr:kend)
+      !
+      DO jj = 1,jpj
+         DO ji = 1,jpi
+            DO jk=kstr,kend
+               ks=(kend-jk)+kstr
+               tabfl(ks) = tabin( ji, jj, jk ) 
+            END DO
+            tabin( ji, jj, kstr:kend ) = tabfl( kstr:kend )
+         END DO 
+      END DO 
+      !
+   END SUBROUTINE flip_vert_dim
+   
+  
+
+
+
+
+
+   SUBROUTINE smooth_field( jpi, jpj, varin, tmask, niter )         
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE smooth_field  ***
+      !!                   
+      !! ** Purpose : smooth the sea level pressure over the ocean
+      !!              to attenuate Gibbs oscillation 
+      !! ** Method  : a 9-point isotropic laplacian filter is applied
+      !!              iteratively on ocean grid points only
+      !!
+      !! Proper treatment of the periodicity is still not yet implemented
+      !!
+      !!----------------------------------------------------------------------     
+      INTEGER, INTENT(in   ) ::   jpi, jpj, niter  
+      REAL(8), INTENT(in   ) ::   tmask  ( 1:jpi, 1:jpj )        
+      REAL(8), INTENT(inout) ::   varin  ( 1:jpi, 1:jpj )
+      INTEGER                :: ji,jj,nit
+      REAL(8)                :: smth_a,smth_b,umask,vmask 
+      REAL(8)                :: FX ( 0:jpi  , 0:jpj+1 )
+      REAL(8)                :: FE1( 0:jpi+1, 0:jpj   )
+      REAL(8)                :: FE ( 1:jpi  , 0:jpj   )       
+      !!  
+      !!=========================================================
+      !!    
+      ! Hanning filter
+      !smth_a = 1./8.
+      !smth_b = 1./4.     
+      ! 9-point isotropic laplacian filter
+      smth_a = 1./12.
+      smth_b = 3./16.      
+
+      FX ( 0:jpi  , 0:jpj+1 ) = 0.
+      FE1( 0:jpi+1, 0:jpj   ) = 0.
+      FE ( 1:jpi  , 0:jpj   ) = 0.
+
+      !!+++++++++
+      DO nit = 1,niter
+      !!+++++++++
+         DO jj=1,jpj              
+            DO ji=1,jpi-1          
+            umask = tmask(ji,jj)*tmask(ji+1,jj)  
+            FX ( ji, jj ) = ( varin( ji+1,jj ) - varin( ji  ,jj ) ) * umask  
+            END DO                    
+         END DO
+         FX(   0  , 1:jpj ) = FX( jpi-1, 1:jpj  )
+         FX  ( jpi, 1:jpj ) = FX(     1, 1:jpj  )      
+         FX( 0:jpi, 0     ) = FX( 0:jpi,     1  )
+         FX( 0:jpi, jpj+1 ) = FX( 0:jpi,     jpj)           
+         !!
+         DO jj=1,jpj-1                 
+            DO ji=1,jpi
+               vmask = tmask(ji,jj)*tmask(ji,jj+1)  
+               FE1( ji, jj ) = ( varin( ji, jj+1 ) - varin( ji  ,jj ) ) * vmask 
+           END DO
+         END DO
+         !! 
+         FE1( 0      , 1:jpj-1 ) = FE1( jpi , 1:jpj-1 )
+         FE1( jpi+1  , 1:jpj-1 ) = FE1(   1 , 1:jpj-1 )      
+         FE1( 0:jpi+1,    0    ) = 0.
+         FE1( 0:jpi+1,    jpj  ) = 0. 
+         !!
+         DO jj=0,jpj                 
+            DO ji=1,jpi
+               FE ( ji, jj ) =   FE1( ji, jj   )                   &
+               & +  smth_a*(  FX ( ji, jj+1 ) + FX( ji-1, jj   )   &
+               &           -  FX ( ji, jj   ) - FX( ji-1, jj+1 ) )
+            END DO
+         END DO
+         !!
+         DO jj = 1, jpj
+            DO ji = 0,jpi
+               FX( ji, jj ) = FX( ji, jj )         &
+              &    + smth_a*( FE1( ji+1, jj ) + FE1( ji  , jj-1 )    &
+              &              -FE1( ji  , jj ) - FE1( ji+1, jj-1 ) )
+            END DO
+            DO ji = 1,jpi
+               varin( ji  ,jj ) = varin( ji  ,jj ) &
+     &         + tmask(ji,jj) * smth_b * (         &
+     &                  FX( ji, jj ) - FX( ji-1, jj )          &
+     &                 +FE( ji, jj ) - FE( ji, jj-1 )  )
+            END DO
+         END DO      
+         !!
+      !!+++++++++      
+      END DO
+      !!+++++++++   
+            
+   END SUBROUTINE smooth_field
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+   
+
+  
+
+
+
+
+!   SUBROUTINE DTV_Filter( jpi, jpj, varin, tmask, niter, time )         
+!      USE module_io
+!      !!---------------------------------------------------------------------
+!      !!                    ***  ROUTINE DTV_Filter  ***
+!      !!                   
+!      !! ** Purpose :   
+!      !!
+!      !! ** Method  : 
+!      !!
+!      !! ** Action  : 
+!      !!----------------------------------------------------------------------   
+!      INTEGER, INTENT(in   ) ::   jpi, jpj, niter, time 
+!      REAL(8), INTENT(in   ) ::   tmask  ( 1:jpi, 1:jpj )        
+!      REAL(8), INTENT(inout) ::   varin  ( 1:jpi, 1:jpj )
+!      INTEGER                ::   jn, jj, ji, nit, nt_n, nt_a, nl2      
+!      REAL(8)                ::   var0,mean,sigma2,cff,lambda
+!      REAL(8)                ::   FX(0:jpi+1,0:jpj+1)
+!      REAL(8)                ::   FE(0:jpi+1,0:jpj+1)
+!      REAL(8)                ::   FL(0:jpi+1,0:jpj+1)
+!      REAL(8)                ::   FR(0:jpi+1,0:jpj+1)  
+!      REAL(8)                ::   wrk ( 1:jpi, 1:jpj, 2 ) 
+!      REAL(8)                ::   div ( 0:jpi+1, 0:jpj+1 ), diag               
+!      REAL(8), PARAMETER     ::   rsmall = 1.E-08
+!      REAL(8), PARAMETER     ::   rbig   = 1.E+14
+!      REAL(8)                ::   umask, vmask, fmask, wght(8), dt
+!      REAL(8)                ::   L2norm_n, L2norm_a
+!      REAL(8), ALLOCATABLE, DIMENSION(:      )   ::   tmp1d      
+!      INTEGER                :: status,ncid,varid1,varid2,dimid1,dimid2  
+!      !!=========================================================
+!      CHARACTER(len=  3  )   :: nn
+!      CHARACTER(len = 500)   :: erai_file, smth_file
+!      LOGICAL                :: ln_diag_smoothing
+!      ln_diag_smoothing = .true.
+!      IF( ln_diag_smoothing ) THEN
+!         erai_file = '/Users/florianlemarie/Documents/INRIA/SIMBAD/ERA_INTERIM_DECEMBRE_2015/phi_ml1_6h_erai_201512.nc'
+!         WRITE(nn,'(I3)') time
+!         DO ji=1,3
+!            IF(nn(ji:ji)==' ') nn(ji:ji)='0'
+!         END DO
+!      
+!         smth_file = 'smoothing_results_DTV_'//nn//'.nc'  
+!         status    = nf90_create( trim(smth_file) , NF90_WRITE, ncid )
+!         status    = nf90_close ( ncid )    
+!         !   
+!         CALL Write_Ncdf_dim ( 'lon'    , trim(smth_file) , jpi     )
+!         CALL Write_Ncdf_dim ( 'lat'    , trim(smth_file) , jpj     )
+!         !
+!         ALLOCATE( tmp1d( 1:jpi ) )
+!         CALL Read_Ncdf_var  ( 'lon', erai_file, tmp1d )
+!         CALL Write_Ncdf_var ( 'lon', 'lon', trim(smth_file), tmp1d, 'double' ) 
+!         DEALLOCATE( tmp1d )
+!         !
+!         ALLOCATE( tmp1d( 1:jpj ) )           
+!         CALL Read_Ncdf_var ( 'lat', erai_file, tmp1d )   
+!         CALL Write_Ncdf_var( 'lat', 'lat', trim(smth_file), tmp1d, 'double' )     
+!         DEALLOCATE( tmp1d ) 
+!         !         
+!         status = nf90_open(trim(smth_file),NF90_WRITE,ncid)     
+!         status = nf90_inq_dimid(ncid, 'lon', dimid1)
+!         status = nf90_inq_dimid(ncid, 'lat', dimid2)
+!         status = nf90_redef(ncid)      
+!         status = nf90_def_var(ncid,'varinp',nf90_double,(/dimid1,dimid2/),varid1)        
+!         status = nf90_def_var(ncid,'varout',nf90_double,(/dimid1,dimid2/),varid2)   
+!         status = nf90_enddef(ncid)
+!         ! 
+!         !
+!         status = nf90_put_var(ncid,varid1,varin)
+!      END IF
+!      !!=========================================================
+!      nit    = 0
+!      nl2    = 0
+!      L2norm_a = 0.
+!      L2norm_n = rbig      
+!      nt_n   = 1 + MOD( nit  , 2 )
+!      nt_a   = 1 + MOD( nit+1, 2 )      
+!      var0   = varin(  nint(0.5*jpi) , nint(0.5*jpj) )  
+!      varin( 1:jpi, 1:jpj       ) = varin( 1:jpi, 1:jpj ) - var0
+!      wrk  ( 1:jpi, 1:jpj, nt_n ) = varin( 1:jpi, 1:jpj )
+!      !! Compute the mean first
+!      mean   = Get_Mean ( jpi , jpj,  varin, tmask       )
+!      sigma2 = Get_Vari ( jpi , jpj,  varin, tmask, mean )
+!      !!
+!      print*,'mean value over the ocean = ',mean + var0
+!      print*,'variance of the input field = ',sigma2      
+!      !!
+!      lambda = (1. / sigma2      )
+!      dt     =  1. / (16.+lambda)
+!      diag   =  0.
+!      
+!      !!>>>>>>>>>>>>>>>>
+!      DO nit = 1,niter
+!      !!>>>>>>>>>>>>>>>>
+!      FX(0:jpi+1,0:jpj+1) = 0.
+!      FE(0:jpi+1,0:jpj+1) = 0.
+!      FL(0:jpi+1,0:jpj+1) = 0.
+!      FR(0:jpi+1,0:jpj+1) = 0.
+!      !!
+!      DO jj = 1,jpj
+!         DO ji = 1,jpi-1
+!            umask        = tmask(ji,jj)*tmask(ji+1,jj)  
+!            FX( ji, jj ) = umask * ( wrk( ji+1, jj, nt_n ) - wrk( ji, jj, nt_n ) )
+!         END DO
+!      END DO  
+!      !!
+!      DO jj = 1,jpj-1
+!         DO ji = 1,jpi
+!            vmask        = tmask(ji,jj)*tmask(ji,jj+1)
+!            FE( ji, jj ) = vmask * ( wrk( ji, jj+1, nt_n ) - wrk( ji, jj, nt_n ) )
+!         END DO
+!      END DO       
+!      !!
+!      DO jj = 1,jpj-1
+!         DO ji = 1,jpi-1
+!            fmask        = tmask(ji,jj)*tmask(ji+1,jj+1)*diag
+!            FL( ji, jj ) = fmask * ( wrk( ji+1, jj+1, nt_n ) - wrk( ji  , jj, nt_n   ) )
+!            fmask        = tmask(ji+1,jj)*tmask(ji,jj+1)*diag       
+!            FR( ji, jj ) = fmask * ( wrk( ji  , jj+1, nt_n ) - wrk( ji+1, jj, nt_n ) )
+!         END DO
+!      END DO 
+!      !!
+!      div( 0:jpi+1, 0:jpj+1 ) = rsmall
+!      !!
+!      DO jj = 1,jpj+1
+!         DO ji = 1,jpi+1           
+!            div(ji,jj) = MAX( sqrt(  FX(ji,jj)**2 + FX(ji-1,jj  )**2 + FE(ji,jj  )**2 + FX(ji,jj-1)**2          &
+!            &                      + FL(ji,jj)**2 + FL(ji-1,jj-1)**2 + FR(ji,jj-1)**2 + FR(ji-1,jj)**2 ), rsmall ) 
+!         END DO
+!      END DO
+!      
+!      
+!       
+!      
+!      DO jj=1,jpj
+!         DO ji=1,jpi
+!            IF( div(ji,jj) .eq. rsmall .or. tmask(ji,jj).lt.0.5 ) THEN
+!               wrk(ji,jj,nt_a) = wrk(ji,jj,nt_n)
+!            ELSE
+!               wght(1)     = 1. +  div(ji,jj) / div(ji+1,jj  ) 
+!               wght(2)     = 1. +  div(ji,jj) / div(ji-1,jj  ) 
+!               wght(3)     = 1. +  div(ji,jj) / div(ji  ,jj+1)                        
+!               wght(4)     = 1. +  div(ji,jj) / div(ji  ,jj-1)           
+!               wght(5)     = 1. +  div(ji,jj) / div(ji+1,jj+1)   
+!               wght(6)     = 1. +  div(ji,jj) / div(ji-1,jj+1)
+!               wght(7)     = 1. +  div(ji,jj) / div(ji-1,jj-1)                       
+!               wght(8)     = 1. +  div(ji,jj) / div(ji+1,jj-1)             
+!              
+!            wrk(ji,jj,nt_a) = wrk(ji,jj,nt_n) +  dt*(                   &
+!               &            + FX(ji  ,jj  ) * wght(1)                   &
+!               &            - FX(ji-1,jj  ) * wght(2)                   &
+!               &            + FE(ji  ,jj  ) * wght(3)                   &
+!               &            - FE(ji  ,jj-1) * wght(4)                   &
+!               &            + FL(ji  ,jj  ) * wght(5)                   &
+!               &            + FR(ji-1,jj  ) * wght(6)                   &
+!               &            - FL(ji-1,jj-1) * wght(7)                   &
+!               &            - FR(ji  ,jj-1) * wght(8)                   &
+!               &            - lambda * div(ji,jj) * ( wrk(ji,jj,nt_n) - varin(ji,jj) ) )  
+!               
+!              IF( isnan(wrk(ji,jj,nt_a)) ) THEN 
+!                  print*,'Nan in smoothing at iteration ',nit
+!                  print*,'at grid point ',ji,jj
+!              END IF    
+!              IF( abs(wrk(ji,jj,nt_a)) .gt. rbig ) THEN
+!                  print*,'Inf in smoothing at iteration ',nit
+!                  print*,'at grid point ',ji,jj                                    
+!              END IF
+!                 L2norm_a = L2norm_a + ( wrk(ji,jj,nt_n)-wrk(ji,jj,nt_a) )**2
+!              END IF                 
+!         END DO
+!      END DO
+!
+!
+!      mean   = Get_Mean ( jpi , jpj,  wrk(:,:,nt_a), tmask       )
+!      sigma2 = Get_Vari ( jpi , jpj,  wrk(:,:,nt_a), tmask, mean )
+!      !!
+!      print*,'mean value over the ocean = ',mean + var0
+!      print*,'variance of the input field = ',sigma2   
+!
+!      
+!      IF( L2norm_a .gt. L2norm_n ) THEN
+!         print*,'convergence after ',nit,' iterations'
+!!         EXIT
+!      END IF     
+!      L2norm_n = L2norm_a 
+!      L2norm_a = 0.     
+!      nt_n = 1 + MOD( nit  , 2 )
+!      nt_a = 1 + MOD( nit+1, 2 ) 
+!           
+!      !!>>>>>>>>>>>>>>>>
+!      END DO
+!      !!>>>>>>>>>>>>>>>>
+!
+!       
+!      DO jj=1,jpj
+!         DO ji=1,jpi
+!            varin(ji,jj) = ( wrk(ji,jj,nt_n) + var0 )*tmask(ji,jj)
+!         END DO
+!      END DO
+!
+!      IF( ln_diag_smoothing ) THEN
+!         status = nf90_put_var(ncid,varid2,varin)
+!         status = nf90_close(ncid)
+!      END IF   
+!      !
+!   END SUBROUTINE dtv_filter
+!
+!
+!
+!   REAL(8) FUNCTION Get_Mean ( jpi , jpj, tabvar, tmask )
+!      !!---------------------------------------------------------------------
+!      !!                    ***  FUNCTION Get_Mean  ***
+!      !!                   
+!      !! ** Purpose : get the mean of the input field 
+!      !!
+!      !!----------------------------------------------------------------------
+!      INTEGER,   INTENT(in)      :: jpi,jpj
+!      REAL(8),   INTENT(in)      :: tabvar(jpi,jpj)
+!      REAL(8),   INTENT(in)      :: tmask (jpi,jpj)
+!      INTEGER                    :: ji,jj,jn    
+!      
+!      !! Compute the mean first
+!      jn       = 0
+!      Get_Mean = 0.
+!      DO jj = 1, jpj
+!         DO ji = 1, jpi
+!            IF(tmask(ji,jj) .gt. 0.5) THEN
+!               Get_Mean = Get_Mean + tabvar( ji,jj )  
+!               jn=jn+1
+!            END IF  
+!         END DO
+!      END DO      
+!      Get_Mean   = (1./jn)   * Get_Mean  
+!      !
+!   END FUNCTION Get_Mean
+!      
+!
+!
+!
+!
+!   REAL(8) FUNCTION Get_Vari ( jpi , jpj, tabvar, tmask, mean )
+!      !!---------------------------------------------------------------------
+!      !!                    ***  FUNCTION Get_Mean  ***
+!      !!                   
+!      !! ** Purpose : get the mean of the input field 
+!      !!
+!      !!----------------------------------------------------------------------
+!      INTEGER,   INTENT(in)      :: jpi,jpj
+!      REAL(8),   INTENT(in)      :: tabvar(jpi,jpj)
+!      REAL(8),   INTENT(in)      :: tmask (jpi,jpj), mean
+!      INTEGER                    :: ji,jj,jn    
+!      
+!      jn       = 0
+!      Get_Vari = 0
+!      !!
+!      DO jj = 1, jpj
+!         DO ji = 1, jpi
+!            IF(tmask(ji,jj) .gt. 0.5) THEN
+!              Get_Vari = Get_Vari + ( tabvar(ji,jj) - mean )**2 
+!              jn = jn+1 
+!            ENDIF  
+!         END DO
+!      END DO 
+!      Get_Vari   = (1./jn)   * Get_Vari 
+!      !
+!   END FUNCTION Get_Vari
+
+
+   
+END MODULE module_grid
Index: /utils/tools_ticket2413/ABL_TOOLS/module_interp.F90
===================================================================
--- /utils/tools_ticket2413/ABL_TOOLS/module_interp.F90	(revision 12863)
+++ /utils/tools_ticket2413/ABL_TOOLS/module_interp.F90	(revision 12863)
@@ -0,0 +1,608 @@
+MODULE module_interp
+   !!======================================================================
+   !!                   ***  MODULE  module_interp  ***
+   !! Ocean forcing:  bulk thermohaline forcing of the ocean (or ice)
+   !!=====================================================================
+   !! History : 2016-10  (F. Lemarié)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   zinterp                : 
+   !!   reconstructandremap    : 
+   !!   reconstructandremap_ps :
+   !! 
+   !!----------------------------------------------------------------------
+   IMPLICIT NONE
+
+CONTAINS
+
+   SUBROUTINE zinterp( jpi, jpj, jpka, jpka_in, ind, tab_in, e3t_in, e3_bak, &   
+      &                              e3t_out, tab_out, interp_type           )   
+      
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE zinterp  ***
+      !!                   
+      !! ** Purpose :   
+      !!
+      !! ** Method  :
+      !!
+      !! ** Action  :  
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in   ) ::   jpi, jpj
+      INTEGER, INTENT(in   ) ::   jpka, jpka_in, interp_type
+      INTEGER, INTENT(in   ) ::   ind     ( 1:jpi, 1:jpj            )
+      REAL(8), INTENT(inout) ::   tab_in  ( 1:jpi, 1:jpj, 1:jpka_in )
+      REAL(8), INTENT(in   ) ::   e3t_in  ( 1:jpi, 1:jpj, 1:jpka_in )
+      REAL(8), INTENT(in   ) ::   e3_bak  ( 1:jpi, 1:jpj            )            
+      REAL(8), INTENT(in   ) ::   e3t_out (               1:jpka+1  )                           
+      REAL(8), INTENT(  out) ::   tab_out ( 1:jpi, 1:jpj, 1:jpka+1  )  
+      !!
+      INTEGER                :: ji,jj,k_in
+      REAL(8)                :: val1,val2,cff
+      
+      SELECT CASE(interp_type)
+      CASE(1)      ! WENO
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               k_in = ind( ji, jj )
+               val1 = tab_in ( ji, jj, k_in-1 )
+               val2 = tab_in ( ji, jj, k_in   )
+               cff  =        val1 * e3_bak( ji, jj         )     &
+                  & +        val2 * e3t_in( ji, jj, k_in-1 )     &
+                  & + (val2-val1) * e3t_in( ji, jj, k_in   )             
+               tab_in( ji, jj, k_in ) = cff / ( e3_bak( ji, jj ) + e3t_in ( ji, jj, k_in-1 ) )
+               !
+               CALL reconstructandremap( tab_in ( ji, jj, 1:k_in   ), e3t_in( ji, jj, 1:k_in ),   &
+                  &                      tab_out( ji, jj, 2:jpka+1 ), e3t_out (    2:jpka+1  ),   &
+                  &                      k_in, jpka )  
+               !
+            END DO
+         END DO   
+      CASE(2)      ! SPLINES
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               k_in = ind( ji, jj )
+               val1 = tab_in ( ji, jj, k_in-1 )
+               val2 = tab_in ( ji, jj, k_in   )
+               cff  =        val1 * e3_bak( ji, jj         )     &
+                  & +        val2 * e3t_in( ji, jj, k_in-1 )     &
+                  & + (val2-val1) * e3t_in( ji, jj, k_in   )             
+               tab_in( ji, jj, k_in ) = cff / ( e3_bak( ji, jj ) + e3t_in ( ji, jj, k_in-1 ) )
+               !
+               CALL reconstructandremap_ps( tab_in ( ji, jj, 1:k_in   ), e3t_in( ji, jj, 1:k_in ),   &
+                  &                         tab_out( ji, jj, 2:jpka+1 ), e3t_out (    2:jpka+1  ),   &
+                  &                         k_in, jpka )  
+               !
+            END DO
+         END DO  
+      CASE DEFAULT
+         WRITE(*,*) "### Error: problem in zinterp, interp_type not set properly"
+         STOP
+      END SELECT      
+      !
+   END SUBROUTINE zinterp     
+
+
+
+
+
+!
+!===================================================================================================
+subroutine reconstructandremap(tabin,hin,tabout,hout,N,Nout)
+!---------------------------------------------------------------------------------------------------
+      implicit none
+      integer            :: N, Nout
+      real(8)            :: tabin(N), tabout(Nout)
+      real(8)            :: hin(N), hout(Nout)
+      real(8)            :: coeffremap(N,3),zwork(N,3)
+      real(8)            :: zwork2(N+1,3)
+      integer            :: k
+      real(8), parameter :: dsmll=1.0d-8  
+      real(8)            :: q,q01,q02,q001,q002,q0
+      real(8)            :: z_win(1:N+1), z_wout(1:Nout+1)
+      real(8),parameter  :: dpthin = 1.D-3
+      integer            :: k1, kbox, ktop, ka, kbot
+      real(8)            :: tsum, qbot, rpsum, zbox, ztop, zthk, zbot, offset, qtop
+!-----
+
+!----------------------
+      z_win(1)=0.; z_wout(1)= 0.
+      do k=1,N
+       z_win(k+1)=z_win(k)+hin(k)
+      enddo 
+      
+      do k=1,Nout
+       z_wout(k+1)=z_wout(k)+hout(k)       
+      enddo       
+
+        do k=2,N
+          zwork(k,1)=1./(hin(k-1)+hin(k))
+        enddo
+        
+        do k=2,N-1
+          q0 = 1./(hin(k-1)+hin(k)+hin(k+1))
+          zwork(k,2)=hin(k-1)+2.*hin(k)+hin(k+1)
+          zwork(k,3)=q0
+        enddo       
+      
+        do k= 2,N
+        zwork2(k,1)=zwork(k,1)*(tabin(k)-tabin(k-1))
+        enddo
+        
+        coeffremap(:,1) = tabin(:)
+ 
+         do k=2,N-1
+        q001 = hin(k)*zwork2(k+1,1)
+        q002 = hin(k)*zwork2(k,1)        
+        if (q001*q002 < 0) then
+          q001 = 0.
+          q002 = 0.
+        endif
+        q=zwork(k,2)
+        q01=q*zwork2(k+1,1)
+        q02=q*zwork2(k,1)
+        if (abs(q001) > abs(q02)) q001 = q02
+        if (abs(q002) > abs(q01)) q002 = q01
+        
+        q=(q001-q002)*zwork(k,3)
+        q001=q001-q*hin(k+1)
+        q002=q002+q*hin(k-1)
+        
+        coeffremap(k,3)=coeffremap(k,1)+q001
+        coeffremap(k,2)=coeffremap(k,1)-q002
+        
+        zwork2(k,1)=(2.*q001-q002)**2
+        zwork2(k,2)=(2.*q002-q001)**2
+        enddo
+        
+        do k=1,N
+        if     (k.eq.1 .or. k.eq.N .or.   hin(k).le.dpthin) then
+        coeffremap(k,3) = coeffremap(k,1)
+        coeffremap(k,2) = coeffremap(k,1)
+        zwork2(k,1) = 0.
+        zwork2(k,2) = 0.
+        endif
+        enddo
+        
+        do k=2,N
+        q002=max(zwork2(k-1,2),dsmll)
+        q001=max(zwork2(k,1),dsmll)
+        zwork2(k,3)=(q001*coeffremap(k-1,3)+q002*coeffremap(k,2))/(q001+q002)
+        enddo
+        
+        zwork2(1,3) = 2*coeffremap(1,1)-zwork2(2,3)
+        zwork2(N+1,3)=2*coeffremap(N,1)-zwork2(N,3)
+ 
+        do k=1,N
+        q01=zwork2(k+1,3)-coeffremap(k,1)
+        q02=coeffremap(k,1)-zwork2(k,3)
+        q001=2.*q01
+        q002=2.*q02
+        if (q01*q02<0) then
+          q01=0.
+          q02=0.
+        elseif (abs(q01)>abs(q002)) then
+          q01=q002
+        elseif (abs(q02)>abs(q001)) then
+          q02=q001
+        endif
+        coeffremap(k,2)=coeffremap(k,1)-q02
+        coeffremap(k,3)=coeffremap(k,1)+q01
+        enddo
+
+      zbot=0.0
+      kbot=1
+      do k=1,Nout
+        ztop=zbot  !top is bottom of previous layer
+        ktop=kbot
+        if     (ztop.ge.z_win(ktop+1)) then
+          ktop=ktop+1
+        endif
+        
+        zbot=z_wout(k+1)
+        zthk=zbot-ztop
+
+        if     (zthk.gt.dpthin .and. ztop.lt.z_wout(Nout+1)) then
+
+          kbot=ktop
+          do while (z_win(kbot+1).lt.zbot.and.kbot.lt.N)
+            kbot=kbot+1
+          enddo
+          zbox=zbot
+          do k1= k+1,Nout
+            if     (z_wout(k1+1)-z_wout(k1).gt.dpthin) then
+              exit !thick layer
+            else
+              zbox=z_wout(k1+1)  !include thin adjacent layers
+              if     (zbox.eq.z_wout(Nout+1)) then
+                exit !at bottom
+              endif
+            endif
+          enddo
+          zthk=zbox-ztop
+
+          kbox=ktop
+          do while (z_win(kbox+1).lt.zbox.and.kbox.lt.N)
+            kbox=kbox+1
+          enddo
+          
+          if     (ktop.eq.kbox) then
+
+
+            if     (z_wout(k)  .ne.z_win(kbox)   .or.z_wout(k+1).ne.z_win(kbox+1)     ) then
+
+              if     (hin(kbox).gt.dpthin) then
+                q001 = (zbox-z_win(kbox))/hin(kbox)
+                q002 = (ztop-z_win(kbox))/hin(kbox)
+                q01=q001**2+q002**2+q001*q002+1.-2.*(q001+q002)
+                q02=q01-1.+(q001+q002)
+                q0=1.-q01-q02
+              else
+                q0 = 1.0
+                q01 = 0.
+                q02 = 0.
+              endif
+          tabout(k)=q0*coeffremap(kbox,1)+q01*coeffremap(kbox,2)+q02*coeffremap(kbox,3)
+              
+            else
+            tabout(k) = tabin(kbox)
+              
+            endif 
+
+          else
+
+            if     (ktop.le.k .and. kbox.ge.k) then
+              ka = k
+            elseif (kbox-ktop.ge.3) then
+              ka = (kbox+ktop)/2
+            elseif (hin(ktop).ge.hin(kbox)) then
+              ka = ktop
+            else
+              ka = kbox
+            endif !choose ka
+
+            offset=coeffremap(ka,1)
+
+            qtop = z_win(ktop+1)-ztop !partial layer thickness
+            if     (hin(ktop).gt.dpthin) then
+              q=(ztop-z_win(ktop))/hin(ktop)
+              q01=q*(q-1.)
+              q02=q01+q
+              q0=1-q01-q02            
+            else
+              q0 = 1.
+              q01 = 0.
+              q02 = 0.
+            endif
+            
+            tsum =((q0*coeffremap(ktop,1)+q01*coeffremap(ktop,2)+q02*coeffremap(ktop,3))-offset)*qtop
+
+            do k1= ktop+1,kbox-1
+              tsum =tsum +(coeffremap(k1,1)-offset)*hin(k1)
+            enddo !k1
+
+            
+            qbot = zbox-z_win(kbox) !partial layer thickness
+            if     (hin(kbox).gt.dpthin) then
+              q=qbot/hin(kbox)
+              q01=(q-1.)**2
+              q02=q01-1.+q
+              q0=1-q01-q02                            
+            else
+              q0 = 1.0
+              q01 = 0.
+              q02 = 0.
+            endif
+           
+            tsum = tsum +((q0*coeffremap(kbox,1)+q01*coeffremap(kbox,2)+q02*coeffremap(kbox,3))-offset)*qbot
+            
+            rpsum=1.0d0/zthk
+              tabout(k)=offset+tsum*rpsum
+              
+          endif !single or multiple layers
+        else
+        if (k==1) then
+        print *,'problem = ',zthk,z_wout(k+1),hout(1)
+        endif
+         tabout(k) = tabout(k-1)
+          
+        endif !normal:thin layer
+      enddo !k
+            
+      return
+      
+!---------------------------------------------------------------------------------------------------
+end subroutine reconstructandremap
+!===================================================================================================
+!
+
+
+
+
+
+
+
+
+
+!
+!===================================================================================================
+      subroutine reconstructandremap_ps(tabin,hin,tabout,hout,N,Nout)      ! parabloc spline
+!---------------------------------------------------------------------------------------------------      
+      implicit none
+      integer N, Nout
+      real(8) tabin(N), tabout(Nout)
+      real(8) hin(N), hout(Nout)
+      real(8) coeffremap(N,3),zwork(N,3)
+      real(8) zwork2(N+1,3)
+      
+      real(8) my_zwork(0:N,3)
+      real(8) my_zwork2(0:N,3)
+      
+      integer k
+      double precision, parameter :: dsmll=1.0d-8  
+      real(8) q,q01,q02,q001,q002,q0
+      real(8) z_win(1:N+1), z_wout(1:Nout+1)
+      real(8),parameter :: dpthin = 1.D-3
+      integer :: k1, kbox, ktop, ka, kbot
+      real(8) :: tsum, qbot, rpsum, zbox, ztop, zthk, zbot, offset, qtop
+      real(8) :: p
+      real(8) :: qtri(0:N)
+
+      z_win(1)=0.; z_wout(1)= 0.
+      do k=1,N
+       z_win(k+1)=z_win(k)+hin(k)
+      enddo 
+      
+      do k=1,Nout
+       z_wout(k+1)=z_wout(k)+hout(k)       
+      enddo       
+
+        do k=2,N
+          zwork(k,1)=1./(hin(k-1)+hin(k))
+        enddo
+        
+        do k=2,N-1
+          q0 = 1./(hin(k-1)+hin(k)+hin(k+1))
+          zwork(k,2)=hin(k-1)+2.*hin(k)+hin(k+1)
+          zwork(k,3)=q0
+        enddo       
+      
+        do k= 2,N
+        zwork2(k,1)=zwork(k,1)*(tabin(k)-tabin(k-1))
+        enddo
+        
+        coeffremap(:,1) = tabin(:)
+ 
+         do k=2,N-1
+        q001 = hin(k)*zwork2(k+1,1)
+        q002 = hin(k)*zwork2(k,1)        
+ !       if (q001*q002 < 0) then
+ !         q001 = 0.
+ !         q002 = 0.
+ !       endif
+        q=zwork(k,2)
+        q01=q*zwork2(k+1,1)
+        q02=q*zwork2(k,1)
+ !       if (abs(q001) > abs(q02)) q001 = q02
+ !       if (abs(q002) > abs(q01)) q002 = q01
+        
+        q=(q001-q002)*zwork(k,3)
+        q001=q001-q*hin(k+1)
+        q002=q002+q*hin(k-1)
+        
+        coeffremap(k,3)=coeffremap(k,1)+q001
+        coeffremap(k,2)=coeffremap(k,1)-q002
+        
+        zwork2(k,1)=(2.*q001-q002)**2
+        zwork2(k,2)=(2.*q002-q001)**2
+        enddo
+        
+        do k=1,N
+        if     (k.eq.1 .or. k.eq.N .or.   hin(k).le.dpthin) then
+        coeffremap(k,3) = coeffremap(k,1)
+        coeffremap(k,2) = coeffremap(k,1)
+        zwork2(k,1) = 0.
+        zwork2(k,2) = 0.
+        endif
+        enddo
+        
+        do k=2,N
+        q002=max(zwork2(k-1,2),dsmll)
+        q001=max(zwork2(k,1),dsmll)
+        zwork2(k,3)=(q001*coeffremap(k-1,3)+q002*coeffremap(k,2))/(q001+q002)
+        enddo
+        
+        zwork2(1,3) = 2*coeffremap(1,1)-zwork2(2,3)
+        zwork2(N+1,3)=2*coeffremap(N,1)-zwork2(N,3)
+ 
+        do k=1,N
+        q01=zwork2(k+1,3)-coeffremap(k,1)
+        q02=coeffremap(k,1)-zwork2(k,3)
+!        q001=2.*q01
+!        q002=2.*q02
+!        if (q01*q02<0) then
+!          q01=0.
+!          q02=0.
+!        elseif (abs(q01)>abs(q002)) then
+!          q01=q002
+!        elseif (abs(q02)>abs(q001)) then
+!          q02=q001
+!        endif
+        coeffremap(k,2)=coeffremap(k,1)-q02
+        coeffremap(k,3)=coeffremap(k,1)+q01
+        enddo
+        
+        
+        do k=0,N
+        if (k==0) then
+        my_zwork(k,1)=0.
+        my_zwork(k,2)=1.
+        my_zwork(k,3)=0.5
+        my_zwork2(k,1)=1.5*tabin(1)
+        elseif (k==N) then
+        my_zwork(k,1)=0.5
+        my_zwork(k,2)=1.
+        my_zwork(k,3)=0.
+        my_zwork2(k,1)=1.5*tabin(k)        
+        else
+        my_zwork(k,1)=hin(k+1)
+        my_zwork(k,2)=2.*(hin(k)+hin(k+1))
+        my_zwork(k,3)=hin(k)
+        my_zwork2(k,1)=3.*(hin(k+1)*tabin(k)+hin(k)*tabin(k+1))
+        my_zwork2(k,2)=my_zwork2(k,1)
+        endif
+        enddo
+        
+        qtri(0)=-my_zwork(0,3)/my_zwork(0,2)
+        my_zwork2(0,1)=my_zwork2(0,1)/my_zwork(0,2)
+        
+        do k=1,N
+        p=1.0/(my_zwork(k,2)+my_zwork(k,1)*qtri(k-1))
+        qtri(k)=-my_zwork(k,3)*p
+        my_zwork2(k,1)=(my_zwork2(k,1)-my_zwork(k,1)*my_zwork2(k-1,1))*p
+        enddo
+        
+        do k=N-1,0,-1
+        my_zwork2(k,1)=my_zwork2(k,1)+qtri(k)*my_zwork2(k+1,1)
+        enddo
+        
+        do k=1,N
+        coeffremap(k,2)=my_zwork2(k-1,1)
+        coeffremap(k,3)=my_zwork2(k,1)
+        enddo
+        
+        do k=2,N-1
+!        print *,'VAL22 = ',my_zwork(k,1)*my_zwork2(k-1,1)
+!     &+my_zwork(k,2)*my_zwork2(k,1)
+!     &  +my_zwork(k,3)*my_zwork2(k+1,1),my_zwork2(k,2)
+        enddo
+
+      zbot=0.0
+      kbot=1
+      do k=1,Nout
+        ztop=zbot  !top is bottom of previous layer
+        ktop=kbot
+        if     (ztop.ge.z_win(ktop+1)) then
+          ktop=ktop+1
+        endif
+        
+        zbot=z_wout(k+1)
+        zthk=zbot-ztop
+
+        if     (zthk.gt.dpthin .and. ztop.lt.z_wout(Nout+1)) then
+
+          kbot=ktop
+          do while (z_win(kbot+1).lt.zbot.and.kbot.lt.N)
+            kbot=kbot+1
+          enddo
+          zbox=zbot
+          do k1= k+1,Nout
+            if     (z_wout(k1+1)-z_wout(k1).gt.dpthin) then
+              exit !thick layer
+            else
+              zbox=z_wout(k1+1)  !include thin adjacent layers
+              if     (zbox.eq.z_wout(Nout+1)) then
+                exit !at bottom
+              endif
+            endif
+          enddo
+          zthk=zbox-ztop
+
+          kbox=ktop
+          do while (z_win(kbox+1).lt.zbox.and.kbox.lt.N)
+            kbox=kbox+1
+          enddo
+          
+          if     (ktop.eq.kbox) then
+
+
+            if     (z_wout(k)  .ne.z_win(kbox).or.z_wout(k+1).ne.z_win(kbox+1)     ) then
+
+              if     (hin(kbox).gt.dpthin) then
+                q001 = (zbox-z_win(kbox))/hin(kbox)
+                q002 = (ztop-z_win(kbox))/hin(kbox)
+                q01=q001**2+q002**2+q001*q002+1.-2.*(q001+q002)
+                q02=q01-1.+(q001+q002)
+                q0=1.-q01-q02
+              else
+                q0 = 1.0
+                q01 = 0.
+                q02 = 0.
+              endif
+          tabout(k)=q0*coeffremap(kbox,1)+q01*coeffremap(kbox,2) &
+       +q02*coeffremap(kbox,3)
+            else
+            tabout(k) = tabin(kbox)
+              
+            endif 
+
+          else
+
+            if     (ktop.le.k .and. kbox.ge.k) then
+              ka = k
+            elseif (kbox-ktop.ge.3) then
+              ka = (kbox+ktop)/2
+            elseif (hin(ktop).ge.hin(kbox)) then
+              ka = ktop
+            else
+              ka = kbox
+            endif !choose ka
+
+            offset=coeffremap(ka,1)
+
+            qtop = z_win(ktop+1)-ztop !partial layer thickness
+            if     (hin(ktop).gt.dpthin) then
+              q=(ztop-z_win(ktop))/hin(ktop)
+              q01=q*(q-1.)
+              q02=q01+q
+              q0=1-q01-q02            
+            else
+              q0 = 1.
+              q01 = 0.
+              q02 = 0.
+            endif
+            
+            tsum =((q0*coeffremap(ktop,1)+q01*coeffremap(ktop,2)+ &
+       q02*coeffremap(ktop,3))-offset)*qtop
+
+            do k1= ktop+1,kbox-1
+              tsum =tsum +(coeffremap(k1,1)-offset)*hin(k1)
+            enddo !k1
+
+            
+            qbot = zbox-z_win(kbox) !partial layer thickness
+            if     (hin(kbox).gt.dpthin) then
+              q=qbot/hin(kbox)
+              q01=(q-1.)**2
+              q02=q01-1.+q
+              q0=1-q01-q02                            
+            else
+              q0 = 1.0
+              q01 = 0.
+              q02 = 0.
+            endif
+           
+        tsum = tsum +((q0*coeffremap(kbox,1)+q01*coeffremap(kbox,2)+ &
+       q02*coeffremap(kbox,3))-offset)*qbot
+            
+            rpsum=1.0d0/zthk
+              tabout(k)=offset+tsum*rpsum
+              
+          endif !single or multiple layers
+        else
+        if (k==1) then
+        print *,'problem = ',zthk,z_wout(k+1),hout(1),hin(1),hin(2)
+        stop
+        endif
+         tabout(k) = tabout(k-1)
+          
+        endif !normal:thin layer
+      enddo !k
+            
+      return
+!---------------------------------------------------------------------------------------------------
+      end subroutine reconstructandremap_ps
+!===================================================================================================
+!
+
+end module module_interp
Index: /utils/tools_ticket2413/ABL_TOOLS/module_io.F90
===================================================================
--- /utils/tools_ticket2413/ABL_TOOLS/module_io.F90	(revision 12863)
+++ /utils/tools_ticket2413/ABL_TOOLS/module_io.F90	(revision 12863)
@@ -0,0 +1,823 @@
+MODULE module_io
+   !!======================================================================
+   !!                   ***  MODULE  module_io  ***
+   !! ABL preprocessing tool netcdf I/O subroutines
+   !!=====================================================================
+   !! History : 2016-10  (F. Lemarié)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!
+   !!   FUNCTIONS   : Var_Existence    
+   !!   SUBROUTINES : Read_Ncdf_dim, Write_Ncdf_dim, Read_Ncdf_var1d_Real,
+   !!                 Read_Ncdf_var4d_Real_nt,       Read_Ncdf_var4d_Real_t,    
+   !!                 Write_Ncdf_var1d_Real       , Write_Ncdf_var2d_Real  ,
+   !!                 Write_Ncdf_var4d_Real_t     , Write_Ncdf_var1d_Real_t,
+   !!                 Duplicate_lon_lat_time
+   !!----------------------------------------------------------------------
+   USE netcdf
+   IMPLICIT NONE
+    
+   INTERFACE Read_Ncdf_var
+          MODULE PROCEDURE Read_Ncdf_var1d_Real   ,       &
+             &             Read_Ncdf_var2d_Real   ,       &
+             &             Read_Ncdf_var2d_Real_t ,       &
+             &             Read_Ncdf_var3d_Real_t ,       &
+             &             Read_Ncdf_var4d_Real_t ,       &
+             &             Read_Ncdf_var2d_Real_nt,       &
+             &             Read_Ncdf_var4d_Real_nt
+   END INTERFACE       
+!
+   INTERFACE Write_Ncdf_var
+          MODULE PROCEDURE Write_Ncdf_var1d_Real  ,       &
+             &             Write_Ncdf_var2d_Real  ,       &          
+             &             Write_Ncdf_var1d_Real_t,       &
+             &             Write_Ncdf_var2d_Real_t,       &
+             &             Write_Ncdf_var4d_Real_t
+   END INTERFACE      
+!      
+CONTAINS
+
+
+
+
+
+   LOGICAL FUNCTION Var_Existence( varname , filename )
+      !!---------------------------------------------------------------------
+      !!                    ***  FUNCTION Var_Existence  ***
+      !!                   
+      !! ** Purpose : check if variables varname exists in filename file  
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(*),   intent(in) :: varname,filename
+      INTEGER                    :: status,ncid,varid        
+      
+      status = nf90_open(TRIM(filename),NF90_NOWRITE,ncid)
+      
+      IF ( status/=nf90_noerr ) THEN    
+            WRITE(*,*) "*** Var_Existence: unable to open netcdf file : ",TRIM(filename)
+            stop
+      END IF 
+      
+      status = nf90_inq_varid( ncid, varname, varid )
+      
+      IF ( status/=nf90_noerr ) THEN
+         Var_Existence = .false.
+      ELSE
+         Var_Existence = .true.
+      END IF   
+
+   END FUNCTION Var_Existence
+   
+   
+   
+   SUBROUTINE Read_Ncdf_dim ( dimname, file, dimval )         
+      !!---------------------------------------------------------------------
+      !!                    ***  SUBROUTINE Read_Ncdf_dim  ***
+      !!                   
+      !! ** Purpose : read the integer dimension dimname in input file and   
+      !!              store it in dimval
+      !!
+      !!----------------------------------------------------------------------
+
+      CHARACTER(*),INTENT(in) :: dimname,file    
+      INTEGER                 :: dimval
+      INTEGER                 :: ncid,status,dimid
+      !     
+      status = nf90_open(file,NF90_NOWRITE,ncid)
+      
+      IF ( status/=nf90_noerr ) THEN    
+         WRITE(*,*)"*** Read_Ncdf_dim: unable to open netcdf file : ",trim(file)
+         STOP
+      END IF     
+      !     
+      status = nf90_inq_dimid        ( ncid, dimname,     dimid  ) 
+      status = nf90_inquire_dimension( ncid, dimid,   len=dimval )
+      status = nf90_close( ncid )
+
+   END SUBROUTINE Read_Ncdf_dim  
+
+
+
+
+
+
+
+   SUBROUTINE Write_Ncdf_dim( dimname, file, dimval )   
+      !!---------------------------------------------------------------------
+      !!                    ***  SUBROUTINE Write_Ncdf_dim  ***
+      !!                   
+      !! ** Purpose : write the dimension dimname in the output file   
+      !!
+      !!----------------------------------------------------------------------               
+      CHARACTER(*), INTENT(in) :: dimname,file    
+      INTEGER                  :: dimval
+      INTEGER                  :: ncid,status,dimid
+      !     
+      status = nf90_open(file,NF90_WRITE,ncid)
+      IF ( status/=nf90_noerr ) THEN    
+         WRITE(*,*)"*** Write_Ncdf_dim: to open netcdf file : ",file
+         STOP
+      END IF          
+      
+      status = nf90_redef(ncid)
+      
+      If( dimval.eq.0 ) THEN
+         status = nf90_def_dim(ncid,dimname,nf90_unlimited,dimid)       
+      ELSE
+         status = nf90_def_dim(ncid,dimname,dimval,dimid)  
+      END If    
+      !!
+      status = nf90_enddef(ncid)
+      status = nf90_close(ncid)
+      !
+   END SUBROUTINE Write_Ncdf_dim   
+
+
+
+
+
+
+   SUBROUTINE Read_Ncdf_var1d_Real( varname, file, tabvar )
+      !!---------------------------------------------------------------------
+      !!                    ***  SUBROUTINE Read_Ncdf_var1d_Real  ***
+      !!                   
+      !! ** Purpose : read the 1D variable varname in the input file   
+      !!              and store it in tabvar
+      !!
+      !!----------------------------------------------------------------------  
+      CHARACTER(*),              INTENT(in)    :: varname,file
+      REAL(8), DIMENSION(:),ALLOCATABLE        :: tabvar
+      INTEGER, DIMENSION(1)                    :: dimID
+      INTEGER                                  :: dim1
+      INTEGER                                  :: status,ncid
+      INTEGER                                  :: varid             
+      !
+      status = nf90_open(file,NF90_NOWRITE,ncid)    
+      IF ( status/=nf90_noerr ) THEN    
+         WRITE(*,*) "*** Read_Ncdf_var1d_Real: unable to open netcdf file : ",file
+         STOP
+      END IF          
+      status = nf90_inq_varid(ncid,varname,varid)
+      status = nf90_inquire_variable(ncid,varid,dimids=dimID)
+      status = nf90_inquire_dimension(ncid,dimID(1),len=dim1)                
+      IF( .not. allocated(tabvar) ) THEN
+         ALLOCATE( tabvar ( dim1 ) )  
+      ELSE
+         IF ( any(shape(tabvar)/=(/dim1/)) ) THEN
+            DEALLOCATE ( tabvar          )   
+            ALLOCATE   ( tabvar ( dim1 ) )   
+            WRITE(*,*) 'Warning change shape of array for ',trim(varname)   
+         END IF      
+      END IF        
+      status = nf90_get_var(ncid,varid,tabvar)     
+      status = nf90_close(ncid)
+      !
+   END SUBROUTINE Read_Ncdf_var1d_Real
+
+
+   SUBROUTINE Read_Ncdf_var2d_Real( varname, file, tabvar )    
+      !!---------------------------------------------------------------------
+      !!                    ***  SUBROUTINE Read_Ncdf_var2d_Real  ***
+      !!                   
+      !! ** Purpose : read the 2D variable varname in the input file   
+      !!              and store it in 2D tabvar
+      !!
+      !!----------------------------------------------------------------------          
+      CHARACTER(*),               INTENT(in)    :: varname, file
+      REAL(8), DIMENSION(:,:),    INTENT(inout) :: tabvar
+      INTEGER, DIMENSION(4)                     :: dimIDS
+      INTEGER                                   :: dim1,dim2
+      INTEGER                                   :: status,ncid
+      INTEGER                                   :: varid             
+      !
+      status = nf90_open(file,NF90_NOWRITE,ncid)      
+      IF (status/=nf90_noerr) THEN    
+         WRITE(*,*)"*** Read_Ncdf_var2d_Real: unable to open netcdf file : ",file
+         STOP
+      END IF         
+      status = nf90_inq_varid        (ncid , varname, varid)       
+      status = nf90_inquire_variable (ncid , varid, dimids=dimIDS)
+      status = nf90_inquire_dimension(ncid , dimIDS(1), len=dim1)
+      status = nf90_inquire_dimension(ncid , dimIDS(2), len=dim2)
+      status = nf90_get_var( ncid, varid, tabvar(:,:),      &
+        &                start = (/1,1/), count=(/dim1,dim2/))                                            
+      IF (status/=nf90_noerr) THEN    
+         WRITE(*,*)"unable to retrieve netcdf variable : ",trim(varname)
+         WRITE(*,*)"in file : ",trim(file)
+         WRITE(*,*) "error code: ", status
+         STOP
+      END IF         
+      status = nf90_close(ncid)
+      !    
+   END SUBROUTINE Read_Ncdf_var2d_Real
+
+   
+   SUBROUTINE Read_Ncdf_var2d_Real_nt( varname, file, tabvar, time, level )    
+      !!---------------------------------------------------------------------
+      !!                    ***  SUBROUTINE Read_Ncdf_var2d_Real_nt  ***
+      !!                   
+      !! ** Purpose : read the 4D variable varname in the input file   
+      !!              for a given time and vertical level, and store it in 2D tabvar
+      !!
+      !!----------------------------------------------------------------------          
+      CHARACTER(*),               INTENT(in)    :: varname, file
+      INTEGER     ,               INTENT(in)    :: time, level
+      !REAL(8), DIMENSION(:,:),    ALLOCATABLE   :: tabvar
+      REAL(8), DIMENSION(:,:),    INTENT(inout) :: tabvar
+      INTEGER, DIMENSION(4)                     :: dimIDS
+      INTEGER                                   :: dim1,dim2
+      INTEGER                                   :: status,ncid
+      INTEGER                                   :: varid             
+      !
+      status = nf90_open(file,NF90_NOWRITE,ncid)      
+      IF (status/=nf90_noerr) THEN    
+         WRITE(*,*)"*** Read_Ncdf_var2d_Real_nt: unable to open netcdf file : ",file
+         STOP
+      END IF         
+      status = nf90_inq_varid        (ncid , varname, varid)       
+      status = nf90_inquire_variable (ncid , varid, dimids=dimIDS)
+      status = nf90_inquire_dimension(ncid , dimIDS(1), len=dim1)
+      status = nf90_inquire_dimension(ncid , dimIDS(2), len=dim2)
+      !IF( .not. allocated( tabvar ) ) then
+      !   ALLOCATE ( tabvar( dim1, dim2 ) )  
+      !ELSE
+      !   IF ( (size(tabvar,1) /= dim1) .OR. (size(tabvar,2) /= dim2) ) THEN
+      !      DEALLOCATE( tabvar )
+      !      ALLOCATE  ( tabvar (dim1, dim2 ) )
+      !   END IF     
+      !END IF       
+      status = nf90_get_var( ncid, varid, tabvar(:,:),      &
+        &                start = (/1,1,level,time/), count=(/dim1,dim2,1,1/))                                            
+      IF (status/=nf90_noerr) THEN    
+         WRITE(*,*)"unable to retrieve netcdf variable : ",trim(varname)
+         WRITE(*,*)"in file : ",trim(file)
+         WRITE(*,*) "error code: ", status
+         STOP
+      END IF         
+      status = nf90_close(ncid)
+      !    
+   END SUBROUTINE Read_Ncdf_var2d_Real_nt
+
+
+ 
+ 
+   SUBROUTINE Read_Ncdf_var4d_Real_nt( varname, file, tabvar, time, level )    
+      !!---------------------------------------------------------------------
+      !!                    ***  SUBROUTINE Read_Ncdf_var4d_Real_nt  ***
+      !!                   
+      !! ** Purpose : read the 4D variable varname in the input file   
+      !!              for a given time and vertical level, and store it in 4D tabvar
+      !!
+      !!----------------------------------------------------------------------          
+      CHARACTER(*),               INTENT(in)    :: varname,file
+      INTEGER     ,               INTENT(in)    :: time,level
+      !REAL(8), DIMENSION(:,:,:,:),ALLOCATABLE   :: tabvar
+      REAL(8), DIMENSION(:,:,:,:),INTENT(inout) :: tabvar
+      INTEGER, DIMENSION(4)                     :: dimIDS
+      INTEGER                                   :: dim1,dim2
+      INTEGER                                   :: status,ncid
+      INTEGER                                   :: varid             
+      !
+      status = nf90_open(file,NF90_NOWRITE,ncid)      
+      IF (status/=nf90_noerr) THEN    
+         WRITE(*,*)"*** Read_Ncdf_var4d_Real_nt: unable to open netcdf file : ",file
+         STOP
+      END IF         
+      status = nf90_inq_varid        (ncid , varname, varid)       
+      status = nf90_inquire_variable (ncid , varid, dimids=dimIDS)
+      status = nf90_inquire_dimension(ncid , dimIDS(1), len=dim1)
+      status = nf90_inquire_dimension(ncid , dimIDS(2), len=dim2)
+      !IF( .not. allocated( tabvar ) ) then
+      !   ALLOCATE ( tabvar( dim1, dim2, 1, 1 ) )  
+      !ELSE
+      !   IF ( (size(tabvar,1) /= dim1) .OR. (size(tabvar,2) /= dim2) ) THEN
+      !      DEALLOCATE( tabvar )
+      !      ALLOCATE  ( tabvar (dim1, dim2, 1, 1 ) )
+      !   END IF     
+      !END IF       
+      status = nf90_get_var( ncid, varid, tabvar(:,:,:,:),      &
+        &                start = (/1,1,level,time/), count=(/dim1,dim2,1,1/))                                            
+      IF (status/=nf90_noerr) THEN    
+         WRITE(*,*)"unable to retrieve netcdf variable : ",trim(varname)
+         WRITE(*,*)"in file : ",trim(file)
+         WRITE(*,*) "error code: ", status
+         STOP
+      END IF         
+      status = nf90_close(ncid)
+      !    
+   END SUBROUTINE Read_Ncdf_var4d_Real_nt
+      
+ 
+ 
+ 
+ 
+ 
+   SUBROUTINE Read_Ncdf_var3d_Real_t( varname, file, tabvar, time)   
+      !!---------------------------------------------------------------------
+      !!                    ***  SUBROUTINE Read_Ncdf_var3d_Real_t  ***
+      !!                   
+      !! ** Purpose : read the 3D variable varname in the input file   
+      !!              for a given time level, and store it in tabvar
+      !!
+      !!----------------------------------------------------------------------           
+      CHARACTER(*),               INTENT(in)    :: varname,file
+      INTEGER     ,               INTENT(in)    :: time
+      !REAL(8), DIMENSION(:,:,:),ALLOCATABLE     :: tabvar
+      REAL(8), DIMENSION(:,:,:), INTENT(inout)  :: tabvar
+      INTEGER, DIMENSION(3)                     :: dimIDS
+      INTEGER                                   :: dim1,dim2
+      INTEGER                                   :: status,ncid
+      INTEGER                                   :: varid             
+      !
+      status = nf90_open(file,NF90_NOWRITE,ncid)      
+      IF (status/=nf90_noerr) then    
+         WRITE(*,*)"*** Read_Ncdf_var3d_Real_t: unable to open netcdf file : ",file
+         STOP
+      END IF
+
+      status = nf90_inq_varid        (ncid, varname,varid)        
+      status = nf90_inquire_variable (ncid, varid,dimids=dimIDS)
+      status = nf90_inquire_dimension(ncid, dimIDS(1),len=dim1)
+      status = nf90_inquire_dimension(ncid, dimIDS(2),len=dim2)
+
+      !IF( .not. allocated(tabvar) ) ALLOCATE(tabvar(dim1,dim2,1))  
+
+      status=nf90_get_var(ncid,varid,tabvar,start=(/1,1,time/))                                             
+      IF ( status/=nf90_noerr ) THEN    
+         WRITE(*,*)"unable to retrieve netcdf variable : ",trim(varname)
+         WRITE(*,*)"in file : ",trim(file)
+         WRITE(*,*) "error code: ", status
+         STOP
+      END IF           
+      status = nf90_close(ncid)
+      !
+   END SUBROUTINE Read_Ncdf_var3d_Real_t        
+ 
+      
+   SUBROUTINE Read_Ncdf_var2d_Real_t(varname,file,tabvar,time)   
+      !!---------------------------------------------------------------------
+      !!                    ***  SUBROUTINE Read_Ncdf_var2d_Real_t  ***
+      !!                   
+      !! ** Purpose : read the 3D variable varname in the input file   
+      !!              for a given time level, and store it in tabvar
+      !!
+      !!----------------------------------------------------------------------           
+      CHARACTER(*),               INTENT(in)    :: varname,file
+      INTEGER     ,               INTENT(in)    :: time
+      !REAL(8), DIMENSION(:,:),ALLOCATABLE       :: tabvar
+      REAL(8), DIMENSION(:,:), INTENT(inout)    :: tabvar
+      INTEGER, DIMENSION(3)                     :: dimIDS
+      INTEGER                                   :: dim1,dim2
+      INTEGER                                   :: status,ncid
+      INTEGER                                   :: varid             
+      !
+      status = nf90_open(file,NF90_NOWRITE,ncid)      
+      IF (status/=nf90_noerr) then    
+         WRITE(*,*)"*** Read_Ncdf_var2d_Real_t: unable to open netcdf file : ",file
+         STOP
+      END IF
+
+      status = nf90_inq_varid        (ncid, varname,varid)        
+      status = nf90_inquire_variable (ncid, varid,dimids=dimIDS)
+      status = nf90_inquire_dimension(ncid, dimIDS(1),len=dim1)
+      status = nf90_inquire_dimension(ncid, dimIDS(2),len=dim2)
+
+      !IF( .not. allocated(tabvar) ) ALLOCATE(tabvar(dim1,dim2))  
+
+      status=nf90_get_var(ncid,varid,tabvar,start=(/1,1,time/))                                             
+      IF ( status/=nf90_noerr ) THEN    
+         WRITE(*,*)"unable to retrieve netcdf variable : ",trim(varname)
+         WRITE(*,*)"in file : ",trim(file)
+         STOP
+      END IF           
+      status = nf90_close(ncid)
+      !
+   END SUBROUTINE Read_Ncdf_var2d_Real_t
+
+
+   SUBROUTINE Read_Ncdf_var4d_Real_t(varname,file,tabvar,time)   
+      !!---------------------------------------------------------------------
+      !!                    ***  SUBROUTINE Read_Ncdf_var4d_Real_t  ***
+      !!                   
+      !! ** Purpose : read the 4D variable varname in the input file   
+      !!              for a given time level, and store it in tabvar
+      !!
+      !!----------------------------------------------------------------------           
+      CHARACTER(*),               INTENT(in)    :: varname,file
+      INTEGER     ,               INTENT(in)    :: time
+      !REAL(8), DIMENSION(:,:,:,:),ALLOCATABLE   :: tabvar
+      REAL(8), DIMENSION(:,:,:,:), INTENT(inout):: tabvar
+      INTEGER, DIMENSION(4)                     :: dimIDS
+      INTEGER                                   :: dim1,dim2,dim3
+      INTEGER                                   :: status,ncid
+      INTEGER                                   :: varid             
+      !
+      status = nf90_open(file,NF90_NOWRITE,ncid)      
+      IF (status/=nf90_noerr) then    
+         WRITE(*,*)"*** Read_Ncdf_var4d_Real_t: unable to open netcdf file : ",file
+         STOP
+      END IF         
+
+      status = nf90_inq_varid        (ncid, varname,varid)        
+      status = nf90_inquire_variable (ncid, varid,dimids=dimIDS)
+      status = nf90_inquire_dimension(ncid, dimIDS(1),len=dim1)
+      status = nf90_inquire_dimension(ncid, dimIDS(2),len=dim2)
+      status = nf90_inquire_dimension(ncid, dimIDS(3),len=dim3)
+
+      !IF( .not. allocated(tabvar) ) ALLOCATE(tabvar(dim1,dim2,dim3,1))
+
+      status=nf90_get_var(ncid,varid,tabvar,start=(/1,1,1,time/))                                             
+      IF ( status/=nf90_noerr ) THEN    
+         WRITE(*,*) "unable to retrieve netcdf variable : ",trim(varname)
+         WRITE(*,*) "in file : ",trim(file)
+         WRITE(*,*) "error code: ", status
+         STOP
+      END IF           
+      status = nf90_close(ncid)
+      !
+   END SUBROUTINE Read_Ncdf_var4d_Real_t        
+   
+
+
+
+
+
+   SUBROUTINE Write_Ncdf_var1d_Real( varname, dimname, file, tabvar, typevar )
+      !!---------------------------------------------------------------------
+      !!                    ***  SUBROUTINE Write_Ncdf_var1d_Real  ***
+      !!                   
+      !! ** Purpose : write the 1D variable varname stored in tabvar 
+      !!              in the output file using typevar type (float or double)             
+      !!
+      !!----------------------------------------------------------------------             
+      CHARACTER(*),               INTENT(in)    :: varname,file,dimname,typevar
+      REAL(8), DIMENSION(:), INTENT(in)         :: tabvar
+      INTEGER                                   :: dimid
+      INTEGER                                   :: status,ncid
+      INTEGER                                   :: varid             
+!
+      status = nf90_open(file,NF90_WRITE,ncid)       
+      IF (status/=nf90_noerr) then    
+         WRITE(*,*)"*** Write_Ncdf_var1d_Real: unable to open netcdf file : ",file
+         STOP
+      END IF         
+      status = nf90_inq_dimid(ncid,dimname, dimid)
+      status = nf90_redef(ncid)
+      SELECT CASE( TRIM(typevar) )
+      CASE('double')
+         status = nf90_def_var(ncid,varname,nf90_double,(/dimid/),varid)
+      CASE('float')
+         status = nf90_def_var(ncid,varname,nf90_float,(/dimid/),varid)      
+      END SELECT
+      status = nf90_enddef ( ncid )
+      status = nf90_put_var( ncid ,varid,tabvar)        
+      status = nf90_close  ( ncid )
+      !
+   END SUBROUTINE Write_Ncdf_var1d_Real 
+      
+      
+      
+
+
+   SUBROUTINE Write_Ncdf_var2d_Real( varname, dimname, file, tabvar, typevar )
+      !!---------------------------------------------------------------------
+      !!                    ***  SUBROUTINE Write_Ncdf_var2d_Real  ***
+      !!                   
+      !! ** Purpose : write the 2D variable varname stored in tabvar 
+      !!              in the output file using typevar type (float or double)             
+      !!
+      !!----------------------------------------------------------------------          
+      CHARACTER(*),               INTENT(in)    :: varname, file, typevar
+      CHARACTER(*), DIMENSION(2), INTENT(in)    :: dimname      
+      REAL(8), DIMENSION(:,:), INTENT(in)       :: tabvar
+      INTEGER                                   :: dimid1, dimid2
+      INTEGER                                   :: status, ncid
+      INTEGER                                   :: varid             
+!
+      status = nf90_open(file,NF90_WRITE,ncid)       
+      IF (status/=nf90_noerr) then    
+         WRITE(*,*)"*** Write_Ncdf_var2d_Real: unable to open netcdf file : ",file
+         WRITE(*,*)"*** Write_Ncdf_var2d_Real: variable : ", varname
+         STOP
+      END IF
+         status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+         status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+         status = nf90_inq_varid(ncid,varname,varid)
+         IF (status /= nf90_noerr) THEN
+            status = nf90_redef(ncid)    
+            SELECT CASE( TRIM(typevar) )
+            CASE('double')
+               status = nf90_def_var(ncid,varname,nf90_double,     &
+               &                    (/dimid1,dimid2/),varid)
+            CASE('float')
+               status = nf90_def_var(ncid,varname,nf90_float,      &
+               &                    (/dimid1,dimid2/),varid)     
+            END SELECT
+            status = nf90_enddef(ncid)
+         END IF
+      status = nf90_put_var(ncid,varid,tabvar)     
+      status = nf90_close(ncid)
+      ! 
+   END SUBROUTINE Write_Ncdf_var2d_Real 
+
+
+
+
+
+
+   SUBROUTINE Write_Ncdf_var4d_Real_t( varname, dimname, file, tabvar, time, typevar )
+      !!---------------------------------------------------------------------
+      !!                    ***  SUBROUTINE Write_Ncdf_var4d_Real_t  ***
+      !!                   
+      !! ** Purpose : write the 4D variable varname stored in tabvar 
+      !!              in the output file at time level time using typevar type (float or double)             
+      !!
+      !!----------------------------------------------------------------------  
+      CHARACTER(*),                INTENT(in)   :: varname,file,typevar
+      CHARACTER(*), DIMENSION(4) , INTENT(in)   :: dimname
+      INTEGER, INTENT(in)                       :: time
+      REAL(8), DIMENSION(:,:,:,:), INTENT(in)   :: tabvar
+      INTEGER                                   :: dimid1,dimid2,dimid3,dimid4
+      INTEGER                                   :: status,ncid
+      INTEGER                                   :: varid             
+!
+      status = nf90_open(file,NF90_WRITE,ncid)       
+      IF ( status/=nf90_noerr ) THEN    
+         WRITE(*,*)"*** Write_Ncdf_var4d_Real_t: unable to open netcdf file : ",file
+         STOP
+      END IF            
+      IF ( time==1 .and. (TRIM(typevar)=='double'  .or. TRIM(typevar)=='float') ) THEN      
+         status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+         status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+         status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+         status = nf90_inq_dimid(ncid,dimname(4), dimid4)
+         status = nf90_redef(ncid)      
+         SELECT CASE(TRIM(typevar))
+         CASE('double')
+            status = nf90_def_var(ncid,TRIM(varname),nf90_double,     &
+            &                     (/dimid1,dimid2,dimid3,dimid4/),varid)  
+         CASE('float')
+            status = nf90_def_var(ncid,TRIM(varname),nf90_float,     &
+            &                     (/dimid1,dimid2,dimid3,dimid4/),varid)    
+         END SELECT
+         status = nf90_enddef(ncid)
+      ELSE
+         status = nf90_inq_varid(ncid, varname, varid)
+      END IF    
+      status = nf90_put_var(ncid,varid,tabvar,start=(/1,1,1,time/))
+      IF (status/=nf90_noerr) THEN    
+         WRITE(*,*)"unable to store variable ",varname, &
+	                                       " in file ",file
+         WRITE(*,*)"erorr code: ", status
+         STOP
+      END IF        
+      status = nf90_close(ncid)
+      !
+   END SUBROUTINE Write_Ncdf_var4d_Real_t           
+
+
+
+
+
+
+
+    
+   SUBROUTINE Write_Ncdf_var1d_Real_t(varname,dimname,file,tabvar,time,typevar)
+      !!---------------------------------------------------------------------
+      !!                    ***  SUBROUTINE Write_Ncdf_var1d_Real_t  ***
+      !!                   
+      !! ** Purpose : write the 1D variable varname stored in tabvar 
+      !!              in the output file at time level time using typevar type (float or double)             
+      !!
+      !!----------------------------------------------------------------------  
+      CHARACTER(*),               INTENT(in)    :: varname,file,typevar
+      CHARACTER(*), DIMENSION(1) ,INTENT(in)    :: dimname
+      INTEGER, INTENT(in)                       :: time
+      REAL(8), DIMENSION(:), INTENT(in)         :: tabvar
+      INTEGER                                   :: dimid1
+      INTEGER                                   :: status,ncid
+      INTEGER                                   :: varid             
+      !
+      status = nf90_open(file,NF90_WRITE,ncid)       
+      IF (status/=nf90_noerr) THEN    
+         WRITE(*,*) "*** Write_Ncdf_var1d_Real_t: unable to open netcdf file : ",file
+         STOP
+      END IF          
+            
+      IF( time==1 ) THEN
+         status = nf90_inq_dimid(ncid,dimname(1), dimid1) 
+         status = nf90_redef(ncid)
+         SELECT CASE ( TRIM(typevar) )
+         CASE ('double')
+            status = nf90_def_var(ncid,varname,nf90_double,     &
+             &                                (/dimid1/),varid) 
+         CASE ('float')
+            status = nf90_def_var(ncid,varname,nf90_float,     &
+             &                                (/dimid1/),varid)    
+         END SELECT      
+         status = nf90_enddef(ncid)
+      ELSE
+         status = nf90_inq_varid(ncid, varname, varid)
+      END IF  
+         
+      status = nf90_put_var(ncid,varid,tabvar,start=(/time/))
+      
+      IF (status/=nf90_noerr) THEN    
+         WRITE(*,*) "unable to store variable ",varname, &
+	                                     " in file ",file
+         STOP
+      END IF        
+      status = nf90_close(ncid)
+      !  
+   END SUBROUTINE Write_Ncdf_var1d_Real_t 
+
+
+
+   SUBROUTINE Write_Ncdf_var2d_Real_t( varname, dimname, file, tabvar, time, typevar)
+      !!---------------------------------------------------------------------
+      !!                    ***  SUBROUTINE Write_Ncdf_var2d_Real_t  ***
+      !!                   
+      !! ** Purpose : write the 1D variable varname stored in tabvar 
+      !!              in the output file at time level time using typevar type (float or double)             
+      !!
+      !!----------------------------------------------------------------------  
+      CHARACTER(*),               INTENT(in)    :: varname, file, typevar
+      CHARACTER(*), DIMENSION(2), INTENT(in)    :: dimname
+      INTEGER, INTENT(in)                       :: time
+      REAL(8), DIMENSION(:,:), INTENT(in)       :: tabvar
+      INTEGER                                   :: dimid1, dimid2, dimidt
+      INTEGER                                   :: status,ncid
+      INTEGER                                   :: varid
+      INTEGER, DIMENSION(2)                     :: dim_size
+      !
+      status = nf90_open( file, NF90_WRITE, ncid)       
+      IF (status/=nf90_noerr) THEN    
+         WRITE(*,*) "*** Write_Ncdf_var2d_Real_t: unable to open netcdf file : ",file
+         STOP
+      END IF          
+
+      IF( time==1 ) THEN
+         status = nf90_inq_dimid( ncid, dimname(1), dimid1) 
+         status = nf90_inq_dimid( ncid, dimname(2), dimid2)
+         status = nf90_inq_dimid( ncid, "time"    , dimidt)
+         !status = nf90_def_dim( ncid, "time", NF90_UNLIMITED, dimidt)
+         status = nf90_redef(ncid)
+         SELECT CASE ( TRIM(typevar) )
+         CASE ('double')
+            status = nf90_def_var( ncid, varname, nf90_double,     &
+             &                                (/dimid1,dimid2,dimidt/), varid) 
+         CASE ('float')
+            status = nf90_def_var( ncid, varname, nf90_float,     &
+             &                                (/dimid1,dimid2,dimidt/), varid)    
+         END SELECT
+         status = nf90_enddef(ncid)
+      ELSE
+         status = nf90_inq_varid( ncid, varname, varid )
+      END IF  
+
+      dim_size = SHAPE(tabvar)
+      status = nf90_put_var( ncid, varid, tabvar(:,:), start=(/1,1,time/), count=(/dim_size(1),dim_size(2),1/) )
+      
+      IF (status/=nf90_noerr) THEN    
+         WRITE(*,*) "unable to store variable ",varname, &
+	                                     " in file ",file
+         WRITE(*,*) "error code: ", status
+         STOP
+      END IF        
+      status = nf90_close(ncid)
+      !  
+   END SUBROUTINE Write_Ncdf_var2d_Real_t 
+
+
+
+   SUBROUTINE add_globatt_real( file, att_name, att_value )
+
+      INTEGER      :: ncid, status
+      CHARACTER(*) :: file, att_name
+      REAL(8)      :: att_value
+
+      status = nf90_open( file, nf90_write, ncid)
+
+      ! Enter define mode so we can add the attribute
+      status = nf90_redef( ncid )
+
+      ! ...  put the range attribute, setting it to eight byte reals...
+      status = nf90_put_att( ncid, NF90_GLOBAL, att_name, att_value )
+
+      ! Leave define mode
+      status = nf90_enddef(ncid)
+
+   END SUBROUTINE add_globatt_real
+
+
+
+   SUBROUTINE Duplicate_lon_lat_time( file_in, file_out )
+      !!---------------------------------------------------------------------
+      !!                    ***  SUBROUTINE Duplicate_lon_lat_time  ***
+      !!                   
+      !! ** Purpose : duplicate the attribute of lon, lat and time variables            
+      !!              from file_in in file_out
+      !!----------------------------------------------------------------------  
+      CHARACTER(*),               INTENT(in)    ::  file_in, file_out
+      INTEGER                                   ::  status
+      INTEGER                                   ::  ncid_in, ncid_out    
+      INTEGER                                   :: varid_in,varid_out 
+      
+      status = nf90_open(file_in ,NF90_NOWRITE,ncid_in )
+      status = nf90_open(file_out,NF90_WRITE  ,ncid_out)
+        
+      status = nf90_inq_varid(ncid_in,'lon',varid_in)
+      status = nf90_inq_varid(ncid_out,'lon',varid_out)
+      status = nf90_redef(ncid_out)     
+      status = nf90_copy_att(ncid_in,varid_in,'standard_name',ncid_out,varid_out)
+      status = nf90_copy_att(ncid_in,varid_in,'long_name',ncid_out,varid_out)
+      status = nf90_copy_att(ncid_in,varid_in,'units',ncid_out,varid_out) 
+      status = nf90_copy_att(ncid_in,varid_in,'axis',ncid_out,varid_out)     
+      status = nf90_enddef(ncid_out)  
+      
+      status = nf90_inq_varid(ncid_in,'lat',varid_in)
+      status = nf90_inq_varid(ncid_out,'lat',varid_out)
+      status = nf90_redef(ncid_out)     
+      status = nf90_copy_att(ncid_in,varid_in,'standard_name',ncid_out,varid_out)
+      status = nf90_copy_att(ncid_in,varid_in,'long_name',ncid_out,varid_out)
+      status = nf90_copy_att(ncid_in,varid_in,'units',ncid_out,varid_out) 
+      status = nf90_copy_att(ncid_in,varid_in,'axis',ncid_out,varid_out)     
+      status = nf90_enddef(ncid_out)        
+      
+      status = nf90_inq_varid(ncid_in,'time',varid_in)
+      status = nf90_inq_varid(ncid_out,'time',varid_out)
+      status = nf90_redef(ncid_out)     
+      status = nf90_copy_att(ncid_in,varid_in,'standard_name',ncid_out,varid_out)
+      status = nf90_copy_att(ncid_in,varid_in,'units',ncid_out,varid_out)
+      status = nf90_copy_att(ncid_in,varid_in,'calendar',ncid_out,varid_out)    
+      status = nf90_copy_att(ncid_in,varid_in,'axis',ncid_out,varid_out)  
+      status = nf90_enddef(ncid_out)        
+      
+      status = nf90_close(ncid_in)
+      status = nf90_close(ncid_out)
+      !   
+   END SUBROUTINE Duplicate_lon_lat_time 
+
+
+
+   SUBROUTINE Duplicate_lev_hyb( file_in, file_out )
+      !!---------------------------------------------------------------------
+      !!                    ***  SUBROUTINE Duplicate_lon_lat_time  ***
+      !!                   
+      !! ** Purpose : duplicate the attribute of lon, lat and time variables            
+      !!              from file_in in file_out
+      !!----------------------------------------------------------------------  
+      CHARACTER(*),               INTENT(in)    ::  file_in, file_out
+      INTEGER                                   ::  status
+      INTEGER                                   ::  ncid_in, ncid_out    
+      INTEGER                                   :: varid_in,varid_out 
+      
+      status = nf90_open(file_in ,NF90_NOWRITE,ncid_in )
+      status = nf90_open(file_out,NF90_WRITE  ,ncid_out)
+        
+      status = nf90_inq_varid(ncid_in,'hyai',varid_in)
+      status = nf90_inq_varid(ncid_out,'hyai',varid_out)
+      status = nf90_redef(ncid_out)     
+      status = nf90_copy_att(ncid_in,varid_in,'long_name',ncid_out,varid_out)
+      status = nf90_copy_att(ncid_in,varid_in,'units',ncid_out,varid_out)     
+      status = nf90_enddef(ncid_out)  
+      
+      status = nf90_inq_varid(ncid_in,'hybi',varid_in)
+      status = nf90_inq_varid(ncid_out,'hybi',varid_out)
+      status = nf90_redef(ncid_out)     
+      status = nf90_copy_att(ncid_in,varid_in,'long_name',ncid_out,varid_out)
+      status = nf90_copy_att(ncid_in,varid_in,'units',ncid_out,varid_out)   
+      status = nf90_enddef(ncid_out)        
+
+      status = nf90_inq_varid(ncid_in,'hyam',varid_in)
+      status = nf90_inq_varid(ncid_out,'hyam',varid_out)
+      status = nf90_redef(ncid_out)     
+      status = nf90_copy_att(ncid_in,varid_in,'long_name',ncid_out,varid_out)
+      status = nf90_copy_att(ncid_in,varid_in,'units',ncid_out,varid_out)     
+      status = nf90_enddef(ncid_out)  
+      
+      status = nf90_inq_varid(ncid_in,'hybm',varid_in)
+      status = nf90_inq_varid(ncid_out,'hybm',varid_out)
+      status = nf90_redef(ncid_out)     
+      status = nf90_copy_att(ncid_in,varid_in,'long_name',ncid_out,varid_out)
+      status = nf90_copy_att(ncid_in,varid_in,'units',ncid_out,varid_out)   
+      status = nf90_enddef(ncid_out)  
+      
+      status = nf90_inq_varid(ncid_in,'lev',varid_in)
+      status = nf90_inq_varid(ncid_out,'lev',varid_out)
+      status = nf90_redef(ncid_out)     
+      status = nf90_copy_att(ncid_in,varid_in,'standard_name',ncid_out,varid_out)
+      status = nf90_copy_att(ncid_in,varid_in,'long_name',ncid_out,varid_out)      
+      status = nf90_copy_att(ncid_in,varid_in,'formula',ncid_out,varid_out)    
+      status = nf90_copy_att(ncid_in,varid_in,'formula_terms',ncid_out,varid_out)                
+      status = nf90_copy_att(ncid_in,varid_in,'units',ncid_out,varid_out)
+      status = nf90_copy_att(ncid_in,varid_in,'positive',ncid_out,varid_out)    
+      status = nf90_enddef(ncid_out)        
+      
+      status = nf90_close(ncid_in)
+      status = nf90_close(ncid_out)
+      !   
+   END SUBROUTINE Duplicate_lev_hyb
+
+END MODULE module_io
Index: /utils/tools_ticket2413/ABL_TOOLS/namelist_abl_tools
===================================================================
--- /utils/tools_ticket2413/ABL_TOOLS/namelist_abl_tools	(revision 12863)
+++ /utils/tools_ticket2413/ABL_TOOLS/namelist_abl_tools	(revision 12863)
@@ -0,0 +1,53 @@
+:
+:-----------------------------------------------------------------------------
+: Atmospheric Boundary Layer preprocessing tool 
+:-----------------------------------------------------------------------------
+:
+&nml_dom
+    jpka         =      50,
+    hmax         =   2000.,
+    theta_s      =      2.,
+    hc           =    100.,
+    ln_impose_z1 =  .true.,
+    z1           =     10.,
+/
+
+&nml_opt
+    ptemp_method    =        3  ,  ! potential temperature computation method
+    ln_slp_smth     =   .true.  ,  ! smooth slp and ghw at high latitudes only
+    ln_drw_smth     =   .false. ,  ! smooth after drowning
+    ln_slp_log      =   .false. ,  ! read log(slp)
+    ln_read_zsurf   =   .false. ,  ! read surface geopotential
+    ln_hpg_frc      =   .true.  ,  ! compute horizontal pressure gradient
+    ln_geo_wnd      =   .false. ,  ! compute geostrophic wind
+    ln_c1d          =   .false. ,  ! 1D case
+    ln_read_mask    =   .true.  ,  ! read mask file
+    ln_lsm_land     =   .false. ,  ! inverse land & sea masks
+    ln_perio_latbc  =   .true.  ,  ! periodic lateral boundary conditions
+/
+
+&nml_fld
+    cn_dir      = '',
+    mask_var    = 'LSM',
+    file_m      = 'MASK.nc',
+    file_u      = 'U3D.nc',
+    file_v      = 'V3D.nc',
+    file_t      = 'T3D.nc',
+    file_q      = 'Q3D.nc',
+    file_p      = 'P2D.nc',
+    file_z      = 'Z2D.nc',
+    file_geos   = 'UVG_OUT.nc',
+    file_hpg    = 'HPG_OUT.nc',
+/
+
+&nml_out
+    grd_file  = 'dom_cfg_abl_L50Z10.nc',
+    abl_file  = 'ABL_L50Z10_OUT.nc',
+    drwn_file = 'ABL_DRWN_L50Z10_OUT.nc',
+    var_name  = '',
+/
+
+&nml_c1d
+    iloc = 283,
+    jloc =  52,
+/
Index: /utils/tools_ticket2413/BDY_TOOLS/bdy_reorder
===================================================================
--- /utils/tools_ticket2413/BDY_TOOLS/bdy_reorder	(revision 12863)
+++ /utils/tools_ticket2413/BDY_TOOLS/bdy_reorder	(revision 12863)
@@ -0,0 +1,58 @@
+#!/bin/ksh
+
+# CALLS: bdy_reorder.exe
+
+#set -ax
+usage ()
+{
+   echo
+   echo "  bdy_reorder"
+   echo "  ************"
+   echo
+   echo "  usage: ${0##*/} [-c] file_in file_out"
+   echo
+   echo "  flags:    -c          target file is a coordinates.bdy.nc file"
+   echo "            -t          template file"
+   echo
+   exit 1
+}
+
+ln_coordinates=".false."
+file_template=""
+
+while getopts ct: opt
+do
+  case ${opt} in
+      c) 
+         ln_coordinates=".true." 
+      ;;
+      t) 
+         file_template=${OPTARG}
+      ;;
+      [?]) usage
+      ;;
+  esac
+done
+shift $(expr ${OPTIND} - 1)
+
+if [[ $# < 2 ]] ; then
+   usage
+fi
+
+script_dir=$(dirname $0)
+
+file_in=$1
+file_out=$2
+
+cat > nam_bdy_reorder << EOC
+&nam_bdy_reorder
+file_in='${file_in}'
+file_out='${file_out}'
+file_template='${file_template}'
+ln_coordinates=${ln_coordinates}
+EOC
+echo "/" >> nam_bdy_reorder
+
+${script_dir}/bdy_reorder.exe 
+
+exit 0
Index: /utils/tools_ticket2413/BDY_TOOLS/src/bdy_reorder.f90
===================================================================
--- /utils/tools_ticket2413/BDY_TOOLS/src/bdy_reorder.f90	(revision 12863)
+++ /utils/tools_ticket2413/BDY_TOOLS/src/bdy_reorder.f90	(revision 12863)
@@ -0,0 +1,609 @@
+PROGRAM bdy_reorder
+
+!===============================================================================
+! A routine to reorder old BDY data files to make them compatible with NEMO 3.4.
+!
+! This routine has 2 modes:
+!   1. If no template file is given then it will re-order the data in the input
+!      file so that it is in order of increasing nbr. 
+!   2. If a template file is given it will re-order the data in the input file 
+!      be consistent with the order of the data in the template file. This is 
+!      useful for making old barotropic and baroclinic data files consistent. 
+!      For older versions of NEMO the barotropic boundary data did not have to
+!      be in the same order as the baroclinic boundary data. The rimwidth 
+!      value can be different in the input file and template file; in this case 
+!      the routine will just re-order the data that the two files have in common. 
+!
+! The routine is mainly for re-ordering BDY data files, but can also be used to
+! re-order BDY coordinate files if ln_coordinates is set to .true.
+!
+! Author: Dave Storkey  Aug 2011
+! Bug notifications etc to:  dave.storkey@metoffice.gov.uk
+!
+!===============================================================================
+  
+      USE netcdf
+
+      IMPLICIT NONE
+
+      INTEGER,PARAMETER         :: numnam=11
+      INTEGER,PARAMETER         :: sp=SELECTED_REAL_KIND(6,37)
+      INTEGER,PARAMETER         :: dp=SELECTED_REAL_KIND(12,307)
+      INTEGER                   :: chunksize = 32000000
+
+      INTEGER                   :: jpbgrd, iostat, ncid_in, ncid_out, ncid_template, nbrid(4), nbrid_template(4)
+      INTEGER                   :: dimids(10), unlimitedDimId
+      INTEGER                   :: xtype, dimid, varid, ndims, ndims_var, nvars, natts, nblen(4), nblen_template(4), dimlen(10)
+      INTEGER                   :: lenvar(10), igrid, ib, ib1, ir, idim, jgrid, jv, icount, attid, len1, idepth, itime
+      INTEGER                   :: idim_time, idim_xb, idim_yb, idim_depth
+      INTEGER                   :: nbr_min, nbr_max, nbr_min_template, nbr_max_template, strlen, nbr_match
+
+      INTEGER, ALLOCATABLE, DIMENSION(:,:)   :: nbr, imap
+      INTEGER, ALLOCATABLE, DIMENSION(:,:)   :: nbi, nbj
+      INTEGER, ALLOCATABLE, DIMENSION(:,:)   :: nbi_template
+      INTEGER, ALLOCATABLE, DIMENSION(:,:)   :: nbj_template
+      INTEGER, ALLOCATABLE, DIMENSION(:,:)   :: nbr_template
+
+      INTEGER, ALLOCATABLE, DIMENSION(:)     :: nbi_extract, nbj_extract
+
+      INTEGER,  ALLOCATABLE, DIMENSION(:,:,:,:)  :: varin_int, varout_int
+      REAL(sp), ALLOCATABLE, DIMENSION(:,:,:,:)  :: varin_float, varout_float
+      REAL(dp), ALLOCATABLE, DIMENSION(:,:,:,:)  :: varin_dble, varout_dble
+
+      LOGICAL                   :: ln_coordinates
+      LOGICAL                   :: ln_template
+
+      CHARACTER(LEN=nf90_max_name)        :: attname, dimname, varname, time, date, zone, timestamp
+      CHARACTER(LEN=nf90_max_name)        :: file_in, file_out, file_template, nbi_name, nbj_name, nbr_name
+      CHARACTER(LEN=1),DIMENSION(4)       :: cgrid
+      CHARACTER(LEN=1)                    :: end_letter
+
+      NAMELIST/nam_bdy_reorder/ file_in, file_out, file_template, ln_coordinates, nbr_match
+
+!=============================================================================
+
+!-----------------------------------------------------------------------------
+! 0. Read namelist and initialise parameters
+!----------------------------------------------------------------------------- 
+
+      file_in = ''
+      file_out = ''
+      file_template = ''
+      ln_coordinates = .false.
+      nbr_match = 0
+
+      OPEN( UNIT=numnam, FILE='nam_bdy_reorder', FORM='FORMATTED', STATUS='OLD' )
+      READ( numnam, nam_bdy_reorder )
+      CLOSE( UNIT=numnam )
+
+      IF( ln_coordinates ) THEN
+         WRITE(*,*) 'Input file is a coordinates.bdy.nc file.'
+         jpbgrd = 4
+      ELSE
+          WRITE(*,*) 'Input file is a boundary data file.'
+         jpbgrd = 1
+      ENDIF
+ 
+      IF( LEN_TRIM(file_template) > 0 ) THEN 
+         WRITE(*,*) 'Reordering data to match template file.'
+         ln_template = .true.
+      ELSE 
+         WRITE(*,*) 'Reordering data in order of increasing nbr values.'
+         ln_template = .false.
+      ENDIF
+
+      cgrid= (/'t','u','v','f'/)
+
+!-----------------------------------------------------------------------------
+! 1. Read in nbr variables from file and create mapping. 
+!----------------------------------------------------------------------------- 
+
+! 1.1 Open input files
+
+      iostat = nf90_open( TRIM(file_in), nf90_nowrite, ncid_in )
+      IF (iostat /= nf90_noerr) THEN
+        WRITE(6,*) TRIM(nf90_strerror(iostat))
+        STOP
+      ENDIF
+      iostat = nf90_inquire( ncid_in, ndims, nvars, natts )
+
+      IF( ln_template ) THEN
+         iostat = nf90_open( TRIM(file_template), nf90_nowrite, ncid_template )
+         IF (iostat /= nf90_noerr) THEN
+           WRITE(6,*) TRIM(nf90_strerror(iostat))
+           STOP
+         ENDIF
+      ENDIF
+
+      DO igrid=1,jpbgrd
+
+! 1.2 Find dimensions of data in input files and allocate arrays
+
+         IF( ln_coordinates ) THEN
+            nbr_name = 'nbr'//cgrid(igrid)
+         ELSE
+            nbr_name = 'nbrdta'
+         ENDIF
+
+         iostat = nf90_inq_varid( ncid_in, nbr_name , nbrid(igrid) )
+         IF (iostat /= nf90_noerr) THEN
+            WRITE(6,*) TRIM(nf90_strerror(iostat))
+            STOP
+         ENDIF
+         iostat = nf90_inquire_variable( ncid_in, nbrid(igrid), ndims=ndims, dimids=dimids )
+         IF( ndims .ne. 2 ) THEN
+            WRITE(*,*) 'ERROR : ',TRIM(nbr_name),' does not have exactly 2 dimensions.'
+            WRITE(*,*) '        in file ',TRIM(file_in)
+            STOP
+         ENDIF
+         iostat = nf90_inquire_dimension( ncid_in, dimids(1), len=nblen(igrid))
+         iostat = nf90_inquire_dimension( ncid_in, dimids(2), len=len1)
+         WRITE(*,*) 'nblen(igrid), len1 : ',nblen(igrid), len1
+         IF( len1 .ne. 1 ) THEN 
+            WRITE(*,*) 'ERROR : second dimension of ',TRIM(nbr_name),' does not have length 1.'
+            WRITE(*,*) '        in file ',TRIM(file_in)
+            WRITE(*,*) '        len1 = ',len1
+            STOP
+         ENDIF
+
+         IF( ln_template ) THEN 
+
+            iostat = nf90_inq_varid( ncid_template, nbr_name , nbrid_template(igrid) )
+            IF (iostat /= nf90_noerr) THEN
+               WRITE(6,*) TRIM(nf90_strerror(iostat))
+               STOP
+            ENDIF
+            iostat = nf90_inquire_variable( ncid_template, nbrid_template(igrid), ndims=ndims, dimids=dimids )
+            IF( ndims .ne. 2 ) THEN
+               WRITE(*,*) 'ERROR : ',TRIM(nbr_name),' does not have exactly 2 dimensions.'
+               WRITE(*,*) '        in file ',TRIM(file_template)
+               STOP
+            ENDIF
+            iostat = nf90_inquire_dimension( ncid_template, dimids(1), len=nblen_template(igrid))
+            iostat = nf90_inquire_dimension( ncid_template, dimids(2), len=len1)
+            WRITE(*,*) 'nblen_template(igrid), len1 : ',nblen_template(igrid), len1
+            IF( len1 .ne. 1 ) THEN 
+               WRITE(*,*) 'ERROR : second dimension of ',TRIM(nbr_name),' does not have length 1.'
+               WRITE(*,*) '        in file ',TRIM(file_template)
+               WRITE(*,*) '        len1 = ',len1
+               STOP
+            ENDIF
+
+         ENDIF ! ln_template
+
+      ENDDO  ! jpbgrd
+
+      ALLOCATE( nbr(MAXVAL(nblen),1), imap(MAXVAL(nblen),jpbgrd) )
+      IF( ln_template ) THEN 
+         ALLOCATE( nbi(MAXVAL(nblen),1), nbj(MAXVAL(nblen),1) )
+         ALLOCATE( nbi_template(MAXVAL(nblen_template),1) )
+         ALLOCATE( nbj_template(MAXVAL(nblen_template),1) )
+         ALLOCATE( nbr_template(MAXVAL(nblen_template),1) )
+      ENDIF
+
+! 1.3 Read in nbr variables and generate mapping.
+
+      nbr(:,:) = -1
+      imap(:,:) = -1    
+      IF( ln_template ) THEN 
+         nbi(:,:) = -1
+         nbj(:,:) = -1
+         nbi_template(:,:) = -1
+         nbj_template(:,:) = -1
+         nbr_template(:,:) = -1
+      ENDIF
+
+      WRITE(*,*) '>>> Generating map.'
+      DO igrid=1,jpbgrd
+
+         iostat = nf90_get_var( ncid_in, nbrid(igrid), nbr(1:nblen(igrid),1:1) ) 
+         IF (iostat /= nf90_noerr) THEN
+           WRITE(6,*) TRIM(nf90_strerror(iostat))
+           STOP
+         ENDIF
+
+         nbr_min = MINVAL( nbr(1:nblen(igrid),1) )
+         nbr_max = MAXVAL( nbr(1:nblen(igrid),1) )
+         IF( nbr_min .ne. 1 ) THEN
+            WRITE(*,*) 'Something wrong with input file ',file_in
+            WRITE(*,*) 'MIN(nbr) /= 1'
+            STOP
+         ENDIF
+
+         IF( ln_template ) THEN 
+
+            IF( ln_coordinates ) THEN
+               nbi_name = 'nbi'//cgrid(igrid)
+               nbj_name = 'nbj'//cgrid(igrid)
+            ELSE
+               nbi_name = 'nbidta'            
+               nbj_name = 'nbjdta'            
+            ENDIF
+
+            ! read in nbi, nbj values from input file
+            iostat = nf90_inq_varid( ncid_in, nbi_name, varid ) 
+            IF (iostat == nf90_noerr) iostat = nf90_get_var( ncid_in, varid, nbi(1:nblen(igrid),1:1) ) 
+            IF (iostat /= nf90_noerr) THEN
+              WRITE(6,*) TRIM(nf90_strerror(iostat))
+              STOP
+            ENDIF
+            iostat = nf90_inq_varid( ncid_in, nbj_name, varid ) 
+            IF (iostat == nf90_noerr) iostat = nf90_get_var( ncid_in, varid, nbj(1:nblen(igrid),1:1) ) 
+            IF (iostat /= nf90_noerr) THEN
+              WRITE(6,*) TRIM(nf90_strerror(iostat))
+              STOP
+            ENDIF
+
+            ! read in nbi, nbj, nbr values from template file
+            iostat = nf90_inq_varid( ncid_template, nbi_name, varid ) 
+            IF (iostat == nf90_noerr) iostat = nf90_get_var( ncid_template, varid, nbi_template(1:nblen_template(igrid),1:1) ) 
+            IF (iostat /= nf90_noerr) THEN
+              WRITE(6,*) TRIM(nf90_strerror(iostat))
+              STOP
+            ENDIF
+            iostat = nf90_inq_varid( ncid_template, nbj_name, varid ) 
+            IF (iostat == nf90_noerr) iostat = nf90_get_var( ncid_template, varid, nbj_template(1:nblen_template(igrid),1:1) ) 
+            IF (iostat /= nf90_noerr) THEN
+              WRITE(6,*) TRIM(nf90_strerror(iostat))
+              STOP
+            ENDIF
+            iostat = nf90_get_var( ncid_template, nbrid_template(igrid), nbr_template(1:nblen_template(igrid),1:1) ) 
+            IF (iostat /= nf90_noerr) THEN
+              WRITE(6,*) TRIM(nf90_strerror(iostat))
+              STOP
+            ENDIF
+
+            nbr_min_template = MINVAL( nbr_template(1:nblen_template(igrid),1) )
+            nbr_max_template = MAXVAL( nbr_template(1:nblen_template(igrid),1) )
+            IF( nbr_min_template .ne. 1 ) THEN
+               WRITE(*,*) 'Something wrong with template file ',file_template
+               WRITE(*,*) 'MIN(nbr) /= 1'
+               STOP
+            ENDIF
+
+            IF( nbr_match .lt. 1 ) nbr_match = MIN(nbr_max, nbr_max_template)
+
+            ! initialise imap to the identity mapping
+            DO ib = 1, nblen(igrid)
+               imap(ib, igrid) = ib
+            ENDDO
+
+            ! allocate "extract" arrays
+            icount = 0
+            DO ib = 1, nblen_template(igrid)
+               IF( nbr_template(ib,1) .eq. 1 ) THEN
+                  icount = icount+1
+               ENDIF
+            ENDDO
+            ALLOCATE( nbi_extract(icount), nbj_extract(icount) )
+
+            DO ir = 1, nbr_match
+
+               ! extract values from template array for this ir value
+               icount = 0
+               DO ib = 1, nblen_template(igrid)
+                  IF( nbr_template(ib,1) .eq. ir ) THEN
+                     icount = icount+1
+                     nbi_extract(icount) = nbi_template(ib,1)               
+                     nbj_extract(icount) = nbj_template(ib,1)               
+                  ENDIF
+               ENDDO
+
+               ! work out the mapping for this ir value
+               icount = 1
+               DO ib = 1, nblen(igrid)
+                  IF( nbr(ib,1) .eq. ir ) THEN                  
+                     DO ib1 = 1, nblen(igrid)
+                        IF( nbi(ib1,1) .eq. nbi_extract(icount) .and. &
+                       &    nbj(ib1,1) .eq. nbj_extract(icount)       ) THEN
+                           imap(ib,igrid) = ib1
+                           icount = icount + 1
+                           EXIT
+                        ENDIF                        
+                     ENDDO ! ib1
+                  ENDIF           
+               ENDDO ! ib
+
+            ENDDO ! ir
+            
+            DEALLOCATE( nbi_extract, nbj_extract )
+
+         ELSE 
+
+            icount = 0
+            DO ir = nbr_min, nbr_max
+               DO ib = 1, nblen(igrid)
+                  IF( nbr(ib,1) .eq. ir ) THEN
+                     icount = icount + 1
+                     imap(icount,igrid) = ib
+                  ENDIF           
+               ENDDO
+            ENDDO
+
+         ENDIF
+     
+      ENDDO  ! jpbgrd
+
+!-----------------------------------------------------------------------------
+! 2. Open output file and copy dimensions and attributes across
+!----------------------------------------------------------------------------- 
+
+      iostat = nf90_inquire( ncid_in, ndims, nvars, natts )
+
+! 2.1 Create the output file  
+
+      WRITE(*,*) '>>> Initialising output file.'
+      iostat = nf90_create( TRIM(file_out), nf90_64bit_offset, ncid_out, chunksize=chunksize)
+
+! 2.2 Copy the dimensions into the output file.
+
+      iostat = nf90_inquire( ncid_in, unlimitedDimId = unlimitedDimId )
+      dimlen(:) = 1
+      DO idim = 1, ndims
+         iostat = nf90_inquire_dimension(ncid_in, idim, dimname, dimlen(idim))
+         IF (idim == unlimitedDimId) THEN
+            iostat = nf90_def_dim( ncid_out, dimname, nf90_unlimited, dimid)    
+            idim_time = idim
+         ELSE
+            iostat = nf90_def_dim( ncid_out, dimname, dimlen(idim), dimid)
+            IF( INDEX(dimname,'x') .gt. 0 ) THEN
+               idim_xb = idim
+            ELSE IF( INDEX(dimname,'y') .gt. 0 ) THEN
+               idim_yb = idim
+            ELSE IF( INDEX(dimname,'depth') .gt. 0 .or. INDEX(dimname,'z') .gt. 0 ) THEN
+               idim_depth = idim
+            ELSE
+               WRITE(*,*) 'ERROR: Unrecognised dimension : ',dimname
+               STOP
+            ENDIF            
+         ENDIF
+      END DO
+      
+
+! 2.2 Copy the global attributes into the output file.
+!     Also need to change the file_name attribute and the TimeStamp attribute.
+
+      DO attid = 1, natts
+         iostat = nf90_inq_attname( ncid_in, nf90_global, attid, attname )
+         WRITE(6,*)'>>> Copying attribute '//TRIM(attname)//' into destination file...'
+         iostat = nf90_copy_att( ncid_in, nf90_global, attname, ncid_out, nf90_global )  
+      END DO
+      iostat = nf90_put_att( ncid_out, nf90_global, "file_name", TRIM(file_out))
+      CALL DATE_AND_TIME ( date=date, time=time, zone=zone )
+      timestamp = date(7:8) // "/" // date(5:6) // "/" // date(1:4) // " " // &
+                  time(1:2) // ":" // time(3:4) // ":" // time(5:6) // " " // &
+                  zone  
+      iostat = nf90_put_att( ncid_out, nf90_global, "TimeStamp", timestamp)
+  
+! 2.3 Copy the variable definitions and attributes into the output file.
+
+      DO jv = 1, nvars
+         iostat = nf90_inquire_variable( ncid_in, jv, varname, xtype, ndims_var, dimids, natts )
+         iostat = nf90_def_var( ncid_out, varname, xtype, dimids(1:ndims_var), varid )
+            IF (natts > 0) THEN
+            DO attid = 1, natts
+               iostat = nf90_inq_attname(ncid_in, varid, attid, attname)
+               iostat = nf90_copy_att( ncid_in, varid, attname, ncid_out, varid )   
+            END DO
+         ENDIF
+      END DO
+ 
+! 2.4 End definitions in output file
+
+      iostat = nf90_enddef( ncid_out )    
+
+!-----------------------------------------------------------------------------
+! 3. Read in variables from input file, re-order and write to output file
+!----------------------------------------------------------------------------- 
+
+     IF( ln_coordinates ) THEN
+        ALLOCATE( varin_int(MAXVAL(nblen),1,1,1), varout_int(MAXVAL(nblen),1,1,1) )
+        ALLOCATE( varin_float(MAXVAL(nblen),1,1,1), varout_float(MAXVAL(nblen),1,1,1) )
+        ALLOCATE( varin_dble(MAXVAL(nblen),1,1,1), varout_dble(MAXVAL(nblen),1,1,1) )
+     ELSE
+        SELECT CASE( ndims ) 
+           CASE( 2 )
+              ALLOCATE(  varin_int(dimlen(idim_xb),dimlen(idim_yb),1,1) )
+              ALLOCATE( varout_int(dimlen(idim_xb),dimlen(idim_yb),1,1) )
+              ALLOCATE(  varin_float(dimlen(idim_xb),dimlen(idim_yb),1,1) ) 
+              ALLOCATE( varout_float(dimlen(idim_xb),dimlen(idim_yb),1,1) )
+              ALLOCATE(  varin_dble(dimlen(idim_xb),dimlen(idim_yb),1,1) ) 
+              ALLOCATE( varout_dble(dimlen(idim_xb),dimlen(idim_yb),1,1) )
+           CASE ( 3 )
+              ALLOCATE(  varin_int(dimlen(idim_xb),dimlen(idim_yb),1,dimlen(idim_time)) )
+              ALLOCATE( varout_int(dimlen(idim_xb),dimlen(idim_yb),1,dimlen(idim_time)) )
+              ALLOCATE(  varin_float(dimlen(idim_xb),dimlen(idim_yb),1,dimlen(idim_time)) ) 
+              ALLOCATE( varout_float(dimlen(idim_xb),dimlen(idim_yb),1,dimlen(idim_time)) )
+              ALLOCATE(  varin_dble(dimlen(idim_xb),dimlen(idim_yb),1,dimlen(idim_time)) ) 
+              ALLOCATE( varout_dble(dimlen(idim_xb),dimlen(idim_yb),1,dimlen(idim_time)) )
+           CASE ( 4 )
+              ALLOCATE(  varin_int(dimlen(idim_xb),dimlen(idim_yb),dimlen(idim_depth),dimlen(idim_time)) ) 
+              ALLOCATE( varout_int(dimlen(idim_xb),dimlen(idim_yb),dimlen(idim_depth),dimlen(idim_time)) )
+              ALLOCATE(  varin_float(dimlen(idim_xb),dimlen(idim_yb),dimlen(idim_depth),dimlen(idim_time)) ) 
+              ALLOCATE( varout_float(dimlen(idim_xb),dimlen(idim_yb),dimlen(idim_depth),dimlen(idim_time)) )
+              ALLOCATE(  varin_dble(dimlen(idim_xb),dimlen(idim_yb),dimlen(idim_depth),dimlen(idim_time)) ) 
+              ALLOCATE( varout_dble(dimlen(idim_xb),dimlen(idim_yb),dimlen(idim_depth),dimlen(idim_time)) )
+           CASE DEFAULT
+              WRITE(*,*) 'ERROR : Can only cope with 2, 3 or 4 dimensions in the boundary data files.'
+              WRITE(*,*) '        This file appears to have ',ndims,' dimensions.'
+              STOP
+        END SELECT
+     ENDIF
+
+     DO jv = 1, nvars
+       iostat = nf90_inquire_variable( ncid_in, jv, varname, xtype, ndims_var, dimids )
+       DO idim = 1, ndims_var
+          lenvar(idim) = dimlen(dimids(idim))
+       ENDDO
+
+       IF( ndims_var .eq. 1 ) THEN
+          WRITE(*,*) '>>> Copying coordinate variable ',TRIM(varname)
+       ELSE
+          WRITE(*,*) '>>> Reordering variable ',TRIM(varname)
+       ENDIF
+       ! Error check here
+
+       IF( ln_coordinates ) THEN
+          strlen = len_trim(varname)
+          end_letter = varname(strlen:strlen)
+          jgrid = -1
+          DO igrid = 1,4
+             IF( end_letter .eq. cgrid(igrid) ) jgrid = igrid
+          END DO
+          IF( jgrid .lt. 0 ) THEN
+             WRITE(*,*) 'ERROR : Could not identify grid for variable ',TRIM(varname)
+             WRITE(*,*) ' varname : ',TRIM(varname),'!'
+             WRITE(*,*) ' strlen : ',strlen
+             WRITE(*,*) ' end_letter : ',end_letter
+             WRITE(*,*) ' cgrid(1) : ',cgrid(1)
+             WRITE(*,*) ' cgrid(2) : ',cgrid(2)
+             WRITE(*,*) ' cgrid(3) : ',cgrid(3)
+             WRITE(*,*) ' cgrid(4) : ',cgrid(4)
+             STOP
+          ENDIF
+       ELSE
+          jgrid=1
+       ENDIF
+           
+       SELECT CASE(xtype)
+
+          CASE( NF90_INT ) 
+             SELECT CASE(ndims_var)
+                CASE( 1 )
+                   WRITE(*,*) 'This is a 1D integer.'
+                   ! Assume this is a depth or time coordinate variable and copy across unchanged.
+                   iostat = nf90_get_var( ncid_in, jv, varin_int(1:lenvar(1),1,1,1) )
+                   iostat = nf90_put_var( ncid_out, jv, varout_int(1:lenvar(1),1,1,1) ) 
+                CASE( 2 )
+                   WRITE(*,*) 'This is a 2D integer.'
+                   iostat = nf90_get_var( ncid_in, jv, varin_int(1:lenvar(1),1:1,1,1) )
+                   DO ib = 1,lenvar(1)
+                      varout_int(ib,1,1,1) = varin_int(imap(ib,jgrid),1,1,1)
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_int(1:lenvar(1),1:1,1,1) ) 
+                CASE( 3 )
+                   WRITE(*,*) 'This is a 3D integer.'
+                   ! Assume third dimension is time.
+                   iostat = nf90_get_var( ncid_in, jv, varin_int(1:lenvar(1),1:1,1,1:lenvar(3)) )
+                   DO itime = 1,lenvar(3)
+                      DO ib = 1,lenvar(1)
+                         varout_int(ib,1,1,itime) = varin_int(imap(ib,jgrid),1,1,itime)
+                      END DO
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_int(1:lenvar(1),1:1,1,1:lenvar(3)) ) 
+                CASE( 4 )
+                   WRITE(*,*) 'This is a 4D integer.'
+                   ! Assume third and fourth dimensions are depth and time respectively.
+                   iostat = nf90_get_var( ncid_in, jv, varin_int(1:lenvar(1),1:1,1:lenvar(3),1:lenvar(4)) )
+                   DO itime = 1,lenvar(4)
+                      DO idepth = 1,lenvar(3)
+                         DO ib = 1,lenvar(1)
+                            varout_int(ib,1,idepth,itime) = varin_int(imap(ib,jgrid),1,idepth,itime)
+                         END DO
+                      END DO
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_int(1:lenvar(1),1:1,1:lenvar(3),1:lenvar(4)) ) 
+                CASE DEFAULT
+                   WRITE(*,*) 'ERROR : Variable with ',ndims_var,' dimensions. Case not coded.'
+                   STOP
+             END SELECT
+
+          CASE( NF90_FLOAT ) 
+             SELECT CASE(ndims_var)
+                CASE( 1 )
+                   WRITE(*,*) 'This is a 1D float.'
+                   ! Assume this is a depth or time coordinate variable and copy across unchanged.
+                   iostat = nf90_get_var( ncid_in, jv, varin_float(1:lenvar(1),1,1,1) )
+                   iostat = nf90_put_var( ncid_out, jv, varout_float(1:lenvar(1),1,1,1) ) 
+                CASE( 2 )
+                   WRITE(*,*) 'This is a 2D float.'
+                   iostat = nf90_get_var( ncid_in, jv, varin_float(1:lenvar(1),1:1,1,1) )
+                   DO ib = 1,lenvar(1)
+                      varout_float(ib,1,1,1) = varin_float(imap(ib,jgrid),1,1,1)
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_float(1:lenvar(1),1:1,1,1) ) 
+                CASE( 3 )
+                   WRITE(*,*) 'This is a 3D float.'
+                   ! Assume third dimension is time.
+                   iostat = nf90_get_var( ncid_in, jv, varin_float(1:lenvar(1),1:1,1,1:lenvar(3)) )
+                   DO itime = 1,lenvar(3)
+                      DO ib = 1,lenvar(1)
+                         varout_float(ib,1,1,itime) = varin_float(imap(ib,jgrid),1,1,itime)
+                      END DO
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_float(1:lenvar(1),1:1,1,1:lenvar(3)) ) 
+                CASE( 4 )
+                   WRITE(*,*) 'This is a 4D float.'
+                   ! Assume third and fourth dimensions are depth and time respectively.
+                   iostat = nf90_get_var( ncid_in, jv, varin_float(1:lenvar(1),1:1,1:lenvar(3),1:lenvar(4)) )
+                   DO itime = 1,lenvar(4)
+                      DO idepth = 1,lenvar(3)
+                         DO ib = 1,lenvar(1)
+                            varout_float(ib,1,idepth,itime) = varin_float(imap(ib,jgrid),1,idepth,itime)
+                         END DO
+                      END DO
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_float(1:lenvar(1),1:1,1:lenvar(3),1:lenvar(4)) ) 
+                CASE DEFAULT
+                   WRITE(*,*) 'ERROR : Variable with ',ndims_var,' dimensions. Case not coded.'
+                   STOP
+             END SELECT
+
+          CASE( NF90_DOUBLE ) 
+             SELECT CASE(ndims_var)
+                CASE( 1 )
+                   WRITE(*,*) 'This is a 1D double.'
+                   ! Assume this is a depth or time coordinate variable and copy across unchanged.
+                   iostat = nf90_get_var( ncid_in, jv, varin_dble(1:lenvar(1),1,1,1) )
+                   iostat = nf90_put_var( ncid_out, jv, varout_dble(1:lenvar(1),1,1,1) ) 
+                CASE( 2 )
+                   WRITE(*,*) 'This is a 2D double.'
+                   iostat = nf90_get_var( ncid_in, jv, varin_dble(1:lenvar(1),1:1,1,1) )
+                   DO ib = 1,lenvar(1)
+                      varout_dble(ib,1,1,1) = varin_dble(imap(ib,jgrid),1,1,1)
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_dble(1:lenvar(1),1:1,1,1) ) 
+                CASE( 3 )
+                   WRITE(*,*) 'This is a 3D double.'
+                   ! Assume third dimension is time.
+                   iostat = nf90_get_var( ncid_in, jv, varin_dble(1:lenvar(1),1:1,1,1:lenvar(3)) )
+                   DO itime = 1,lenvar(3)
+                      DO ib = 1,lenvar(1)
+                         varout_dble(ib,1,1,itime) = varin_dble(imap(ib,jgrid),1,1,itime)
+                      END DO
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_dble(1:lenvar(1),1:1,1,1:lenvar(3)) ) 
+                CASE( 4 )
+                   WRITE(*,*) 'This is a 4D double.'
+                   ! Assume third and fourth dimensions are depth and time respectively.
+                   iostat = nf90_get_var( ncid_in, jv, varin_dble(1:lenvar(1),1:1,1:lenvar(3),1:lenvar(4)) )
+                   DO itime = 1,lenvar(4)
+                      DO idepth = 1,lenvar(3)
+                         DO ib = 1,lenvar(1)
+                            varout_dble(ib,1,idepth,itime) = varin_dble(imap(ib,jgrid),1,idepth,itime)
+                         END DO
+                      END DO
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_dble(1:lenvar(1),1:1,1:lenvar(3),1:lenvar(4)) ) 
+                CASE DEFAULT
+                   WRITE(*,*) 'ERROR : Variable with ',ndims_var,' dimensions. Case not coded.'
+                   STOP
+             END SELECT
+
+             CASE DEFAULT
+                WRITE(*,*) 'ERROR : Unrecognised data type.'           
+                STOP
+
+       END SELECT
+
+       END DO ! jv
+
+!-----------------------------------------------------------------------------
+! 4. Close input and output files
+!----------------------------------------------------------------------------- 
+
+      iostat = nf90_close( ncid_out )
+      iostat = nf90_close( ncid_in )
+
+
+END PROGRAM bdy_reorder
Index: /utils/tools_ticket2413/DIAMLR/diamlr.py
===================================================================
--- /utils/tools_ticket2413/DIAMLR/diamlr.py	(revision 12863)
+++ /utils/tools_ticket2413/DIAMLR/diamlr.py	(revision 12863)
@@ -0,0 +1,189 @@
+#! /usr/bin/python
+# ======================================================================
+#                        ***  TOOL diamlr.py  ***
+# Postprocessing of intermediate NEMO model output for
+# multiple-linear-regression analysis (diamlr)
+# ======================================================================
+# History :      !  2019  (S. Mueller)
+# ----------------------------------------------------------------------
+import sys
+# ----------------------------------------------------------------------
+# NEMO/TOOLS 4.0 , NEMO Consortium (2019)
+# $Id$
+# Software governed by the CeCILL license (see ./LICENSE)
+# ----------------------------------------------------------------------
+
+# ----------------------------------------------------------------------
+#                    ***  SUBROUTINE get_args  ***
+# Parse command line arguments
+# ----------------------------------------------------------------------
+def get_args():
+    from argparse import ArgumentParser
+    import re
+
+    # Set up command-line argument parser
+    parser = ArgumentParser(
+        description='Postprocessing of intermediate NEMO model output'+
+                    ' for multiple-linear-regression analysis (diamlr)')
+    parser.add_argument('--file_scalar', help=
+                        'Filename of scalar intermediate NEMO model'+
+                        ' output for multiple-linear-regression'+
+                        ' analysis')
+    parser.add_argument('--file_grid', help=
+                        'Filename of gridded intermediate NEMO model'+
+                        ' output for multiple-linear-regression'+
+                        ' analysis')
+    parser.add_argument('--regressors', nargs='+', required=False,
+                        help='Optional list of regressors to include'+
+                        ' in analysis; if omitted, all available'+
+                        ' regressors will be included')
+    args = parser.parse_args()
+    return args
+
+# ----------------------------------------------------------------------
+#                    ***  SUBROUTINE main  ***
+# Finalisation of multiple-linear-regression analysis
+# ----------------------------------------------------------------------
+def main():
+    from netCDF4 import Dataset as nc
+    import re
+    import numpy as np
+    from os.path import basename, splitext
+    from time import strftime, localtime
+
+    # Get command-line arguments
+    args = get_args()
+
+    # Get filenames/locations of intermdiate diamlr output
+    fn_scalar = args.file_scalar
+    fn_grid   = args.file_grid
+
+    # Open regressor-regressor scalar-product data set
+    f = nc(fn_scalar, 'r')
+
+    # Detect available regressors; reduce list of regressors according
+    # to list of selected regressors (if specified)
+    regs = {}
+    vn_re = re.compile('(diamlr_r[0-9]{3})\.(diamlr_r[0-9]{3})')
+    for vn in f.variables.keys():
+        vn_match = vn_re.match(vn)
+        if (vn_match):
+            reg1 = vn_match.group(1)
+            reg2 = vn_match.group(2)
+            if not args.regressors or reg1 in args.regressors:
+                regs[vn_match.group(1)] = True
+            if not args.regressors or reg2 in args.regressors:
+                regs[vn_match.group(2)] = True
+    regs = regs.keys()
+    regs.sort()
+
+    print('Compile and invert matrix of regressor-regressor scalar'+
+          'products ...')
+
+    # Set up square matrix, XX, of regressor-regressor scalar products
+    xx = np.matrix(np.zeros((len(regs), len(regs))))
+    for i1 in range(len(regs)):
+        vn1 = regs[i1]
+        for i2 in range(regs.index(vn1)+1):
+            vn2 = regs[i2]
+            if f.variables[vn1+'.'+vn2]:
+                xx_sum = np.sum(f.variables[vn1+'.'+vn2][:])
+            else:
+                xx_sum = np.sum(f.variables[vn2+'.'+vn1][:])
+            xx[i1,i2] = xx_sum
+            if i1 != i2:
+                xx[i2,i1] = xx_sum
+
+    # Close regressor-regressor scalar-product data set
+    f.close()
+
+    # Compute inverse matrix, XX^-1; convert matrix to an array to
+    # enable the dot-product computation of XX with a large array below
+    ixx = np.array(xx**-1)
+
+    print('   ... done')
+
+    # Open field-regressor scalar-product data set
+    f = nc(fn_grid, 'r')
+
+    # Detect analysed fields
+    flds = {}
+    vn_re = re.compile('(diamlr_f[0-9]{3})\.(diamlr_r[0-9]{3})')
+    for vn in f.variables.keys():
+        vn_match = vn_re.match(vn)
+        if (vn_match):
+            if vn_match.group(2) in regs:
+                flds[vn_match.group(1)] = True
+    flds = flds.keys()
+    flds.sort()
+
+    # Open and prepare output file, incl. replication of
+    # domain-decomposition metadata (if present) from the
+    # field-regressor data set
+    fn_out = './'+basename(fn_grid)
+    if fn_out.find('diamlr') > 0:
+        fn_out = fn_out.replace('diamlr', 'diamlr_coeffs')
+    else:
+        fn_parts = splitext(basename(fn_grid))
+        fn_out = fn_parts[0]+'_diamlr_coeffs'+fn_parts[1]
+    nc_out = nc(fn_out, 'w', format='NETCDF4', clobber=False)
+    nc_atts = {
+        'name'        : fn_out,
+        'description' : 'Multiple-linear-regression analysis output',
+        'title'       : 'Multiple-linear-regression analysis output',
+        'timeStamp'   : strftime('%Y-%m-%d %H:%M:%S %Z', localtime())}
+    for nc_att in f.ncattrs():
+        if nc_att in ['ibegin', 'jbegin',
+                      'ni', 'nj'] or nc_att.startswith('DOMAIN'):
+           nc_atts[nc_att] = f.getncattr(nc_att)
+    nc_out.setncatts(nc_atts)
+    for nc_dimname in f.dimensions.keys():
+        nc_dim = f.dimensions[nc_dimname]
+        if nc_dim.isunlimited():
+            nc_out.createDimension(nc_dim.name)
+        else:
+            nc_out.createDimension(nc_dim.name, nc_dim.size)
+
+    # Read in fields of scalar products of model diagnostics and
+    # regressors and compute the regression coefficients for the current
+    # field; add resulting fields to output file
+    for fld in flds:
+        print('Completing analysis for field '+fld+' ...')
+        xy = np.array([])
+        for reg in regs:
+            if xy.size == 0:
+                xy = np.sum(f.variables[fld+'.'+reg][:],
+                            axis=0)[np.newaxis,:]
+            else:
+                xy = np.r_[xy, np.sum(f.variables[fld+'.'+reg][:],
+                                      axis=0)[np.newaxis,:]]
+        b=np.reshape(np.dot(ixx, np.reshape(xy,(len(xy),xy[0,:].size))),
+                     (xy.shape))
+        print('   ... done')
+
+        for reg in regs:
+            nr = regs.index(reg)
+            nc_gridvar = f.variables[fld+'.'+reg]
+            name = nc_gridvar.name.split('.')
+            nc_var = nc_out.createVariable(name[0]+'-'+name[1],
+                                           nc_gridvar.datatype,
+                                           nc_gridvar.dimensions)
+            for nc_att in nc_gridvar.ncattrs():
+                if nc_att in ['_FillValue', 'missing_value']:
+                    nc_var.setncattr(nc_att, nc_gridvar.getncattr(
+                        nc_att))
+            name = nc_gridvar.getncattr('standard_name').split('.')
+            nc_var.setncattr(
+                'standard_name', name[0]+' regressed on '+name[1])
+            nc_var[0,:] = b[nr,:].data
+
+    # Close output file; close field-regressor scalar-product data set
+    nc_out.close()
+    f.close()
+
+# ----------------------------------------------------------------------
+#                     ***  main PROGRAM  ***
+# ----------------------------------------------------------------------
+if __name__ == "__main__":
+
+    main()
Index: /utils/tools_ticket2413/DMP_TOOLS/README
===================================================================
--- /utils/tools_ticket2413/DMP_TOOLS/README	(revision 12863)
+++ /utils/tools_ticket2413/DMP_TOOLS/README	(revision 12863)
@@ -0,0 +1,5 @@
+DMP_TOOLS should be used to create a netcdf file called resto.nc containing restoration coefficients for use with the tra_dmp module in NEMO. Further instructions for it's use are available in the NEMO users guide.
+
+The tool can be compiled using the maketools script in the NEMOGCM/TOOLS directory as follows:
+./maketools -m $ARCH -n DMP_TOOLS
+where $ARCH indicates the arch file to be used from the directory NEMOGCM/ARCH. For example to use NEMOGCM/ARCH/arch-PW7_MONSOON.fcm, $ARCH would be PW7_MONSOON.
Index: /utils/tools_ticket2413/DMP_TOOLS/doc_DMP_tool.bib
===================================================================
--- /utils/tools_ticket2413/DMP_TOOLS/doc_DMP_tool.bib	(revision 12863)
+++ /utils/tools_ticket2413/DMP_TOOLS/doc_DMP_tool.bib	(revision 12863)
@@ -0,0 +1,31 @@
+@ARTICLE{Reverdin1991,
+  author =       {G. Reverdin and P. Delecluse and C. L\'{e}vy and
+                  P. Andrich and A. Morli\`{e}re and J. M. Verstraete},
+  title =        {The near surface tropical Atlantic in 1982-1984 :
+                  results from a numerical simulation and a data
+                  analysis},
+  journal =      PO,
+  year =         1991,
+  volume =       27,
+  pages =        {273--340}
+}
+
+@ARTICLE{Fujio1991,
+  author =       {S. Fujio and N. Imasato},
+  title =        {Diagnostic calculation for circulation and water
+                  mass movement in the deep Pacific},
+  journal =      JGR,
+  year =         1991,
+  volume =       96,
+  pages =        {759--774}
+}
+
+@PHDTHESIS{Marti_PhD92,
+  author =       {O. Marti},
+  title =        {Etude de l'oc\'{e}an mondial : mod\'{e}lisation de
+                  la circulation et du transport de traceurs
+                  anthropog\'{e}niques},
+  school =       {Universit\'{e} Pierre et Marie Curie, Paris, France,
+                  201pp},
+  year =         1992
+}
Index: /utils/tools_ticket2413/DMP_TOOLS/doc_DMP_tool.tex
===================================================================
--- /utils/tools_ticket2413/DMP_TOOLS/doc_DMP_tool.tex	(revision 12863)
+++ /utils/tools_ticket2413/DMP_TOOLS/doc_DMP_tool.tex	(revision 12863)
@@ -0,0 +1,65 @@
+\documentclass{article}
+
+\usepackage{xspace, natbib, minted}
+
+\setminted{style=emacs, fontsize=\scriptsize, breaklines, frame=leftline}
+
+\renewcommand{\deg}{$^{\circ} $ \xspace}
+\newcommand{\ifile}[1]{\textit{#1.nc}\index{Input NetCDF files!#1.nc}}
+\newcommand{\mdl}[1]{\textit{#1.F90}\index{Modules!#1}}
+\newcommand{\ngn}[1]{\textit{#1}\index{Namelist Group Name!#1}}
+\newcommand{\np}[1]{\textit{#1}\index{Namelist variables!#1}}
+
+\begin{document}
+
+DMP\_TOOLS can be used to generate a netcdf file containing the restoration coefficient $\gamma$.
+Note that in order to maintain bit comparison with previous NEMO versions DMP\_TOOLS must be compiled and
+run on the same machine as the NEMO model.
+A \ifile{mesh\_mask} file for the model configuration is required as an input.
+This can be generated by carrying out a short model run with the namelist parameter \np{nn\_msh} set to 1.
+The namelist parameter \np{ln\_tradmp} will also need to be set to .false. for this to work.
+The \ngn{nam\_dmp\_create} namelist in the DMP\_TOOLS directory is used to specify options for
+the restoration coefficient.
+
+%--------------------------------------------nam_dmp_create-------------------------------------------------
+\inputminted{fortran}{./namelist}
+%-------------------------------------------------------------------------------------------------------
+
+\np{cp\_cfg}, \np{cp\_cpz}, \np{jp\_cfg} and \np{jperio} specify the model configuration being used and
+should be the same as specified in \ngn{namcfg}.
+The variable \np{lzoom} is used to specify that the damping is being used as in case \textit{a} above to
+provide boundary conditions to a zoom configuration.
+In the case of the arctic or antarctic zoom configurations this includes some specific treatment.
+Otherwise damping is applied to the 6 grid points along the ocean boundaries.
+The open boundaries are specified by the variables \np{lzoom\_n}, \np{lzoom\_e}, \np{lzoom\_s}, \np{lzoom\_w} in
+the \ngn{nam\_zoom\_dmp} namelist.
+
+The remaining switch namelist variables determine the spatial variation of the restoration coefficient in
+non-zoom configurations.
+\np{ln\_full\_field} specifies that newtonian damping should be applied to the whole model domain.
+\np{ln\_med\_red\_seas} specifies grid specific restoration coefficients in the Mediterranean Sea for
+the ORCA4, ORCA2 and ORCA05 configurations.
+If \np{ln\_old\_31\_lev\_code} is set then the depth variation of the coeffients will be specified as
+a function of the model number.
+This option is included to allow backwards compatability of the ORCA2 reference configurations with
+previous model versions.
+\np{ln\_coast} specifies that the restoration coefficient should be reduced near to coastlines.
+This option only has an effect if \np{ln\_full\_field} is true.
+\np{ln\_zero\_top\_layer} specifies that the restoration coefficient should be zero in the surface layer.
+Finally \np{ln\_custom} specifies that the custom module will be called.
+This module is contained in the file \mdl{custom} and can be edited by users.
+For example damping could be applied in a specific region.
+
+The restoration coefficient can be set to zero in equatorial regions by
+specifying a positive value of \np{nn\_hdmp}.
+Equatorward of this latitude the restoration coefficient will be zero with a smooth transition to 
+the full values of a 10\deg latitud band.
+This is often used because of the short adjustment time scale in the equatorial region
+\citep{Reverdin1991, Fujio1991, Marti_PhD92}.
+The time scale associated with the damping depends on the depth as a hyperbolic tangent,
+with \np{rn\_surf} as surface value, \np{rn\_bot} as bottom value and a transition depth of \np{rn\_dep}.
+
+\bibliography{doc_DMP_tool}
+\bibliographystyle{plainnat}
+
+\end{document}
Index: /utils/tools_ticket2413/DMP_TOOLS/namelist
===================================================================
--- /utils/tools_ticket2413/DMP_TOOLS/namelist	(revision 12863)
+++ /utils/tools_ticket2413/DMP_TOOLS/namelist	(revision 12863)
@@ -0,0 +1,24 @@
+&nam_dmp_create
+    cp_cfg = 'orca'            ! Name of model grid (orca and C1D have special options - otherwise ignored)
+    cp_cfz = 'antarctic'       ! Name of zoom configuration (arctic and antarctic have some special treatment if lzoom=.true.)
+    jp_cfg = 2                 ! Resolution of the model (used for med_red_seas damping)
+    lzoom = .false.            ! Zoom configuration or not
+    ln_full_field = .false.    ! Calculate coefficient over whole of domain 
+    ln_med_red_seas = .true.   ! Damping in Med/Red Seas (or local modifications here if ln_full_field=.true.)
+    ln_old_31_lev_code = .true.   ! Replicate behaviour of old online code for 31 level model (Med/Red seas damping based on level number instead of depth)
+    ln_coast = .true.          ! Reduce near to coastlines 
+    ln_zero_top_layer = .true. ! No damping in top layer
+    ln_custom = .false.        ! Call "custom" module to apply user modifications to the damping coefficient field
+    nn_hdmp = 10               ! Damp poleward of this latitude (smooth transition up to maximum damping)
+    pn_surf = 0.25             ! Surface Relaxation timescale (days) 
+    pn_bot = 0.25              ! Bottom relaxation timescale (days)
+    pn_dep = 1000              ! Transition depth from upper to deep ocean
+    jperio = 2                 ! Lateral boundary condition (as specified in namelist_cfg for model run).
+/
+
+&nam_zoom_dmp
+    lzoom_n = .false.     ! Open boundary had northern edge?
+    lzoom_e = .false.     ! Open boundary at eastern edge?
+    lzoom_w = .false.     ! Open boundary at western edge?
+    lzoom_s = .false.     ! Open boundary at southern edge?
+/
Index: /utils/tools_ticket2413/DMP_TOOLS/src/coast_dist.F90
===================================================================
--- /utils/tools_ticket2413/DMP_TOOLS/src/coast_dist.F90	(revision 12863)
+++ /utils/tools_ticket2413/DMP_TOOLS/src/coast_dist.F90	(revision 12863)
@@ -0,0 +1,220 @@
+MODULE coastdist
+
+   USE utils
+   USE netcdf
+
+   IMPLICIT NONE
+   PUBLIC 
+
+   CONTAINS
+
+   SUBROUTINE coast_dist_weight( presto ) 
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE coast_dist_weight ***
+      !!
+      !! ** Purpose: Weight restoration coefficient by distance to coast
+      !!
+      !! ** Method: 1) Calculate distance to coast
+      !!            2) Reduce resto with 1000km of coast
+      !!
+      IMPLICIT NONE
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) :: presto
+      REAL(wp), DIMENSION(jpi,jpj) :: zdct
+      REAL(wp) :: zinfl = 1000.e3_wp  ! Distance of influence of coast line (could be
+                                  ! a namelist setting)
+      INTEGER :: jj, ji           ! dummy loop indices
+      
+
+      CALL cofdis( zdct )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zdct(ji,jj) = MIN( zinfl, zdct(ji,jj) )
+            presto(ji,jj) = presto(ji, jj) * 0.5_wp * (  1._wp - COS( rpi*zdct(ji,jj)/zinfl) )
+         END DO
+      END DO
+
+   END SUBROUTINE coast_dist_weight
+
+
+   SUBROUTINE cofdis( pdct )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE cofdis  ***
+      !!
+      !! ** Purpose :   Compute the distance between ocean T-points and the
+      !!      ocean model coastlines.
+      !!
+      !! ** Method  :   For each model level, the distance-to-coast is 
+      !!      computed as follows : 
+      !!       - The coastline is defined as the serie of U-,V-,F-points
+      !!      that are at the ocean-land bound.
+      !!       - For each ocean T-point, the distance-to-coast is then 
+      !!      computed as the smallest distance (on the sphere) between the 
+      !!      T-point and all the coastline points.
+      !!       - For land T-points, the distance-to-coast is set to zero.
+      !!
+      !! ** Action  : - pdct, distance to the coastline (argument)
+      !!              - NetCDF file 'dist.coast.nc' 
+      !!----------------------------------------------------------------------
+      !!
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( out ) ::   pdct   ! distance to the coastline
+      !!
+      INTEGER ::   ji, jj, jl   ! dummy loop indices
+      INTEGER ::   iju, ijt, icoast, itime, ierr, icot   ! local integers
+      CHARACTER (len=32) ::   clname                     ! local name
+      REAL(wp) ::   zdate0                               ! local scalar
+      REAL(wp), POINTER, DIMENSION(:,:) ::  zxt, zyt, zzt, zmask
+      REAL(wp), POINTER, DIMENSION(:  ) ::  zxc, zyc, zzc, zdis    ! temporary workspace
+      LOGICAL , ALLOCATABLE, DIMENSION(:,:) ::  llcotu, llcotv, llcotf   ! 2D logical workspace
+
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( zxt(jpi,jpj) , zyt(jpi,jpj) , zzt(jpi,jpj) , zmask(jpi,jpj)    )
+      ALLOCATE(zxc(3*jpi*jpj), zyc(3*jpi*jpj), zzc(3*jpi*jpj), zdis(3*jpi*jpj)     )
+      ALLOCATE( llcotu(jpi,jpj), llcotv(jpi,jpj), llcotf(jpi,jpj)  )
+      ALLOCATE( gphiu(jpi,jpj), gphiv(jpi,jpj), gphif(jpi,jpj)  )
+      ALLOCATE( glamu(jpi,jpj), glamv(jpi,jpj), glamf(jpi,jpj), glamt(jpi,jpj)  )
+      ALLOCATE( umask(jpi,jpj), vmask(jpi,jpj), fmask(jpi,jpj)  )
+      !
+
+      CALL check_nf90( nf90_get_var( ncin, gphit_id, gphit, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, gphiu_id, gphiu, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, gphiv_id, gphiv, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, gphif_id, gphif, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, glamt_id, glamt, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, glamu_id, glamu, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, glamv_id, glamv, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, glamf_id, glamf, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, tmask_id, tmask, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, umask_id, umask, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, vmask_id, vmask, (/ 1,1 /), (/ jpi, jpj /) ) )
+      CALL check_nf90( nf90_get_var( ncin, fmask_id, fmask, (/ 1,1 /), (/ jpi, jpj /) ) )
+
+      pdct(:,:) = 0._wp
+      zxt(:,:) = COS( rad * gphit(:,:) ) * COS( rad * glamt(:,:) )
+      zyt(:,:) = COS( rad * gphit(:,:) ) * SIN( rad * glamt(:,:) )
+      zzt(:,:) = SIN( rad * gphit(:,:) )
+
+
+         ! Define the coastline points (U, V and F)
+         DO jj = 2, jpj-1
+            DO ji = 2, jpi-1
+               zmask(ji,jj) =  ( tmask(ji,jj+1) + tmask(ji+1,jj+1) &
+                   &           + tmask(ji,jj  ) + tmask(ji+1,jj  ) )
+               llcotu(ji,jj) = ( tmask(ji,jj ) + tmask(ji+1,jj  ) == 1._wp ) 
+               llcotv(ji,jj) = ( tmask(ji,jj  ) + tmask(ji  ,jj+1) == 1._wp ) 
+               llcotf(ji,jj) = ( zmask(ji,jj) > 0._wp ) .AND. ( zmask(ji,jj) < 4._wp )
+            END DO
+         END DO
+
+         ! Lateral boundaries conditions
+         llcotu(:, 1 ) = umask(:,  2  ) == 1
+         llcotu(:,jpj) = umask(:,jpj-1) == 1
+         llcotv(:, 1 ) = vmask(:,  2  ) == 1
+         llcotv(:,jpj) = vmask(:,jpj-1) == 1
+         llcotf(:, 1 ) = fmask(:,  2  ) == 1
+         llcotf(:,jpj) = fmask(:,jpj-1) == 1
+
+         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
+            llcotu( 1 ,:) = llcotu(jpi-1,:)
+            llcotu(jpi,:) = llcotu(  2  ,:)
+            llcotv( 1 ,:) = llcotv(jpi-1,:)
+            llcotv(jpi,:) = llcotv(  2  ,:)
+            llcotf( 1 ,:) = llcotf(jpi-1,:)
+            llcotf(jpi,:) = llcotf(  2  ,:)
+         ELSE
+            llcotu( 1 ,:) = umask(  2  ,:) == 1
+            llcotu(jpi,:) = umask(jpi-1,:) == 1
+            llcotv( 1 ,:) = vmask(  2  ,:) == 1
+            llcotv(jpi,:) = vmask(jpi-1,:) == 1
+            llcotf( 1 ,:) = fmask(  2  ,:) == 1
+            llcotf(jpi,:) = fmask(jpi-1,:) == 1
+         ENDIF
+         IF( jperio == 3 .OR. jperio == 4 ) THEN
+            DO ji = 1, jpi-1
+               iju = jpi - ji + 1
+               llcotu(ji,jpj  ) = llcotu(iju,jpj-2)
+               llcotf(ji,jpj-1) = llcotf(iju,jpj-2)
+               llcotf(ji,jpj  ) = llcotf(iju,jpj-3)
+            END DO
+            DO ji = jpi/2, jpi-1
+               iju = jpi - ji + 1
+               llcotu(ji,jpj-1) = llcotu(iju,jpj-1)
+            END DO
+            DO ji = 2, jpi
+               ijt = jpi - ji + 2
+               llcotv(ji,jpj-1) = llcotv(ijt,jpj-2)
+               llcotv(ji,jpj  ) = llcotv(ijt,jpj-3)
+            END DO
+         ENDIF
+         IF( jperio == 5 .OR. jperio == 6 ) THEN
+            DO ji = 1, jpi-1
+               iju = jpi - ji
+               llcotu(ji,jpj  ) = llcotu(iju,jpj-1)
+               llcotf(ji,jpj  ) = llcotf(iju,jpj-2)
+            END DO
+            DO ji = jpi/2, jpi-1
+               iju = jpi - ji
+               llcotf(ji,jpj-1) = llcotf(iju,jpj-1)
+            END DO
+            DO ji = 1, jpi
+               ijt = jpi - ji + 1
+               llcotv(ji,jpj  ) = llcotv(ijt,jpj-1)
+            END DO
+            DO ji = jpi/2+1, jpi
+               ijt = jpi - ji + 1
+               llcotv(ji,jpj-1) = llcotv(ijt,jpj-1)
+            END DO
+         ENDIF
+
+         ! Compute cartesian coordinates of coastline points
+         ! and the number of coastline points
+         icoast = 0
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( llcotf(ji,jj) ) THEN
+                  icoast = icoast + 1
+                  zxc(icoast) = COS( rad*gphif(ji,jj) ) * COS( rad*glamf(ji,jj) )
+                  zyc(icoast) = COS( rad*gphif(ji,jj) ) * SIN( rad*glamf(ji,jj) )
+                  zzc(icoast) = SIN( rad*gphif(ji,jj) )
+               ENDIF
+               IF( llcotu(ji,jj) ) THEN
+                  icoast = icoast+1
+                  zxc(icoast) = COS( rad*gphiu(ji,jj) ) * COS( rad*glamu(ji,jj) )
+                  zyc(icoast) = COS( rad*gphiu(ji,jj) ) * SIN( rad*glamu(ji,jj) )
+                  zzc(icoast) = SIN( rad*gphiu(ji,jj) )
+               ENDIF
+               IF( llcotv(ji,jj) ) THEN
+                  icoast = icoast+1
+                  zxc(icoast) = COS( rad*gphiv(ji,jj) ) * COS( rad*glamv(ji,jj) )
+                  zyc(icoast) = COS( rad*gphiv(ji,jj) ) * SIN( rad*glamv(ji,jj) )
+                  zzc(icoast) = SIN( rad*gphiv(ji,jj) )
+               ENDIF
+            END DO
+         END DO
+
+         ! Distance for the T-points
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( tmask(ji,jj) == 0._wp ) THEN
+                  pdct(ji,jj) = 0._wp
+               ELSE
+                  DO jl = 1, icoast
+                     zdis(jl) = ( zxt(ji,jj) - zxc(jl) )**2   &
+                        &     + ( zyt(ji,jj) - zyc(jl) )**2   &
+                        &     + ( zzt(ji,jj) - zzc(jl) )**2
+                  END DO
+                  pdct(ji,jj) = ra * SQRT( MINVAL( zdis(1:icoast) ) )
+               ENDIF
+            END DO
+         END DO
+
+      DEALLOCATE( zxt , zyt , zzt , zmask    )
+      DEALLOCATE(zxc, zyc, zzc, zdis    )
+      DEALLOCATE( llcotu, llcotv, llcotf  )
+      DEALLOCATE( gphiu, gphiv, gphif  )
+      DEALLOCATE( glamu, glamv, glamf, glamt  )
+      DEALLOCATE( umask, vmask, fmask  )
+
+   END SUBROUTINE cofdis
+
+END MODULE coastdist
Index: /utils/tools_ticket2413/DMP_TOOLS/src/custom.F90
===================================================================
--- /utils/tools_ticket2413/DMP_TOOLS/src/custom.F90	(revision 12863)
+++ /utils/tools_ticket2413/DMP_TOOLS/src/custom.F90	(revision 12863)
@@ -0,0 +1,22 @@
+MODULE custom
+
+   USE utils
+
+   IMPLICIT NONE
+   PUBLIC
+
+   CONTAINS
+
+   SUBROUTINE custom_resto( presto )
+      !!---------------------------------
+      !!     **ROUTINE: custom_resto
+      !!
+      !!  ** Purpose: Module to be edited by users to create custom restoration
+      !!              coefficient files (e.g. regional damping).
+      !!
+      !!-------------------------------------
+      REAL(wp), DIMENSION(jpi,jpk), INTENT(inout) :: presto
+
+   END SUBROUTINE custom_resto
+
+END MODULE custom
Index: /utils/tools_ticket2413/DMP_TOOLS/src/make_dmp_file.F90
===================================================================
--- /utils/tools_ticket2413/DMP_TOOLS/src/make_dmp_file.F90	(revision 12863)
+++ /utils/tools_ticket2413/DMP_TOOLS/src/make_dmp_file.F90	(revision 12863)
@@ -0,0 +1,123 @@
+PROGRAM make_dmp_file
+  !================================================================================
+  !               *** PROGRAM make_dmp_file ****
+  !================================================================================
+  !
+  !  Purpose: Create a file containing a spacially varying
+  !           restoration coefficient to be used by TRADMP
+  !
+  !  Method:  1) Read in tmask from mesh_mask file to use as a template
+  !           2) Calculate restoration coefficients according to options
+  !           specified in the namelist. The user may modify custom.F90 to
+  !           specify specific damping options e.g. to mask certain regions only).
+  !           3) Write the array to output file
+  !
+  !  History: Original code: Tim Graham (Jul 2014) - some code moved from
+  !                            old tradmp.F90 module to this tool (as part of NEMO
+  !                            simplification process).
+  !-------------------------------------------------------------------------------
+
+  ! Declare variables
+  USE netcdf 
+  USE utils
+  USE coastdist
+  USE med_red_seas
+  USE zoom
+  USE custom
+
+  IMPLICIT NONE
+  INTEGER  :: ji, jj, jk                         ! dummpy loop variables
+  REAL(wp) :: zsdmp, zbdmp                     ! Surface and bottom damping coeff
+  CHARACTER(LEN=200) :: meshfile = 'mesh_mask.nc'   ! mesh file
+  CHARACTER(LEN=200) :: outfile = 'resto.nc'     ! output file
+  REAL(wp) :: zlat, zlat2, zlat0
+
+  ! Read namelist
+  OPEN( UNIT=numnam, FILE='namelist', FORM='FORMATTED', STATUS='OLD' )
+  READ( numnam, nam_dmp_create )
+  CLOSE( numnam )
+  
+  IF ( ln_full_field .AND. lzoom ) THEN
+    WRITE(numerr,*) 'Only one of ln_full_field and lzoom can be .true.'
+    STOP
+  ENDIF
+
+  CALL grid_info(meshfile)
+  WRITE(numout, *) 'jpi = ',jpi
+  WRITE(numout, *) 'jpj = ',jpj
+  WRITE(numout, *) 'jpk = ',jpk
+
+  ALLOCATE( resto(jpi, jpj) )
+
+  !Create output file
+  CALL make_outfile( outfile )
+  
+  CALL check_nf90( nf90_get_var( ncin, gphit_id, gphit, (/ 1,1 /), (/ jpi, jpj /) ) )
+
+  !Calculate surface and bottom damping coefficients
+  zsdmp = 1._wp / ( pn_surf * rday )
+  zbdmp = 1._wp / ( pn_bot  * rday )
+
+  !Loop through levels and read in tmask for each level as starting point for
+  !coefficient array
+  DO jk = 1, jpk-1
+     resto(:,:) = 0._wp
+     
+     IF (.NOT. (jk == 1 .AND. ln_zero_top_layer) ) THEN 
+        !Read in tmask depth for this level
+        CALL check_nf90( nf90_get_var( ncin, tmask_id, tmask, (/ 1,1,jk /), (/ jpi, jpj,1 /) ) )
+        CALL check_nf90( nf90_get_var( ncin, gdept_id, gdept, (/ 1,1,jk /), (/ jpi, jpj,1 /) ) )
+     
+
+        IF ( ln_full_field ) THEN
+           !Set basic value of resto
+           DO jj = 1, jpj
+              DO ji = 1, jpi
+                 resto(ji,jj) = tmask(ji, jj) * (zbdmp + (zsdmp-zbdmp) * EXP(-gdept(ji,jj)/pn_dep))
+              END DO
+           END DO
+           IF ((nn_hdmp > 0)) THEN
+              zlat0 = 10. !width of latitude strip where resto decreases
+              zlat2 = nn_hdmp + zlat0
+              DO jj = 1, jpj
+                 DO ji = 1, jpi
+                    zlat = ABS(gphit(ji,jj))
+                    IF ( nn_hdmp <= zlat .AND. zlat <= zlat2 ) THEN
+                       resto(ji,jj) = resto(ji,jj) * 0.5_wp * (  1._wp - COS( rpi*(zlat-nn_hdmp)/zlat0 ) )
+                    ELSE IF ( zlat < nn_hdmp ) THEN
+                       resto(ji,jj) = 0._wp
+                    ENDIF
+                 END DO
+              END DO
+           ENDIF
+    
+           IF (ln_coast) THEN
+              ! Reduce damping in vicinity of coastlines
+              CALL coast_dist_weight(resto)
+           ENDIF
+        ENDIF
+
+        ! Damping in Med/Red Seas (or local modifications if full field is set)
+        IF (ln_med_red_seas .AND. (cp_cfg == 'orca') .AND. (.NOT. lzoom)) THEN
+           CALL med_red_dmp(resto, jk, ln_old_31_lev_code)
+        ENDIF
+
+        IF ( lzoom ) THEN
+              CALL dtacof_zoom(resto, tmask)
+        ENDIF
+        
+        !Any user modifications can be added in the custom module
+        IF ( ln_custom ) THEN
+              CALL custom_resto( resto )
+        ENDIF
+     ENDIF
+
+     ! Write out resto for this level
+     CALL check_nf90( nf90_put_var( ncout, resto_id, resto, (/ 1,1,jk /), (/ jpi, jpj,1 /) ) )
+
+  END DO
+  
+  ! Close the output file
+  CALL check_nf90( nf90_close(ncout) )
+
+END PROGRAM make_dmp_file
Index: /utils/tools_ticket2413/DMP_TOOLS/src/med_red_seas.F90
===================================================================
--- /utils/tools_ticket2413/DMP_TOOLS/src/med_red_seas.F90	(revision 12863)
+++ /utils/tools_ticket2413/DMP_TOOLS/src/med_red_seas.F90	(revision 12863)
@@ -0,0 +1,135 @@
+MODULE med_red_seas
+
+   USE utils
+   
+   IMPLICIT NONE
+   PUBLIC
+
+   CONTAINS  
+
+   SUBROUTINE med_red_dmp(presto, jk, ln_31_lev)
+      !!------------------------------------
+      !!    **ROUTINE: med_red_dmp
+      !! 
+      !! **Purpose: Apply specific modifications to damping coefficients on ORCA
+      !!            grids in Med and Red Seas
+      !!
+      !!-----------------------------------
+      INTEGER :: ij0,ij1,ii0,ii1,ji,jj     
+      INTEGER, INTENT(in) :: jk
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zmrs
+      REAL(wp) :: zhfac, zsdmp, zbdmp
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: presto
+      LOGICAL, INTENT(in), OPTIONAL :: ln_31_lev
+      LOGICAL :: l_31_lev
+
+      WRITE(numout,*) 'ORCA Med and Red Seas Damping'
+      
+      IF ( PRESENT(ln_31_lev)) THEN
+         l_31_lev = ln_31_lev
+      ELSE
+         l_31_lev = .false.
+      ENDIF
+      
+      ALLOCATE( zmrs(jpi, jpj) )
+         !
+         zmrs(:,:) = 0._wp
+         !
+         SELECT CASE ( jp_cfg )
+         !                                           ! =======================
+         CASE ( 4 )                                  !  ORCA_R4 configuration 
+            !                                        ! =======================
+            ij0 =  50   ;   ij1 =  56                    ! Mediterranean Sea
+
+            ii0 =  81   ;   ii1 =  91   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1.
+            ij0 =  50   ;   ij1 =  55
+            ii0 =  75   ;   ii1 =  80   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1.
+            ij0 =  52   ;   ij1 =  53
+            ii0 =  70   ;   ii1 =  74   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1.
+           !
+           !                                        ! =======================
+         CASE ( 2 )                                  !  ORCA_R2 configuration 
+            !                                        ! =======================
+            ij0 =  96   ;   ij1 = 110                    ! Mediterranean Sea
+            ii0 = 157   ;   ii1 = 181   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+            ij0 = 100   ;   ij1 = 110
+            ii0 = 144   ;   ii1 = 156   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+            ij0 = 100   ;   ij1 = 103
+            ii0 = 139   ;   ii1 = 143   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+            !
+            ij0 = 101   ;   ij1 = 102                    ! Decrease before Gibraltar Strait
+            ii0 = 139   ;   ii1 = 141   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0._wp
+            ii0 = 142   ;   ii1 = 142   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp / 90._wp
+            ii0 = 143   ;   ii1 = 143   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0.40_wp
+            ii0 = 144   ;   ii1 = 144   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0.75_wp
+            !
+            ij0 =  87   ;   ij1 =  96                    ! Red Sea
+            ii0 = 147   ;   ii1 = 163   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+            !
+            ij0 =  91   ;   ij1 =  91                    ! Decrease before Bab el Mandeb Strait
+            ii0 = 153   ;   ii1 = 160   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0.80_wp
+            ij0 =  90   ;   ij1 =  90
+            ii0 = 153   ;   ii1 = 160   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0.40_wp
+            ij0 =  89   ;   ij1 =  89
+            ii0 = 158   ;   ii1 = 160   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp / 90._wp
+            ij0 =  88   ;   ij1 =  88
+            ii0 = 160   ;   ii1 = 163   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0._wp
+            !
+            !                                        ! =======================
+         CASE ( 05 )                                 !  ORCA_R05 configuration
+            !                                        ! =======================
+            ii0 = 568   ;   ii1 = 574                    ! Mediterranean Sea
+            ij0 = 324   ;   ij1 = 333   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+            ii0 = 575   ;   ii1 = 658
+            ij0 = 314   ;   ij1 = 366   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+            !
+            ii0 = 641   ;   ii1 = 651                    ! Black Sea (remaining part
+            ij0 = 367   ;   ij1 = 372   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+            !
+            ij0 = 324   ;   ij1 = 333                    ! Decrease before Gibraltar Strait
+            ii0 = 565   ;   ii1 = 565   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp / 90._wp
+            ii0 = 566   ;   ii1 = 566   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0.40_wp
+            ii0 = 567   ;   ii1 = 567   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 0.75_wp
+            !
+            ii0 = 641   ;   ii1 = 665                    ! Red Sea
+            ij0 = 270   ;   ij1 = 310   ;   zmrs( ii0:ii1 , ij0:ij1 ) = 1._wp
+            !
+            ii0 = 666   ;   ii1 = 675                    ! Decrease before Bab el Mandeb Strait
+            ij0 = 270   ;   ij1 = 290   
+            DO ji = ii0, ii1
+               zmrs( ji , ij0:ij1 ) = 0.1_wp * ABS( FLOAT(ji - ii1) )
+            END DO 
+            !                                       ! ========================
+         CASE ( 025 )                               !  ORCA_R025 configuration 
+            !                                       ! ========================
+            WRITE(numerr,*) ' Mediterranean and Red Sea damping option not implemented for ORCA_R025'
+            WRITE(numerr,*) ' Set ln_med_red = .false.'
+            STOP
+            !
+         END SELECT
+
+         zsdmp = 1._wp / ( pn_surf * rday )
+         zbdmp = 1._wp / ( pn_bot  * rday )
+
+         ! The l_31_lev option is used to reproduce the old behaviour of
+         ! defining the restoration coefficient based on the level number.
+         ! This is included to allow damping coefficients for reference
+         ! configurations to be kept the same.
+         IF (l_31_lev) THEN
+            IF (jk <= 17) THEN
+               zhfac = 0.5_wp * (  1. - COS( rpi * REAL(jk-1,wp) / 16._wp )  ) / rday
+            ELSE
+               zhfac = 1._wp / rday
+            ENDIF
+         ELSE
+            zhfac = (  zbdmp + (zsdmp-zbdmp) * EXP( -gdept(1,1)/pn_dep )  )
+         ENDIF
+
+         presto(:,:) = zmrs(:,:) * zhfac + ( 1._wp - zmrs(:,:) ) * presto(:,:)
+
+         DEALLOCATE( zmrs )         
+
+   END SUBROUTINE med_red_dmp
+
+
+END MODULE med_red_seas
Index: /utils/tools_ticket2413/DMP_TOOLS/src/utils.F90
===================================================================
--- /utils/tools_ticket2413/DMP_TOOLS/src/utils.F90	(revision 12863)
+++ /utils/tools_ticket2413/DMP_TOOLS/src/utils.F90	(revision 12863)
@@ -0,0 +1,130 @@
+MODULE utils
+
+  USE netcdf
+
+  IMPLICIT NONE
+  PUBLIC
+  
+  INTEGER, PUBLIC, PARAMETER   :: dp=8 , sp=4, wp=dp
+  INTEGER :: tmask_id, umask_id, vmask_id, fmask_id
+  INTEGER :: gdept_id
+  INTEGER :: gphit_id, gphiv_id, gphiu_id, gphif_id        ! Variable ids
+  INTEGER :: glamt_id, glamv_id, glamu_id, glamf_id        ! Variable ids
+  INTEGER :: resto_id                           ! Variable ID for output
+  INTEGER :: jpi, jpj, jpk                      ! Size of domain
+  INTEGER  :: ncin, ncout                              ! File handles for netCDF files
+  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphit, glamt
+  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphiu, glamu
+  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphiv, glamv
+  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphif, glamf
+  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: tmask, umask, vmask, fmask
+  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gdept
+  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: resto
+
+  INTEGER,PARAMETER :: numout = 6
+  INTEGER,PARAMETER :: numerr = 0
+  INTEGER,PARAMETER :: numnam = 11
+  REAL(wp),PARAMETER :: rday = 86400           ! seconds in a day
+  REAL(wp),PARAMETER ::   rpi = 3.141592653589793
+  REAL(wp),PARAMETER ::   rad = 3.141592653589793/180.
+  REAL(wp),PARAMETER ::   ra =  6371229.
+
+  ! Namelist variables
+  CHARACTER(LEN=30) :: cp_cfg = 'ORCA'
+  CHARACTER(LEN=30) :: cp_cfz = 'No zoom'
+  INTEGER :: jp_cfg = 2
+  REAL(KIND=8) :: pn_surf = 1
+  REAL(KIND=8) :: pn_bot = 1
+  REAL(KIND=8) :: pn_dep = 1000         
+  INTEGER  :: nn_hdmp = 0                          ! damping option
+  INTEGER  :: jperio = 0                          ! damping option
+  LOGICAL :: lzoom = .false.
+  LOGICAL :: ln_coast = .false.
+  LOGICAL :: ln_full_field = .true.
+  LOGICAL :: ln_med_red_seas = .false.
+  LOGICAL :: ln_old_31_lev_code = .false.
+  LOGICAL :: ln_zero_top_layer = .false.
+  LOGICAL :: ln_custom = .false.
+
+  NAMELIST/nam_dmp_create/cp_cfg, cp_cfz, jp_cfg, lzoom, ln_full_field, &
+                          ln_med_red_seas, ln_old_31_lev_code, ln_coast, &
+                          ln_zero_top_layer, ln_custom, &
+                          pn_surf, pn_bot, pn_dep, nn_hdmp, jperio
+
+  CONTAINS 
+
+  SUBROUTINE grid_info(mesh)
+     CHARACTER(LEN=*),INTENT(in) :: mesh
+
+     ! Open meshfile
+     CALL check_nf90( nf90_open(mesh, NF90_NOWRITE, ncin), 'Error opening mesh_mask file' )
+  
+     ! Get size of grid from meshfile
+     CALL dimlen( ncin, 'x', jpi )
+     CALL dimlen( ncin, 'y', jpj )
+     CALL dimlen( ncin, 'z', jpk )
+
+     ALLOCATE( tmask(jpi, jpj), gdept(jpi, jpj), gphit(jpi,jpj) )
+
+     !Get ID of tmask in meshfile
+     CALL check_nf90( nf90_inq_varid( ncin, 'tmask', tmask_id ), 'Cannot get variable ID for tmask')
+     CALL check_nf90( nf90_inq_varid( ncin, 'umask', umask_id ), 'Cannot get variable ID for umask')
+     CALL check_nf90( nf90_inq_varid( ncin, 'vmask', vmask_id ), 'Cannot get variable ID for vmask')
+     CALL check_nf90( nf90_inq_varid( ncin, 'fmask', fmask_id ), 'Cannot get variable ID for fmask')
+     CALL check_nf90( nf90_inq_varid( ncin, 'gdept_0', gdept_id ), 'Cannot get variable ID for gdept_0')
+     CALL check_nf90( nf90_inq_varid( ncin, 'gphit', gphit_id ), 'Cannot get variable ID for gphit')
+     CALL check_nf90( nf90_inq_varid( ncin, 'gphiu', gphiu_id ), 'Cannot get variable ID for gphiu')
+     CALL check_nf90( nf90_inq_varid( ncin, 'gphiv', gphiv_id ), 'Cannot get variable ID for gphiv')
+     CALL check_nf90( nf90_inq_varid( ncin, 'gphif', gphif_id ), 'Cannot get variable ID for gphif')
+     CALL check_nf90( nf90_inq_varid( ncin, 'glamt', glamt_id ), 'Cannot get variable ID for glamt')
+     CALL check_nf90( nf90_inq_varid( ncin, 'glamu', glamu_id ), 'Cannot get variable ID for glamu')
+     CALL check_nf90( nf90_inq_varid( ncin, 'glamv', glamv_id ), 'Cannot get variable ID for glamv')
+     CALL check_nf90( nf90_inq_varid( ncin, 'glamf', glamf_id ), 'Cannot get variable ID for glamf')
+  
+  END SUBROUTINE grid_info
+
+  SUBROUTINE dimlen( ncid, dimname, len )
+     ! Determine the length of dimension dimname
+     INTEGER, INTENT(in)          :: ncid
+     CHARACTER(LEN=*), INTENT(in) :: dimname
+     INTEGER, INTENT(out)         :: len
+     ! Local variables
+     INTEGER :: id_var, istatus
+
+     id_var = 1
+     CALL check_nf90( nf90_inq_dimid(ncid, dimname, id_var), 'Dimension not found in file')
+     CALL check_nf90( nf90_inquire_dimension(ncid,id_var,len=len))
+
+  END SUBROUTINE dimlen
+
+  SUBROUTINE make_outfile( filename )
+     ! Create the output file
+     ! Define dimensions and resto variable
+     CHARACTER(LEN=*), INTENT(in) :: filename
+     INTEGER :: id_x, id_y, id_z
+
+     CALL check_nf90( nf90_create(filename, NF90_CLOBBER, ncout), 'Could not create output file')
+     CALL check_nf90( nf90_def_dim(ncout, 'x', jpi, id_x) )
+     CALL check_nf90( nf90_def_dim(ncout, 'y', jpj, id_y) )
+     CALL check_nf90( nf90_def_dim(ncout, 'z', jpk, id_z) )
+
+     CALL check_nf90( nf90_def_var(ncout, 'resto', nf90_double, (/id_x,id_y,id_z/), resto_id ) )
+     CALL check_nf90( nf90_enddef(ncout) )
+
+  END SUBROUTINE make_outfile
+
+
+  SUBROUTINE check_nf90( istat, message )
+     !Check for netcdf errors
+     INTEGER, INTENT(in) :: istat
+     CHARACTER(LEN=*), INTENT(in), OPTIONAL :: message
+     
+     IF (istat /= nf90_noerr) THEN
+        WRITE(numerr,*) 'ERROR! : '//TRIM(nf90_strerror(istat))
+        IF ( PRESENT(message) ) THEN ; WRITE(numerr,*) message ; ENDIF
+        STOP
+     ENDIF
+
+  END SUBROUTINE check_nf90
+
+END MODULE utils
Index: /utils/tools_ticket2413/DMP_TOOLS/src/zoom.F90
===================================================================
--- /utils/tools_ticket2413/DMP_TOOLS/src/zoom.F90	(revision 12863)
+++ /utils/tools_ticket2413/DMP_TOOLS/src/zoom.F90	(revision 12863)
@@ -0,0 +1,87 @@
+MODULE zoom
+   
+   USE utils
+
+   CONTAINS
+
+   SUBROUTINE dtacof_zoom( presto, mask)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dtacof_zoom  ***
+      !!
+      !! ** Purpose :   Compute the damping coefficient for zoom domain
+      !!
+      !! ** Method  : - set along closed boundary due to zoom a damping over
+      !!                6 points with a max time scale of 5 days.
+      !!              - ORCA arctic/antarctic zoom: set the damping along
+      !!                south/north boundary over a latitude strip.
+      !!
+      !! ** Action  : - resto, the damping coeff. for T and S
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)  ::   presto   ! restoring coeff. (s-1)
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  ::   mask   ! restoring coeff. (s-1)
+      !
+      INTEGER  ::   ji, jj, jn   ! dummy loop indices
+      REAL(wp) ::   zlat, zlat0, zlat1, zlat2, z1_5d   ! local scalar
+      REAL(wp), DIMENSION(6)  ::   zfact               ! 1Dworkspace
+
+      !Namelist variables
+      LOGICAL :: lzoom_w, lzoom_e, lzoom_n, lzoom_s 
+      NAMELIST/nam_zoom_dmp/lzoom_n,lzoom_e,lzoom_w,lzoom_s
+      !!----------------------------------------------------------------------
+
+      ! Read namelist
+      OPEN( UNIT=numnam, FILE='namelist', FORM='FORMATTED', STATUS='OLD' )
+      READ( numnam, nam_dmp_create )
+      CLOSE( numnam )
+
+      zfact(1) =  1._wp
+      zfact(2) =  1._wp
+      zfact(3) = 11._wp / 12._wp
+      zfact(4) =  8._wp / 12._wp
+      zfact(5) =  4._wp / 12._wp
+      zfact(6) =  1._wp / 12._wp
+      zfact(:) = zfact(:) / ( 5._wp * rday )    ! 5 days max restoring time scale
+
+      presto(:,:) = 0._wp
+
+      ! damping along the forced closed boundary over 6 grid-points
+      DO jn = 1, 6
+         IF( lzoom_w )   presto( jn, : )                    = zfact(jn)   ! west  closed
+         IF( lzoom_s )   presto( : , jn )                    = zfact(jn)   ! south closed 
+         IF( lzoom_e )   presto( jpi+1-jn , : ) = zfact(jn)   ! east  closed 
+         IF( lzoom_n )   presto( : , jpj+1-jn ) = zfact(jn)   ! north closed
+      END DO
+
+      !                                           ! ====================================================
+      IF( cp_cfz == "arctic" .OR. cp_cfz == "antarctic" ) THEN   !  ORCA configuration : arctic or antarctic zoom
+         !                                        ! ====================================================
+         WRITE(numout,*)
+         IF(cp_cfz == "arctic" ) WRITE(numout,*) '              dtacof_zoom : ORCA    Arctic zoom'
+         IF(cp_cfz == "antarctic" ) WRITE(numout,*) '           dtacof_zoom : ORCA Antarctic zoom'
+         WRITE(numout,*)
+         !
+         !                          ! Initialization : 
+         presto(:,:) = 0._wp
+         zlat0 = 10._wp                     ! zlat0 : latitude strip where resto decreases
+         zlat1 = 30._wp                     ! zlat1 : resto = 1 before zlat1
+         zlat2 = zlat1 + zlat0              ! zlat2 : resto decreases from 1 to 0 between zlat1 and zlat2
+         z1_5d = 1._wp / ( 5._wp * rday )   ! z1_5d : 1 / 5days
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zlat = ABS( gphit(ji,jj) )
+               IF( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN
+                  presto(ji,jj) = 0.5_wp * z1_5d * (  1._wp - COS( rpi*(zlat2-zlat)/zlat0 )  ) 
+               ELSEIF( zlat < zlat1 ) THEN
+                  presto(ji,jj) = z1_5d
+               ENDIF
+            END DO
+         END DO
+         !
+      ENDIF
+      !                             ! Mask resto array
+      presto(:,:) = presto(:,:) * mask(:,:)
+
+   END SUBROUTINE dtacof_zoom
+
+END MODULE zoom
Index: /utils/tools_ticket2413/DOMAINcfg/README.rst
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/README.rst	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/README.rst	(revision 12863)
@@ -0,0 +1,86 @@
+================================
+= HOW TO COMPILE
+================================
+The DOMAINcfg tool can be compiled using the maketools script in the NEMOGCM/TOOLS directory as follows:
+:::::::::::::::::::::::::::::::::
+./maketools -m $ARCH -n DOMAINcfg
+:::::::::::::::::::::::::::::::::
+where $ARCH indicates the arch file to be used from the directory NEMOGCM/ARCH. 
+
+DOMAINcfg compiled will create "make_domain_cfg.exe" executable script (the main routine of this tool is make_domain_cfg.f90)
+
+================================
+= HOW TO RUN
+================================
+just run :
+:::::::::::::::::::::::::::::::::::::::::::::::::
+mpirun -np 1 ./make_domain_cfg.exe
+:::::::::::::::::::::::::::::::::::::::::::::::::
+NOTA: it can be run in multiproc mode, but in output there will be domain_cfg_00xx.nc files
+
+================================
+= HOW TO USE
+================================
+1) copy in DOMAINcfg  directory namelist_cfg all settings (that you had in 3.6_stable) of the configuration for which you want prepare domain_cfg.nc file
+IMPORTANT : keep the namelist_ref committed inchanged. !!!
+
+NEW OPTION:
+* ln_e3_dep
+till nemo_v3.6_stable e3 were done like an analytical derivative of depth function
+now  e3=dk[depth] in discret sens
+
+If you want to create same e3[tuvw] like 3.6 you've to use "ln_e3_dep=.false."
+
+ ln_e3_dep   = .true.    ! =T : e3=dk[depth] in discret sens.
+   !                       !      ===>>> will become the only possibility in v4.0
+   !                       ! =F : e3 analytical derivative of depth function
+   !                       !      only there for backward compatibility test with v3.6
+   !
+
+* ln_domclo
+The definition of closed sea are now integrated into ./make_domain_cfg.exe. The need on an external python script and hard coded indices has been removed.
+ln_domclo=T will generate the masks needed to mask or correct 
+the fwf unbalance over closed sea. If non defined closed sea are detected, a mask containing this will also be generated.
+The detection of the lake is done using a lat/lon seed and a flood filling algorithm (the default namelist should work for any resolution).
+The definition of the target area is done by defining a lat/lon position center, then all wet points at a defined distance of it will be selected.
+Options are available to select only coastal points if needed.
+For each lake, name, lon_src, lat_src, lon_trg, lat_trg, river mouth area, correction scheme, radius trg, id trg need to be defined.
+* lon/lat_src/trg are the seed location of the closed sea (src) and its river outflow (trg).
+* river mouth area is to defined is you spread the closed sea emp correction locally (circle with raduis 'radius trg' in m) 
+  or along the coast point into a circle with raduis 'radius trg' (in m) 
+  or globally (open sea mask)
+* correction scheme defined how you want to spread the closed sea correction 
+  * glo : as emp globally
+  * rnf : as a runoff for the net precip and on emp for net evaporation case locally or along the coast
+  * emp : as emp locally or along the coast
+* id trg is a integer used to defined group of closed sea and their river outflow (for example all the great lake and the St Laurent outflow).
+
+2) copy in DOMAINcfg directory same input files (of related configuration) required in v3.6_stable.
+
+DOMAINcfg package is EXACTLY what does exist in NEMO version 3.6 to define a model domain (both domain related namelist and initialization).
+DOMAINcfg tool creates a netcdf file "domain_cfg.nc" containing all the ocean domain informations required to define an ocean configuration,
+these files are :
+          
+    domain size
+    domain characteristics (periodic)
+    horizontal mesh
+    Coriolis parameter
+    depth and vertical scale factors
+
+FOR EXAMPLE 
+- for AMM12 : 
+            coordinates.nc
+            bathy_meter.nc
+            bathy_level.nc
+            amm12_rivers.nc
+            coordinates.bdy.nc
+            amm12_restart_oce.nc
+         directories:   bdydta/
+                        fluxes/
+- for ORCA2 : 
+            coordinates.nc
+            bathy_meter.nc
+            bathy_level.nc
+            domain_def.xml
+            field_def.xml
+            iodef.xml
Index: /utils/tools_ticket2413/DOMAINcfg/README_configs_namcfg_namdom
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/README_configs_namcfg_namdom	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/README_configs_namcfg_namdom	(revision 12863)
@@ -0,0 +1,609 @@
+
+
+This README file contains the informations for the &namcfg namelist for some configurations whic are not one of the reference configurations.
+These informations wher previoulsy in NEMO/OCE_SRC_par_*.h90 files. The full test with these configurations has not been done.
+
+
+ORCA_R4
+=======
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   jp_cfg      =       4               !  resolution of the configuration
+   jpidta      =      92               !  1st lateral dimension ( >= jpi )
+   jpjdta      =      76               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      31               !  number of levels      ( >= jpk )
+   jpiglo      =      92               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =      76               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       4               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     255.58049070440   ! (default coefficients)
+   ppa1        =     245.58132232490   !
+   ppkth       =      21.43336197938   !
+   ppacr       =       3.0             !
+   ppdzmin     =  999999.0             !  Minimum vertical spacing
+   pphmax      =  999999.0             !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.0             !  Double tanh function parameters
+   ppkth2      =  999999.0             !
+   ppacr2      =  999999.0             !
+/
+
+ORCA_R1 75 vertical levels
+=======
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   jp_cfg      =       1               !  resolution of the configuration
+   jpidta      =     362               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     292               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      75               !  number of levels      ( >= jpk )
+   jpiglo      =     362               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =     292               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       6               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -3958.951371276829  !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     103.9530096000000 ! (default coefficients)
+   ppa1        =       2.415951269000000   !
+   ppkth       =      15.35101370000000    !
+   ppacr       =       7.0             !
+   ppdzmin     =  999999.0             !  Minimum vertical spacing
+   pphmax      =  999999.0             !  Maximum depth
+   ldbletanh   =   .TRUE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =     100.7609285000000 !  Double tanh function parameters
+   ppkth2      =      48.02989372000000    !
+   ppacr2      =      13.00000000000   !
+/
+
+
+ORCA_R1 46 vertical levels
+=======
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   jp_cfg      =       1               !  resolution of the configuration
+   jpidta      =     362               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     292               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      46               !  number of levels      ( >= jpk )
+   jpiglo      =     362               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =     292               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       6               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =  999998.0             !  ORCA r4, r2 and r05 coefficients
+   ppa0        =  999998.0             ! (default coefficients)
+   ppa1        =  999998.0             !
+   ppkth       =      23.563           !
+   ppacr       =       9.0             !
+   ppdzmin     =       6.0             !  Minimum vertical spacing
+   pphmax      =    5750.              !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.0             !  Double tanh function parameters
+   ppkth2      =  999999.0             !
+   ppacr2      =  999999.0             !
+/
+ORCA_R05 
+========
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   jp_cfg      =      05               !  resolution of the configuration
+   jpidta      =     722               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     511               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      31               !  number of levels      ( >= jpk )
+   jpiglo      =     722               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =     511               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       6               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     255.58049070440   ! (default coefficients)
+   ppa1        =     245.58132232490   !
+   ppkth       =      21.43336197938   !
+   ppacr       =       3.0             !
+   ppdzmin     =  999999.0             !  Minimum vertical spacing
+   pphmax      =  999999.0             !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.0             !  Double tanh function parameters
+   ppkth2      =  999999.0             !
+   ppacr2      =  999999.0             !
+/
+
+
+ORCA_R05 Antarctic zoom
+========
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   cp_cfz      =  "antarctic"          !  name of the zoom of configuration
+   jp_cfg      =      05               !  resolution of the configuration
+   jpidta      =     722               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     511               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      31               !  number of levels      ( >= jpk )
+   jpiglo      =     722               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =     187               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       1               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     255.58049070440   ! (default coefficients)
+   ppa1        =     245.58132232490   !
+   ppkth       =      21.43336197938   !
+   ppacr       =       3.0             !
+   ppdzmin     =  999999.0             !  Minimum vertical spacing
+   pphmax      =  999999.0             !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.0             !  Double tanh function parameters
+   ppkth2      =  999999.0             !
+   ppacr2      =  999999.0             !
+/
+
+
+ORCA_R05 Arctic zoom
+========
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   cp_cfz      =  "arctic"             !  name of the zoom of configuration
+   jp_cfg      =      05               !  resolution of the configuration
+   jpidta      =     722               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     511               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      31               !  number of levels      ( >= jpk )
+   jpiglo      =     562               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =     211               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =      81               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =     301               !  in data domain indices
+   jperio      =       5               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     255.58049070440   ! (default coefficients)
+   ppa1        =     245.58132232490   !
+   ppkth       =      21.43336197938   !
+   ppacr       =       3.0             !
+   ppdzmin     =  999999.0             !  Minimum vertical spacing
+   pphmax      =  999999.0             !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.0             !  Double tanh function parameters
+   ppkth2      =  999999.0             !
+   ppacr2      =  999999.0             !
+/
+
+ORCA2 - Antarctic zoom
+======================
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   cp_cfz      =  "antarctic"          !  name of the zoom of configuration
+   jp_cfg      =       2               !  resolution of the configuration
+   jpidta      =     182               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     149               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      31               !  number of levels      ( >= jpk )
+   jpiglo      =     182               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =      50               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       1               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     255.58049070440   ! (default coefficients)
+   ppa1        =     245.58132232490   !
+   ppkth       =      21.43336197938   !
+   ppacr       =       3.0             !
+   ppdzmin     =  999999.              !  Minimum vertical spacing
+   pphmax      =  999999.              !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.              !  Double tanh function parameters
+   ppkth2      =  999999.              !
+   ppacr2      =  999999.              !
+/
+
+
+ORCA2 - Arctic zoom
+=================== 
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   cp_cfz      =  "arctic"             !  name of the zoom of configuration
+   jp_cfg      =       2               !  resolution of the configuration
+   jpidta      =     182               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     149               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      31               !  number of levels      ( >= jpk )
+   jpiglo      =     142               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =      53               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =      21               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =      97               !  in data domain indices
+   jperio      =       3               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     255.58049070440   ! (default coefficients)
+   ppa1        =     245.58132232490   !
+   ppkth       =      21.43336197938   !
+   ppacr       =       3.0             !
+   ppdzmin     =  999999.              !  Minimum vertical spacing
+   pphmax      =  999999.              !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.              !  Double tanh function parameters
+   ppkth2      =  999999.              !
+   ppacr2      =  999999.              !
+/
+
+
+ORCA025 - 75 vertical levels
+=======
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   jp_cfg      =     025               !  resolution of the configuration
+   jpidta      =    1442               !  1st lateral dimension ( >= jpi )
+   jpjdta      =    1021               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      75               !  number of levels      ( >= jpk )
+   jpiglo      =    1442               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =    1021               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       4               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -3958.951371276829  !  ORCA r4, r2 and r05 coefficients
+   ppa0        =    103.9530096000000  ! (default coefficients)
+   ppa1        =      2.415951269000000  !
+   ppkth       =     15.35101370000000 !
+   ppacr       =       7.0             !
+   ppdzmin     =  999999.0             !  Minimum vertical spacing
+   pphmax      =  999999.0             !  Maximum depth
+   ldbletanh   =   .TRUE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =     100.7609285000000 !  Double tanh function parameters
+   ppkth2      =      48.02989372000000  !
+   ppacr2      =      13.              !
+/
+
+
+ORCA025 - 46 vertical levels
+=======
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   jp_cfg      =    1442               !  resolution of the configuration
+   jpidta      =    1021               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     511               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      46               !  number of levels      ( >= jpk )
+   jpiglo      =    1442               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =    1021               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       4               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =  999998.0             !  ORCA r4, r2 and r05 coefficients
+   ppa0        =  999998.0             ! (default coefficients)
+   ppa1        =  999998.0             !
+   ppkth       =      23.563           !
+   ppacr       =       9.0             !
+   ppdzmin     =       6.0             !  Minimum vertical spacing
+   pphmax      =    5750.0             !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.0             !  Double tanh function parameters
+   ppkth2      =  999999.0             !
+   ppacr2      =  999999.0             !
+/
+EEL R2: channel
+======
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =   "eel"               !  name of the configuration
+   jp_cfg      =       2               !  resolution of the configuration
+   jpidta      =      83               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     242               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      30               !  number of levels      ( >= jpk )
+   jpiglo      =      83               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =     242               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       1               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       3               !  type of horizontal mesh
+   ppglam0     =       0.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =      35.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =    2000.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =    2000.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -2033.194295283385  !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     155.8325369664153 ! (default coefficients)
+   ppa1        =     146.3615918601890 !
+   ppkth       =      17.28520372419791  !
+   ppacr       =       5.0             !
+   ppdzmin     =  999999.0             !  Minimum vertical spacing
+   pphmax      =  999999.0             !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.0             !  Double tanh function parameters
+   ppkth2      =  999999.0             !
+   ppacr2      =  999999.0             !
+/
+
+
+EEL R5: channel
+======
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =   "eel"               !  name of the configuration
+   jp_cfg      =       5               !  resolution of the configuration
+   jpidta      =      66               !  1st lateral dimension ( >= jpi )
+   jpjdta      =      66               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      31               !  number of levels      ( >= jpk )
+   jpiglo      =      66               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =      66               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       1               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       2               !  type of horizontal mesh
+   ppglam0     =       0.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =      43.436430714     ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =    8000.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =    8000.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     255.58049070440   ! (default coefficients)
+   ppa1        =     245.58132232490   !
+   ppkth       =      21.43336197938   !
+   ppacr       =       3.0             !
+   ppdzmin     =  999999.0             !  Minimum vertical spacing
+   pphmax      =  999999.0             !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.0             !  Double tanh function parameters
+   ppkth2      =  999999.0             !
+   ppacr2      =  999999.0             !
+/
+
+
+EEL R6: 6 km resolution channel
+======
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =   "eel"               !  name of the configuration
+   jp_cfg      =       6               !  resolution of the configuration
+   jpidta      =      29               !  1st lateral dimension ( >= jpi )
+   jpjdta      =      83               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      30               !  number of levels      ( >= jpk )
+   jpiglo      =      29               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =      83               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       1               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       3               !  type of horizontal mesh
+   ppglam0     =       0.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =      35.              ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =    6000.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =    6000.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -2033.194295283385  !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     155.8325369664153 ! (default coefficients)
+   ppa1        =     146.3615918601890 !
+   ppkth       =      17.28520372419791   !
+   ppacr       =       5.0             !
+   ppdzmin     =  999999.0             !  Minimum vertical spacing
+   pphmax      =  999999.0             !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.0             !  Double tanh function parameters
+   ppkth2      =  999999.0             !
+   ppacr2      =  999999.0             !
+/
+
+
+POMME: 025
+======
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =   "pomme"             !  name of the configuration
+   jp_cfg      =     025               !  resolution of the configuration
+   jpidta      =      30               !  1st lateral dimension ( >= jpi )
+   jpjdta      =      40               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      46               !  number of levels      ( >= jpk )
+   jpiglo      =      30               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =      40               !  2nd    -                  -    --> j  =jpjdta
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       0               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =  999998.0             !  ORCA r4, r2 and r05 coefficients
+   ppa0        =  999998.0             ! (default coefficients)
+   ppa1        =  999998.0             !
+   ppkth       =      23.563           !
+   ppacr       =       9.0             !
+   ppdzmin     =       6.0             !  Minimum vertical spacing
+   pphmax      =    5750.0             !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.0             !  Double tanh function parameters
+   ppkth2      =  999999.0             !
+   ppacr2      =  999999.0             !
+/
+
+C1D - 1D configuration. Add key_c1d in active cpp keys
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   cp_cfg      =  "orca"               !  name of the configuration
+   jp_cfg      =       2               !  resolution of the configuration
+   jpidta      =     182               !  1st lateral dimension ( >= jpi )
+   jpjdta      =     149               !  2nd    "         "    ( >= jpj )
+   jpkdta      =      31               !  number of levels      ( >= jpk )
+   jpiglo      =       3               !  1st dimension of global domain --> i =jpidta
+   jpjglo      =       3               !  2nd    -                  -    --> j  =jpjdta
+! Choose postion of the 1D column: 
+!            jpizoom =   61, jpjzoom =   133  (160W,75N)
+!            jpizoom =   61, jpjzoom =   110  (160W,50N)
+!            jpizoom =   61, jpjzoom =   97   (160W,30N)
+!            jpizoom =   61, jpjzoom =   86   (160W,10N)
+!            jpizoom =   61, jpjzoom =   49   (160W,30S)
+!            jpizoom =   61, jpjzoom =   27   (160W,60S)
+!            jpizoom =   61, jpjzoom =    7   (160W,75S)
+!            jpizoom =   110,jpjzoom =   97   (64W,31.5N) BATS site
+   jpizoom     =       1               !  left bottom (i,j) indices of the zoom
+   jpjzoom     =       1               !  in data domain indices
+   jperio      =       0               !  lateral cond. type (between 0 and 6)
+/
+!-----------------------------------------------------------------------
+&namdom        !  
+!-----------------------------------------------------------------------
+   jphgr_msh   =       0               !  type of horizontal mesh
+   ppglam0     =  999999.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =  999999.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =  999999.0             !  meridional grid-spacing (degrees)
+   ppe1_m      =  999999.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =  999999.0             !  meridional grid-spacing (degrees)
+   ppsur       =   -4762.96143546300   !  ORCA r4, r2 and r05 coefficients
+   ppa0        =     255.58049070440   ! (default coefficients)
+   ppa1        =     245.58132232490   !
+   ppkth       =      21.43336197938   !
+   ppacr       =       3.0             !
+   ppdzmin     =  999999.              !  Minimum vertical spacing
+   pphmax      =  999999.              !  Maximum depth
+   ldbletanh   =  .FALSE.              !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =  999999.              !  Double tanh function parameters
+   ppkth2      =  999999.              !
+   ppacr2      =  999999.              !
+/
Index: /utils/tools_ticket2413/DOMAINcfg/README_make_closea_masks
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/README_make_closea_masks	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/README_make_closea_masks	(revision 12863)
@@ -0,0 +1,24 @@
+Make_closea_masks.py is a python routine to create closea mask fields
+based on the old NEMO closea index definitions.  Details of the grid
+and the bathymetry are read in from the domain_cfg.nc file and the
+closea_mask* fields are appended to the same domain_cfg.nc file.
+
+To use this routine:
+
+  1. Provide domain_cfg.nc file for your configuration.
+
+  2. Define closed seas for your configuration in Section 2 
+     using indices in the old NEMO style. (Read the comments on 
+     indexing in Section 2!). Examples are given for eORCA025 
+     (UK version) for the three different options:
+        - just defining closed seas (and distribute fluxes over global ocean)
+        - defining closed seas with a RNF mapping for the American Great Lakes to the St Laurence Seaway
+        - defining closed seas with an EMPMR mapping for the American Great Lakes to the St Laurence Seaway
+
+  3. Choose whether to mask the closea_mask* fields. This is not required
+     but makes the fields easier to check.
+
+  4. Module can be run in python or from linux command line if you
+     change the top line to point to your python installation. If 
+     using from command line, type "make_closea_masks.py --help"
+     for usage.
Index: /utils/tools_ticket2413/DOMAINcfg/cpp_DOMAINcfg.fcm
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/cpp_DOMAINcfg.fcm	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/cpp_DOMAINcfg.fcm	(revision 12863)
@@ -0,0 +1,1 @@
+ bld::tool::fppkeys key_mpp_mpi
Index: /utils/tools_ticket2413/DOMAINcfg/namelist_cfg
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/namelist_cfg	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/namelist_cfg	(revision 12863)
@@ -0,0 +1,61 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OCE :   Configuration namelist_cfg used to overwrite defaults value defined in namelist_ref
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OCE  :  1 - Domain & run manager (namrun, namcfg, namdom, namzgr, namzgr_sco )
+!!              2 - diagnostics      (namnc4)
+!!              3 - miscellaneous    (nammpp, namctl)
+!!
+!! namelist skeleton : egrep -E '(^/ *$|^! *$|^ *$|&nam.*|!---.*|!! .*|!!==.*|!!>>>.*)' namelist_ref > namelist_skl
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate                                  (default: NO selection)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzgr_isf    !   isf cavity geometry definition
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namzgr_sco    !   s-coordinate or hybrid z-s-coordinate                (default F)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namclo ! (closed sea : need ln_domclo = .true. in namcfg)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition                  (default: NO selection)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namagrif      !  AGRIF zoom                                            ("key_agrif")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries                          (default: OFF)
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi")
+!-----------------------------------------------------------------------
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints                                       (default: OFF)
+!-----------------------------------------------------------------------
+/
Index: /utils/tools_ticket2413/DOMAINcfg/namelist_ref
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/namelist_ref	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/namelist_ref	(revision 12863)
@@ -0,0 +1,267 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OCE :   Reference namelist_ref                                !!
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OCE  :  1 - Domain & run manager (namrun, namcfg, namdom, namzgr, namzgr_sco )
+!!              2 - diagnostics      (namnc4)
+!!              3 - miscellaneous    (nammpp, namctl)
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  Assimilation cycle index
+   cn_exp      =  "ORCA2"  !  experience name
+   nn_it000    =       1   !  first time step
+   nn_itend    =    5840   !  last  time step (std 5840)
+   nn_date0    =  010101   !  date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1)
+   nn_time0    =       0   !  initial time of day in hhmm
+   nn_leapy    =       0   !  Leap year calendar (1) or not (0)
+   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
+      nn_euler    =    1      !  = 0 : start with forward time step if ln_rstart=T
+      nn_rstctl   =    0      !  restart control ==> activated only if ln_rstart=T
+      !                          !    = 0 nn_date0 read in namelist ; nn_it000 : read in namelist
+      !                          !    = 1 nn_date0 read in namelist ; nn_it000 : check consistancy between namelist and restart
+      !                          !    = 2 nn_date0 read in restart  ; nn_it000 : check consistancy between namelist and restart
+      cn_ocerst_in    = "restart"   !  suffix of ocean restart name (input)
+      cn_ocerst_indir = "."         !  directory from which to read input ocean restarts
+      cn_ocerst_out   = "restart"   !  suffix of ocean restart name (output)
+      cn_ocerst_outdir = "."         !  directory in which to write output ocean restarts
+   ln_iscpl    = .false.   !  cavity evolution forcing or coupling to ice sheet model
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   ln_rst_list = .false.   !  output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F)
+   nn_stock    =    5840   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_stocklist = 0,0,0,0,0,0,0,0,0,0 ! List of timesteps when a restart file is to be written
+   nn_write    =    5475   !  frequency of write in the output file   (modulo referenced to nn_it000)
+   ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%)
+   ln_cfmeta   = .false.   !  output additional data to netCDF files required for compliance with the CF metadata standard
+   ln_clobber  = .true.    !  clobber (overwrite) an existing file
+   nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   nn_bathy    =    1      !  compute (=0) or read (=1) the bathymetry file
+   rn_bathy    =    0.     !  value of the bathymetry. if (=0) bottom flat at jpkm1
+   nn_msh      =    0      !  create (=1) a mesh file or not (=0)
+   rn_hmin     =   -3.     !  min depth of the ocean (>0) or min number of ocean level (<0)
+   rn_e3zps_min=   20.     !  partial step thickness is set larger than the minimum of
+   rn_e3zps_rat=    0.1    !  rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1
+                           !
+   rn_rdt      = 5760.     !  time step for the dynamics (and tracer if nn_acc=0)
+   rn_atfp     =    0.1    !  asselin time filter parameter
+   ln_crs      = .false.      !  Logical switch for coarsening module
+   jphgr_msh   =       0               !  type of horizontal mesh
+                                       !  = 0 curvilinear coordinate on the sphere read in coordinate.nc
+                                       !  = 1 geographical mesh on the sphere with regular grid-spacing
+                                       !  = 2 f-plane with regular grid-spacing
+                                       !  = 3 beta-plane with regular grid-spacing
+                                       !  = 4 Mercator grid with T/U point at the equator
+   ppglam0     =       0.0             !  longitude of first raw and column T-point (jphgr_msh = 1)
+   ppgphi0     =     -35.0             ! latitude  of first raw and column T-point (jphgr_msh = 1)
+   ppe1_deg    =       1.0             !  zonal      grid-spacing (degrees)
+   ppe2_deg    =       0.5             !  meridional grid-spacing (degrees)
+   ppe1_m      =    5000.0             !  zonal      grid-spacing (degrees)
+   ppe2_m      =    5000.0             !  meridional grid-spacing (degrees)
+   ppsur       =    -4762.96143546300  !  ORCA r4, r2 and r05 coefficients
+   ppa0        =      255.58049070440  ! (default coefficients)
+   ppa1        =      245.58132232490  !
+   ppkth       =       21.43336197938  !
+   ppacr       =        3.0            !
+   ppdzmin     =       10.             !  Minimum vertical spacing
+   pphmax      =     5000.             !  Maximum depth
+   ldbletanh   =    .TRUE.             !  Use/do not use double tanf function for vertical coordinates
+   ppa2        =      100.760928500000 !  Double tanh function parameters
+   ppkth2      =       48.029893720000 !
+   ppacr2      =       13.000000000000 !
+/
+!-----------------------------------------------------------------------
+&namcfg        !   parameters of the configuration
+!-----------------------------------------------------------------------
+   !
+   ln_e3_dep   = .true.    ! =T : e3=dk[depth] in discret sens.
+   !                       !      ===>>> will become the only possibility in v4.0
+   !                       ! =F : e3 analytical derivative of depth function
+   !                       !      only there for backward compatibility test with v3.6
+   !
+   cp_cfg      = "default" !  name of the configuration
+   cp_cfz      = "no zoom" !  name of the zoom of configuration
+   jp_cfg      =      0    !  resolution of the configuration
+   jpkdta      =     31    !  number of levels      ( >= jpk )
+   jpiglo      =     10    !  1st dimension of global domain --> i =jpidta
+   jpjglo      =     12    !  2nd    -                  -    --> j =jpjdta
+   jperio      =      0    !  lateral cond. type (between 0 and 6)
+                                 !  = 0 closed                 ;   = 1 cyclic East-West
+                                 !  = 2 equatorial symmetric   ;   = 3 North fold T-point pivot
+                                 !  = 4 cyclic East-West AND North fold T-point pivot
+                                 !  = 5 North fold F-point pivot
+                                 !  = 6 cyclic East-West AND North fold F-point pivot
+   ln_use_jattr = .false.  !  use (T) the file attribute: open_ocean_jstart, if present
+                           !  in netcdf input files, as the start j-row for reading
+   ln_domclo = .false.     ! computation of closed sea masks (see namclo)
+/
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate                                  (default: NO selection)
+!-----------------------------------------------------------------------
+   ln_zco      = .false.   !  z-coordinate - full    steps
+   ln_zps      = .false.   !  z-coordinate - partial steps
+   ln_sco      = .false.   !  s- or hybrid z-s-coordinate
+   ln_isfcav   = .false.   !  ice shelf cavity             (T: see namzgr_isf)
+   ln_linssh   = .false.   !  linear free surface
+/
+!-----------------------------------------------------------------------
+&namzgr_isf    !   isf cavity geometry definition                       (default: OFF)
+!-----------------------------------------------------------------------
+   rn_isfdep_min    = 10.         ! minimum isf draft tickness (if lower, isf draft set to this value)
+   rn_glhw_min      = 1.e-3       ! minimum water column thickness to define the grounding line
+   rn_isfhw_min     = 10          ! minimum water column thickness in the cavity once the grounding line defined.
+   ln_isfchannel    = .false.     ! remove channel (based on 2d mask build from isfdraft-bathy)
+   ln_isfconnect    = .false.     ! force connection under the ice shelf (based on 2d mask build from isfdraft-bathy)
+      nn_kisfmax       = 999         ! limiter in level on the previous condition. (if change larger than this number, get back to value before we enforce the connection)
+      rn_zisfmax       = 7000.       ! limiter in m     on the previous condition. (if change larger than this number, get back to value before we enforce the connection)
+   ln_isfcheminey   = .false.     ! close cheminey
+   ln_isfsubgl      = .false.     ! remove subglacial lake created by the remapping process
+      rn_isfsubgllon   =    0.0      !  longitude of the seed to determine the open ocean
+      rn_isfsubgllat   =    0.0      !  latitude  of the seed to determine the open ocean
+/
+!-----------------------------------------------------------------------
+&namzgr_sco    !   s-coordinate or hybrid z-s-coordinate                (default: OFF)
+!-----------------------------------------------------------------------
+   ln_s_sh94   = .false.    !  Song & Haidvogel 1994 hybrid S-sigma   (T)|
+   ln_s_sf12   = .false.   !  Siddorn & Furner 2012 hybrid S-z-sigma (T)| if both are false the NEMO tanh stretching is applied
+   ln_sigcrit  = .false.   !  use sigma coordinates below critical depth (T) or Z coordinates (F) for Siddorn & Furner stretch
+                           !  stretching coefficients for all functions
+   rn_sbot_min =   10.0    !  minimum depth of s-bottom surface (>0) (m)
+   rn_sbot_max = 7000.0    !  maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+   rn_hc       =  150.0    !  critical depth for transition to stretched coordinates
+                        !!!!!!!  Envelop bathymetry
+   rn_rmax     =    0.3    !  maximum cut-off r-value allowed (0<r_max<1)
+                        !!!!!!!  SH94 stretching coefficients  (ln_s_sh94 = .true.)
+   rn_theta    =    6.0    !  surface control parameter (0<=theta<=20)
+   rn_bb       =    0.8    !  stretching with SH94 s-sigma
+                        !!!!!!!  SF12 stretching coefficient  (ln_s_sf12 = .true.)
+   rn_alpha    =    4.4    !  stretching with SF12 s-sigma
+   rn_efold    =    0.0    !  efold length scale for transition to stretched coord
+   rn_zs       =    1.0    !  depth of surface grid box
+                           !  bottom cell depth (Zb) is a linear function of water depth Zb = H*a + b
+   rn_zb_a     =    0.024  !  bathymetry scaling factor for calculating Zb
+   rn_zb_b     =   -0.2    !  offset for calculating Zb
+                        !!!!!!!! Other stretching (not SH94 or SF12) [also uses rn_theta above]
+   rn_thetb    =    1.0    !  bottom control parameter  (0<=thetb<= 1)
+/
+!-----------------------------------------------------------------------
+&namclo ! (closed sea : need ln_domclo = .true. in namcfg)              (default: OFF)
+!-----------------------------------------------------------------------
+   rn_lon_opnsea =  0.0    ! longitude seed of open ocean
+   rn_lat_opnsea =  0.0    ! latitude  seed of open ocean
+   nn_closea = 8           ! number of closed seas ( = 0; only the open_sea mask will be computed)
+   !
+   !                name   ! lon_src ! lat_src ! lon_trg ! lat_trg ! river mouth area   ! correction scheme ! radius trg   ! id trg
+   !                       ! (degree)! (degree)! (degree)! (degree)! local/coast/global ! (glo/rnf/emp)     !     (m)      !
+   ! North American lakes
+   sn_lake(1) = 'superior' ,  -86.57 ,  47.30  , -66.49  , 50.45   , 'local'            , 'rnf'             ,   550000.0   , 2    
+   sn_lake(2) = 'michigan' ,  -87.06 ,  42.74  , -66.49  , 50.45   , 'local'            , 'rnf'             ,   550000.0   , 2    
+   sn_lake(3) = 'huron'    ,  -82.51 ,  44.74  , -66.49  , 50.45   , 'local'            , 'rnf'             ,   550000.0   , 2    
+   sn_lake(4) = 'erie'     ,  -81.13 ,  42.25  , -66.49  , 50.45   , 'local'            , 'rnf'             ,   550000.0   , 2    
+   sn_lake(5) = 'ontario'  ,  -77.72 ,  43.62  , -66.49  , 50.45   , 'local'            , 'rnf'             ,   550000.0   , 2    
+   ! African Lake
+   sn_lake(6) = 'victoria' ,   32.93 ,  -1.08  ,  30.44  , 31.37   , 'coast'            , 'emp'             ,   100000.0   , 3    
+   ! Asian Lakes
+   sn_lake(7) = 'caspian'  ,   50.0  ,  44.0   ,   0.0   ,  0.0    , 'global'           , 'glo'             ,        0.0   , 1     
+   sn_lake(8) = 'aral'     ,   60.0  ,  45.0   ,   0.0   ,  0.0    , 'global'           , 'glo'             ,        0.0   , 1    
+/
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition                  (default: NO selection)
+!-----------------------------------------------------------------------
+   !                       !  free slip  !   partial slip  !   no slip   ! strong slip
+   rn_shlat    =  0        !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+   ln_vorlat   = .false.   !  consistency of vorticity boundary condition with analytical Eqs.
+/
+!-----------------------------------------------------------------------
+&namagrif      !  AGRIF zoom                                            ("key_agrif")
+!-----------------------------------------------------------------------
+   ln_spc_dyn    = .true.  !  use 0 as special value for dynamics
+   rn_sponge_tra = 2880.   !  coefficient for tracer   sponge layer [m2/s]
+   rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [m2/s]
+   ln_chk_bathy  = .false. !  =T  check the parent bathymetry
+/
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries                          (default: OFF)
+!-----------------------------------------------------------------------
+   ln_bdy         = .false.   !  Use unstructured open boundaries
+   nb_bdy         = 0         !  number of open boundary sets
+   ln_coords_file = .true.    !  =T : read bdy coordinates from file
+      cn_coords_file = 'coordinates.bdy.nc'  !  bdy coordinates files
+   ln_mask_file   = .false.   !  =T : read mask from file
+      cn_mask_file = ''        !  name of mask file (if ln_mask_file=.TRUE.)
+   cn_dyn2d    = 'none'       !
+   nn_dyn2d_dta   =  0        !  = 0, bdy data are equal to the initial state
+      !                       !  = 1, bdy data are read in 'bdydata   .nc' files
+      !                       !  = 2, use tidal harmonic forcing data from files
+      !                       !  = 3, use external data AND tidal harmonic forcing
+   cn_dyn3d      =  'none'    !
+   nn_dyn3d_dta  =  0         !  = 0, bdy data are equal to the initial state
+   !                          !  = 1, bdy data are read in 'bdydata   .nc' files
+   cn_tra        =  'none'    !
+   nn_tra_dta    =  0         !  = 0, bdy data are equal to the initial state
+   !                          !  = 1, bdy data are read in 'bdydata   .nc' files
+   cn_ice        =  'none'    !
+   nn_ice_dta    =  0         !  = 0, bdy data are equal to the initial state
+   !                          !  = 1, bdy data are read in 'bdydata   .nc' files
+   rn_ice_tem    = 270.       !  si3 only: arbitrary temperature of incoming sea ice
+   rn_ice_sal    = 10.        !  si3 only:      --   salinity           --
+   rn_ice_age    = 30.        !  si3 only:      --   age                --
+   !
+   ln_tra_dmp    =.false.     !  open boudaries conditions for tracers
+   ln_dyn3d_dmp  =.false.     !  open boundary condition for baroclinic velocities
+   rn_time_dmp   =  1.        !  Damping time scale in days
+   rn_time_dmp_out = 1.        !  Outflow damping time scale
+   nn_rimwidth   = 10         !  width of the relaxation zone
+   ln_vol        = .false.    !  total volume correction (see nn_volctl parameter)
+   nn_volctl     =  1         !  = 0, the total water flux across open boundaries is zero
+   nb_jpk_bdy    = -1         ! number of levels in the bdy data (set < 0 if consistent with planned run)
+/
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
+!-----------------------------------------------------------------------
+   nn_nchunks_i =   4       !  number of chunks in i-dimension
+   nn_nchunks_j =   4       !  number of chunks in j-dimension
+   nn_nchunks_k =   31      !  number of chunks in k-dimension
+   !                       !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+   !                       !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip   = .true.    !  (T) use netcdf4 chunking and compression
+   !                       !  (F) ignore chunking information and produce netcdf3-compatible files
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi")
+!-----------------------------------------------------------------------
+   cn_mpi_send =  'I'      !  mpi send/recieve type   ='S', 'B', or 'I' for standard send,
+   !                       !  buffer blocking send or immediate non-blocking sends, resp.
+   nn_buffer   =   0       !  size in bytes of exported buffer ('B' case), 0 no exportation
+   ln_nnogather =  .true.  !  activate code to avoid mpi_allgather use at the northfold
+   jpni        =   0       !  jpni   number of processors following i (set automatically if < 1)
+   jpnj        =   0       !  jpnj   number of processors following j (set automatically if < 1)
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints                                       (default: OFF)
+!-----------------------------------------------------------------------
+   ln_ctl = .FALSE.                 ! Toggle all report printing on/off (T/F); Ignored if sn_cfctl%l_config is T
+     sn_cfctl%l_config = .TRUE.     ! IF .true. then control which reports are written with the following
+       sn_cfctl%l_runstat = .FALSE. ! switches and which areas produce reports with the proc integer settings.
+       sn_cfctl%l_trcstat = .FALSE. ! The default settings for the proc integers should ensure
+       sn_cfctl%l_oceout  = .FALSE. ! that  all areas report.
+       sn_cfctl%l_layout  = .FALSE. !
+       sn_cfctl%l_mppout  = .FALSE. !
+       sn_cfctl%l_mpptop  = .FALSE. !
+       sn_cfctl%procmin   = 0       ! Minimum area number for reporting [default:0]
+       sn_cfctl%procmax   = 1000000 ! Maximum area number for reporting [default:1000000]
+       sn_cfctl%procincr  = 1       ! Increment for optional subsetting of areas [default:1]
+       sn_cfctl%ptimincr  = 1       ! Timestep increment for writing time step progress info
+   nn_print    =    0      !  level of print (0 no extra print)
+   nn_ictls    =    0      !  start i indice of control sum (use to compare mono versus
+   nn_ictle    =    0      !  end   i indice of control sum        multi processor runs
+   nn_jctls    =    0      !  start j indice of control               over a subdomain)
+   nn_jctle    =    0      !  end   j indice of control
+   nn_isplt    =    1      !  number of processors in i-direction
+   nn_jsplt    =    1      !  number of processors in j-direction
+   ln_timing   = .false.   !  timing by routine write out in timing.output file
+   ln_diacfl   = .false.   !  CFL diagnostics write out in cfl_diagnostics.ascii
+/
Index: /utils/tools_ticket2413/DOMAINcfg/src/agrif2model.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/agrif2model.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/agrif2model.F90	(revision 12863)
@@ -0,0 +1,89 @@
+#if defined key_agrif
+   !!----------------------------------------------------------------------
+   !! NEMO/NST 4.0 , NEMO Consortium (2018)
+   !! $Id: agrif2model.F90 10068 2018-08-28 14:09:04Z nicolasmartin $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+SUBROUTINE Agrif2Model
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif2Model ***
+      !!--------------------------------------------- 
+END SUBROUTINE Agrif2model
+
+SUBROUTINE Agrif_Set_numberofcells(Agrif_Gr)
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Set_numberofcells ***
+      !!--------------------------------------------- 
+   USE Agrif_Grids
+   IMPLICIT NONE
+
+   TYPE(Agrif_Grid), POINTER :: Agrif_Gr
+
+   IF ( ASSOCIATED(Agrif_Curgrid) )THEN
+#include "SetNumberofcells.h"
+   ENDIF
+
+END SUBROUTINE Agrif_Set_numberofcells
+
+SUBROUTINE Agrif_Get_numberofcells(Agrif_Gr)
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Get_numberofcells ***
+      !!--------------------------------------------- 
+   USE Agrif_Grids
+   IMPLICIT NONE
+
+   TYPE(Agrif_Grid), POINTER :: Agrif_Gr
+
+   IF ( ASSOCIATED(Agrif_Curgrid) ) THEN
+#include "GetNumberofcells.h"
+   ENDIF
+
+END SUBROUTINE Agrif_Get_numberofcells
+
+SUBROUTINE Agrif_Allocationcalls(Agrif_Gr)
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Allocationscalls ***
+      !!--------------------------------------------- 
+   USE Agrif_Grids 
+#include "include_use_Alloc_agrif.h"
+   IMPLICIT NONE
+
+   TYPE(Agrif_Grid), POINTER :: Agrif_Gr
+
+#include "allocations_calls_agrif.h"
+
+END SUBROUTINE Agrif_Allocationcalls
+
+SUBROUTINE Agrif_probdim_modtype_def()
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_probdim_modtype_def ***
+      !!--------------------------------------------- 
+   USE Agrif_Types
+   IMPLICIT NONE
+
+#include "modtype_agrif.h"
+#include "probdim_agrif.h"
+#include "keys_agrif.h"
+
+   RETURN
+
+END SUBROUTINE Agrif_probdim_modtype_def
+
+SUBROUTINE Agrif_clustering_def()
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_clustering_def ***
+      !!--------------------------------------------- 
+   IMPLICIT NONE
+
+   RETURN
+
+END SUBROUTINE Agrif_clustering_def
+
+#else
+SUBROUTINE Agrif2Model
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif2Model ***
+      !!--------------------------------------------- 
+   WRITE(*,*) 'Impossible to bet here'
+END SUBROUTINE Agrif2model
+#endif
Index: /utils/tools_ticket2413/DOMAINcfg/src/agrif_boundary_connections.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/agrif_boundary_connections.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/agrif_boundary_connections.F90	(revision 12863)
@@ -0,0 +1,351 @@
+#if defined key_agrif
+subroutine agrif_boundary_connections
+use agrif_profiles
+use agrif_parameters
+implicit none
+external connect_e3t_copy, connect_e3t_connect, connect_bottom_level,connect_e3u, connect_e3v
+if (agrif_root()) return
+
+call Agrif_connection()
+
+call Agrif_Bc_variable(bottom_level_id, procname = connect_bottom_level)
+
+call Agrif_Bc_variable(e3t_copy_id, procname = connect_e3t_copy)
+
+! Agrif_UseSpecialValue = .TRUE.
+! Agrif_SpecialValue = 0.
+! call Agrif_Bc_variable(e3t_connect_id, procname = connect_e3t_connect)
+! Agrif_UseSpecialValue = .FALSE.
+
+
+      Agrif_SpecialValue    = 0.
+      Agrif_UseSpecialValue = ln_spc_dyn
+      !
+      CALL Agrif_Bc_variable( e3u_id, procname=connect_e3u )
+      CALL Agrif_Bc_variable( e3v_id, procname=connect_e3v )
+      !
+      Agrif_UseSpecialValue = .FALSE.
+      
+end subroutine agrif_boundary_connections
+
+
+    SUBROUTINE connect_e3t_copy( ptab, i1, i2, j1, j2, k1, k2, before, nb,ndir)
+    USE dom_oce
+    USE domzgr
+    USE agrif_parameters
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2
+      REAL, DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!---------------------------------------------------------------------- 
+      INTEGER :: ji,jj,jk      
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+
+      IF( before) THEN
+         ptab(i1:i2,j1:j2,k1:k2) = e3t_0(i1:i2,j1:j2,k1:k2)
+      ELSE
+         e3t_0(i1:i2,j1:j2,k1:k2) = ptab(i1:i2,j1:j2,k1:k2)
+      ENDIF
+      !
+   END SUBROUTINE connect_e3t_copy
+   
+    SUBROUTINE connect_bottom_level( ptab, i1, i2, j1, j2, before, nb,ndir)
+    USE dom_oce
+    USE domzgr
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2)    , INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!---------------------------------------------------------------------- 
+      INTEGER :: ji,jj     
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = mbkt(i1:i2,j1:j2)*ssmask(i1:i2,j1:j2)
+      ELSE
+         mbkt(i1:i2,j1:j2) = nint(ptab(i1:i2,j1:j2))
+         
+         WHERE (mbkt(i1:i2,j1:j2)==0)
+           ssmask(i1:i2,j1:j2) = 0.
+         END WHERE
+           
+      ENDIF
+      !
+   END SUBROUTINE connect_bottom_level
+   
+    SUBROUTINE connect_e3t_connect( ptab, i1, i2, j1, j2, k1, k2, before, nb,ndir)
+    USE dom_oce
+    USE domzgr
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2
+      REAL, DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!---------------------------------------------------------------------- 
+      INTEGER :: ji,jj,jk    
+      REAL,DIMENSION(i1:i2,j1:j2) :: bathy_local      
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+
+      IF( before) THEN
+         do jk=1,jpk
+         do jj=j1,j2
+         do ji=i1,i2
+          if (mbkt(ji,jj)>=jk) then
+            ptab(ji,jj,jk) = e3t_0(ji,jj,jk)
+          else
+            ptab(ji,jj,jk) = 0.
+          endif
+         enddo
+         enddo
+         enddo
+         
+         do jj=j1,j2
+         do ji=i1,i2
+           ptab(ji,jj,jpk+1) = SUM ( e3t_0(ji,jj, 1:mbkt(ji,jj) ) ) * ssmask(ji,jj)
+         enddo
+         enddo
+
+      ELSE
+         do jj=j1,j2
+         do ji=i1,i2
+           bathy_local (ji,jj) = SUM ( e3t_0(ji,jj, 1:mbkt(ji,jj) ) ) * ssmask(ji,jj)
+           print *,'ji = ',ji,jj,bathy_local(ji,jj),ptab(ji,jj,jpk+1)
+         enddo
+         enddo
+         
+         ! DO jk=1,jpk
+           ! DO jj=j1,j2
+             ! DO ji=i1,i2
+                 ! e3t_0(ji,jj,jk) = MAX(ptab(ji,jj,jk),MIN(e3zps_min, e3t_1d(jk)*e3zps_rat ))
+                 ! e3t_0(ji,jj,jk) = MIN(e3t_0(ji,jj,jk),e3t_1d(jk))
+             ! ENDDO
+           ! ENDDO
+         ! ENDDO
+      ENDIF
+      !
+   END SUBROUTINE connect_e3t_connect
+   
+   SUBROUTINE connect_e3u( ptab, i1, i2, j1, j2, k1, k2,before, nb, ndir )
+   USE dom_oce
+      !!----------------------------------------------------------------------
+      !!                  *** ROUTINE interpun ***
+      !!---------------------------------------------    
+      !!
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !!
+      INTEGER :: ji,jj,jk
+      REAL(wp) :: zrhoy
+      ! vertical interpolation:
+      REAL(wp), DIMENSION(k1:k2) :: tabin, h_in
+      REAL(wp), DIMENSION(1:jpk) :: h_out
+      INTEGER  :: N_in, N_out, iref
+      REAL(wp) :: h_diff
+      LOGICAL  :: western_side, eastern_side
+      !!---------------------------------------------    
+      !
+      IF (before) THEN 
+         DO jk=1,jpk
+            DO jj=j1,j2
+               DO ji=i1,i2
+                 if (min(mbkt(ji,jj),mbkt(ji+1,jj))<jk) then
+                  ptab(ji,jj,jk) = 0.
+                 else
+                  ptab(ji,jj,jk) = e2u(ji,jj) * e3u_0(ji,jj,jk)
+                 endif
+# if defined key_vertical
+                  ptab(ji,jj,jk,2) = (umask(ji,jj,jk) * e2u(ji,jj) * e3u_n(ji,jj,jk))
+# endif
+               END DO
+            END DO
+         END DO
+      ELSE
+         zrhoy = Agrif_rhoy()
+# if defined key_vertical
+! VERTICAL REFINEMENT BEGIN
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+
+         DO ji=i1,i2
+            iref = ji
+            IF (western_side) iref = MAX(2,ji)
+            IF (eastern_side) iref = MIN(nlci-2,ji)
+            DO jj=j1,j2
+               N_in = 0
+               DO jk=k1,k2
+                  IF (ptab(ji,jj,jk,2) == 0) EXIT
+                  N_in = N_in + 1
+                  tabin(jk) = ptab(ji,jj,jk,1)/ptab(ji,jj,jk,2)
+                  h_in(N_in) = ptab(ji,jj,jk,2)/(e2u(ji,jj)*zrhoy) 
+              ENDDO
+         
+              IF (N_in == 0) THEN
+                 ua(ji,jj,:) = 0._wp
+                 CYCLE
+              ENDIF
+         
+              N_out = 0
+              DO jk=1,jpk
+                 if (umask(iref,jj,jk) == 0) EXIT
+                 N_out = N_out + 1
+                 h_out(N_out) = e3u_a(iref,jj,jk)
+              ENDDO
+         
+              IF (N_out == 0) THEN
+                 ua(ji,jj,:) = 0._wp
+                 CYCLE
+              ENDIF
+         
+              IF (N_in * N_out > 0) THEN
+                 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in))
+! Should be able to remove the next IF/ELSEIF statement once scale factors are dealt with properly
+                 if (h_diff < -1.e4) then
+                    print *,'CHECK YOUR BATHY ...', h_diff, sum(h_out(1:N_out)), sum(h_in(1:N_in))
+!                    stop
+                 endif
+              ENDIF
+              call reconstructandremap(tabin(1:N_in),h_in(1:N_in),ua(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out)
+            ENDDO
+         ENDDO
+
+# else
+         DO jk = 1, jpkm1
+            DO jj=j1,j2
+            do ji=i1,i2
+              if (min(mbkt(ji+1,jj),mbkt(ji,jj))<jk) then
+                e3u_0(ji,jj,jk)=e3t_1d(jk)
+              else
+                e3u_0(ji,jj,jk) = MAX(ptab(ji,jj,jk) / ( zrhoy * e2u(ji,jj) ),MIN(e3zps_min,e3t_1d(jk)*e3zps_rat))
+              endif
+            enddo
+               
+            END DO
+         END DO
+# endif
+
+      ENDIF
+      ! 
+   END SUBROUTINE connect_e3u
+   
+   SUBROUTINE connect_e3v( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir )
+   USE dom_oce
+      !!----------------------------------------------------------------------
+      !!                  *** ROUTINE interpvn ***
+      !!----------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
+      LOGICAL, INTENT(in) :: before
+      INTEGER, INTENT(in) :: nb , ndir
+      !
+      INTEGER :: ji,jj,jk
+      REAL(wp) :: zrhox
+      ! vertical interpolation:
+      REAL(wp), DIMENSION(k1:k2) :: tabin, h_in
+      REAL(wp), DIMENSION(1:jpk) :: h_out
+      INTEGER  :: N_in, N_out, jref
+      REAL(wp) :: h_diff
+      LOGICAL  :: northern_side,southern_side
+      !!---------------------------------------------    
+      !      
+      IF (before) THEN          
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                 if (min(mbkt(ji,jj),mbkt(ji,jj+1))<jk) then
+                  ptab(ji,jj,jk) = 0.
+                 else
+                  ptab(ji,jj,jk) = (e1v(ji,jj) * e3v_0(ji,jj,jk))
+                 endif
+# if defined key_vertical
+                  ptab(ji,jj,jk,2) = vmask(ji,jj,jk) * e1v(ji,jj) * e3v_n(ji,jj,jk)
+# endif
+               END DO
+            END DO
+         END DO
+      ELSE       
+         zrhox = Agrif_rhox()
+# if defined key_vertical
+
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+
+         DO jj=j1,j2
+            jref = jj
+            IF (southern_side) jref = MAX(2,jj)
+            IF (northern_side) jref = MIN(nlcj-2,jj)
+            DO ji=i1,i2
+               N_in = 0
+               DO jk=k1,k2
+                  if (ptab(ji,jj,jk,2) == 0) EXIT
+                  N_in = N_in + 1
+                  tabin(jk) = ptab(ji,jj,jk,1)/ptab(ji,jj,jk,2)
+                  h_in(N_in) = ptab(ji,jj,jk,2)/(e1v(ji,jj)*zrhox)
+               END DO
+               IF (N_in == 0) THEN
+                  va(ji,jj,:) = 0._wp
+                  CYCLE
+               ENDIF
+         
+               N_out = 0
+               DO jk=1,jpk
+                  if (vmask(ji,jref,jk) == 0) EXIT
+                  N_out = N_out + 1
+                  h_out(N_out) = e3v_a(ji,jref,jk)
+               END DO
+               IF (N_out == 0) THEN
+                 va(ji,jj,:) = 0._wp
+                 CYCLE
+               ENDIF
+               call reconstructandremap(tabin(1:N_in),h_in(1:N_in),va(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out)
+            END DO
+         END DO
+# else
+         DO jk = 1, jpkm1
+          DO jj=j1,j2
+          DO ji=i1,i2
+              if (min(mbkt(ji,jj),mbkt(ji,jj+1))<jk) then
+                e3v_0(ji,jj,jk)=e3t_1d(jk)
+              else
+                e3v_0(ji,jj,jk) = MAX(ptab(ji,jj,jk) / ( zrhox * e1v(ji,jj) ),MIN(e3zps_min,e3t_1d(jk)*e3zps_rat))
+              endif
+          ENDDO
+          ENDDO
+         END DO
+# endif
+      ENDIF
+      !        
+   END SUBROUTINE connect_e3v
+
+#else
+subroutine agrif_boundary_connections_empty
+end subroutine agrif_boundary_connections_empty
+#endif
Index: /utils/tools_ticket2413/DOMAINcfg/src/agrif_connection.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/agrif_connection.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/agrif_connection.F90	(revision 12863)
@@ -0,0 +1,72 @@
+#if defined key_agrif
+   SUBROUTINE Agrif_connection
+   use dom_oce
+   use agrif_parameters
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE  Agrif_Sponge ***
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, ind1, ind2
+      INTEGER  ::   ispongearea
+      REAL(wp) ::   z1_spongearea
+      !!----------------------------------------------------------------------
+      !
+         ! Define ramp from boundaries towards domain interior at T-points
+         ! Store it in ztabramp
+
+         ALLOCATE(ztabramp(jpi,jpj))
+         ispongearea  = 1 + npt_connect * Agrif_irhox()
+         z1_spongearea = 1._wp / REAL( ispongearea )
+         
+         ztabramp(:,:) = 0._wp
+
+         ! --- West --- !
+         IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN
+            ind1 = 1+nbghostcells
+            ind2 = 1+nbghostcells + ispongearea 
+            DO jj = 1, jpj
+               DO ji = ind1, ind2                
+                  ztabramp(ji,jj) = REAL( ind2 - ji ) * z1_spongearea * umask(ind1,jj,1)
+               END DO
+            ENDDO
+         ENDIF
+
+         ! --- East --- !
+         IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN
+            ind1 = nlci - nbghostcells - ispongearea
+            ind2 = nlci - nbghostcells
+            DO jj = 1, jpj
+               DO ji = ind1, ind2
+                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ji - ind1 ) * z1_spongearea * umask(ind2-1,jj,1) )
+               ENDDO
+            ENDDO
+         ENDIF
+
+         ! --- South --- !
+         IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN
+            ind1 = 1+nbghostcells
+            ind2 = 1+nbghostcells + ispongearea
+            DO jj = ind1, ind2 
+               DO ji = 1, jpi
+                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - jj ) * z1_spongearea * vmask(ji,ind1,1) )
+               END DO
+            ENDDO
+         ENDIF
+
+         ! --- North --- !
+         IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN
+            ind1 = nlcj - nbghostcells - ispongearea
+            ind2 = nlcj - nbghostcells
+            DO jj = ind1, ind2
+               DO ji = 1, jpi
+                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( jj - ind1 ) * z1_spongearea * vmask(ji,ind2-1,1) )
+               END DO
+            ENDDO
+         ENDIF
+      !
+      !
+   END SUBROUTINE Agrif_connection
+   
+#else
+subroutine agrif_connection_empty
+end subroutine agrif_connection_empty
+#endif
Index: /utils/tools_ticket2413/DOMAINcfg/src/agrif_domzgr.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/agrif_domzgr.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/agrif_domzgr.F90	(revision 12863)
@@ -0,0 +1,40 @@
+#if defined key_agrif
+subroutine agrif_domzgr
+end subroutine agrif_domzgr
+
+subroutine agrif_create_bathy_meter
+use agrif_profiles
+external :: init_bathy
+
+call Agrif_Init_variable(bathy_id, procname = init_bathy)
+
+end subroutine agrif_create_bathy_meter
+
+    SUBROUTINE init_bathy( ptab, i1, i2, j1, j2, before, nb,ndir)
+    use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = bathy(i1:i2,j1:j2)
+      ELSE
+         bathy(i1:i2,j1:j2)=ptab
+      ENDIF
+      !
+   END SUBROUTINE init_bathy
+#else
+subroutine agrif_domzgr_empty
+end subroutine agrif_domzgr_empty
+#endif
Index: /utils/tools_ticket2413/DOMAINcfg/src/agrif_parameters.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/agrif_parameters.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/agrif_parameters.F90	(revision 12863)
@@ -0,0 +1,19 @@
+#ifdef key_agrif
+module agrif_parameters
+USE par_kind
+
+INTEGER :: nn_cln_update
+LOGICAL :: ln_spc_dyn
+REAL(wp) :: rn_sponge_tra
+REAL(wp) :: rn_sponge_dyn
+LOGICAL :: ln_chk_bathy
+INTEGER :: npt_copy
+INTEGER :: npt_connect
+
+REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   ztabramp
+
+end module agrif_parameters
+#else
+subroutine agrif_parameters_empty
+end subroutine agrif_parameters_empty
+#endif
Index: /utils/tools_ticket2413/DOMAINcfg/src/agrif_profiles.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/agrif_profiles.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/agrif_profiles.F90	(revision 12863)
@@ -0,0 +1,20 @@
+module agrif_profiles
+
+integer :: glamt_id, glamu_id, glamv_id,glamf_id
+integer :: gphit_id, gphiu_id, gphiv_id,gphif_id
+integer :: e1t_id, e1u_id, e1v_id, e1f_id
+integer :: e2t_id, e2u_id, e2v_id, e2f_id
+
+
+integer :: bathy_id
+
+! Vertical scale factors
+
+integer :: e3t_id
+integer :: e3t_copy_id
+integer :: e3t_connect_id
+integer :: e3u_id, e3v_id
+
+! Bottom level
+integer :: bottom_level_id
+end module agrif_profiles
Index: /utils/tools_ticket2413/DOMAINcfg/src/agrif_recompute_scalefactors.f90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/agrif_recompute_scalefactors.f90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/agrif_recompute_scalefactors.f90	(revision 12863)
@@ -0,0 +1,88 @@
+#if defined key_agrif
+subroutine agrif_recompute_scalefactors
+   USE dom_oce
+   USE lbclnk            ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp
+implicit none
+INTEGER :: ji,jj,jk,ikb,ikt
+
+      ! Scale factors and depth at U-, V-, UW and VW-points
+      DO jk = 1, jpk                        ! initialisation to z-scale factors
+!         e3u_0 (:,:,jk) = e3t_1d(jk)
+!         e3v_0 (:,:,jk) = e3t_1d(jk)
+         e3uw_0(:,:,jk) = e3w_1d(jk)
+         e3vw_0(:,:,jk) = e3w_1d(jk)
+      END DO
+
+      DO jk = 1,jpk                         ! Computed as the minimum of neighbooring scale factors
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1   ! vector opt.
+!               e3u_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji+1,jj,jk) )
+!               e3v_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji,jj+1,jk) )
+               e3uw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji+1,jj,jk) )
+               e3vw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji,jj+1,jk) )
+            END DO
+         END DO
+      END DO
+      IF ( ln_isfcav ) THEN
+      ! (ISF) define e3uw (adapted for 2 cells in the water column)
+         DO jj = 2, jpjm1 
+            DO ji = 2, jpim1   ! vector opt. 
+               ikb = MAX(mbathy (ji,jj),mbathy (ji+1,jj))
+               ikt = MAX(misfdep(ji,jj),misfdep(ji+1,jj))
+               IF (ikb == ikt+1) e3uw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji+1,jj  ,ikb  ) ) &
+                                       &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji+1,jj  ,ikb-1) )
+               ikb = MAX(mbathy (ji,jj),mbathy (ji,jj+1))
+               ikt = MAX(misfdep(ji,jj),misfdep(ji,jj+1))
+               IF (ikb == ikt+1) e3vw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji  ,jj+1,ikb  ) ) &
+                                       &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji  ,jj+1,ikb-1) )
+            END DO
+         END DO
+      END IF
+
+      CALL lbc_lnk('toto', e3u_0 , 'U', 1._wp )   ;   CALL lbc_lnk('toto', e3uw_0, 'U', 1._wp )   ! lateral boundary conditions
+      CALL lbc_lnk( 'toto',e3v_0 , 'V', 1._wp )   ;   CALL lbc_lnk('toto', e3vw_0, 'V', 1._wp )
+      !
+
+      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
+         WHERE( e3u_0 (:,:,jk) == 0._wp )   e3u_0 (:,:,jk) = e3t_1d(jk)
+         WHERE( e3v_0 (:,:,jk) == 0._wp )   e3v_0 (:,:,jk) = e3t_1d(jk)
+         WHERE( e3uw_0(:,:,jk) == 0._wp )   e3uw_0(:,:,jk) = e3w_1d(jk)
+         WHERE( e3vw_0(:,:,jk) == 0._wp )   e3vw_0(:,:,jk) = e3w_1d(jk)
+      END DO
+      
+      ! Scale factor at F-point
+      DO jk = 1, jpk                        ! initialisation to z-scale factors
+         e3f_0(:,:,jk) = e3t_1d(jk)
+      END DO
+      DO jk = 1, jpk                        ! Computed as the minimum of neighbooring V-scale factors
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1   ! vector opt.
+               e3f_0(ji,jj,jk) = MIN( e3v_0(ji,jj,jk), e3v_0(ji+1,jj,jk) )
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk('toto', e3f_0, 'F', 1._wp )       ! Lateral boundary conditions
+      !
+      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
+         WHERE( e3f_0(:,:,jk) == 0._wp )   e3f_0(:,:,jk) = e3t_1d(jk)
+      END DO
+!!gm  bug ? :  must be a do loop with mj0,mj1
+      ! 
+      e3t_0(:,mj0(1),:) = e3t_0(:,mj0(2),:)     ! we duplicate factor scales for jj = 1 and jj = 2
+      e3w_0(:,mj0(1),:) = e3w_0(:,mj0(2),:) 
+      e3u_0(:,mj0(1),:) = e3u_0(:,mj0(2),:) 
+      e3v_0(:,mj0(1),:) = e3v_0(:,mj0(2),:) 
+      e3f_0(:,mj0(1),:) = e3f_0(:,mj0(2),:) 
+
+      ! Control of the sign
+      IF( MINVAL( e3t_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3t_0 <= 0' )
+      IF( MINVAL( e3w_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3w_0 <= 0' )
+      IF( MINVAL( gdept_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdept_0 <  0' )
+      IF( MINVAL( gdepw_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw_0 <  0' )
+      
+end subroutine agrif_recompute_scalefactors
+#else
+subroutine agrif_recompute_scalefactors_empty
+end subroutine agrif_recompute_scalefactors_empty
+#endif
Index: /utils/tools_ticket2413/DOMAINcfg/src/agrif_update.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/agrif_update.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/agrif_update.F90	(revision 12863)
@@ -0,0 +1,187 @@
+#if defined key_agrif
+subroutine agrif_update_all
+USE agrif_parameters
+USE agrif_profiles
+external update_bottom_level, update_e3t, update_e3u, update_e3v
+
+if (agrif_root()) return
+call agrif_update_variable(bottom_level_id,locupdate=(/npt_copy,0/),procname = update_bottom_level)
+
+      Agrif_UseSpecialValueInUpdate = .TRUE.
+      Agrif_SpecialValueFineGrid    = 0._wp
+      
+call agrif_update_variable(e3t_id,procname = update_e3t)
+      Agrif_UseSpecialValueInUpdate = .FALSE.
+
+call agrif_update_variable(e3u_id,procname = update_e3u)
+call agrif_update_variable(e3v_id,procname = update_e3v)
+      
+end subroutine agrif_update_all
+
+    SUBROUTINE update_bottom_level( ptab, i1, i2, j1, j2, before, nb,ndir)
+    USE dom_oce
+    USE domzgr
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2)    , INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!---------------------------------------------------------------------- 
+      INTEGER :: ji,jj     
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = mbkt(i1:i2,j1:j2)*ssmask(i1:i2,j1:j2)
+      ELSE
+         mbkt(i1:i2,j1:j2) = nint(ptab(i1:i2,j1:j2))
+         
+         WHERE (mbkt(i1:i2,j1:j2)==0)
+           ssmask(i1:i2,j1:j2) = 0.
+         END WHERE
+           
+      ENDIF
+      !
+   END SUBROUTINE update_bottom_level
+   
+   SUBROUTINE update_e3t( tabres, i1, i2, j1, j2, k1, k2,  before )
+   USE dom_oce
+   implicit none
+      !!---------------------------------------------
+      !!           *** update_e3t updateT ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+      !!
+      INTEGER :: ji,jj,jk
+      !!---------------------------------------------
+      !
+      IF (before) THEN
+            DO jk=k1,k2
+               DO jj=j1,j2
+                  DO ji=i1,i2
+                   if (mbkt(ji,jj) < jk) then
+                     tabres(ji,jj,jk) = e3t_0(ji,jj,jk)
+                   else
+                     tabres(ji,jj,jk) = 0.
+                   endif
+                  END DO
+               END DO
+            END DO
+      ELSE
+            DO jk=k1,k2
+               DO jj=j1,j2
+                  DO ji=i1,i2
+                   if (mbkt(ji,jj) < jk) then
+                     e3t_0(ji,jj,jk) = e3t_1d(jk)
+                   else
+                     e3t_0(ji,jj,jk) = MAX(tabres(ji,jj,jk),MIN(e3zps_min,e3t_1d(jk)*e3zps_rat))
+                   endif
+                  END DO
+               END DO
+            END DO
+         !
+      ENDIF
+      ! 
+   END SUBROUTINE update_e3t
+   
+   SUBROUTINE update_e3u( tabres, i1, i2, j1, j2, k1, k2, before )
+   USE dom_oce
+   implicit none
+      !!---------------------------------------------
+      !!           *** ROUTINE update_e3u ***
+      !!---------------------------------------------
+      INTEGER                               , INTENT(in   ) :: i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+      LOGICAL                                     , INTENT(in   ) :: before
+      !
+      INTEGER  :: ji, jj, jk
+      REAL :: zrhoy
+      !!---------------------------------------------
+      ! 
+      IF( before ) THEN
+         zrhoy = Agrif_Rhoy()
+         DO jk = k1, k2
+          do jj=j1,j2
+          do ji=i1,i2
+           if (min(mbkt(ji,jj),mbkt(ji+1,jj))<jk) then
+            tabres(ji,jj,jk) = zrhoy * e2u(ji,jj) * MIN(e3zps_min,e3t_1d(jk)*e3zps_rat)
+           else
+            tabres(ji,jj,jk) = zrhoy * e2u(ji,jj) * e3u_0(ji,jj,jk)
+           endif
+          enddo
+          enddo
+         END DO
+      ELSE
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                 if (min(mbkt(ji,jj),mbkt(ji+1,jj))<jk) then
+                   e3u_0(ji,jj,jk)=e3t_1d(jk)
+                 else
+                   e3u_0(ji,jj,jk) = MAX(tabres(ji,jj,jk) / e2u(ji,jj),MIN(e3zps_min,e3t_1d(jk)*e3zps_rat))
+                 endif
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF
+      ! 
+   END SUBROUTINE update_e3u
+   
+   SUBROUTINE update_e3v( tabres, i1, i2, j1, j2, k1, k2, before )
+   USE dom_oce
+   implicit none
+      !!---------------------------------------------
+      !!           *** ROUTINE update_e3v ***
+      !!---------------------------------------------
+      INTEGER                               , INTENT(in   ) :: i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+      LOGICAL                                     , INTENT(in   ) :: before
+      !
+      INTEGER  :: ji, jj, jk
+      REAL :: zrhox
+      !!---------------------------------------------
+      ! 
+      IF( before ) THEN
+         zrhox = Agrif_Rhox()
+         DO jk = k1, k2
+          do jj=j1,j2
+          do ji=i1,i2
+           if (min(mbkt(ji,jj),mbkt(ji,jj+1))<jk) then
+            tabres(ji,jj,jk) = zrhox * e1v(ji,jj) * MIN(e3zps_min,e3t_1d(jk)*e3zps_rat)
+           else
+            tabres(ji,jj,jk) = zrhox * e1v(ji,jj) * e3v_0(ji,jj,jk)
+           endif
+          enddo
+          enddo
+         END DO
+      ELSE
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                 if (min(mbkt(ji,jj),mbkt(ji,jj+1))<jk) then
+                   e3v_0(ji,jj,jk)=e3t_1d(jk)
+                 else
+                   e3v_0(ji,jj,jk) = MAX(tabres(ji,jj,jk) / e1v(ji,jj),MIN(e3zps_min,e3t_1d(jk)*e3zps_rat))
+                 endif
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF
+      ! 
+   END SUBROUTINE update_e3v
+   
+#else
+subroutine agrif_update_all_empty
+end subroutine agrif_update_all_empty
+#endif
Index: /utils/tools_ticket2413/DOMAINcfg/src/agrif_user.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/agrif_user.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/agrif_user.F90	(revision 12863)
@@ -0,0 +1,811 @@
+#if defined key_agrif
+subroutine agrif_initworkspace()
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE Agrif_InitWorkspace ***
+      !!----------------------------------------------------------------------
+end subroutine agrif_initworkspace
+SUBROUTINE Agrif_InitValues
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE Agrif_InitValues ***
+      !!
+      !! ** Purpose :: Declaration of variables to be interpolated
+      !!----------------------------------------------------------------------
+   USE Agrif_Util
+   USE dom_oce
+   USE nemogcm
+   USE domain
+   !!
+   IMPLICIT NONE
+   
+ 
+   CALL nemo_init       !* Initializations of each fine grid
+
+   CALL dom_nam
+   CALL cfg_write         ! create the configuration file
+   
+END SUBROUTINE Agrif_InitValues
+
+SUBROUTINE Agrif_InitValues_cont
+
+use dom_oce
+    integer :: irafx, irafy
+    logical :: ln_perio
+    integer nx,ny
+
+irafx = agrif_irhox()
+irafy = agrif_irhoy()
+
+nx=nlci ; ny=nlcj
+
+   !       IF(jperio /=1 .AND. jperio/=4 .AND. jperio/=6 ) THEN
+   !          nx = (nbcellsx)+2*nbghostcellsfine+2
+   !          ny = (nbcellsy)+2*nbghostcellsfine+2
+   !          nbghostcellsfine_tot_x= nbghostcellsfine_x +1
+   !          nbghostcellsfine_tot_y= nbghostcellsfine_y +1
+   !       ELSE
+   !         nx = (nbcellsx)+2*nbghostcellsfine_x 
+   !         ny = (nbcellsy)+2*nbghostcellsfine+2
+   !         nbghostcellsfine_tot_x= 1
+   !         nbghostcellsfine_tot_y= nbghostcellsfine_y +1
+   !      ENDIF
+   !    ELSE
+   !       nbghostcellsfine = 0
+   !       nx = nbcellsx+irafx
+   !       ny = nbcellsy+irafy
+       
+  WRITE(*,*) ' '
+  WRITE(*,*)'Size of the High resolution grid: ',nx,' x ',ny
+  WRITE(*,*) ' '
+       
+       call agrif_init_lonlat()
+       ln_perio=.FALSE. 
+       if( jperio ==1 .OR. jperio==2 .OR. jperio==4) ln_perio=.TRUE.
+
+       where (glamt < -180) glamt = glamt +360.
+       if (ln_perio) then
+         glamt(1,:)=glamt(nx-1,:)
+         glamt(nx,:)=glamt(2,:)
+       endif
+ 
+       where (glamu < -180) glamu = glamu +360.
+       if (ln_perio) then
+         glamu(1,:)=glamu(nx-1,:)
+         glamu(nx,:)=glamu(2,:)
+       endif
+
+      where (glamv < -180) glamv = glamv +360.
+       if (ln_perio) then
+         glamv(1,:)=glamv(nx-1,:)
+         glamv(nx,:)=glamv(2,:)
+       endif
+
+      where (glamf < -180) glamf = glamf +360.
+       if (ln_perio) then
+         glamf(1,:)=glamf(nx-1,:)
+         glamf(nx,:)=glamf(2,:)
+       endif
+
+       call agrif_init_scales()
+
+        
+END SUBROUTINE Agrif_InitValues_cont  
+
+
+subroutine agrif_declare_var()
+use par_oce
+use dom_oce
+use agrif_profiles
+use agrif_parameters
+
+   IMPLICIT NONE
+   
+integer :: ind1, ind2, ind3
+integer nx,ny
+integer nbghostcellsfine_tot_x, nbghostcellsfine_tot_y
+INTEGER :: irafx
+!!----------------------------------------------------------------------
+
+   ! 1. Declaration of the type of variable which have to be interpolated
+   !---------------------------------------------------------------------
+ nx=nlci ; ny=nlcj
+
+!ind2 = nbghostcellsfine_tot_x + 1
+!ind3 = nbghostcellsfine_tot_y + 1
+ind2 = 2 + nbghostcells
+ind3 = ind2
+nbghostcellsfine_tot_x=nbghostcells+1
+nbghostcellsfine_tot_y=nbghostcells+1
+
+irafx = Agrif_irhox()
+
+CALL agrif_nemo_init  ! specific namelist part if needed
+
+CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),glamt_id)
+CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),glamu_id)
+CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nx,ny/),glamv_id)
+CALL agrif_declare_variable((/1,1/),(/ind2-1,ind3-1/),(/'x','y'/),(/1,1/),(/nx,ny/),glamf_id)
+
+CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),gphit_id)
+CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),gphiu_id)
+CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nx,ny/),gphiv_id)
+CALL agrif_declare_variable((/1,1/),(/ind2-1,ind3-1/),(/'x','y'/),(/1,1/),(/nx,ny/),gphif_id)
+
+! Horizontal scale factors
+
+CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),e1t_id)
+CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),e1u_id)
+CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nx,ny/),e1v_id)
+CALL agrif_declare_variable((/1,1/),(/ind2-1,ind3-1/),(/'x','y'/),(/1,1/),(/nx,ny/),e1f_id)
+
+CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),e2t_id)
+CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),e2u_id)
+CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nx,ny/),e2v_id)
+CALL agrif_declare_variable((/1,1/),(/ind2-1,ind3-1/),(/'x','y'/),(/1,1/),(/nx,ny/),e2f_id)
+
+! Bathymetry
+
+CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),bathy_id)
+
+! Vertical scale factors
+CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nx,ny,jpk/),e3t_id)
+CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nx,ny,jpk/),e3t_copy_id)
+CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nx,ny,jpk+1/),e3t_connect_id)
+
+CALL agrif_declare_variable((/1,2,0/),(/ind2-1,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nx,ny,jpk/),e3u_id)
+CALL agrif_declare_variable((/2,1,0/),(/ind2,ind3-1,0/),(/'x','y','N'/),(/1,1,1/),(/nx,ny,jpk/),e3v_id)
+
+! Bottom level
+
+CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),bottom_level_id)
+
+CALL Agrif_Set_bcinterp(glamt_id,interp=AGRIF_linear)
+CALL Agrif_Set_interp(glamt_id,interp=AGRIF_linear)
+CALL Agrif_Set_bc( glamt_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(glamu_id,interp=AGRIF_linear)
+CALL Agrif_Set_interp(glamu_id,interp=AGRIF_linear)
+CALL Agrif_Set_bc( glamu_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(glamv_id,interp=AGRIF_linear)
+CALL Agrif_Set_interp(glamv_id,interp=AGRIF_linear)
+CALL Agrif_Set_bc( glamv_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(glamf_id,interp=AGRIF_linear)
+CALL Agrif_Set_interp(glamf_id,interp=AGRIF_linear)
+CALL Agrif_Set_bc( glamf_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(gphit_id,interp=AGRIF_linear)
+CALL Agrif_Set_interp(gphit_id,interp=AGRIF_linear)
+CALL Agrif_Set_bc( gphit_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(gphiu_id,interp=AGRIF_linear)
+CALL Agrif_Set_interp(gphiu_id,interp=AGRIF_linear)
+CALL Agrif_Set_bc( gphiu_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(gphiv_id,interp=AGRIF_linear)
+CALL Agrif_Set_interp(gphiv_id,interp=AGRIF_linear)
+CALL Agrif_Set_bc( gphiv_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(gphif_id,interp=AGRIF_linear)
+CALL Agrif_Set_interp(gphif_id,interp=AGRIF_linear)
+CALL Agrif_Set_bc( gphif_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+!
+
+CALL Agrif_Set_bcinterp(e1t_id,interp=AGRIF_ppm)
+CALL Agrif_Set_interp(e1t_id,interp=AGRIF_ppm)
+CALL Agrif_Set_bc( e1t_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm)
+CALL Agrif_Set_interp(e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm)
+CALL Agrif_Set_bc( e1u_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(e1v_id,interp1=AGRIF_ppm, interp2=Agrif_linear)
+CALL Agrif_Set_interp(e1v_id, interp1=AGRIF_ppm, interp2=Agrif_linear)
+CALL Agrif_Set_bc( e1v_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(e1f_id,interp=AGRIF_linear)
+CALL Agrif_Set_interp(e1f_id,interp=AGRIF_linear)
+CALL Agrif_Set_bc( e1f_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(e2t_id,interp=AGRIF_ppm)
+CALL Agrif_Set_interp(e2t_id,interp=AGRIF_ppm)
+CALL Agrif_Set_bc( e2t_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(e2u_id,interp1=Agrif_linear, interp2=AGRIF_ppm)
+CALL Agrif_Set_interp(e2u_id,interp1=Agrif_linear, interp2=AGRIF_ppm)
+CALL Agrif_Set_bc( e2u_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm, interp2=Agrif_linear)
+CALL Agrif_Set_interp(e2v_id,interp1=AGRIF_ppm, interp2=Agrif_linear)
+CALL Agrif_Set_bc( e2v_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(e2f_id,interp=AGRIF_linear)
+CALL Agrif_Set_interp(e2f_id,interp=AGRIF_linear)
+CALL Agrif_Set_bc( e2f_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+CALL Agrif_Set_bcinterp(bathy_id,interp=AGRIF_linear)
+CALL Agrif_Set_interp(bathy_id,interp=AGRIF_linear)
+CALL Agrif_Set_bc( bathy_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+
+! Vertical scale factors
+CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_ppm)
+CALL Agrif_Set_interp(e3t_id,interp=AGRIF_ppm)
+CALL Agrif_Set_bc( e3t_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+CALL Agrif_Set_Updatetype( e3t_id, update = AGRIF_Update_Average)
+
+CALL Agrif_Set_bcinterp(e3t_copy_id,interp=AGRIF_constant)
+CALL Agrif_Set_interp(e3t_copy_id,interp=AGRIF_constant)
+CALL Agrif_Set_bc( e3t_copy_id, (/-npt_copy*irafx-1,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/))
+
+CALL Agrif_Set_bcinterp(e3t_connect_id,interp=AGRIF_ppm)
+CALL Agrif_Set_interp(e3t_connect_id,interp=AGRIF_ppm)
+CALL Agrif_Set_bc( e3t_connect_id, (/-(npt_copy+npt_connect)*irafx-1,-npt_copy*irafx-2/))
+
+CALL Agrif_Set_bcinterp(e3u_id, interp1=Agrif_linear, interp2=AGRIF_ppm)
+CALL Agrif_Set_interp(e3u_id, interp1=Agrif_linear, interp2=AGRIF_ppm)
+CALL Agrif_Set_bc( e3u_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+CALL Agrif_Set_Updatetype(e3u_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
+
+CALL Agrif_Set_bcinterp(e3v_id,interp1=AGRIF_ppm, interp2=Agrif_linear)
+CALL Agrif_Set_interp(e3v_id, interp1=AGRIF_ppm, interp2=Agrif_linear)
+CALL Agrif_Set_bc( e3v_id, (/0,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/) )
+CALL Agrif_Set_Updatetype(e3v_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
+   
+! Bottom level
+CALL Agrif_Set_bcinterp(bottom_level_id,interp=AGRIF_constant)
+CALL Agrif_Set_interp(bottom_level_id,interp=AGRIF_constant)
+CALL Agrif_Set_bc( bottom_level_id, (/-npt_copy*irafx-1,max(nbghostcellsfine_tot_x,nbghostcellsfine_tot_y)-1/))
+CALL Agrif_Set_Updatetype( bottom_level_id, update = AGRIF_Update_Max)
+
+end subroutine agrif_declare_var
+
+
+subroutine agrif_init_lonlat()
+use agrif_profiles
+use agrif_util
+external :: init_glamt, init_glamu, init_glamv, init_glamf
+external :: init_gphit, init_gphiu, init_gphiv, init_gphif
+
+call Agrif_Init_variable(glamt_id, procname = init_glamt)
+call Agrif_Init_variable(glamu_id, procname = init_glamu)
+call Agrif_Init_variable(glamv_id, procname = init_glamv)
+call Agrif_Init_variable(glamf_id, procname = init_glamf)
+
+call Agrif_Init_variable(gphit_id, procname = init_gphit)
+call Agrif_Init_variable(gphiu_id, procname = init_gphiu)
+call Agrif_Init_variable(gphiv_id, procname = init_gphiv)
+call Agrif_Init_variable(gphif_id, procname = init_gphif)
+
+end subroutine agrif_init_lonlat
+
+subroutine agrif_init_scales()
+use agrif_profiles
+use agrif_util
+external :: init_e1t, init_e1u, init_e1v, init_e1f
+external :: init_e2t, init_e2u, init_e2v, init_e2f
+
+call Agrif_Init_variable(e1t_id, procname = init_e1t)
+call Agrif_Init_variable(e1u_id, procname = init_e1u)
+call Agrif_Init_variable(e1v_id, procname = init_e1v)
+call Agrif_Init_variable(e1f_id, procname = init_e1f)
+
+call Agrif_Init_variable(e2t_id, procname = init_e2t)
+call Agrif_Init_variable(e2u_id, procname = init_e2u)
+call Agrif_Init_variable(e2v_id, procname = init_e2v)
+call Agrif_Init_variable(e2f_id, procname = init_e2f)
+
+end subroutine agrif_init_scales
+
+
+
+   SUBROUTINE init_glamt( ptab, i1, i2, j1, j2, before, nb,ndir)
+   use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = glamt(i1:i2,j1:j2)
+      ELSE
+         glamt(i1:i2,j1:j2)=ptab
+      ENDIF
+      !
+   END SUBROUTINE init_glamt
+
+    SUBROUTINE init_glamu( ptab, i1, i2, j1, j2, before, nb,ndir)
+    use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = glamu(i1:i2,j1:j2)
+      ELSE
+         glamu(i1:i2,j1:j2)=ptab
+      ENDIF
+      !
+   END SUBROUTINE init_glamu
+
+   SUBROUTINE init_glamv( ptab, i1, i2, j1, j2, before, nb,ndir)
+   use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = glamv(i1:i2,j1:j2)
+      ELSE
+         glamv(i1:i2,j1:j2)=ptab
+      ENDIF
+      !
+   END SUBROUTINE init_glamv
+
+   SUBROUTINE init_glamf( ptab, i1, i2, j1, j2, before, nb,ndir)
+   use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = glamf(i1:i2,j1:j2)
+      ELSE
+         glamf(i1:i2,j1:j2)=ptab
+      ENDIF
+      !
+   END SUBROUTINE init_glamf
+
+   SUBROUTINE init_gphit( ptab, i1, i2, j1, j2, before, nb,ndir)
+   use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = gphit(i1:i2,j1:j2)
+      ELSE
+         gphit(i1:i2,j1:j2)=ptab
+      ENDIF
+      !
+   END SUBROUTINE init_gphit
+
+    SUBROUTINE init_gphiu( ptab, i1, i2, j1, j2, before, nb,ndir)
+    use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = gphiu(i1:i2,j1:j2)
+      ELSE
+         gphiu(i1:i2,j1:j2)=ptab
+      ENDIF
+      !
+   END SUBROUTINE init_gphiu
+
+    SUBROUTINE init_gphiv( ptab, i1, i2, j1, j2, before, nb,ndir)
+    use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = gphiv(i1:i2,j1:j2)
+      ELSE
+         gphiv(i1:i2,j1:j2)=ptab
+      ENDIF
+      !
+   END SUBROUTINE init_gphiv
+
+
+   SUBROUTINE init_gphif( ptab, i1, i2, j1, j2, before, nb,ndir)
+   use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = gphif(i1:i2,j1:j2)
+      ELSE
+         gphif(i1:i2,j1:j2)=ptab
+      ENDIF
+      !
+   END SUBROUTINE init_gphif
+
+
+   SUBROUTINE init_e1t( ptab, i1, i2, j1, j2, before, nb,ndir)
+   use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = e1t(i1:i2,j1:j2)
+      ELSE
+         e1t(i1:i2,j1:j2)=ptab/Agrif_rhoy()
+      ENDIF
+      !
+   END SUBROUTINE init_e1t
+
+   SUBROUTINE init_e1u( ptab, i1, i2, j1, j2, before, nb,ndir)
+   use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = e1u(i1:i2,j1:j2)
+      ELSE
+         e1u(i1:i2,j1:j2)=ptab/Agrif_rhoy()
+      ENDIF
+      !
+   END SUBROUTINE init_e1u
+
+   SUBROUTINE init_e1v( ptab, i1, i2, j1, j2, before, nb,ndir)
+   use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2)
+      ELSE
+         e1v(i1:i2,j1:j2)=ptab/Agrif_rhoy()
+      ENDIF
+      !
+   END SUBROUTINE init_e1v
+
+   SUBROUTINE init_e1f( ptab, i1, i2, j1, j2, before, nb,ndir)
+   use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = e1f(i1:i2,j1:j2)
+      ELSE
+         e1f(i1:i2,j1:j2)=ptab/Agrif_rhoy()
+      ENDIF
+      !
+   END SUBROUTINE init_e1f
+
+  SUBROUTINE init_e2t( ptab, i1, i2, j1, j2, before, nb,ndir)
+   use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = e2t(i1:i2,j1:j2)
+      ELSE
+         e2t(i1:i2,j1:j2)=ptab/Agrif_rhoy()
+      ENDIF
+      !
+   END SUBROUTINE init_e2t
+
+   SUBROUTINE init_e2u( ptab, i1, i2, j1, j2, before, nb,ndir)
+   use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2)
+      ELSE
+         e2u(i1:i2,j1:j2)=ptab/Agrif_rhoy()
+      ENDIF
+      !
+   END SUBROUTINE init_e2u
+
+   SUBROUTINE init_e2v( ptab, i1, i2, j1, j2, before, nb,ndir)
+   use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = e2v(i1:i2,j1:j2)
+      ELSE
+         e2v(i1:i2,j1:j2)=ptab/Agrif_rhoy()
+      ENDIF
+      !
+   END SUBROUTINE init_e2v
+
+   SUBROUTINE init_e2f( ptab, i1, i2, j1, j2, before, nb,ndir)
+   use dom_oce
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpsshn  ***
+      !!----------------------------------------------------------------------  
+      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2
+      REAL, DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab
+      LOGICAL                         , INTENT(in   ) ::   before
+      INTEGER                         , INTENT(in   ) ::   nb , ndir
+      LOGICAL  ::   western_side, eastern_side,northern_side,southern_side
+      !
+      !!----------------------------------------------------------------------  
+      !
+         western_side  = (nb == 1).AND.(ndir == 1)
+         eastern_side  = (nb == 1).AND.(ndir == 2)
+         southern_side = (nb == 2).AND.(ndir == 1)
+         northern_side = (nb == 2).AND.(ndir == 2)
+      IF( before) THEN
+         ptab(i1:i2,j1:j2) = e2f(i1:i2,j1:j2)
+      ELSE
+         e2f(i1:i2,j1:j2)=ptab/Agrif_rhoy()
+      ENDIF
+      !
+   END SUBROUTINE init_e2f
+
+
+SUBROUTINE agrif_nemo_init
+USE agrif_parameters
+USE in_out_manager
+USE lib_mpp
+
+   
+   !!
+   IMPLICIT NONE
+   
+   INTEGER ::   ios
+   
+   NAMELIST/namagrif/ nn_cln_update,ln_spc_dyn,rn_sponge_tra,rn_sponge_dyn,ln_chk_bathy,npt_connect, npt_copy
+
+      REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : nesting parameters
+      READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : nesting parameters
+      READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namagrif )
+
+      IF(lwp) THEN                     ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'agrif_nemo_init : nesting'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '   Namelist namagrif : set nesting parameters'
+         WRITE(numout,*) '      npt_copy     = ', npt_copy
+         WRITE(numout,*) '      npt_connect  = ', npt_connect
+      ENDIF
+      
+END SUBROUTINE agrif_nemo_init
+   
+
+SUBROUTINE Agrif_detect( kg, ksizex )
+      !!----------------------------------------------------------------------
+      !!                      *** ROUTINE Agrif_detect ***
+      !!----------------------------------------------------------------------
+   INTEGER, DIMENSION(2) :: ksizex
+   INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
+      !!----------------------------------------------------------------------
+   !
+   RETURN
+   !
+END SUBROUTINE Agrif_detect
+SUBROUTINE agrif_before_regridding
+END SUBROUTINE agrif_before_regridding
+
+SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
+      !!----------------------------------------------------------------------
+      !!                     *** ROUTINE Agrif_InvLoc ***
+      !!----------------------------------------------------------------------
+   USE dom_oce
+   !!
+   IMPLICIT NONE
+   !
+   INTEGER :: indglob, indloc, nprocloc, i
+      !!----------------------------------------------------------------------
+   !
+   SELECT CASE( i )
+   CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
+   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1
+   CASE DEFAULT
+      indglob = indloc
+   END SELECT
+   !
+END SUBROUTINE Agrif_InvLoc
+
+SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE Agrif_get_proc_info ***
+      !!----------------------------------------------------------------------
+   USE par_oce
+   USE dom_oce 
+   !!
+   IMPLICIT NONE
+   !
+   INTEGER, INTENT(out) :: imin, imax
+   INTEGER, INTENT(out) :: jmin, jmax
+      !!----------------------------------------------------------------------
+   !
+   imin = nimppt(Agrif_Procrank+1)  ! ?????
+   jmin = njmppt(Agrif_Procrank+1)  ! ?????
+   imax = imin + jpi - 1
+   jmax = jmin + jpj - 1
+   ! 
+END SUBROUTINE Agrif_get_proc_info
+
+SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE Agrif_estimate_parallel_cost ***
+      !!----------------------------------------------------------------------
+   USE par_oce
+   !!
+   IMPLICIT NONE
+   !
+   INTEGER,  INTENT(in)  :: imin, imax
+   INTEGER,  INTENT(in)  :: jmin, jmax
+   INTEGER,  INTENT(in)  :: nbprocs
+   REAL(wp), INTENT(out) :: grid_cost
+      !!----------------------------------------------------------------------
+   !
+   grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
+   !
+END SUBROUTINE Agrif_estimate_parallel_cost
+
+#endif
Index: /utils/tools_ticket2413/DOMAINcfg/src/bdy_oce.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/bdy_oce.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/bdy_oce.F90	(revision 12863)
@@ -0,0 +1,169 @@
+MODULE bdy_oce
+   !!======================================================================
+   !!                       ***  MODULE bdy_oce   ***
+   !! Unstructured Open Boundary Cond. :   define related variables
+   !!======================================================================
+   !! History :  1.0  !  2001-05  (J. Chanut, A. Sellar)  Original code
+   !!            3.0  !  2008-04  (NEMO team)  add in the reference version     
+   !!            3.3  !  2010-09  (D. Storkey) add ice boundary conditions
+   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
+   !!            3.6  !  2014-01  (C. Rousset) add ice boundary conditions for new model
+   !!            4.0  !  2018     (C. Rousset) SI3 compatibility
+   !!----------------------------------------------------------------------
+   USE par_oce         ! ocean parameters
+
+   IMPLICIT NONE
+   PUBLIC
+
+   INTEGER, PUBLIC, PARAMETER ::   jp_bdy  = 10       !: Maximum number of bdy sets
+   INTEGER, PUBLIC, PARAMETER ::   jpbgrd  = 3        !: Number of horizontal grid types used  (T, U, V)
+
+   TYPE, PUBLIC ::   OBC_INDEX    !: Indices and weights which define the open boundary
+      INTEGER ,          DIMENSION(jpbgrd) ::  nblen
+      INTEGER ,          DIMENSION(jpbgrd) ::  nblenrim
+      INTEGER , POINTER, DIMENSION(:,:)    ::  nbi
+      INTEGER , POINTER, DIMENSION(:,:)    ::  nbj
+      INTEGER , POINTER, DIMENSION(:,:)    ::  nbr
+      INTEGER , POINTER, DIMENSION(:,:)    ::  nbmap
+      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbw
+      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbd
+      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbdout
+      REAL(wp), POINTER, DIMENSION(:,:)    ::  flagu
+      REAL(wp), POINTER, DIMENSION(:,:)    ::  flagv
+   END TYPE OBC_INDEX
+
+   !! Logicals in OBC_DATA structure are true if the chosen algorithm requires this
+   !! field as external data. If true the data can come from external files
+   !! or model initial conditions. If false then no "external" data array
+   !! is required for this field. 
+
+   TYPE, PUBLIC ::   OBC_DATA     !: Storage for external data
+      INTEGER          , DIMENSION(2)   ::  nread
+      LOGICAL                           ::  ll_ssh
+      LOGICAL                           ::  ll_u2d
+      LOGICAL                           ::  ll_v2d
+      LOGICAL                           ::  ll_u3d
+      LOGICAL                           ::  ll_v3d
+      LOGICAL                           ::  ll_tem
+      LOGICAL                           ::  ll_sal
+      LOGICAL                           ::  ll_fvl
+      REAL(wp), POINTER, DIMENSION(:)   ::  ssh
+      REAL(wp), POINTER, DIMENSION(:)   ::  u2d
+      REAL(wp), POINTER, DIMENSION(:)   ::  v2d
+      REAL(wp), POINTER, DIMENSION(:,:) ::  u3d
+      REAL(wp), POINTER, DIMENSION(:,:) ::  v3d
+      REAL(wp), POINTER, DIMENSION(:,:) ::  tem
+      REAL(wp), POINTER, DIMENSION(:,:) ::  sal
+#if defined key_si3
+      LOGICAL                           ::   ll_a_i
+      LOGICAL                           ::   ll_h_i
+      LOGICAL                           ::   ll_h_s
+      REAL(wp), POINTER, DIMENSION(:,:) ::   a_i    !: now ice leads fraction climatology
+      REAL(wp), POINTER, DIMENSION(:,:) ::   h_i    !: Now ice  thickness climatology
+      REAL(wp), POINTER, DIMENSION(:,:) ::   h_s    !: now snow thickness
+#endif
+#if defined key_top
+      CHARACTER(LEN=20)                   :: cn_obc  !: type of boundary condition to apply
+      REAL(wp)                            :: rn_fac  !: multiplicative scaling factor
+      REAL(wp), POINTER, DIMENSION(:,:)   :: trc     !: now field of the tracer
+      LOGICAL                             :: dmp     !: obc damping term
+#endif
+   END TYPE OBC_DATA
+
+   !!----------------------------------------------------------------------
+   !! Namelist variables
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC            ::   ln_bdy                   !: Unstructured Ocean Boundary Condition
+
+   CHARACTER(len=80), DIMENSION(jp_bdy) ::   cn_coords_file !: Name of bdy coordinates file
+   CHARACTER(len=80)                    ::   cn_mask_file   !: Name of bdy mask file
+   !
+   LOGICAL, DIMENSION(jp_bdy) ::   ln_coords_file           !: =T read bdy coordinates from file; 
+   !                                                        !: =F read bdy coordinates from namelist
+   LOGICAL                    ::   ln_mask_file             !: =T read bdymask from file
+   LOGICAL                    ::   ln_vol                   !: =T volume correction             
+   !
+   INTEGER                    ::   nb_bdy                   !: number of open boundary sets
+   INTEGER                    ::   nb_jpk_bdy               !: number of levels in the bdy data (set < 0 if consistent with planned run)
+   INTEGER, DIMENSION(jp_bdy) ::   nn_rimwidth              !: boundary rim width for Flow Relaxation Scheme
+   INTEGER                    ::   nn_volctl                !: = 0 the total volume will have the variability of the surface Flux E-P 
+   !                                                        !  = 1 the volume will be constant during all the integration.
+   CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_dyn2d       ! Choice of boundary condition for barotropic variables (U,V,SSH)
+   INTEGER, DIMENSION(jp_bdy)           ::   nn_dyn2d_dta   !: = 0 use the initial state as bdy dta ; 
+                                                            !: = 1 read it in a NetCDF file
+                                                            !: = 2 read tidal harmonic forcing from a NetCDF file
+                                                            !: = 3 read external data AND tidal harmonic forcing from NetCDF files
+   CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_dyn3d       ! Choice of boundary condition for baroclinic velocities 
+   INTEGER, DIMENSION(jp_bdy)           ::   nn_dyn3d_dta   !: = 0 use the initial state as bdy dta ; 
+                                                            !: = 1 read it in a NetCDF file
+   CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_tra         ! Choice of boundary condition for active tracers (T and S)
+   INTEGER, DIMENSION(jp_bdy)           ::   nn_tra_dta     !: = 0 use the initial state as bdy dta ; 
+                                                            !: = 1 read it in a NetCDF file
+   LOGICAL , DIMENSION(jp_bdy) ::   ln_tra_dmp              !: =T Tracer damping
+   LOGICAL , DIMENSION(jp_bdy) ::   ln_dyn3d_dmp            !: =T Baroclinic velocity damping
+   REAL(wp), DIMENSION(jp_bdy) ::   rn_time_dmp             !: Damping time scale in days
+   REAL(wp), DIMENSION(jp_bdy) ::   rn_time_dmp_out         !: Damping time scale in days at radiation outflow points
+
+   CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_ice         ! Choice of boundary condition for sea ice variables 
+   INTEGER , DIMENSION(jp_bdy)          ::   nn_ice_dta     !: = 0 use the initial state as bdy dta ; 
+                                                            !: = 1 read it in a NetCDF file
+   REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_tem              !: choice of the temperature of incoming sea ice
+   REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_sal              !: choice of the salinity    of incoming sea ice
+   REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_age              !: choice of the age         of incoming sea ice
+   !
+   
+   !!----------------------------------------------------------------------
+   !! Global variables
+   !!----------------------------------------------------------------------
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   bdytmask   !: Mask defining computational domain at T-points
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   bdyumask   !: Mask defining computational domain at U-points
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   bdyvmask   !: Mask defining computational domain at V-points
+
+   REAL(wp)                                    ::   bdysurftot !: Lateral surface of unstructured open boundary
+
+   !!----------------------------------------------------------------------
+   !! open boundary data variables
+   !!----------------------------------------------------------------------
+
+   INTEGER,  DIMENSION(jp_bdy)                     ::   nn_dta            !: =0 => *all* data is set to initial conditions
+                                                                          !: =1 => some data to be read in from data files
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global        !: workspace for reading in global data arrays (unstr.  bdy)
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global_z      !: workspace for reading in global depth arrays (unstr.  bdy)
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global_dz     !: workspace for reading in global depth arrays (unstr.  bdy)
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global2       !: workspace for reading in global data arrays (struct. bdy)
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global2_z     !: workspace for reading in global depth arrays (struct. bdy)
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global2_dz    !: workspace for reading in global depth arrays (struct. bdy)
+!$AGRIF_DO_NOT_TREAT
+   TYPE(OBC_INDEX), DIMENSION(jp_bdy), TARGET      ::   idx_bdy           !: bdy indices (local process)
+   TYPE(OBC_DATA) , DIMENSION(jp_bdy), TARGET      ::   dta_bdy           !: bdy external data (local process)
+!$AGRIF_END_DO_NOT_TREAT
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: bdy_oce.F90 10425 2018-12-19 21:54:16Z smasson $ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   FUNCTION bdy_oce_alloc()
+      !!----------------------------------------------------------------------
+      USE lib_mpp, ONLY: ctl_stop, mpp_sum
+      !
+      INTEGER :: bdy_oce_alloc
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( bdytmask(jpi,jpj) , bdyumask(jpi,jpj), bdyvmask(jpi,jpj),     &  
+         &      STAT=bdy_oce_alloc )
+      !
+      ! Initialize masks 
+      bdytmask(:,:) = 1._wp
+      bdyumask(:,:) = 1._wp
+      bdyvmask(:,:) = 1._wp
+      ! 
+      CALL mpp_sum ( 'bdy_oce', bdy_oce_alloc )
+      IF( bdy_oce_alloc /= 0 )   CALL ctl_stop( 'STOP', 'bdy_oce_alloc: failed to allocate arrays.' )
+      !
+   END FUNCTION bdy_oce_alloc
+
+   !!======================================================================
+END MODULE bdy_oce
+
Index: /utils/tools_ticket2413/DOMAINcfg/src/bilinear_interp.f90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/bilinear_interp.f90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/bilinear_interp.f90	(revision 12863)
@@ -0,0 +1,3 @@
+MODULE bilinear_interp
+
+END MODULE
Index: /utils/tools_ticket2413/DOMAINcfg/src/calendar.f90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/calendar.f90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/calendar.f90	(revision 12863)
@@ -0,0 +1,1044 @@
+MODULE calendar
+!-
+!$Id: calendar.f90 2459 2010-12-07 11:17:48Z smasson $
+!-
+! 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: /utils/tools_ticket2413/DOMAINcfg/src/defprec.f90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/defprec.f90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/defprec.f90	(revision 12863)
@@ -0,0 +1,22 @@
+MODULE defprec 
+!-
+! $Id: defprec.f90 2281 2010-10-15 14:21:13Z smasson $
+!-
+! 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: /utils/tools_ticket2413/DOMAINcfg/src/dom_oce.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/dom_oce.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/dom_oce.F90	(revision 12863)
@@ -0,0 +1,360 @@
+MODULE dom_oce
+   !!======================================================================
+   !!                       ***  MODULE dom_oce  ***
+   !!       
+   !! ** Purpose :   Define in memory all the ocean space domain variables
+   !!======================================================================
+   !! History :  1.0  ! 2005-10  (A. Beckmann, G. Madec)  reactivate s-coordinate 
+   !!            3.3  ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level
+   !!            3.4  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!            3.5  ! 2012     (S. Mocavero, I. Epicoco) Add arrays associated
+   !!                             to the optimization of BDY communications
+   !!            3.7  ! 2015-11  (G. Madec) introduce surface and scale factor ratio
+   !!             -   ! 2015-11  (G. Madec, A. Coward)  time varying zgr by default
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   Agrif_Root    : dummy function used when lk_agrif=F
+   !!   Agrif_CFixed  : dummy function used when lk_agrif=F
+   !!   dom_oce_alloc : dynamical allocation of dom_oce arrays
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+
+   IMPLICIT NONE
+   PUBLIC             ! allows the acces to par_oce when dom_oce is used (exception to coding rules)
+
+   PUBLIC dom_oce_alloc  ! Called from nemogcm.F90
+
+  !! time & space domain namelist
+   !! ----------------------------
+   INTEGER , PUBLIC ::   nmsh            !: = 1 create a mesh-mask file
+   !                                    !!* Namelist namdom : time & space domain *
+   INTEGER , PUBLIC ::   nn_bathy        !: = 0/1/2 ,compute/read the bathymetry file
+   REAL(wp), PUBLIC ::   rn_bathy        !: depth of flat bottom (active if nn_bathy=0; if =0 depth=jpkm1)
+   REAL(wp), PUBLIC ::   rn_hmin         !: minimum ocean depth (>0) or minimum number of ocean levels (<0)
+   REAL(wp), PUBLIC ::   rn_e3zps_min    !: miminum thickness for partial steps (meters)
+   REAL(wp), PUBLIC ::   rn_e3zps_rat    !: minimum thickness ration for partial steps
+   INTEGER , PUBLIC ::   nn_msh          !: = 1 create a mesh-mask file
+
+   INTEGER , PUBLIC ::   ntopo           !: = 0/1 ,compute/read the bathymetry file
+   INTEGER, PUBLIC  ::   nperio          !: type of lateral boundary condition
+   REAL(wp), PUBLIC ::   e3zps_min       !: miminum thickness for partial steps (meters)
+   REAL(wp), PUBLIC ::   e3zps_rat       !: minimum thickness ration for partial steps
+
+   INTEGER, PUBLIC :: nn_interp
+   CHARACTER(LEN=132), PUBLIC :: cn_topo
+   CHARACTER(LEN=132), PUBLIC :: cn_bath
+   CHARACTER(LEN=132), PUBLIC :: cn_lon
+   CHARACTER(LEN=132), PUBLIC :: cn_lat
+
+   LOGICAL, PUBLIC ::   lzoom      =  .FALSE.   !: zoom flag
+   LOGICAL, PUBLIC ::   lzoom_e    =  .FALSE.   !: East  zoom type flag
+   LOGICAL, PUBLIC ::   lzoom_w    =  .FALSE.   !: West  zoom type flag
+   LOGICAL, PUBLIC ::   lzoom_s    =  .FALSE.   !: South zoom type flag
+   LOGICAL, PUBLIC ::   lzoom_n    =  .FALSE.   !: North zoom type flag
+
+   LOGICAL, PUBLIC ::   ln_domclo  =  .FALSE.
+
+   INTEGER       ::   jphgr_msh          !: type of horizontal mesh
+   !                                       !  = 0 curvilinear coordinate on the sphere read in coordinate.nc
+   !                                       !  = 1 geographical mesh on the sphere with regular grid-spacing
+   !                                       !  = 2 f-plane with regular grid-spacing
+   !                                       !  = 3 beta-plane with regular grid-spacing
+   !                                       !  = 4 Mercator grid with T/U point at the equator
+
+   REAL(wp)      ::   ppglam0            !: longitude of first raw and column T-point (jphgr_msh = 1)
+   REAL(wp)      ::   ppgphi0            !: latitude  of first raw and column T-point (jphgr_msh = 1)
+   !                                                        !  used for Coriolis & Beta parameters (jphgr_msh = 2 or 3)
+   REAL(wp)      ::   ppe1_deg           !: zonal      grid-spacing (degrees)
+   REAL(wp)      ::   ppe2_deg           !: meridional grid-spacing (degrees)
+   REAL(wp)      ::   ppe1_m             !: zonal      grid-spacing (degrees)
+   REAL(wp)      ::   ppe2_m             !: meridional grid-spacing (degrees)
+
+   !! Vertical grid parameter for domzgr
+   !! ==================================
+   REAL(wp)      ::   ppsur              !: ORCA r4, r2 and r05 coefficients
+   REAL(wp)      ::   ppa0               !: (default coefficients)
+   REAL(wp)      ::   ppa1               !:
+   REAL(wp)      ::   ppkth              !:
+   REAL(wp)      ::   ppacr              !:
+   !
+   !  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   REAL(wp)      ::   ppdzmin            !: Minimum vertical spacing
+   REAL(wp)      ::   pphmax             !: Maximum depth
+   !
+   LOGICAL       ::   ldbletanh          !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp)      ::   ppa2               !: Double tanh function parameters
+   REAL(wp)      ::   ppkth2             !:
+   REAL(wp)      ::   ppacr2             !:
+
+   !!----------------------------------------------------------------------
+   !! time & space domain namelist
+   !! ----------------------------
+   !                                   !!* Namelist namdom : time & space domain *
+   LOGICAL , PUBLIC ::   ln_linssh      !: =T  linear free surface ==>> model level are fixed in time
+   LOGICAL , PUBLIC ::   ln_meshmask    !: =T  create a mesh-mask file (mesh_mask.nc)
+   REAL(wp), PUBLIC ::   rn_isfhmin     !: threshold to discriminate grounded ice to floating ice
+   REAL(wp), PUBLIC ::   rn_rdt         !: time step for the dynamics and tracer
+   REAL(wp), PUBLIC ::   rn_atfp        !: asselin time filter parameter
+   INTEGER , PUBLIC ::   nn_euler       !: =0 start with forward time step or not (=1)
+   LOGICAL , PUBLIC ::   ln_iscpl       !: coupling with ice sheet
+   LOGICAL , PUBLIC ::   ln_crs         !: Apply grid coarsening to dynamical model output or online passive tracers
+
+   !! Free surface parameters
+   !! =======================
+   LOGICAL , PUBLIC :: ln_dynspg_exp    !: Explicit free surface flag
+   LOGICAL , PUBLIC :: ln_dynspg_ts     !: Split-Explicit free surface flag
+
+   !! Time splitting parameters
+   !! =========================
+   LOGICAL,  PUBLIC :: ln_bt_fw         !: Forward integration of barotropic sub-stepping
+   LOGICAL,  PUBLIC :: ln_bt_av         !: Time averaging of barotropic variables
+   LOGICAL,  PUBLIC :: ln_bt_auto       !: Set number of barotropic iterations automatically
+   INTEGER,  PUBLIC :: nn_bt_flt        !: Filter choice
+   INTEGER,  PUBLIC :: nn_baro          !: Number of barotropic iterations during one baroclinic step (rdt)
+   REAL(wp), PUBLIC :: rn_bt_cmax       !: Maximum allowed courant number (used if ln_bt_auto=T)
+   REAL(wp), PUBLIC :: rn_bt_alpha      !: Time stepping diffusion parameter
+
+
+   !                                   !! old non-DOCTOR names still used in the model
+   REAL(wp), PUBLIC ::   atfp           !: asselin time filter parameter
+   REAL(wp), PUBLIC ::   rdt            !: time step for the dynamics and tracer
+
+   !                                   !!! associated variables
+   INTEGER , PUBLIC ::   neuler         !: restart euler forward option (0=Euler)
+   REAL(wp), PUBLIC ::   r2dt           !: = 2*rdt except at nit000 (=rdt) if neuler=0
+
+   !!----------------------------------------------------------------------
+   !! space domain parameters
+   !!----------------------------------------------------------------------
+   INTEGER, PUBLIC ::   jperio   !: Global domain lateral boundary type (between 0 and 7)
+   !                                !  = 0 closed                 ;   = 1 cyclic East-West
+   !                                !  = 2 cyclic North-South     ;   = 3 North fold T-point pivot
+   !                                !  = 4 cyclic East-West AND North fold T-point pivot
+   !                                !  = 5 North fold F-point pivot
+   !                                !  = 6 cyclic East-West AND North fold F-point pivot
+   !                                !  = 7 bi-cyclic East-West AND North-South
+   LOGICAL, PUBLIC ::   l_Iperio, l_Jperio   !   should we explicitely take care I/J periodicity 
+
+   !                                 !  domain MPP decomposition parameters
+   INTEGER             , PUBLIC ::   nimpp, njmpp     !: i- & j-indexes for mpp-subdomain left bottom
+   INTEGER             , PUBLIC ::   nreci, nrecj     !: overlap region in i and j
+   INTEGER             , PUBLIC ::   nproc            !: number for local processor
+   INTEGER             , PUBLIC ::   narea            !: number for local area
+   INTEGER             , PUBLIC ::   nbondi, nbondj   !: mark of i- and j-direction local boundaries
+   INTEGER, ALLOCATABLE, PUBLIC ::   nbondi_bdy(:)    !: mark i-direction local boundaries for BDY open boundaries
+   INTEGER, ALLOCATABLE, PUBLIC ::   nbondj_bdy(:)    !: mark j-direction local boundaries for BDY open boundaries
+   INTEGER, ALLOCATABLE, PUBLIC ::   nbondi_bdy_b(:)  !: mark i-direction of neighbours local boundaries for BDY open boundaries  
+   INTEGER, ALLOCATABLE, PUBLIC ::   nbondj_bdy_b(:)  !: mark j-direction of neighbours local boundaries for BDY open boundaries  
+
+   INTEGER, PUBLIC ::   npolj             !: north fold mark (0, 3 or 4)
+   INTEGER, PUBLIC ::   nlci, nldi, nlei  !: i-dimensions of the local subdomain and its first and last indoor indices
+   INTEGER, PUBLIC ::   nlcj, nldj, nlej  !: i-dimensions of the local subdomain and its first and last indoor indices
+   INTEGER, PUBLIC ::   noea, nowe        !: index of the local neighboring processors in
+   INTEGER, PUBLIC ::   noso, nono        !: east, west, south and north directions
+   INTEGER, PUBLIC ::   nidom             !: ???
+
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mig        !: local  ==> global domain i-index
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mjg        !: local  ==> global domain j-index
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mi0, mi1   !: global ==> local  domain i-index (mi0=1 and mi1=0 if the global index
+   !                                                                !                                             is not in the local domain)
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mj0, mj1   !: global ==> local  domain j-index (mj0=1 and mj1=0 if the global index
+   !                                                                !                                             is not in the local domain)
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nimppt, njmppt   !: i-, j-indexes for each processor
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ibonit, ibonjt   !: i-, j- processor neighbour existence
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nlcit , nlcjt    !: dimensions of every subdomain
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nldit , nldjt    !: first, last indoor index for each i-domain
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nleit , nlejt    !: first, last indoor index for each j-domain
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfiimpp, nfipproc, nfilcit
+
+   !!----------------------------------------------------------------------
+   !! horizontal curvilinear coordinate and scale factors
+   !! ---------------------------------------------------------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   glamt , glamu, glamv , glamf    !: longitude at t, u, v, f-points [degree]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   gphit , gphiu, gphiv , gphif    !: latitude  at t, u, v, f-points [degree]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1t   , e2t  , r1_e1t, r1_e2t   !: t-point horizontal scale factors    [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1u   , e2u  , r1_e1u, r1_e2u   !: horizontal scale factors at u-point [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1v   , e2v  , r1_e1v, r1_e2v   !: horizontal scale factors at v-point [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1f   , e2f  , r1_e1f, r1_e2f   !: horizontal scale factors at f-point [m]
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2t , r1_e1e2t                !: associated metrics at t-point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2u , r1_e1e2u , e2_e1u       !: associated metrics at u-point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2v , r1_e1e2v , e1_e2v       !: associated metrics at v-point
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2f , r1_e1e2f                !: associated metrics at f-point
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   ff_f  , ff_t                    !: Coriolis factor at f- & t-points  [1/s]
+
+   !! s-coordinate and hybrid z-s-coordinate
+   !! =----------------======---------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   gsigt, gsigw       !: model level depth coefficient at t-, w-levels (analytic)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   gsi3w              !: model level depth coefficient at w-level (sum of gsigw)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   esigt, esigw       !: vertical scale factor coef. at t-, w-levels
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hbatv , hbatf      !: ocean depth at the vertical of  v--f
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hbatt , hbatu      !:                                 t--u points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   scosrf, scobot     !: ocean surface and bottom topographies
+   !                                                                           !  (if deviating from coordinate surfaces in HYBRID)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hifv  , hiff       !: interface depth between stretching at v--f
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hift  , hifu       !: and quasi-uniform spacing             t--u points (m)
+!!gm end
+
+   !!----------------------------------------------------------------------
+   !! vertical coordinate and scale factors
+   !! ---------------------------------------------------------------------
+   LOGICAL, PUBLIC ::   ln_zco       !: z-coordinate - full step
+   LOGICAL, PUBLIC ::   ln_zps       !: z-coordinate - partial step
+   LOGICAL, PUBLIC ::   ln_sco       !: s-coordinate or hybrid z-s coordinate
+   LOGICAL, PUBLIC ::   ln_isfcav    !: presence of ISF 
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  e3t_0, e3u_0 , e3v_0 , e3f_0 !: t-,u-,v-,f-vert. scale factor [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  e3w_0, e3uw_0, e3vw_0        !: w-,uw-,vw-vert. scale factor [m]
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_0 !: t- depth              [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdepw_0 !: w- depth              [m]
+   !
+   INTEGER, PUBLIC ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1)
+   INTEGER, PUBLIC ::   nlb10              !: shallowest W level Bellow ~10m (nla10 + 1) 
+   !
+   !! 1D reference  vertical coordinate
+   !! =-----------------====------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   gdept_1d, gdepw_1d !: reference depth of t- and w-points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   e3t_1d  , e3w_1d   !: reference vertical scale factors at T- and W-pts (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3tp    , e3wp     !: ocean bottom level thickness at T and W points
+
+   !!----------------------------------------------------------------------
+   !! masks, top and bottom ocean point position
+   !! ---------------------------------------------------------------------
+!!gm Proposition of new name for top/bottom vertical indices
+!   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mtk_t, mtk_u, mtk_v   !: top first wet T-, U-, V-, F-level (ISF)
+!   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbk_t, mbk_u, mbk_v   !: bottom last wet T-, U- and V-level
+!!gm
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbathy             !: number of ocean level (=0, 1, ... , jpk-1)
+   REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bathy             !: number of ocean level (=0, 1, ... , jpk-1)
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbkt, mbku, mbkv   !: bottom last wet T-, U- and V-level
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_i            !: interior domain T-point mask
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_h            !: internal domain T-point mask (Figure 8.5 NEMO book)
+
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   misfdep                 !: top first ocean level             (ISF)
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mikt, miku, mikv, mikf  !: top first wet T-, U-, V-, F-level (ISF)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   risfdep                 !: Iceshelf draft                    (ISF)
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssmask, ssumask, ssvmask             !: surface mask at T-,U-, V- and F-pts
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wmask                        !: land/ocean mask at W- pts               
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: msk_opnsea  , msk_csundef                !: open ocean mask, closed sea mask (all of them)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: msk_csglo   , msk_csrnf   , msk_csemp    !: closed sea masks
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: msk_csgrpglo, msk_csgrprnf, msk_csgrpemp !: closed sea masks
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tpol, fpol          !: north fold mask (jperio= 3 or 4)
+
+   !!----------------------------------------------------------------------
+   !! calendar variables
+   !! ---------------------------------------------------------------------
+   INTEGER , PUBLIC ::   nyear         !: current year
+   INTEGER , PUBLIC ::   nmonth        !: current month
+   INTEGER , PUBLIC ::   nday          !: current day of the month
+   INTEGER , PUBLIC ::   nhour         !: current hour
+   INTEGER , PUBLIC ::   nminute       !: current minute
+   INTEGER , PUBLIC ::   ndastp        !: time step date in yyyymmdd format
+   INTEGER , PUBLIC ::   nday_year     !: current day counted from jan 1st of the current year
+   INTEGER , PUBLIC ::   nsec_year     !: current time step counted in second since 00h jan 1st of the current year
+   INTEGER , PUBLIC ::   nsec_month    !: current time step counted in second since 00h 1st day of the current month
+   INTEGER , PUBLIC ::   nsec_week     !: current time step counted in second since 00h of last monday
+   INTEGER , PUBLIC ::   nsec_day      !: current time step counted in second since 00h of the current day
+   REAL(wp), PUBLIC ::   fjulday       !: current julian day 
+   REAL(wp), PUBLIC ::   fjulstartyear !: first day of the current year in julian days
+   REAL(wp), PUBLIC ::   adatrj        !: number of elapsed days since the begining of the whole simulation
+   !                                   !: (cumulative duration of previous runs that may have used different time-step size)
+   INTEGER , PUBLIC, DIMENSION(0: 2) ::   nyear_len     !: length in days of the previous/current/next year
+   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_len    !: length in days of the months of the current year
+   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_half   !: second since Jan 1st 0h of the current year and the half of the months
+   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_end    !: second since Jan 1st 0h of the current year and the end of the months
+   INTEGER , PUBLIC                  ::   nsec1jan000   !: second since Jan 1st 0h of nit000 year and Jan 1st 0h the current year
+
+   !!----------------------------------------------------------------------
+   !! agrif domain
+   !!----------------------------------------------------------------------
+#if defined key_agrif
+   LOGICAL, PUBLIC, PARAMETER ::   lk_agrif = .TRUE.    !: agrif flag
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_agrif = .FALSE.   !: agrif flag
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: dom_oce.F90 10068 2018-08-28 14:09:04Z nicolasmartin $ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+#if ! defined key_agrif
+   !!----------------------------------------------------------------------
+   !! NOT 'key_agrif'      dummy function                     No AGRIF zoom
+   !!----------------------------------------------------------------------
+   LOGICAL FUNCTION Agrif_Root()
+      Agrif_Root = .TRUE.
+   END FUNCTION Agrif_Root
+
+   CHARACTER(len=3) FUNCTION Agrif_CFixed()
+      Agrif_CFixed = '0' 
+   END FUNCTION Agrif_CFixed
+#endif
+
+   INTEGER FUNCTION dom_oce_alloc()
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(11) :: ierr
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !
+      ALLOCATE( mig(jpi), mjg(jpj), STAT=ierr(1) )
+         !
+      ALLOCATE( mi0(jpiglo)   , mi1 (jpiglo),  mj0(jpjglo)   , mj1 (jpjglo) ,     &
+         &      tpol(jpiglo)  , fpol(jpiglo)                                , STAT=ierr(2) )
+         !
+      ALLOCATE( glamt(jpi,jpj) ,    glamu(jpi,jpj) ,  glamv(jpi,jpj) ,  glamf(jpi,jpj) ,     &
+         &      gphit(jpi,jpj) ,    gphiu(jpi,jpj) ,  gphiv(jpi,jpj) ,  gphif(jpi,jpj) ,     &
+         &       e1t (jpi,jpj) ,     e2t (jpi,jpj) , r1_e1t(jpi,jpj) , r1_e2t(jpi,jpj) ,     &
+         &       e1u (jpi,jpj) ,     e2u (jpi,jpj) , r1_e1u(jpi,jpj) , r1_e2u(jpi,jpj) ,     &
+         &       e1v (jpi,jpj) ,     e2v (jpi,jpj) , r1_e1v(jpi,jpj) , r1_e2v(jpi,jpj) ,     &
+         &       e1f (jpi,jpj) ,     e2f (jpi,jpj) , r1_e1f(jpi,jpj) , r1_e2f(jpi,jpj) ,     &
+         &      e1e2t(jpi,jpj) , r1_e1e2t(jpi,jpj)                                     ,     &
+         &      e1e2u(jpi,jpj) , r1_e1e2u(jpi,jpj) , e2_e1u(jpi,jpj)                   ,     &
+         &      e1e2v(jpi,jpj) , r1_e1e2v(jpi,jpj) , e1_e2v(jpi,jpj)                   ,     &
+         &      e1e2f(jpi,jpj) , r1_e1e2f(jpi,jpj)                                     ,     &
+         &      ff_f (jpi,jpj) ,    ff_t (jpi,jpj)                                     , STAT=ierr(3) )
+         !
+      ALLOCATE( gdept_0(jpi,jpj,jpk) , gdepw_0(jpi,jpj,jpk) , STAT=ierr(4) )
+         !
+      ALLOCATE( e3t_0 (jpi,jpj,jpk) , e3u_0 (jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0(jpi,jpj,jpk) , e3w_0(jpi,jpj,jpk) ,   &
+         &      e3uw_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) , STAT=ierr(5) )                       
+         !
+      ALLOCATE( gdept_1d(jpk) , e3tp (jpi,jpj), e3wp(jpi,jpj) ,gdepw_1d(jpk) , e3t_1d(jpk) , e3w_1d(jpk) , STAT=ierr(6) )
+         !
+      ALLOCATE( bathy(jpi,jpj),mbathy(jpi,jpj), tmask_i(jpi,jpj) , tmask_h(jpi,jpj) ,                        & 
+         &      ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) ,     &
+         &      mbkt   (jpi,jpj) , mbku   (jpi,jpj) , mbkv   (jpi,jpj) , STAT=ierr(7) )
+         !
+      ALLOCATE( misfdep(jpi,jpj) , mikt(jpi,jpj) , miku(jpi,jpj) ,     &
+         &      risfdep(jpi,jpj) , mikv(jpi,jpj) , mikf(jpi,jpj) , STAT=ierr(8) )
+         !
+      ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk) ,     & 
+         &      vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk) , wmask(jpi,jpj,jpk) , STAT=ierr(9) )
+         !
+      ALLOCATE( hbatv (jpi,jpj) , hbatf (jpi,jpj) ,     &
+         &      hbatt (jpi,jpj) , hbatu (jpi,jpj) ,     &
+         &      scosrf(jpi,jpj) , scobot(jpi,jpj) ,     &
+         &      hifv  (jpi,jpj) , hiff  (jpi,jpj) ,     &
+         &      hift  (jpi,jpj) , hifu  (jpi,jpj) , STAT=ierr(10) )
+
+      ALLOCATE( msk_opnsea  (jpi,jpj), msk_csundef (jpi,jpj),                        &
+         &      msk_csglo   (jpi,jpj), msk_csrnf   (jpi,jpj), msk_csemp   (jpi,jpj), &
+         &      msk_csgrpglo(jpi,jpj), msk_csgrprnf(jpi,jpj), msk_csgrpemp(jpi,jpj), STAT=ierr(11) )
+      !
+      dom_oce_alloc = MAXVAL(ierr)
+      !
+   END FUNCTION dom_oce_alloc
+
+   !!======================================================================
+END MODULE dom_oce
Index: /utils/tools_ticket2413/DOMAINcfg/src/domain.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/domain.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/domain.F90	(revision 12863)
@@ -0,0 +1,440 @@
+MODULE domain
+   !!==============================================================================
+   !!                       ***  MODULE domain   ***
+   !! Ocean initialization : domain initialization
+   !!==============================================================================
+   !! History :  OPA  !  1990-10  (C. Levy - G. Madec)  Original code
+   !!                 !  1992-01  (M. Imbard) insert time step initialization
+   !!                 !  1996-06  (G. Madec) generalized vertical coordinate 
+   !!                 !  1997-02  (G. Madec) creation of domwri.F
+   !!                 !  2001-05  (E.Durand - G. Madec) insert closed sea
+   !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form and module
+   !!            2.0  !  2005-11  (V. Garnier) Surface pressure gradient organization
+   !!            3.3  !  2010-11  (G. Madec)  initialisation in C1D configuration
+   !!            3.6  !  2013     ( J. Simeon, C. Calone, G. Madec, C. Ethe ) Online coarsening of outputs
+   !!            3.7  !  2015-11  (G. Madec, A. Coward)  time varying zgr by default
+   !!----------------------------------------------------------------------
+   
+   !!----------------------------------------------------------------------
+   !!   dom_init       : initialize the space and time domain
+   !!   dom_nam        : read and contral domain namelists
+   !!   dom_ctl        : control print for the ocean domain
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! domain: ocean
+   USE phycst          ! physical constants
+   USE domhgr          ! domain: set the horizontal mesh
+   USE domzgr          ! domain: set the vertical mesh
+   USE dommsk          ! domain: set the mask system
+   USE domclo          ! domain: set closed sea mask
+   !
+   USE lib_mpp         !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_init   ! called by opa.F90
+   PUBLIC   dom_nam  ! called by opa.F90
+   PUBLIC   cfg_write   ! called by opa.F90
+
+   !!-------------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: domain.F90 6140 2015-12-21 11:35:23Z timgraham $
+   !! Software governed by the CeCILL licence        (./LICENSE)
+   !!-------------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_init  ***
+      !!                    
+      !! ** Purpose :   Domain initialization. Call the routines that are 
+      !!              required to create the arrays which define the space 
+      !!              and time domain of the ocean model.
+      !!
+      !! ** Method  : - dom_msk: compute the masks from the bathymetry file
+      !!              - dom_hgr: compute or read the horizontal grid-point position
+      !!                         and scale factors, and the coriolis factor
+      !!              - dom_zgr: define the vertical coordinate and the bathymetry
+      !!              - dom_stp: defined the model time step
+      !!              - dom_wri: create the meshmask file if nmsh=1
+      !!              - 1D configuration, move Coriolis, u and v at T-point
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_init : domain initialization'
+         WRITE(numout,*) '~~~~~~~~'
+      ENDIF
+      !
+      !                       !==  Reference coordinate system  ==!
+      !
+      CALL dom_nam                  ! read namelist ( namrun, namdom )
+      !
+      CALL dom_hgr                  ! Horizontal mesh
+      !
+      CALL dom_zgr                  ! Vertical mesh and bathymetry
+      !
+      CALL dom_msk                  ! compute mask (needed by write_cfg)
+      !
+      IF ( ln_domclo ) CALL dom_clo ! Closed seas and lake
+      !
+      CALL dom_ctl                  ! print extrema of masked scale factors
+      ! 
+      CALL cfg_write                ! create the configuration file
+      !
+   END SUBROUTINE dom_init
+
+   SUBROUTINE dom_nam
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_nam  ***
+      !!                    
+      !! ** Purpose :   read domaine namelists and print the variables.
+      !!
+      !! ** input   : - namrun namelist
+      !!              - namdom namelist
+      !!              - namnc4 namelist   ! "key_netcdf4" only
+      !!----------------------------------------------------------------------
+      USE ioipsl
+      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 &
+                       nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     &
+         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     &
+         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, nn_euler  ,     &
+         &             ln_cfmeta, ln_iscpl
+      NAMELIST/namdom/ nn_bathy, cn_topo, cn_bath, cn_lon, cn_lat, nn_interp,                        &
+         &             rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin,                       &
+         &             rn_atfp , rn_rdt   , ln_crs      , jphgr_msh ,                                &
+         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m,                         &
+         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh,                  &
+         &             ppa2, ppkth2, ppacr2
+
+
+
+      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
+      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
+      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namrun )
+      !
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   Namelist namrun'
+         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
+         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
+         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta
+         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
+         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
+      ENDIF
+
+      cexper = cn_exp
+      nrstdt = nn_rstctl
+      nit000 = nn_it000
+      nitend = nn_itend
+      ndate0 = nn_date0
+      nleapy = nn_leapy
+      ninist = nn_istate
+      nstock = nn_stock
+      nstocklist = nn_stocklist
+      nwrite = nn_write
+      neuler = nn_euler
+      IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN
+         WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 '
+         CALL ctl_warn( ctmp1 )
+         neuler = 0
+      ENDIF
+
+      !                             ! control of output frequency
+      IF ( nstock == 0 .OR. nstock > nitend ) THEN
+         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
+         CALL ctl_warn( ctmp1 )
+         nstock = nitend
+      ENDIF
+      IF ( nwrite == 0 ) THEN
+         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
+         CALL ctl_warn( ctmp1 )
+         nwrite = nitend
+      ENDIF
+
+
+
+
+      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
+      CASE (  1 ) 
+         CALL ioconf_calendar('gregorian')
+         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
+      CASE (  0 )
+         CALL ioconf_calendar('noleap')
+         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
+      CASE ( 30 )
+         CALL ioconf_calendar('360d')
+         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
+      END SELECT
+
+
+
+
+      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
+      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
+903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
+  
+      !
+      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
+      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
+904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namdom )
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namdom : space & time domain'
+         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
+         IF( nn_bathy == 2 ) THEN
+            WRITE(numout,*) '      compute bathymetry from file      cn_topo      = ', cn_topo
+         ENDIF   
+         WRITE(numout,*) '      Depth (if =0 bathy=jpkm1)         rn_bathy     = ', rn_bathy
+         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
+         WRITE(numout,*) '      min number of ocean level (<0)       '
+         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
+         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
+         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
+         WRITE(numout,*) '           = 0   no file created           '
+         WRITE(numout,*) '           = 1   mesh_mask                 '
+         WRITE(numout,*) '           = 2   mesh and mask             '
+         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask'
+         WRITE(numout,*) '      type of horizontal mesh jphgr_msh           = ', jphgr_msh
+         WRITE(numout,*) '      longitude of first raw and column T-point ppglam0 = ', ppglam0
+         WRITE(numout,*) '      latitude  of first raw and column T-point ppgphi0 = ', ppgphi0
+         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_deg        = ', ppe1_deg
+         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_deg        = ', ppe2_deg
+         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_m          = ', ppe1_m
+         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_m          = ', ppe2_m
+         WRITE(numout,*) '      ORCA r4, r2 and r05 coefficients  ppsur           = ', ppsur
+         WRITE(numout,*) '                                        ppa0            = ', ppa0
+         WRITE(numout,*) '                                        ppa1            = ', ppa1
+         WRITE(numout,*) '                                        ppkth           = ', ppkth
+         WRITE(numout,*) '                                        ppacr           = ', ppacr
+         WRITE(numout,*) '      Minimum vertical spacing ppdzmin                  = ', ppdzmin
+         WRITE(numout,*) '      Maximum depth pphmax                              = ', pphmax
+         WRITE(numout,*) '      Use double tanf function for vertical coordinates ldbletanh = ', ldbletanh
+         WRITE(numout,*) '      Double tanh function parameters ppa2              = ', ppa2
+         WRITE(numout,*) '                                      ppkth2            = ', ppkth2
+         WRITE(numout,*) '                                      ppacr2            = ', ppacr2
+      ENDIF
+      !
+      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
+      e3zps_min = rn_e3zps_min
+      e3zps_rat = rn_e3zps_rat
+      nmsh      = nn_msh
+      atfp      = rn_atfp
+      rdt       = rn_rdt
+
+      snc4set%luse = .FALSE.        ! No NetCDF 4 case
+      !
+   END SUBROUTINE dom_nam
+
+
+   SUBROUTINE dom_ctl
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_ctl  ***
+      !!
+      !! ** Purpose :   Domain control.
+      !!
+      !! ** Method  :   compute and print extrema of masked scale factors
+      !!----------------------------------------------------------------------
+      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
+      INTEGER, DIMENSION(2) ::   iloc   ! 
+      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
+      !!----------------------------------------------------------------------
+      !
+      IF(lk_mpp) THEN
+         CALL mpp_minloc( 'dom_ctl', e1t(:,:), tmask_i(:,:), ze1min, iloc )
+         iimi1 = iloc(1) ; ijmi1 = iloc(2)
+         CALL mpp_minloc( 'dom_ctl', e2t(:,:), tmask_i(:,:), ze2min, iloc )
+         iimi2 = iloc(1) ; ijmi2 = iloc(2)
+         CALL mpp_maxloc( 'dom_ctl', e1t(:,:), tmask_i(:,:), ze1max, iloc )
+         iima1 = iloc(1) ; ijma1 = iloc(2)
+         CALL mpp_maxloc( 'dom_ctl', e2t(:,:), tmask_i(:,:), ze2max, iloc )
+         iima2 = iloc(1) ; ijma2 = iloc(2)
+      ELSE
+         ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )    
+         ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )    
+         ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )    
+         ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )    
+
+         iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
+         iimi1 = iloc(1) + nimpp - 1
+         ijmi1 = iloc(2) + njmpp - 1
+         iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
+         iimi2 = iloc(1) + nimpp - 1
+         ijmi2 = iloc(2) + njmpp - 1
+         iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
+         iima1 = iloc(1) + nimpp - 1
+         ijma1 = iloc(2) + njmpp - 1
+         iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
+         iima2 = iloc(1) + nimpp - 1
+         ijma2 = iloc(2) + njmpp - 1
+      ENDIF
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
+         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
+         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
+         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
+      ENDIF
+      !
+   END SUBROUTINE dom_ctl
+
+
+   SUBROUTINE cfg_write
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE cfg_write  ***
+      !!                   
+      !! ** Purpose :   Create the "domain_cfg" file, a NetCDF file which 
+      !!              contains all the ocean domain informations required to 
+      !!              define an ocean configuration.
+      !!
+      !! ** Method  :   Write in a file all the arrays required to set up an
+      !!              ocean configuration.
+      !!
+      !! ** output file :   domain_cfg.nc : domain size, characteristics,horizontal mesh,
+      !!                              Coriolis parameter, and vertical scale factors
+      !!                              NB: also contains ORCA family information (if cp_cfg = "ORCA")
+      !!                              and depths (ln_e3_dep=F) 
+      !!----------------------------------------------------------------------
+      INTEGER           ::   ji, jj, jk   ! dummy loop indices
+      INTEGER           ::   izco, izps, isco, icav
+      INTEGER           ::   inum     ! temprary units for 'domain_cfg.nc' file
+      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations)
+      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'cfg_write : create the "domain_cfg.nc" file containing all required configuration information'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
+      !
+      !                       ! ============================= !
+      !                       !  create 'domain_cfg.nc' file  !
+      !                       ! ============================= !
+      !         
+      clnam = 'domain_cfg'  ! filename (configuration information)
+      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE.)!, kiolib = jprstlib )
+      
+      !
+      !                             !==  ORCA family specificities  ==!
+      IF( cp_cfg == "ORCA" ) THEN
+         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 )
+         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( jp_cfg, wp), ktype = jp_i4 )         
+      ENDIF
+      !                             !==  global domain size  ==!
+      !
+      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 )
+      !
+      !                             !==  domain characteristics  ==!
+      !
+      !                                   ! lateral boundary of the global
+      !                                   domain
+      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
+      !
+      !                                   ! type of vertical coordinate
+      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
+      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
+      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
+      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
+      !
+      !                                   ! ocean cavities under iceshelves
+      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
+      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
+      !
+      !                             !==  horizontal mesh  !
+      !
+      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude
+      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
+      !                                
+      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude
+      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
+      !                                
+      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.)
+      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 )
+      !
+      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.)
+      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 )
+      !
+      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor
+      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
+      !
+      !                             !==  vertical mesh  ==!
+      !                                                     
+      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d  , ktype = jp_r8 )   !  reference 1D-coordinate
+      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d  , ktype = jp_r8 )
+      !
+      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0   , ktype = jp_r8 )   !  vertical scale factors (e
+      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0   , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0   , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0   , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0   , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0  , ktype = jp_r8 )
+      !
+      IF(.NOT.ln_e3_dep ) THEN                                             !  depth (t- & w-points)
+         CALL iom_rstput( 0, 0, inum, 'gdept_1d', gdept_1d, ktype = jp_r8 )   ! required only with  
+         CALL iom_rstput( 0, 0, inum, 'gdepw_1d', gdepw_1d, ktype = jp_r8 )   ! the old e3. definition
+         CALL iom_rstput( 0, 0, inum, 'gdept_0' , gdept_0 , ktype = jp_r8 )
+         CALL iom_rstput( 0, 0, inum, 'gdepw_0' , gdepw_0 , ktype = jp_r8 )
+      ENDIF
+      !                                         
+      !                             !==  ocean top and bottom level  ==!
+      !
+      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points
+      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF)
+      CALL iom_rstput( 0, 0, inum, 'isf_draft'    , risfdep , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'bathy_metry'  , bathy   , ktype = jp_r8 )
+      !
+      !                              !== closed sea ==!
+      IF (ln_domclo) THEN
+         ! mask for the open sea
+         CALL iom_rstput( 0, 0, inum, 'mask_opensea' , msk_opnsea  , ktype = jp_i4 )
+         ! mask for all the under closed sea
+         CALL iom_rstput( 0, 0, inum, 'mask_csundef' , msk_csundef , ktype = jp_i4 )
+         ! mask for global, local net precip, local net precip and evaporation correction
+         CALL iom_rstput( 0, 0, inum, 'mask_csglo'   , msk_csglo   , ktype = jp_i4 )
+         CALL iom_rstput( 0, 0, inum, 'mask_csemp'   , msk_csemp   , ktype = jp_i4 )
+         CALL iom_rstput( 0, 0, inum, 'mask_csrnf'   , msk_csrnf   , ktype = jp_i4 )
+         ! mask for the various river mouth (in case multiple lake in the same outlet)
+         CALL iom_rstput( 0, 0, inum, 'mask_csgrpglo', msk_csgrpglo, ktype = jp_i4 )
+         CALL iom_rstput( 0, 0, inum, 'mask_csgrpemp', msk_csgrpemp, ktype = jp_i4 )
+         CALL iom_rstput( 0, 0, inum, 'mask_csgrprnf', msk_csgrprnf, ktype = jp_i4 )
+      END IF
+      !
+      !                                ! ============================
+      !                                !        close the files 
+      !                                ! ============================
+      CALL iom_close( inum )
+      !
+   END SUBROUTINE cfg_write
+
+
+
+   !!======================================================================
+END MODULE domain
Index: /utils/tools_ticket2413/DOMAINcfg/src/dombat.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/dombat.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/dombat.F90	(revision 12863)
@@ -0,0 +1,243 @@
+MODULE dombat
+
+   USE dom_oce           ! ocean domain
+!   USE closea            ! closed seas
+   !
+   USE in_out_manager    ! I/O manager
+   USE iom               ! I/O library
+   USE lbclnk            ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp           ! distributed memory computing library
+   USE agrif_modutil
+   USE bilinear_interp
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_bat        ! called by dom_zgr.F90
+
+CONTAINS
+
+   SUBROUTINE dom_bat
+
+      INTEGER :: inum, isize, jsize, id, ji, jj
+      INTEGER :: tabdim1, tabdim2, nxhr, nyhr, nxyhr
+      INTEGER, DIMENSION(2) :: ddims
+      INTEGER, DIMENSION(3) :: status
+      INTEGER, DIMENSION(:,:), ALLOCATABLE :: trouble_points ,  vardep,mask_oce
+      INTEGER :: iimin,iimax,jjmin,jjmax
+      INTEGER, DIMENSION(1) :: i_min,i_max
+      INTEGER, DIMENSION(1) ::j_min,j_max
+      REAL(wp), DIMENSION(jpi,jpj) :: myglamf
+      INTEGER,DIMENSION(:)  ,POINTER     ::   src_add,dst_add => NULL()
+      REAL(wp), DIMENSION(:)  ,ALLOCATABLE ::   vardep1d, lon_new1D,lat_new1D 
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: bathy_new, lat_new, lon_new, bathy_test
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: coarselon, coarselat, coarsebathy
+      REAL(wp) :: Cell_lonmin, Cell_lonmax, Cell_latmin, Cell_latmax
+      LOGICAL :: identical_grids
+      LOGICAL, DIMENSION(:,:), ALLOCATABLE     ::   masksrc
+      REAL*8, DIMENSION(:,:),POINTER     ::   matrix,interpdata => NULL() 
+      LOGICAL :: lonlat_2D
+
+      CHARACTER(32) :: bathyfile, bathyname, lonname,latname       
+
+     lonlat_2D=.false.
+
+      bathyfile=TRIM(cn_topo)
+      bathyname=TRIM(cn_bath)
+      lonname=TRIM(cn_lon)
+      latname=TRIM(cn_lat)
+   
+      CALL iom_open( bathyfile, inum, lagrif=.FALSE. )
+      id = iom_varid( inum, bathyname, ddims )
+      
+      status=-1
+      ALLOCATE(lon_new  (ddims(1),ddims(2)), STAT=status(1)) 
+      ALLOCATE(lat_new  (ddims(1),ddims(2)), STAT=status(2)) 
+      ALLOCATE(bathy_new(ddims(1),ddims(2)), STAT=status(3)) 
+      IF( sum(status) /= 0 )   CALL ctl_stop( 'STOP', 'dom_bat : unable to allocate arrays' )
+
+      IF (lonlat_2D) THEN
+        CALL iom_get  ( inum, jpdom_unknown, lonname, lon_new )
+        CALL iom_get  ( inum, jpdom_unknown, latname, lat_new )
+      ELSE
+        ALLOCATE(lon_new1D(ddims(1)), lat_new1D(ddims(2)))
+        CALL iom_get  ( inum, jpdom_unknown, lonname, lon_new1D )
+        CALL iom_get  ( inum, jpdom_unknown, latname, lat_new1D )
+        DO ji=1, ddims(1)
+           lon_new(ji,:)=lon_new1D(ji)
+        ENDDO              
+        DO ji=1, ddims(2)
+           lat_new(:,ji)=lat_new1D(ji)
+        ENDDO              
+      ENDIF  
+      CALL iom_get  ( inum, jpdom_unknown, bathyname, bathy_new )
+      CALL iom_close (inum)
+      WHERE (bathy_new > 0.)        
+        bathy_new=0.
+      ENDWHERE 
+      bathy_new=-bathy_new 
+
+       ! Eventually add here a pre-selection of the area (coarselon/lat)
+       i_min=10  ; j_min=10
+       i_max= ddims(1)-10 ; j_max=ddims(2)-10 
+
+       tabdim1 = i_max(1) -  i_min(1) + 1 
+       tabdim2 = j_max(1) - j_min(1) + 1
+       !
+
+       ALLOCATE(coarselon(tabdim1,tabdim2))
+       ALLOCATE(coarselat(tabdim1,tabdim2))
+       ALLOCATE(coarsebathy(tabdim1,tabdim2))          
+       !
+       WHERE( lon_new < 0. )   lon_new = lon_new + 360.
+       myglamf=glamf
+       WHERE( myglamf < 0. )   myglamf = myglamf + 360.
+
+       coarselat(:,:)   =  lat_new  (i_min(1):i_max(1), j_min(1):j_max(1))
+       coarselon  (:,:) =  lon_new  (i_min(1):i_max(1), j_min(1):j_max(1))
+       coarsebathy(:,:) =  bathy_new(i_min(1):i_max(1), j_min(1):j_max(1))
+
+       IF( nn_interp == 0 .OR. nn_interp == 1 ) THEN   ! arithmetic or median averages
+        !                                                            ! ----------------------------- 
+        ALLOCATE(trouble_points(jpi,jpj))
+        trouble_points(:,:) = 0
+        !                       
+        DO jj = 2, jpj
+           DO ji = 2, jpi
+              !       
+              ! fine grid cell extension               
+              Cell_lonmin = MIN(myglamf(ji-1,jj-1),myglamf(ji,jj-1),myglamf(ji,jj),myglamf(ji-1,jj))
+              Cell_lonmax = MAX(myglamf(ji-1,jj-1),myglamf(ji,jj-1),myglamf(ji,jj),myglamf(ji-1,jj))
+              Cell_latmin = MIN(gphif(ji-1,jj-1),gphif(ji,jj-1),gphif(ji,jj),gphif(ji-1,jj))
+              Cell_latmax = MAX(gphif(ji-1,jj-1),gphif(ji,jj-1),gphif(ji,jj),gphif(ji-1,jj)) 
+              !               
+              ! look for points in G0 (bathy dataset) contained in the fine grid cells  
+              iimin = 1
+              DO WHILE( coarselon(iimin,1) < Cell_lonmin ) 
+                 iimin = iimin + 1
+              ENDDO
+              !               
+              jjmin = 1
+              DO WHILE( coarselat(iimin,jjmin) < Cell_latmin ) 
+                 jjmin = jjmin + 1
+              ENDDO
+             !                
+              iimax = iimin 
+              DO WHILE( coarselon(iimax,1) <= Cell_lonmax ) 
+                 iimax = iimax + 1
+                 iimax = MIN( iimax,SIZE(coarsebathy,1))
+              ENDDO
+              !                               
+              jjmax = jjmin 
+              DO WHILE( coarselat(iimax,jjmax) <= Cell_latmax ) 
+                 jjmax = jjmax + 1
+                 jjmax = MIN( jjmax,SIZE(coarsebathy,2))
+              ENDDO
+              !
+              IF( .NOT. Agrif_Root() ) THEN
+                 iimax = iimax-1
+                 jjmax = jjmax-1
+              ELSE
+                 iimax = MAX(iimin,iimax-1)
+                 jjmax = MAX(jjmin,jjmax-1)
+              ENDIF
+              !               
+              iimin = MAX( iimin,1 )
+              jjmin = MAX( jjmin,1 )
+              iimax = MIN( iimax,SIZE(coarsebathy,1))
+              jjmax = MIN( jjmax,SIZE(coarsebathy,2))
+
+              nxhr = iimax - iimin + 1
+              nyhr = jjmax - jjmin + 1                    
+
+                
+              IF( nxhr == 0 .OR. nyhr == 0 ) THEN
+                 !
+                 trouble_points(ji,jj) = 1
+                 !
+              ELSE
+                 !
+                 ALLOCATE( vardep(nxhr,nyhr), mask_oce(nxhr,nyhr) )
+                 vardep(:,:) = coarsebathy(iimin:iimax,jjmin:jjmax)
+                 !
+                 WHERE( vardep(:,:) .GT. 0. )   ;   mask_oce = 1 ;
+                 ELSEWHERE                      ;   mask_oce = 0 ;
+                 ENDWHERE
+                 !
+                 nxyhr = nxhr*nyhr
+                 IF( SUM(mask_oce) < 0.5*(nxyhr) ) THEN ! if more than half of the points are on land then bathy fine = 0
+                    bathy(ji,jj) = 0.
+                 ELSE
+                    IF( nn_interp == 0 ) THEN     ! Arithmetic average
+                      bathy(ji,jj) = SUM( vardep(:,:) * mask_oce(:,:) ) / SUM( mask_oce(:,:) )
+                    ELSE                                  ! Median average
+                       ALLOCATE(vardep1d(nxyhr))
+                       vardep1d = RESHAPE(vardep,(/ nxyhr /) )
+                       !!CALL ssort(vardep1d,nxyhr)
+                       CALL quicksort(vardep1d,1,nxyhr)
+                       !
+                       ! Calculate median
+                       IF (MOD(nxyhr,2) .NE. 0) THEN
+                          bathy(ji,jj) = vardep1d( nxyhr/2 + 1 )
+                       ELSE
+                          bathy(ji,jj) = 0.5 * ( vardep1d(nxyhr/2) + vardep1d(nxyhr/2+1) )
+                       END IF
+                       DEALLOCATE(vardep1d)   
+                    ENDIF
+                 ENDIF
+                 DEALLOCATE (mask_oce,vardep)
+                 !
+              ENDIF
+           ENDDO
+        ENDDO
+
+        IF( SUM( trouble_points ) > 0 ) THEN
+           PRINT*,'too much empty cells, proceed to bilinear interpolation'
+           nn_interp = 2
+           stop
+        ENDIF           
+     ENDIF
+
+#undef MYTEST
+#ifdef MYTEST
+         IF( nn_interp == 2) THEN                        ! Bilinear interpolation
+        !                                                    ! ----------------------------- 
+        identical_grids = .FALSE.
+
+        IF( SIZE(coarselat,1) == jpi .AND. SIZE(coarselat,2) == jpj  .AND.   &
+            SIZE(coarselon,1) == jpj .AND. SIZE(coarselon,2) == jpj ) THEN
+           IF( MAXVAL( ABS(coarselat(:,:)- gphit(:,:)) ) < 0.0001 .AND.   &
+               MAXVAL( ABS(coarselon(:,:)- glamt(:,:)) ) < 0.0001 ) THEN
+              PRINT*,'same grid between ', cn_topo,' and child domain'    
+              bathy = bathy_new
+              identical_grids = .TRUE.                          
+           ENDIF
+        ENDIF
+
+        IF( .NOT. identical_grids ) THEN 
+
+           ALLOCATE(masksrc(SIZE(bathy_new,1),SIZE(bathy_new,2)))
+           ALLOCATE(bathy_test(jpi,jpj))
+           !
+           !Where(G0%bathy_meter.le.0.00001) 
+           !  masksrc = .false.
+           !ElseWhere
+              masksrc = .TRUE.
+           !End where                       
+           !            
+           ! compute remapping matrix thanks to SCRIP package            
+           CALL get_remap_matrix(coarselat,gphit,coarselon,glamt,masksrc,matrix,src_add,dst_add)
+           CALL make_remap(bathy_new,bathy_test,jpi,jpj,matrix,src_add,dst_add)  
+           !                                  
+           bathy = bathy_test               
+           !            
+           DEALLOCATE(masksrc)
+           DEALLOCATE(bathy_test) 
+
+        ENDIF
+        !            
+     ENDIF
+#endif 
+   END SUBROUTINE dom_bat
+
+END MODULE dombat
Index: /utils/tools_ticket2413/DOMAINcfg/src/dombat_util.f90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/dombat_util.f90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/dombat_util.f90	(revision 12863)
@@ -0,0 +1,472 @@
+!
+MODULE agrif_modutil
+  !
+CONTAINS
+  !
+  !************************************************************************
+  ! 									*
+  ! MODULE  AGRIF_MODUTIL							*
+  !									*
+  ! module containing subroutine used for : 				*
+  !   - unrolling 2D arrays to 1D arrays (required for SCRIP package use)	*
+  !   - convert 1D arrays to 2D arrays (required for SCRIP package use)	*
+  !   - remapping process (use SCRIP remapping matrix)			*
+  !									*
+  !************************************************************************
+  ! 
+  !***********************************************************    
+  SUBROUTINE ssort (x, nb)
+    !***********************************************************
+    !
+    IMPLICIT NONE
+
+    INTEGER :: nb
+    REAL*8, DIMENSION(:) :: x
+    REAL*8 :: temp
+    INTEGER ji,jj,jmax,itemp
+    !      
+    jmax=nb-1
+    !
+    !
+    DO ji=1,nb-1
+       temp=HUGE(1)
+
+       DO jj=1,jmax
+
+          IF(X(jj).LE.X(jj+1)) THEN 
+             temp=X(jj)
+             X(jj)=X(jj+1)
+             X(jj+1)=temp
+          ENDIF
+
+       ENDDO
+
+       IF(temp.EQ.HUGE(1)) RETURN
+       jmax=jmax-1
+    ENDDO
+
+    RETURN
+  END SUBROUTINE ssort
+  !
+  !***********************************************************
+  !                    --- quicksort ---
+  ! Author: t-nissie
+  ! License: GPLv3
+  ! Gist: https://gist.github.com/t-nissie/479f0f16966925fa29ea
+  !***********************************************************
+  RECURSIVE SUBROUTINE quicksort(var, first, last)
+     IMPLICIT NONE
+
+     REAL*8, DIMENSION(:), INTENT(inout) :: var
+     INTEGER,              INTENT(in)    :: first, last
+     REAL*8  :: x, t
+     INTEGER :: ji, jj
+     
+     x = var( (first+last) / 2 )
+     ji = first
+     jj = last
+     DO
+        DO WHILE (var(ji) < x)
+           ji=ji+1
+        END DO
+        DO WHILE (x < var(jj))
+           jj=jj-1
+        END DO
+        IF (ji >= jj) EXIT
+        t = var(ji);  var(ji) = var(jj);  var(jj) = t
+        ji=ji+1
+        jj=jj-1
+     END DO
+     IF (first < ji-1) CALL quicksort(var, first, ji-1)
+     IF (jj+1 < last)  CALL quicksort(var, jj+1, last)
+  END SUBROUTINE quicksort
+  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE 1Dto2D
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE tab1Dto2D(tab1D,tab2D,nx,ny)
+    !
+    IMPLICIT NONE   
+    !
+    REAL*8,DIMENSION(:) :: tab1D
+    REAL*8,DIMENSION(:,:) :: tab2D
+    !          
+    INTEGER :: xpos,ypos
+    INTEGER :: nx,ny   
+    INTEGER :: i      
+    !      
+    xpos=0
+    ypos=1
+    !      
+    DO i=1,nx*ny
+       xpos=xpos+1
+       IF(xpos.GT.nx) THEN
+          xpos=1
+          ypos=ypos+1
+       ENDIF
+       tab2D(ypos,xpos)=tab1D(i)
+    END DO
+    !
+  END SUBROUTINE tab1Dto2D
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE tab2Dto1D
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE tab2Dto1D(tab2D,tab1D)
+    !
+    IMPLICIT NONE 
+    !       
+    REAL*8,DIMENSION(:,:) :: tab2D
+    REAL*8,DIMENSION(:) :: tab1D
+    !          
+    INTEGER :: xpos,ypos
+    INTEGER :: nx,ny
+    INTEGER :: i
+    !
+    nx = SIZE(tab2D,2)
+    ny = SIZE(tab2D,1)
+    !      
+    xpos = 0
+    ypos = 1
+    DO i = 1,nx*ny
+       xpos = xpos + 1
+       IF(xpos.GT.nx) THEN
+          xpos = 1
+          ypos = ypos + 1
+       END IF
+       tab1D(i) = tab2D(ypos,xpos)
+    END DO
+    !
+  END SUBROUTINE tab2Dto1D
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE tab2Dto1D logical
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE logtab2Dto1D(tab2D,tab1D)
+    !
+    IMPLICIT NONE 
+    !       
+    LOGICAL,DIMENSION(:,:) :: tab2D
+    LOGICAL,DIMENSION(:) :: tab1D
+    !          
+    INTEGER :: xpos,ypos
+    INTEGER :: nx,ny
+    INTEGER :: i
+    !
+    nx = SIZE(tab2D,2)
+    ny = SIZE(tab2D,1)
+    !      
+    xpos = 0
+    ypos = 1
+    DO i = 1,nx*ny
+       xpos = xpos + 1
+       IF(xpos.GT.nx) THEN
+          xpos = 1
+          ypos = ypos + 1
+       END IF
+       tab1D(i) = tab2D(ypos,xpos)
+    END DO
+    !
+  END SUBROUTINE logtab2Dto1D
+  !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE 1Dto2D
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE logtab1Dto2D(tab1D,tab2D,nx,ny)
+    !
+    IMPLICIT NONE   
+    !
+    LOGICAL,DIMENSION(:) :: tab1D
+    LOGICAL,DIMENSION(:,:) :: tab2D
+    !          
+    INTEGER :: xpos,ypos
+    INTEGER :: nx,ny   
+    INTEGER :: i      
+    !      
+    xpos=0
+    ypos=1
+    !      
+    DO i=1,nx*ny
+       xpos=xpos+1
+       IF(xpos.GT.nx) THEN
+          xpos=1
+          ypos=ypos+1
+       ENDIF
+       tab2D(ypos,xpos)=tab1D(i)
+    END DO
+    !
+  END SUBROUTINE logtab1Dto2D
+
+  !**************************************************************
+  !   subroutine make_remap
+  !**************************************************************            
+  !
+  SUBROUTINE make_remap(tabin,tabout,nxfin,nyfin,matrix,src_add,dst_add) 
+    !      
+    IMPLICIT NONE
+    !      
+    REAL*8, DIMENSION(:,:)  :: tabin 
+    REAL*8, DIMENSION(:,:) :: tabout 
+    REAL*8, POINTER, DIMENSION(:,:) :: tabtemp    
+    INTEGER,DIMENSION(:) :: src_add,dst_add
+    INTEGER :: nxfin,nyfin      
+    REAL*8, POINTER, DIMENSION(:) :: var1D,var_interp1D
+    REAL*8,DIMENSION(:,:) :: matrix 
+    INTEGER :: num_links,i
+    ! 
+    ALLOCATE(var1D(SIZE(tabin,1)*SIZE(tabin,2)))     
+    CALL tab2Dto1D(tabin,var1D)
+    !      
+    ALLOCATE(var_interp1D(nxfin*nyfin))
+    var_interp1D = 0.0
+    num_links = SIZE(dst_add)
+    !
+    DO i = 1,num_links
+       var_interp1D(dst_add(i)) = var_interp1D(dst_add(i)) &
+            + matrix(1,i)*var1D(src_add(i))
+    END DO
+    !
+    ALLOCATE(tabtemp(SIZE(tabout,1),SIZE(tabout,2)))
+    !
+    CALL tab1Dto2D(var_interp1D,tabtemp,nyfin,nxfin)
+    !
+    tabout = tabtemp
+    !
+    DEALLOCATE(var_interp1D,var1D,tabtemp)  
+    ! 
+  END SUBROUTINE make_remap
+  !          
+  !
+  !**************************************************************
+  !   end subroutine make_remap
+  !**************************************************************          
+  !
+  !
+  !**************************************************************
+  !   subroutine make_bicubic_remap
+  !**************************************************************            
+  !
+  SUBROUTINE make_bicubic_remap(tabin,masksrc,tabout,nxfin,nyfin,matrix,src_add,dst_add) 
+    !      
+    IMPLICIT NONE
+    !      
+    REAL*8, DIMENSION(:,:)  :: tabin
+    LOGICAL, DIMENSION(:,:)  :: masksrc
+    LOGICAL, POINTER, DIMENSION(:)  :: grid1_mask
+    REAL*8, DIMENSION(:,:) :: tabout     
+    INTEGER,DIMENSION(:) :: src_add,dst_add
+    INTEGER :: nxfin,nyfin      
+    REAL*8, POINTER, DIMENSION(:) :: var1D,var_interp1D,gradi,gradj,gradij,deriv1,deriv2
+    REAL*8,DIMENSION(:,:) :: matrix 
+    INTEGER :: num_links,i,j,nx,ny,n,ip1,im1,jp1,jm1
+    INTEGER :: in_x,is,ie,iw,ine,inw,ise,isw
+    REAL*8 :: delew,delns
+    !
+    nx = SIZE(tabin,1)
+    ny = SIZE(tabin,2)
+    ALLOCATE(gradi(nx*ny),gradj(nx*ny),gradij(nx*ny),deriv1(nx*ny),deriv2(nx*ny))
+    ALLOCATE(var1D(nx*ny),grid1_mask(nx*ny))
+    !           
+    CALL tab2Dto1D(tabin,var1D)
+    CALL logtab2Dto1D(masksrc,grid1_mask)     
+    !
+    gradi  = 0.0
+    gradj  = 0.0
+    gradij = 0.0
+    !
+    DO n = 1,nx*ny
+
+       IF( grid1_mask(n) ) THEN                        
+          !                     
+          delew = 0.5      
+          delns = 0.5
+
+          j = (n-1)/ny + 1
+          i = n - (j-1)*ny
+          !
+          ip1 = i+1
+          im1 = i-1
+          jp1 = j+1
+          jm1 = j-1      
+          !
+          IF (ip1 > ny) ip1 = ip1 - ny
+
+          IF (im1 < 1 ) im1 = ny
+
+          IF (jp1 > nx) THEN
+             jp1 = j
+             delns = 1.
+          ENDIF
+
+          IF (jm1 < 1 ) THEN
+             jm1 = j
+             delns = 1.
+          ENDIF
+          !
+          in_x  = (jp1-1)*ny + i
+          is  = (jm1-1)*ny + i
+          ie  = (j  -1)*ny + ip1
+          iw  = (j  -1)*ny + im1
+          !
+          ine = (jp1-1)*ny + ip1
+          inw = (jp1-1)*ny + im1
+          ise = (jm1-1)*ny + ip1
+          isw = (jm1-1)*ny + im1
+          !
+          !*** compute i-gradient
+
+          IF (.NOT. grid1_mask(ie)) THEN
+             ie = n
+             delew = 1.
+          ENDIF
+          !            
+          IF (.NOT. grid1_mask(iw)) THEN
+             iw = n
+             delew = 1.
+          ENDIF
+          !
+          gradi(n) = delew*(var1D(ie) - var1D(iw))
+          !
+          !*** compute j-gradient
+
+          IF (.NOT. grid1_mask(in_x)) THEN
+             in_x = n
+             delns = 1.
+          ENDIF
+          !                      
+          IF (.NOT. grid1_mask(is)) THEN
+             is = n
+             delns = 1.
+          ENDIF
+          !
+          gradj(n) = delns*(var1D(in_x) - var1D(is))                    
+          !
+          !*** compute ij-gradient
+
+          delew = 0.5
+
+          IF (jp1 == j .OR. jm1 == j) THEN
+             delns = 1.
+          ELSE 
+             delns = 0.5
+          ENDIF
+          !
+          IF (.NOT. grid1_mask(ine)) THEN
+             IF (in_x /= n) THEN
+                ine = in_x
+                delew = 1.
+             ELSE IF (ie /= n) THEN
+                ine = ie
+                inw = iw
+                IF (inw == n) delew = 1.
+                delns = 1.
+             ELSE
+                ine = n
+                inw = iw
+                delew = 1
+                delns = 1
+             ENDIF
+          ENDIF
+          !
+          IF (.NOT. grid1_mask(inw)) THEN
+             IF (in_x /= n) THEN
+                inw = in_x
+                delew = 1.
+             ELSE IF (iw /= n) THEN
+                inw = iw
+                ine = ie
+                IF (ie == n) delew = 1.
+                delns = 1.
+             ELSE
+                inw = n
+                ine = ie
+                delew = 1.
+                delns = 1.
+             ENDIF
+          ENDIF
+          !
+          deriv1(n) = delew*(var1D(ine)-var1D(inw))                    
+          !
+          IF (.NOT. grid1_mask(ise)) THEN
+             IF (is /= n) THEN
+                ise = is
+                delew = 1.
+             ELSE IF (ie /= n) THEN
+                ise = ie
+                isw = iw
+                IF (isw == n) delew = 1.
+                delns = 1.
+             ELSE
+                ise = n
+                isw = iw
+                delew = 1.
+                delns = 1.
+             ENDIF
+          ENDIF
+          !
+          IF (.NOT. grid1_mask(isw)) THEN
+             IF (is /= n) THEN
+                isw = is
+                delew = 1.
+             ELSE IF (iw /= n) THEN
+                isw = iw
+                ise = ie
+                IF (ie == n) delew = 1.
+                delns = 1.
+             ELSE
+                isw = n
+                ise = ie
+                delew = 1.
+                delns = 1.
+             ENDIF
+          ENDIF
+
+          deriv2(n) = delew*(var1D(ise) - var1D(isw))
+          gradij(n) = delns*(deriv1(n) - deriv2(n))
+       ENDIF
+    END DO
+    !
+    DEALLOCATE(deriv1,deriv2,grid1_mask)
+
+    !       
+    ALLOCATE(var_interp1D(nxfin*nyfin))
+    var_interp1D = 0.0
+    num_links = SIZE(dst_add)
+    !      
+    DO i = 1,num_links
+       !        
+       var_interp1D(dst_add(i)) = var_interp1D(dst_add(i))        +      &
+            matrix(1,i)*var1D(src_add(i))   +      &
+            matrix(2,i)*gradi(src_add(i))   +      &
+            matrix(3,i)*gradj(src_add(i))   +      & 
+            matrix(4,i)*gradij(src_add(i))
+    END DO
+    !
+    DEALLOCATE(gradi,gradj,gradij,var1D)
+    !
+    CALL tab1Dto2D(var_interp1D,tabout,nyfin,nxfin)
+    !      
+    DEALLOCATE(var_interp1D)       
+    ! 
+  END SUBROUTINE make_bicubic_remap
+  !          
+  !
+  !**************************************************************
+  !   end subroutine make_bicubic_remap
+  !**************************************************************          
+  !
+  !
+END MODULE agrif_modutil
Index: /utils/tools_ticket2413/DOMAINcfg/src/domcfg.f90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/domcfg.f90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/domcfg.f90	(revision 12863)
@@ -0,0 +1,126 @@
+MODULE domcfg
+   !!==============================================================================
+   !!                       ***  MODULE domcfg   ***
+   !! Ocean initialization : domain configuration initialization
+   !!==============================================================================
+   !! History :  1.0  ! 2003-09  (G. Madec)  Original code
+   !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_cfg        : initialize the domain configuration
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distributed memory computing library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_cfg    ! called by opa.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
+   !! $Id: domcfg.F90 6140 2015-12-21 11:35:23Z timgraham $ 
+   !! Software governed by the CeCILL licence     (./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_cfg
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_cfg  ***
+      !!                    
+      !! ** Purpose :   set the domain configuration
+      !!
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN                   ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_cfg : set the ocean configuration'
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   ocean model configuration used :   cp_cfg = ', cp_cfg, ' jp_cfg = ', jp_cfg
+         !
+         WRITE(numout,*) '   global domain lateral boundaries'
+         !
+         IF( jperio == 0 )   WRITE(numout,*) '      jperio= 0, closed'
+         IF( jperio == 1 )   WRITE(numout,*) '      jperio= 1, cyclic east-west'
+         IF( jperio == 2 )   WRITE(numout,*) '      jperio= 2, equatorial symmetric'
+         IF( jperio == 3 )   WRITE(numout,*) '      jperio= 3, north fold with T-point pivot'
+         IF( jperio == 4 )   WRITE(numout,*) '      jperio= 4, cyclic east-west and north fold with T-point pivot'
+         IF( jperio == 5 )   WRITE(numout,*) '      jperio= 5, north fold with F-point pivot'
+         IF( jperio == 6 )   WRITE(numout,*) '      jperio= 6, cyclic east-west and north fold with F-point pivot'
+      ENDIF
+      !
+      IF( jperio <  0 .OR. jperio > 6 )   CALL ctl_stop( 'jperio is out of range' )
+      !
+      CALL dom_glo                   ! global domain versus zoom and/or local domain
+      !
+   END SUBROUTINE dom_cfg
+
+   SUBROUTINE dom_glo
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_glo  ***
+      !!
+      !! ** Purpose :   initialization of global domain <--> local domain indices
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  : - mig , mjg : local  domain indices ==> global domain indices
+      !!              - mi0 , mi1 : global domain indices ==> local  domain indices
+      !!              - mj0,, mj1   (global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj   ! dummy loop argument
+      !!----------------------------------------------------------------------
+      !
+      DO ji = 1, jpi                 ! local domain indices ==> global domain indices
+        mig(ji) = ji + nimpp - 1
+      END DO
+      DO jj = 1, jpj
+        mjg(jj) = jj + njmpp - 1
+      END DO
+      !                              ! global domain indices ==> local domain indices
+      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the 
+      !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain. 
+      DO ji = 1, jpiglo
+        mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) )
+        mi1(ji) = MAX( 0 , MIN( ji - nimpp + 1, jpi   ) )
+      END DO
+      DO jj = 1, jpjglo
+        mj0(jj) = MAX( 1 , MIN( jj - njmpp + 1, jpj+1 ) )
+        mj1(jj) = MAX( 0 , MIN( jj - njmpp + 1, jpj   ) )
+      END DO
+      IF(lwp) THEN                   ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_glo : domain: global <<==>> local '
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   global domain:   jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo
+         WRITE(numout,*) '   local  domain:   jpi    = ', jpi   , ' jpj    = ', jpj   , ' jpk    = ', jpk
+         WRITE(numout,*)
+         WRITE(numout,*) '   conversion from local to global domain indices (and vise versa) done'
+         IF( nn_print >= 1 ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) '          conversion local  ==> global i-index domain (mig)'
+            WRITE(numout,25)              (mig(ji),ji = 1,jpi)
+            WRITE(numout,*)
+            WRITE(numout,*) '          conversion global ==> local  i-index domain'
+            WRITE(numout,*) '             starting index (mi0)'
+            WRITE(numout,25)              (mi0(ji),ji = 1,jpiglo)
+            WRITE(numout,*) '             ending index (mi1)'
+            WRITE(numout,25)              (mi1(ji),ji = 1,jpiglo)
+            WRITE(numout,*)
+            WRITE(numout,*) '          conversion local  ==> global j-index domain (mjg)'
+            WRITE(numout,25)              (mjg(jj),jj = 1,jpj)
+            WRITE(numout,*)
+            WRITE(numout,*) '          conversion global ==> local  j-index domain'
+            WRITE(numout,*) '             starting index (mj0)'
+            WRITE(numout,25)              (mj0(jj),jj = 1,jpjglo)
+            WRITE(numout,*) '             ending index (mj1)'
+            WRITE(numout,25)              (mj1(jj),jj = 1,jpjglo)
+         ENDIF
+      ENDIF
+ 25   FORMAT( 100(10x,19i4,/) )
+      !
+   END SUBROUTINE dom_glo
+   !!======================================================================
+END MODULE domcfg
Index: /utils/tools_ticket2413/DOMAINcfg/src/domclo.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/domclo.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/domclo.F90	(revision 12863)
@@ -0,0 +1,329 @@
+MODULE domclo
+   !!======================================================================
+   !!                       ***  MODULE  domclo  ***
+   !! domclo : definition of closed sea mask needed by NEMO
+   !!======================================================================
+   !! History : NEMO 4.0 ! 07-2019 (P. Mathiot) original version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   dom_clo    : definition of closed sea mask needed by NEMO
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE domngb          ! closest point algorithm
+   USE phycst          ! rpi, rad, ra
+   USE domutil         ! flood filling algorithm (fill_pool)
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! lateral boundary condition - MPP exchanges
+   USE lib_mpp
+   USE lib_fortran
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC dom_clo      ! routine called by domain module
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: closea.F90 7213 2016-11-09 09:07:42Z timgraham $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_clo
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_clo  ***
+      !!        
+      !! ** Purpose :   Closed sea mask definition
+      !!
+      !! ** Method  :   A flood filling algorithm is used to detect lake and open ocean
+      !!                Namelist provide seed for each lake and condition on how to
+      !!                manage net evap/runoff.
+      !!
+      !! ** Action  :  - compute open ocean mask 
+      !!               - loop over all the lake in namelist 
+      !!               - define lake msk (msk_csglo/emp/rnf)
+      !!               - define river mouth mask for each lake or group of lake with the same river mouth
+      !!                 (msk_csgrpglo/emp/rnf) 
+      !!               
+      !!----------------------------------------------------------------------
+
+      TYPE closea 
+         CHARACTER(256) :: cname                       ! name
+         REAL(wp)       :: rlonsrc                     ! seed src location (lon)
+         REAL(wp)       :: rlatsrc                     ! seed src location (lat)
+         REAL(wp)       :: rlontrg                     ! seed trg location (lon)
+         REAL(wp)       :: rlattrg                     ! seed trg location (lat)
+         CHARACTER(256) :: cloctrg                     ! where water is spread
+         CHARACTER(256) :: cschtrg                     ! how   water is spread
+         REAL(wp)       :: radtrg                      ! radius of closed sea river mouth (used if cschtrg is rnf or emp)
+         INTEGER        :: idtrg                       ! target id in case multiple lakes for the same river mouth
+      END TYPE
+         
+      INTEGER, PARAMETER :: jp_closea = 98 ! number maximal of closea
+      INTEGER :: ji, jj, jcs, jsch  ! loop indexes
+      INTEGER :: jglo, jemp, jrnf   ! closed sea indexes for global, emp, rnf spreading
+      INTEGER :: jiseed, jjseed     ! seed indexes
+      INTEGER :: jloc, jcoast       ! counter
+      INTEGER :: ios
+      INTEGER :: nn_closea          ! number of closed seas
+
+      REAL(wp) :: zdistseed                         ! distance to seed
+      REAL(wp) :: zarea                             ! river mouth area
+      REAL(wp) :: rn_lon_opnsea, rn_lat_opnsea      ! open sea seed
+      REAL(wp), DIMENSION(1)       :: zchk, zradtrg !
+      REAL(wp), DIMENSION(jpi,jpj) :: zdist         ! distance to seed trg location
+      REAL(wp), DIMENSION(jpi,jpj) :: zmsksrc, zmsktrg, zmsk_coastline ! various mask
+
+      CHARACTER(256) :: csch, cloc                       ! scheme name for water spreading (glo, rnf, emp)
+      TYPE(closea)  , DIMENSION(jp_closea)   :: sn_lake  ! lake properties
+
+      LOGICAL :: lskip     ! flag in case lake seed on land or already filled (...)
+
+      !!----------------------------------------------------------------------
+      !! 0 : Read namelist for closed sea definition
+      !!----------------------------------------------------------------------
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*)'dom_clo : closed seas '
+      IF(lwp) WRITE(numout,*)'~~~~~~~'
+
+      NAMELIST/namclo/ rn_lon_opnsea, rn_lat_opnsea, nn_closea, sn_lake
+      !!---------------------------------------------------------------------
+      
+      REWIND( numnam_ref )              ! Namelist namlbc in reference namelist : Lateral momentum boundary condition
+      READ  ( numnam_ref, namclo, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namclo in reference namelist', lwp )
+      REWIND( numnam_cfg )              ! Namelist namlbc in configuration namelist : Lateral momentum boundary condition
+      READ  ( numnam_cfg, namclo, IOSTAT = ios, ERR = 902 )
+902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namclo in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namclo )
+
+      !!----------------------------------------------------------------------
+      !! 1 : Define open ocean and closed sea masks
+      !!----------------------------------------------------------------------
+
+      !! 1.1 get closest point to the lat/lon seed
+      msk_opnsea(:,:) = ssmask(:,:)
+      CALL dom_ngb(rn_lon_opnsea, rn_lat_opnsea, jiseed, jjseed, zdistseed, 'T')
+
+      !! 1.2 fill connected cell to -1
+      CALL fill_pool( jiseed, jjseed, msk_opnsea, -1._wp )
+
+      !! sanity check on the msk value (closea mask should be 99 otherwise, lake already processed)
+      !! check if some lake are not connected
+      zchk = 0._wp
+      IF (mi0(jiseed) == mi1(jiseed) .AND. mj0(jjseed) == mj1(jjseed)) zchk = ssmask(mi0(jiseed),mj0(jjseed))
+      CALL mpp_max('domclo',zchk)
+      IF (zchk(1) == 0._wp) CALL ctl_stop( 'STOP', 'open sea seed is on land, please update namelist (rn_lon_opnsea,rn_lat_opnsea)' ) 
+
+      !! print
+      IF (lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)'open ocean: '
+         WRITE(numout,'(a,2f7.2)')'    lon/lat seed to detect main ocean is: ', rn_lon_opnsea, rn_lat_opnsea
+         WRITE(numout,'(a,2i7)'  )'    i/j     seed to detect main ocean is: ', jiseed, jjseed
+         WRITE(numout,'(a,f8.0)' )'    distance (m) between namelist seed location and model seed location: ', zdistseed
+         WRITE(numout,*)
+      END IF
+      
+      !! 1.3 set to 0 everything >0 and revert mask
+      WHERE (msk_opnsea(:,:) > 0._wp) msk_opnsea(:,:) = 0._wp ! mask all closed seas
+      WHERE (msk_opnsea(:,:) < 0._wp) msk_opnsea(:,:) = 1._wp ! restore mask value
+
+      !! 1.4 Define closed sea mask (all of them, ie defined in the namelist or not)
+      !! needed to remove the undefined closed seas at the end
+      msk_csundef(:,:) = ( ssmask(:,:) - msk_opnsea(:,:) ) * 99._wp
+
+      !!----------------------------------------------------------------------
+      !! 2 : compute closed sea mask for global, rnf and emp cases
+      !!----------------------------------------------------------------------
+
+      !! 2.1 : initialisation of masks and lake indexes
+      jglo = 1 ; jrnf = 1 ; jemp = 1
+      !! mask used to group lake by net evap/precip distribution technics
+      msk_csglo(:,:) = msk_csundef(:,:)
+      msk_csrnf(:,:) = msk_csundef(:,:)
+      msk_csemp(:,:) = msk_csundef(:,:)
+
+      !! mask used to define group of lake sharing the same river mouth
+      msk_csgrpglo(:,:) = 0.0_wp
+      msk_csgrprnf(:,:) = 0.0_wp
+      msk_csgrpemp(:,:) = 0.0_wp
+
+      IF (lwp) WRITE(numout,*)'closed seas: '
+ 
+      DO jcs = 1,nn_closea
+
+         !! how the excess of the closed seas is spread out:
+         cloc = sn_lake(jcs)%cloctrg
+         csch = sn_lake(jcs)%cschtrg
+
+         !! set up indexes and mask
+         SELECT CASE (csch)
+         CASE('glo')
+            jsch = jglo
+            zmsksrc(:,:) = msk_csglo(:,:)
+            zmsktrg(:,:) = msk_csgrpglo(:,:)
+         CASE('rnf') 
+            jsch = jrnf
+            zmsksrc(:,:) = msk_csrnf(:,:)
+            zmsktrg(:,:) = msk_csgrprnf(:,:)
+         CASE('emp')
+            jsch = jemp 
+            zmsksrc(:,:) = msk_csemp(:,:)
+            zmsktrg(:,:) = msk_csgrpemp(:,:)
+         CASE DEFAULT
+            CALL ctl_stop( 'STOP', 'domclo: ',TRIM(csch),' is an unknown target type for lake (should be glo, emp, rnf)' )
+         END SELECT
+
+         !! 2.2 : print out and sanity check
+         !! flag changed in sanity checks
+         lskip = .FALSE.
+
+         !! define seed to extract the closed sea jcs
+         CALL dom_ngb(sn_lake(jcs)%rlonsrc, sn_lake(jcs)%rlatsrc, jiseed, jjseed, zdistseed, 'T')
+
+         !! sanity check on the msk value (closea mask should be 99 otherwise, lake already processed)
+         !! check if seed on land or lake already processed
+         zchk = 0._wp
+         IF (mi0(jiseed) == mi1(jiseed) .AND. mj0(jjseed) == mj1(jjseed)) zchk = msk_csundef(mi0(jiseed),mj0(jjseed))
+         CALL mpp_max('domclo',zchk)
+         
+         IF (zchk(1) /= 99._wp) THEN
+            IF (lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*)'W A R N I N G: lake ',TRIM(sn_lake(jcs)%cname),' already processed or seed on land, we skip it.'
+               WRITE(numout,*)'It is possible this lake is connected to another one already processed.'
+               WRITE(numout,*)'It is possible the seed is on land because the lake is not present in the bathymetry file'
+               WRITE(numout,*)'If concerned about it, check input file and namelist definition of this lake.'
+            END IF
+            lskip = .TRUE.
+         END IF
+ 
+         !! 2.3 : compute mask for global, rnf, emp case
+         IF (.NOT. lskip) THEN
+
+            IF (lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,'(a,a10,a,2f7.2,a,2i6,a,f7.2,a)')                               &
+                    &         '    processing lake ',TRIM(sn_lake(jcs)%cname)               &
+                    &        ,' ( lat/lon : ',sn_lake(jcs)%rlatsrc, sn_lake(jcs)%rlonsrc    &
+                    &        ,' , i/j     : ',jiseed,jjseed                                 &
+                    &        ,' , distance to seed : ',zdistseed,'m )'
+            END IF
+
+            !! fill close sea mask with counter value
+            !! and update undefined closed sea mask
+            CALL fill_pool( jiseed, jjseed, zmsksrc, REAL(jsch  ,8))
+            WHERE (zmsksrc(:,:) == REAL(jsch,8))
+               msk_csundef = 0._wp
+               zmsktrg    = sn_lake(jcs)%idtrg
+            END WHERE
+
+            !! compute location of river mouth and distance to river mouth
+            IF (cloc /= 'global') THEN
+
+               !! set value for radius of the river influence
+               zradtrg = 0._wp
+               IF (mi0(jiseed) == mi1(jiseed) .AND. mj0(jjseed) == mj1(jjseed)) THEN
+                  zradtrg(1) = MAX( sn_lake(jcs)%radtrg, e1t( mi0(jiseed), mj0(jjseed) ), e2t( mi0(jiseed), mj0(jjseed) ) )
+               END IF
+               CALL mpp_max('domclo',zradtrg)
+              
+               !! compute seed location for print 
+               CALL dom_ngb(sn_lake(jcs)%rlontrg, sn_lake(jcs)%rlattrg, jiseed, jjseed, zdistseed, 'T')
+
+               !! compute distance to river mouth
+               zdist(:,:) = dist(sn_lake(jcs)%rlontrg, sn_lake(jcs)%rlattrg, glamt, gphit)
+
+            END IF
+
+            !! define estuary
+            !! deal with global/local/coastal cases
+            SELECT CASE (cloc)
+            CASE ('global')
+               WHERE (msk_opnsea(:,:) == 1._wp) zmsktrg = sn_lake(jcs)%idtrg
+
+            CASE ('local')
+               !! compute mask
+               WHERE (zdist(:,:) < zradtrg(1) .AND. msk_opnsea(:,:) == 1 ) zmsktrg = sn_lake(jcs)%idtrg
+
+               !! print
+               IF (lwp) WRITE(numout,'(a,f7.0,a,2f7.2,a,2i7,a,f7.0,a)')                                            &
+                             &         '         river mouth area is defined by         points within ',zradtrg(1) &
+                             &        ,' m of lat/lon ', sn_lake(jcs)%rlontrg, sn_lake(jcs)%rlattrg                &
+                             &        ,' (closest wet point is i/j ',jiseed, jjseed,' at ',zdistseed,' m )'
+            CASE ('coast')
+               !! define coastline mask
+               zmsk_coastline = 0._wp
+               DO jj=2,jpj-1
+                  DO ji=2,jpi-1
+                     IF ( ssmask(ji,jj) == 1._wp .AND. SUM(ssmask(ji-1:ji+1,jj-1:jj+1)) < 9 ) zmsk_coastline(ji,jj) = 1._wp
+                  END DO
+               END DO
+               CALL lbc_lnk('domclo', zmsk_coastline,'T',1._wp)
+   
+               !! compute mask
+               WHERE ( zdist(:,:) < zradtrg(1) .AND. zmsk_coastline(:,:) == 1 .AND. msk_opnsea(:,:) == 1 ) zmsktrg = sn_lake(jcs)%idtrg
+
+               !! print
+               IF (lwp) WRITE(numout,'(a,f7.0,a,2f7.2,a,2i7,a,f7.0,a)')                                            &
+                             &         '         river mouth area is defined by coastal points within ',zradtrg(1) &
+                             &        ,' m of lat/lon ', sn_lake(jcs)%rlontrg, sn_lake(jcs)%rlattrg                &
+                             &        ,' (closest wet point is i/j ',jiseed, jjseed,' at ',zdistseed,' m )'
+
+            CASE DEFAULT
+               CALL ctl_stop( 'STOP', 'domclo: unknown target type for lake (should be global, coast or local)' )
+
+            END SELECT
+   
+            !! sanity check
+            zarea = glob_sum('domclo',zmsktrg * msk_opnsea)
+            IF (zarea == 0._wp) CALL ctl_stop( 'STOP', 'river mouth area is 0, tune lon/lat trg or radtrg for this lake') 
+            !
+            zarea = glob_sum('domclo',zmsksrc * msk_opnsea)
+            IF (zarea > 0._wp) CALL ctl_stop( 'STOP', 'closed seas and open ocean have common points, '                           &
+               &                                    , 'tune lon/lat src or check if your lake is really closed on the model grid')
+
+            !! set up indexes and mask 
+            SELECT CASE (csch)
+            CASE ('glo')
+               jglo = jglo + 1
+               msk_csglo(:,:)    = zmsksrc(:,:)
+               msk_csgrpglo(:,:) = zmsktrg(:,:)
+               IF (lwp) WRITE(numout,*)'        net evap/precip will be spread globally (glo)'
+            CASE ('rnf')
+               jrnf = jrnf + 1
+               msk_csrnf(:,:)    = zmsksrc(:,:)
+               msk_csgrprnf(:,:) = zmsktrg(:,:)
+               IF (lwp) WRITE(numout,*)'        net precip will be spread locally and net evap globally (rnf)'
+            CASE ('emp')
+               jemp = jemp + 1
+               msk_csemp(:,:)    = zmsksrc(:,:)
+               msk_csgrpemp(:,:) = zmsktrg(:,:)
+               IF (lwp) WRITE(numout,*)'        net evap/precip will be spread locally (emp)'
+            END SELECT
+
+         END IF ! lskip
+
+      END DO ! nn_closea
+
+      !!----------------------------------------------------------------------
+      !! 3 : clean the masks of possible remaining undefined closed seas
+      !!----------------------------------------------------------------------
+
+      !! mask all the cells not defined as closed sea
+      WHERE ( msk_csglo(:,:) == 99._wp )  msk_csglo = 0._wp
+      WHERE ( msk_csrnf(:,:) == 99._wp )  msk_csrnf = 0._wp
+      WHERE ( msk_csemp(:,:) == 99._wp )  msk_csemp = 0._wp
+
+      !!  non defined closed sea
+      WHERE ( msk_csundef(:,:) > 0._wp ) msk_csundef = 1._wp
+
+   END SUBROUTINE dom_clo
+
+   !!======================================================================
+
+END MODULE domclo
+
Index: /utils/tools_ticket2413/DOMAINcfg/src/domhgr.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/domhgr.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/domhgr.F90	(revision 12863)
@@ -0,0 +1,501 @@
+MODULE domhgr
+   !!==============================================================================
+   !!                       ***  MODULE domhgr   ***
+   !! Ocean initialization : domain initialization
+   !!==============================================================================
+   !! History :  OPA  ! 1988-03  (G. Madec) Original code
+   !!            7.0  ! 1996-01  (G. Madec)  terrain following coordinates
+   !!            8.0  ! 1997-02  (G. Madec)  print mesh informations
+   !!            8.1  ! 1999-11  (M. Imbard) NetCDF format with IO-IPSL
+   !!            8.2  ! 2000-08  (D. Ludicone) Reduced section at Bab el Mandeb
+   !!             -   ! 2001-09  (M. Levy)  eel config: grid in km, beta-plane
+   !!  NEMO      1.0  ! 2002-08  (G. Madec)  F90: Free form and module, namelist
+   !!             -   ! 2004-01  (A.M. Treguier, J.M. Molines) Case 4 (Mercator mesh)
+   !!                            use of parameters in par_CONFIG-Rxx.h90, not in namelist
+   !!             -   ! 2004-05  (A. Koch-Larrouy) Add Gyre configuration 
+   !!            3.7  ! 2015-09  (G. Madec, S. Flavoni) add cell surface and their inverse
+   !!                                       add optional read of e1e2u & e1e2v
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_hgr       : initialize the horizontal mesh 
+   !!   hgr_read      : read "coordinate" NetCDF file 
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE domwri         ! write 'meshmask.nc' & 'coordinate_e1e2u_v.nc' files
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   REAL(wp) ::   glam0, gphi0   ! variables corresponding to parameters ppglam0 ppgphi0 set in par_oce
+
+   PUBLIC   dom_hgr   ! called by domain.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id: domhgr.F90 6140 2015-12-21 11:35:23Z timgraham $ 
+   !! Software governed by the CeCILL licence     (./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_hgr
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_hgr  ***
+      !!
+      !! ** Purpose :   Compute the geographical position (in degre) of the 
+      !!      model grid-points,  the horizontal scale factors (in meters) and 
+      !!      the Coriolis factor (in s-1).
+      !!
+      !! ** Method  :   The geographical position of the model grid-points is
+      !!      defined from analytical functions, fslam and fsphi, the deriva-
+      !!      tives of which gives the horizontal scale factors e1,e2.
+      !!      Defining two function fslam and fsphi and their derivatives in 
+      !!      the two horizontal directions (fse1 and fse2), the model grid-
+      !!      point position and scale factors are given by:
+      !!         t-point:
+      !!      glamt(i,j) = fslam(i    ,j    )   e1t(i,j) = fse1(i    ,j    )
+      !!      gphit(i,j) = fsphi(i    ,j    )   e2t(i,j) = fse2(i    ,j    )
+      !!         u-point:
+      !!      glamu(i,j) = fslam(i+1/2,j    )   e1u(i,j) = fse1(i+1/2,j    )
+      !!      gphiu(i,j) = fsphi(i+1/2,j    )   e2u(i,j) = fse2(i+1/2,j    )
+      !!         v-point:
+      !!      glamv(i,j) = fslam(i    ,j+1/2)   e1v(i,j) = fse1(i    ,j+1/2)
+      !!      gphiv(i,j) = fsphi(i    ,j+1/2)   e2v(i,j) = fse2(i    ,j+1/2)
+      !!            f-point:
+      !!      glamf(i,j) = fslam(i+1/2,j+1/2)   e1f(i,j) = fse1(i+1/2,j+1/2)
+      !!      gphif(i,j) = fsphi(i+1/2,j+1/2)   e2f(i,j) = fse2(i+1/2,j+1/2)
+      !!      Where fse1 and fse2 are defined by:
+      !!         fse1(i,j) = ra * rad * SQRT( (cos(phi) di(fslam))**2
+      !!                                     +          di(fsphi) **2 )(i,j)
+      !!         fse2(i,j) = ra * rad * SQRT( (cos(phi) dj(fslam))**2
+      !!                                     +          dj(fsphi) **2 )(i,j)
+      !!
+      !!        The coriolis factor is given at z-point by:
+      !!                     ff = 2.*omega*sin(gphif)      (in s-1)
+      !!
+      !!        This routine is given as an example, it must be modified
+      !!      following the user s desiderata. nevertheless, the output as
+      !!      well as the way to compute the model grid-point position and
+      !!      horizontal scale factors must be respected in order to insure
+      !!      second order accuracy schemes.
+      !!
+      !! N.B. If the domain is periodic, verify that scale factors are also
+      !!      periodic, and the coriolis term again.
+      !!
+      !! ** Action  : - define  glamt, glamu, glamv, glamf: longitude of t-, 
+      !!                u-, v- and f-points (in degre)
+      !!              - define  gphit, gphiu, gphiv, gphit: latitude  of t-,
+      !!               u-, v-  and f-points (in degre)
+      !!        define e1t, e2t, e1u, e2u, e1v, e2v, e1f, e2f: horizontal
+      !!      scale factors (in meters) at t-, u-, v-, and f-points.
+      !!        define ff: coriolis factor at f-point
+      !!
+      !! References :   Marti, Madec and Delecluse, 1992, JGR
+      !!                Madec, Imbard, 1996, Clim. Dyn.
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj               ! dummy loop indices
+      INTEGER  ::   ii0, ii1, ij0, ij1   ! temporary integers
+      INTEGER  ::   ijeq                 ! index of equator T point (used in case 4)
+      REAL(wp) ::   zti, zui, zvi, zfi   ! local scalars
+      REAL(wp) ::   ztj, zuj, zvj, zfj   !   -      -
+      REAL(wp) ::   zphi0, zbeta, znorme !
+      REAL(wp) ::   zarg, zf0, zminff, zmaxff
+      REAL(wp) ::   zlam1, zcos_alpha, zim1 , zjm1 , ze1, ze1deg
+      REAL(wp) ::   zphi1, zsin_alpha, zim05, zjm05
+      INTEGER  ::   isrow                ! index for ORCA1 starting row
+      INTEGER  ::   ie1e2u_v             ! fag for u- & v-surface read in coordinate file or not
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_hgr : define the horizontal mesh from ithe following par_oce parameters '
+         WRITE(numout,*) '~~~~~~~      type of horizontal mesh           jphgr_msh = ', jphgr_msh
+         WRITE(numout,*) '             position of the first row and     ppglam0  = ', ppglam0
+         WRITE(numout,*) '             column grid-point (degrees)       ppgphi0  = ', ppgphi0
+         WRITE(numout,*) '             zonal      grid-spacing (degrees) ppe1_deg = ', ppe1_deg
+         WRITE(numout,*) '             meridional grid-spacing (degrees) ppe2_deg = ', ppe2_deg
+         WRITE(numout,*) '             zonal      grid-spacing (meters)  ppe1_m   = ', ppe1_m  
+         WRITE(numout,*) '             meridional grid-spacing (meters)  ppe2_m   = ', ppe2_m  
+      ENDIF
+      !
+      !
+      SELECT CASE( jphgr_msh )   !  type of horizontal mesh  
+      !
+      CASE ( 0 )                     !==  read in coordinate.nc file  ==!
+         !
+#if defined key_agrif
+         IF (agrif_root()) THEN
+#endif
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          curvilinear coordinate on the sphere read in "coordinate" file'
+         !
+         ie1e2u_v = 0                  ! set to unread e1e2u and e1e2v
+         !
+         CALL hgr_read( ie1e2u_v )     ! read the coordinate.nc file
+         !
+         IF( ie1e2u_v == 0 ) THEN      ! e1e2u and e1e2v have not been read: compute them
+            !                          ! e2u and e1v does not include a reduction in some strait: apply reduction
+            e1e2u (:,:) = e1u(:,:) * e2u(:,:)   
+            e1e2v (:,:) = e1v(:,:) * e2v(:,:) 
+         ENDIF
+#if defined key_agrif
+         ELSE
+           CALL Agrif_InitValues_cont()
+         ENDIF
+#endif
+         !
+      CASE ( 1 )                     !==  geographical mesh on the sphere with regular (in degree) grid-spacing  ==!
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          geographical mesh on the sphere with regular grid-spacing'
+         IF(lwp) WRITE(numout,*) '          given by ppe1_deg and ppe2_deg' 
+         !
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zti = REAL( ji - 1 + nimpp - 1 )         ;   ztj = REAL( jj - 1 + njmpp - 1 )
+               zui = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = REAL( jj - 1 + njmpp - 1 )
+               zvi = REAL( ji - 1 + nimpp - 1 )         ;   zvj = REAL( jj - 1 + njmpp - 1 ) + 0.5
+               zfi = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = REAL( jj - 1 + njmpp - 1 ) + 0.5
+         ! Longitude
+               glamt(ji,jj) = ppglam0 + ppe1_deg * zti
+               glamu(ji,jj) = ppglam0 + ppe1_deg * zui
+               glamv(ji,jj) = ppglam0 + ppe1_deg * zvi
+               glamf(ji,jj) = ppglam0 + ppe1_deg * zfi
+         ! Latitude
+               gphit(ji,jj) = ppgphi0 + ppe2_deg * ztj
+               gphiu(ji,jj) = ppgphi0 + ppe2_deg * zuj
+               gphiv(ji,jj) = ppgphi0 + ppe2_deg * zvj
+               gphif(ji,jj) = ppgphi0 + ppe2_deg * zfj
+         ! e1
+               e1t(ji,jj) = ra * rad * COS( rad * gphit(ji,jj) ) * ppe1_deg
+               e1u(ji,jj) = ra * rad * COS( rad * gphiu(ji,jj) ) * ppe1_deg
+               e1v(ji,jj) = ra * rad * COS( rad * gphiv(ji,jj) ) * ppe1_deg
+               e1f(ji,jj) = ra * rad * COS( rad * gphif(ji,jj) ) * ppe1_deg
+         ! e2
+               e2t(ji,jj) = ra * rad * ppe2_deg
+               e2u(ji,jj) = ra * rad * ppe2_deg
+               e2v(ji,jj) = ra * rad * ppe2_deg
+               e2f(ji,jj) = ra * rad * ppe2_deg
+            END DO
+         END DO
+         !
+      CASE ( 2:3 )                   !==  f- or beta-plane with regular grid-spacing  ==!
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          f- or beta-plane with regular grid-spacing'
+         IF(lwp) WRITE(numout,*) '          given by ppe1_m and ppe2_m' 
+         !
+         ! Position coordinates (in kilometers)
+         !                          ==========
+         glam0 = 0._wp
+         gphi0 = - ppe2_m * 1.e-3
+         !
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               glamt(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( REAL( ji - 1 + nimpp - 1 )       )
+               glamu(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( REAL( ji - 1 + nimpp - 1 ) + 0.5 )
+               glamv(ji,jj) = glamt(ji,jj)
+               glamf(ji,jj) = glamu(ji,jj)
+               !
+               gphit(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( REAL( jj - 1 + njmpp - 1 )       )
+               gphiu(ji,jj) = gphit(ji,jj)
+               gphiv(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( REAL( jj - 1 + njmpp - 1 ) + 0.5 )
+               gphif(ji,jj) = gphiv(ji,jj)
+            END DO
+         END DO
+         !
+         ! Horizontal scale factors (in meters)
+         !                              ======
+         e1t(:,:) = ppe1_m      ;      e2t(:,:) = ppe2_m
+         e1u(:,:) = ppe1_m      ;      e2u(:,:) = ppe2_m
+         e1v(:,:) = ppe1_m      ;      e2v(:,:) = ppe2_m
+         e1f(:,:) = ppe1_m      ;      e2f(:,:) = ppe2_m
+         !
+      CASE ( 4 )                     !==  geographical mesh on the sphere, isotropic MERCATOR type  ==!
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          geographical mesh on the sphere, MERCATOR type'
+         IF(lwp) WRITE(numout,*) '          longitudinal/latitudinal spacing given by ppe1_deg'
+         IF ( ppgphi0 == -90 ) CALL ctl_stop( ' Mercator grid cannot start at south pole !!!! ' )
+         !
+         !  Find index corresponding to the equator, given the grid spacing e1_deg
+         !  and the (approximate) southern latitude ppgphi0.
+         !  This way we ensure that the equator is at a "T / U" point, when in the domain.
+         !  The formula should work even if the equator is outside the domain.
+         zarg = rpi / 4. - rpi / 180. * ppgphi0 / 2.
+         ijeq = ABS( 180./rpi * LOG( COS( zarg ) / SIN( zarg ) ) / ppe1_deg )
+         IF(  ppgphi0 > 0 )  ijeq = -ijeq
+         !
+         IF(lwp) WRITE(numout,*) '          Index of the equator on the MERCATOR grid:', ijeq
+         !
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zti = REAL( ji - 1 + nimpp - 1 )         ;   ztj = REAL( jj - ijeq + njmpp - 1 )
+               zui = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = REAL( jj - ijeq + njmpp - 1 )
+               zvi = REAL( ji - 1 + nimpp - 1 )         ;   zvj = REAL( jj - ijeq + njmpp - 1 ) + 0.5
+               zfi = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = REAL( jj - ijeq + njmpp - 1 ) + 0.5
+         ! Longitude
+               glamt(ji,jj) = ppglam0 + ppe1_deg * zti
+               glamu(ji,jj) = ppglam0 + ppe1_deg * zui
+               glamv(ji,jj) = ppglam0 + ppe1_deg * zvi
+               glamf(ji,jj) = ppglam0 + ppe1_deg * zfi
+         ! Latitude
+               gphit(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* ztj ) )
+               gphiu(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* zuj ) )
+               gphiv(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* zvj ) )
+               gphif(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* zfj ) )
+         ! e1
+               e1t(ji,jj) = ra * rad * COS( rad * gphit(ji,jj) ) * ppe1_deg
+               e1u(ji,jj) = ra * rad * COS( rad * gphiu(ji,jj) ) * ppe1_deg
+               e1v(ji,jj) = ra * rad * COS( rad * gphiv(ji,jj) ) * ppe1_deg
+               e1f(ji,jj) = ra * rad * COS( rad * gphif(ji,jj) ) * ppe1_deg
+         ! e2
+               e2t(ji,jj) = ra * rad * COS( rad * gphit(ji,jj) ) * ppe1_deg
+               e2u(ji,jj) = ra * rad * COS( rad * gphiu(ji,jj) ) * ppe1_deg
+               e2v(ji,jj) = ra * rad * COS( rad * gphiv(ji,jj) ) * ppe1_deg
+               e2f(ji,jj) = ra * rad * COS( rad * gphif(ji,jj) ) * ppe1_deg
+            END DO
+         END DO
+         !
+      CASE ( 5 )                   !==  beta-plane with regular grid-spacing and rotated domain ==! (GYRE configuration)
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          beta-plane with regular grid-spacing and rotated domain (GYRE configuration)'
+         IF(lwp) WRITE(numout,*) '          given by ppe1_m and ppe2_m'
+         !
+         ! Position coordinates (in kilometers)
+         !                          ==========
+         !
+         ! angle 45deg and ze1=106.e+3 / jp_cfg forced -> zlam1 = -85deg, zphi1 = 29degN
+         zlam1 = -85._wp
+         zphi1 =  29._wp
+         ! resolution in meters
+         ze1 = 106000. / REAL( jp_cfg , wp )            
+         ! benchmark: forced the resolution to be about 100 km
+       !  IF( nbench /= 0 )   ze1 = 106000._wp     
+         zsin_alpha = - SQRT( 2._wp ) * 0.5_wp
+         zcos_alpha =   SQRT( 2._wp ) * 0.5_wp
+         ze1deg = ze1 / (ra * rad)
+       !  IF( nbench /= 0 )   ze1deg = ze1deg / REAL( jp_cfg , wp )   ! benchmark: keep the lat/+lon
+         !                                                           ! at the right jp_cfg resolution
+         glam0 = zlam1 + zcos_alpha * ze1deg * REAL( jpjglo-2 , wp )
+         gphi0 = zphi1 + zsin_alpha * ze1deg * REAL( jpjglo-2 , wp )
+         !
+         IF( nprint==1 .AND. lwp )   THEN
+            WRITE(numout,*) '          ze1', ze1, 'cosalpha', zcos_alpha, 'sinalpha', zsin_alpha
+            WRITE(numout,*) '          ze1deg', ze1deg, 'glam0', glam0, 'gphi0', gphi0
+         ENDIF
+         !
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zim1 = REAL( ji + nimpp - 1 ) - 1.   ;   zim05 = REAL( ji + nimpp - 1 ) - 1.5
+               zjm1 = REAL( jj + njmpp - 1 ) - 1.   ;   zjm05 = REAL( jj + njmpp - 1 ) - 1.5
+               !
+               glamf(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha
+               gphif(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha
+               !
+               glamt(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
+               gphit(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
+               !
+               glamu(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
+               gphiu(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
+               !
+               glamv(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha
+               gphiv(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha
+            END DO
+         END DO
+         !
+         ! Horizontal scale factors (in meters)
+         !                              ======
+         e1t(:,:) =  ze1     ;      e2t(:,:) = ze1
+         e1u(:,:) =  ze1     ;      e2u(:,:) = ze1
+         e1v(:,:) =  ze1     ;      e2v(:,:) = ze1
+         e1f(:,:) =  ze1     ;      e2f(:,:) = ze1
+         !
+      CASE DEFAULT
+         WRITE(ctmp1,*) '          bad flag value for jphgr_msh = ', jphgr_msh
+         CALL ctl_stop( ctmp1 )
+         !
+      END SELECT
+      
+      ! associated horizontal metrics
+      ! -----------------------------
+      !
+      r1_e1t(:,:) = 1._wp / e1t(:,:)   ;   r1_e2t (:,:) = 1._wp / e2t(:,:)
+      r1_e1u(:,:) = 1._wp / e1u(:,:)   ;   r1_e2u (:,:) = 1._wp / e2u(:,:)
+      r1_e1v(:,:) = 1._wp / e1v(:,:)   ;   r1_e2v (:,:) = 1._wp / e2v(:,:)
+      r1_e1f(:,:) = 1._wp / e1f(:,:)   ;   r1_e2f (:,:) = 1._wp / e2f(:,:)
+      !
+      e1e2t (:,:) = e1t(:,:) * e2t(:,:)   ;   r1_e1e2t(:,:) = 1._wp / e1e2t(:,:)
+      e1e2f (:,:) = e1f(:,:) * e2f(:,:)   ;   r1_e1e2f(:,:) = 1._wp / e1e2f(:,:)
+      IF( jphgr_msh /= 0 ) THEN               ! e1e2u and e1e2v have not been set: compute them
+         e1e2u (:,:) = e1u(:,:) * e2u(:,:)   
+         e1e2v (:,:) = e1v(:,:) * e2v(:,:) 
+      ENDIF
+      r1_e1e2u(:,:) = 1._wp / e1e2u(:,:)     ! compute their invert in both cases
+      r1_e1e2v(:,:) = 1._wp / e1e2v(:,:)
+      !   
+      e2_e1u(:,:) = e2u(:,:) / e1u(:,:)
+      e1_e2v(:,:) = e1v(:,:) / e2v(:,:)
+
+      IF( lwp .AND. nn_print >=1 .AND. .NOT.ln_rstart ) THEN      ! Control print : Grid informations (if not restart)
+         WRITE(numout,*)
+         WRITE(numout,*) '          longitude and e1 scale factors'
+         WRITE(numout,*) '          ------------------------------'
+         WRITE(numout,9300) ( ji, glamt(ji,1), glamu(ji,1),   &
+            glamv(ji,1), glamf(ji,1),   &
+            e1t(ji,1), e1u(ji,1),   &
+            e1v(ji,1), e1f(ji,1), ji = 1, jpi,10)
+9300     FORMAT( 1x, i4, f8.2,1x, f8.2,1x, f8.2,1x, f8.2, 1x,    &
+            f19.10, 1x, f19.10, 1x, f19.10, 1x, f19.10 )
+            !
+         WRITE(numout,*)
+         WRITE(numout,*) '          latitude and e2 scale factors'
+         WRITE(numout,*) '          -----------------------------'
+         WRITE(numout,9300) ( jj, gphit(1,jj), gphiu(1,jj),   &
+            &                     gphiv(1,jj), gphif(1,jj),   &
+            &                     e2t  (1,jj), e2u  (1,jj),   &
+            &                     e2v  (1,jj), e2f  (1,jj), jj = 1, jpj, 10 )
+      ENDIF
+
+
+      ! ================= !
+      !  Coriolis factor  !
+      ! ================= !
+
+      SELECT CASE( jphgr_msh )   ! type of horizontal mesh
+      !
+      CASE ( 0, 1, 4 )               ! mesh on the sphere
+         !
+         ff_f(:,:) = 2. * omega * SIN( rad * gphif(:,:) ) 
+         ff_t(:,:) = 2. * omega * SIN( rad * gphit(:,:) )     !    -        -       - at t-point
+         !
+      CASE ( 2 )                     ! f-plane at ppgphi0 
+         !
+         ff_f(:,:) = 2. * omega * SIN( rad * ppgphi0 )
+         ff_t(:,:) = 2. * omega * SIN( rad * ppgphi0 )
+         !
+         IF(lwp) WRITE(numout,*) '          f-plane: Coriolis parameter = constant = ', ff_f(1,1)
+         !
+      CASE ( 3 )                     ! beta-plane
+         !
+         zbeta   = 2. * omega * COS( rad * ppgphi0 ) / ra                       ! beta at latitude ppgphi0
+         zphi0   = ppgphi0 - REAL( jpjglo/2) * ppe2_m / ( ra * rad )           ! latitude of the first row F-points
+         !
+         zf0     = 2. * omega * SIN( rad * zphi0 )                              ! compute f0 1st point south
+         !
+         ff_f(:,:) = ( zf0  + zbeta * gphif(:,:) * 1.e+3 )                        ! f = f0 +beta* y ( y=0 at south)
+         ff_t(:,:) = ( zf0  + zbeta * gphit(:,:) * 1.e+3 )                        ! f = f0 +beta* y ( y=0 at south)
+         !
+         IF(lwp) THEN
+            WRITE(numout,*) 
+            WRITE(numout,*) '          Beta-plane: Beta parameter = constant = ', ff_f(nldi,nldj)
+            WRITE(numout,*) '          Coriolis parameter varies from ', ff_f(nldi,nldj),' to ', ff_f(nldi,nlej)
+         ENDIF
+         IF( lk_mpp ) THEN 
+            zminff=ff_f(nldi,nldj)
+            zmaxff=ff_f(nldi,nlej)
+            CALL mpp_min( 'toto',zminff )   ! min over the global domain
+            CALL mpp_max( 'toto',zmaxff )   ! max over the global domain
+            IF(lwp) WRITE(numout,*) '          Coriolis parameter varies globally from ', zminff,' to ', zmaxff
+         END IF
+         !
+      CASE ( 5 )                     ! beta-plane and rotated domain (gyre configuration)
+         !
+         zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra                     ! beta at latitude ppgphi0
+         zphi0 = 15._wp                                                     ! latitude of the first row F-points
+         zf0   = 2. * omega * SIN( rad * zphi0 )                            ! compute f0 1st point south
+         !
+         ff_f(:,:) = ( zf0 + zbeta * ABS( gphif(:,:) - zphi0 ) * rad * ra )   ! f = f0 +beta* y ( y=0 at south)
+         ff_t(:,:) = ( zf0 + zbeta * ABS( gphit(:,:) - zphi0 ) * rad * ra )   ! f = f0 +beta* y ( y=0 at south)
+         !
+         IF(lwp) THEN
+            WRITE(numout,*) 
+            WRITE(numout,*) '          Beta-plane and rotated domain : '
+            WRITE(numout,*) '          Coriolis parameter varies in this processor from ', ff_f(nldi,nldj),' to ', ff_f(nldi,nlej)
+         ENDIF
+         !
+         IF( lk_mpp ) THEN 
+            zminff=ff_f(nldi,nldj)
+            zmaxff=ff_f(nldi,nlej)
+            CALL mpp_min('toto', zminff )   ! min over the global domain
+            CALL mpp_max( 'toto',zmaxff )   ! max over the global domain
+            IF(lwp) WRITE(numout,*) '          Coriolis parameter varies globally from ', zminff,' to ', zmaxff
+         END IF
+         !
+      END SELECT
+
+
+      ! Control of domain for symetrical condition
+      ! ------------------------------------------
+      ! The equator line must be the latitude coordinate axe
+! (PM) be carefull with nperio/jperio 
+      IF( jperio == 2 ) THEN
+         znorme = SQRT( SUM( gphiu(:,2) * gphiu(:,2) ) ) / REAL( jpi )
+         IF( znorme > 1.e-13 ) CALL ctl_stop( ' ===>>>> : symmetrical condition: rerun with good equator line' )
+      ENDIF
+      !
+   END SUBROUTINE dom_hgr
+
+
+   SUBROUTINE hgr_read( ke1e2u_v )
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE hgr_read  ***
+      !!
+      !! ** Purpose :   Read a coordinate file in NetCDF format using IOM
+      !!
+      !!----------------------------------------------------------------------
+      USE iom
+      !!
+      INTEGER, INTENT( inout ) ::   ke1e2u_v   ! fag: e1e2u & e1e2v read in coordinate file (=1) or not (=0)
+      !
+      INTEGER ::   inum   ! temporary logical unit
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'hgr_read : read the horizontal coordinates'
+         WRITE(numout,*) '~~~~~~~~      jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpk = ', jpk
+      ENDIF
+      !
+      CALL iom_open( 'coordinates', inum )
+      !
+      CALL iom_get( inum, jpdom_data, 'glamt', glamt, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'glamu', glamu, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'glamv', glamv, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'glamf', glamf, lrowattr=ln_use_jattr )
+      !
+      CALL iom_get( inum, jpdom_data, 'gphit', gphit, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'gphiu', gphiu, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'gphiv', gphiv, lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'gphif', gphif, lrowattr=ln_use_jattr )
+      !
+      CALL iom_get( inum, jpdom_data, 'e1t'  , e1t  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e1u'  , e1u  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e1v'  , e1v  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e1f'  , e1f  , lrowattr=ln_use_jattr )
+      !
+      CALL iom_get( inum, jpdom_data, 'e2t'  , e2t  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e2u'  , e2u  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e2v'  , e2v  , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_data, 'e2f'  , e2f  , lrowattr=ln_use_jattr )
+      !
+      IF( iom_varid( inum, 'e1e2u', ldstop = .FALSE. ) > 0 ) THEN
+         IF(lwp) WRITE(numout,*) 'hgr_read : e1e2u & e1e2v read in coordinates file'
+         CALL iom_get( inum, jpdom_data, 'e1e2u'  , e1e2u  , lrowattr=ln_use_jattr )
+         CALL iom_get( inum, jpdom_data, 'e1e2v'  , e1e2v  , lrowattr=ln_use_jattr )
+         ke1e2u_v = 1
+      ELSE
+         ke1e2u_v = 0
+      ENDIF
+      !
+      CALL iom_close( inum )
+      
+    END SUBROUTINE hgr_read
+    
+   !!======================================================================
+END MODULE domhgr
Index: /utils/tools_ticket2413/DOMAINcfg/src/domisf.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/domisf.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/domisf.F90	(revision 12863)
@@ -0,0 +1,568 @@
+MODULE domisf
+   !!==============================================================================
+   !!                       ***  MODULE domisf   ***
+   !! Ocean domain : 
+   !!==============================================================================
+   !! History :  4.1  ! 2019-07  (P. Mathiot) re-write of the geometry definition under ice shelf
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   zgr_isf_nam    : read ice shelf namelist; print and compatibility option check
+   !!   zgr_isf_zspace : check compatibility between bathymetry and ice shelf draft and adjust ice shelf draft if needed (z space) 
+   !!   zgr_isf_kspace : adjust ice shelf draft and compute top level to fit 2 cell in the water column (k space) 
+   !!   zgr_isf        : compute top partial cell scale factor
+   !!   zgr_isf_e3uv_w : correct e3uw and e3vw in case of 2 cell in water column under an ice shelf
+   !!---------------------------------------------------------------------
+   USE dom_oce
+   USE domutil           ! flood filling algorithm
+   USE domngb            ! find nearest neighbourg
+   USE in_out_manager    ! I/O manager
+   USE lbclnk            ! lbclnk and lbclnk_multi
+   USE lib_mpp           ! 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   zgr_isf_nam    !: read domisf namelist
+   PUBLIC   zgr_isf_zspace !: check compatibility ice shelf draft/bathymetry and dig ice shelf draft if needed
+   PUBLIC   zgr_isf_kspace !: compute misfdep and dig ice shelf draft if needed
+   PUBLIC   zps_isf        !: compute zps scale factor
+   PUBLIC   zps_isf_e3uv_w !: compute e3uw and e3vw in case of 2 cell in water column
+   PUBLIC   zgr_isf_subgl
+
+   INTEGER          :: nn_kisfmax    = 999              !: maximal number of level change allowed by ln_isfconnect option 
+   REAL(wp), PUBLIC :: rn_isfdep_min = 10.0_wp          !: ice shelf minimal thickness 
+   REAL(wp), PUBLIC :: rn_glhw_min   = 1.0e-3           !: threshold on hw to define grounding line water
+   REAL(wp), PUBLIC :: rn_isfhw_min  = 1.0e-3           !: threshold on hw to define isf draft into the cavity
+   REAL(wp), PUBLIC :: rn_isfshallow = 0.0_wp           !: threshold to define shallow ice shelf cavity
+   REAL(wp), PUBLIC :: rn_zisfmax    = 6000.0_wp        !: maximun meter of ice we are allowed to dig to assure connectivity
+   REAL(wp), PUBLIC :: rn_isfsubgllon, rn_isfsubgllat   !: seed for the detection of the 3d open ocean
+   LOGICAL , PUBLIC :: ln_isfcheminey= .FALSE.          !: remove cheminey
+   LOGICAL , PUBLIC :: ln_isfconnect = .FALSE.          !: assure connectivity 
+   LOGICAL , PUBLIC :: ln_isfchannel = .FALSE.          !: remove channel in water column (on z space not level space)
+   LOGICAL , PUBLIC :: ln_isfsubgl   = .FALSE.          !: remove subglacial lakes
+
+CONTAINS
+
+   SUBROUTINE zgr_isf_nam
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zps_isf  ***
+      !!   
+      !! ** Purpose :   Read namzgr_isf namelist and 
+      !!                check compatibility with other option
+      !!   
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER  :: ios, ierr 
+      !!---------------------------------------------------------------------
+      NAMELIST/namzgr_isf/nn_kisfmax, rn_zisfmax, rn_isfdep_min, rn_glhw_min, rn_isfhw_min, &
+         &                ln_isfcheminey, ln_isfconnect, ln_isfchannel, ln_isfsubgl, rn_isfsubgllon, rn_isfsubgllat
+      !
+      ! 0.0 read namelist
+      REWIND( numnam_ref )              ! Namelist namzgr_isf in reference namelist : ice shelf geometry definition
+      READ  ( numnam_ref, namzgr_isf, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr_isf in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namzgr_sco in configuration namelist : ice shelf geometry definition
+      READ  ( numnam_cfg, namzgr_isf, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr_isf in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namzgr_isf )
+      !
+      IF (lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' dom_isf : '
+         WRITE(numout,*) ' ~~~~~~~   '
+         WRITE(numout,*) ' nn_kisfmax       = ',nn_kisfmax           !
+         WRITE(numout,*) ' rn_zisfmax       = ',rn_zisfmax           !
+         WRITE(numout,*) ' rn_isfdep_min    = ',rn_isfdep_min        !
+         WRITE(numout,*) ' rn_isfhw_min     = ',rn_isfhw_min         !
+         WRITE(numout,*) ' rn_glhw_min      = ',rn_glhw_min          !
+         WRITE(numout,*) ' ln_isfcheminey   = ',ln_isfcheminey       !
+         WRITE(numout,*) ' ln_isfconnect    = ',ln_isfconnect        !
+         WRITE(numout,*) ' ln_isfchannel    = ',ln_isfchannel        !
+      END IF
+      !
+      ! 0.1 compatibility option
+      ierr = 0
+      IF ( ln_zco .OR. ln_sco ) ierr = ierr + 1
+      IF ( ierr > 0 ) CALL ctl_stop( ' Cavity not tested/compatible with full step (zco) and sigma (ln_sco) ' )
+
+   END SUBROUTINE zgr_isf_nam
+
+   SUBROUTINE zgr_isf_zspace
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dom_isf  ***
+      !!   
+      !! ** Purpose :   compute the grounding line position
+      !!   
+      !! ** Method  :   bathy set to 0 and isfdraft are modified (dig/close) to respect
+      !!                these criterions.
+      !!                digging and filling base on depth criterion only
+      !!                          1.0 = set iceshelf to the minimum depth allowed
+      !!                          1.1 = ground ice shelf if water column less than X m
+      !!                          1.2 = ensure a minimum thickness for iceshelf cavity in shallow water
+      !!                          1.3 = remove channels and single point 'bay'
+      !!   
+      !! ** Action  : - test compatibility between isfdraft and bathy 
+      !!              - bathy and isfdraft are modified
+      !!----------------------------------------------------------------------
+      !!  
+      INTEGER  :: ji, jj                             ! loop indexes
+      INTEGER  :: imskjp1, imskjm1, imskip1, imskim1 ! local variable
+      INTEGER, DIMENSION(jpi,jpj) :: imask           ! isf mask
+      !
+      REAL(wp) ::   zisfdep_min  ! minimal ice shelf draft allowed
+      !!---------------------------------------------------------------------
+      !
+      ! 1.0 set iceshelf to the minimum depth allowed
+      zisfdep_min = MAX(rn_isfdep_min,e3t_1d(1))
+      WHERE(risfdep(:,:) > 0.0_wp .AND. risfdep(:,:) < zisfdep_min)
+         risfdep(:,:) = zisfdep_min
+      END WHERE
+      !  
+      ! 1.1 ground ice shelf if water column less than rn_glhw_min m 
+      ! => set the grounding line position
+      WHERE( bathy(:,:) - risfdep(:,:) < rn_glhw_min .AND. risfdep(:,:) > 0.0_wp ) 
+         bathy  (:,:) = 0._wp ; risfdep(:,:) = 0._wp
+      END WHERE
+      !
+      ! 1.2 ensure a minimum thickness for iceshelf cavity 
+      ! => avoid to negative e3t if ssh + sum(e3t_0*tmask) < 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF ( bathy(ji,jj) - risfdep(ji,jj) < rn_isfhw_min .AND. risfdep(ji,jj) > 0.0_wp ) THEN
+               risfdep(ji,jj) = bathy(ji,jj) - rn_isfhw_min
+               ! sanity check on risfdep (if < zisfdep_min)
+               ! => we ground it as it failed to respect condition 1.0 and 1.1
+               IF ( risfdep(ji,jj) < zisfdep_min ) THEN 
+                  bathy(ji,jj)=0._wp ; risfdep(ji,jj)=0._wp
+               END IF
+            END IF
+         END DO
+      END DO
+      !
+      ! 1.3 Remove channels and single point 'bay' using bathy mask.
+      ! => channel could be created if connectivity is enforced later.
+      IF (ln_isfchannel) THEN
+         imask(:,:) = 0
+         WHERE ( bathy(:,:) > 0._wp )
+            imask(:,:) = 1
+         END WHERE
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               IF( imask(ji,jj) == 1 .AND. risfdep(ji,jj) > 0._wp) THEN
+                  ! define connexion
+                  imskip1=imask(ji,jj)*imask(ji+1,jj  )  ! 1 = connexion
+                  imskjp1=imask(ji,jj)*imask(ji  ,jj+1)  ! 1 = connexion
+                  imskim1=imask(ji,jj)*imask(ji-1,jj  )  ! 1 = connexion
+                  imskjm1=imask(ji,jj)*imask(ji  ,jj-1)  ! 1 = connexion
+                  ! zonal channel and single bay
+                  IF ((imskip1+imskim1>=1) .AND. (imskjp1+imskjm1==0)) THEN
+                     bathy(ji,jj)=0._wp ; risfdep(ji,jj)=0._wp
+                  END IF
+                  ! meridionnal channel and single bay
+                  IF ((imskjp1+imskjm1>=1) .AND. (imskip1+imskim1==0)) THEN
+                     bathy(ji,jj)=0._wp ; risfdep(ji,jj)=0._wp
+                  END IF
+               END IF
+            END DO
+         END DO
+         ! ensure halo correct 
+         CALL lbc_lnk_multi( 'domisf', risfdep, 'T', 1._wp, bathy  , 'T', 1._wp )
+      END IF
+      !
+   END SUBROUTINE zgr_isf_zspace
+
+   SUBROUTINE zgr_isf_kspace
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dom_isf  ***
+      !!   
+      !! ** Purpose :   compute misfdep and update isf draft if needed
+      !!   
+      !! ** Method  :   The water column has to contain at least 2 wet cells in the water column under an ice shelf
+      !!                isf draft is modified (dig/close) to respect this criterion.
+      !!                compute level
+      !!                          2.0 = compute level
+      !!                          2.1 = ensure misfdep is not below bathymetry after step 2.0
+      !!                digging and filling base on level criterion only                
+      !!                          3.0 = dig to fit the 2 water level criterion (closed pool possible after this step)
+      !!                          3.1 = dig enough to ensure connectivity of all the cell beneath an ice shelf 
+      !!                                (most of the close pool should be remove after this step)
+      !!                          3.2 = fill chimney
+      !!   
+      !! ** Action  : - compute misfdep
+      !!              - isf draft is modified if needed
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk, jn
+      INTEGER  ::   icompt
+      INTEGER  ::   ibtest,           ibtestim1, ibtestip1, ibtestjm1, ibtestjp1
+      INTEGER  ::   ibathy, ibathyij, ibathyim1, ibathyip1, ibathyjm1, ibathyjp1
+      INTEGER  ::   imskjp1  , imskjm1  , imskip1  , imskim1
+      INTEGER  ::   imskip1_r, imskim1_r, imskjp1_r, imskjm1_r
+      INTEGER , DIMENSION(jpi,jpj) :: imbathy, imisfdep, imask
+      !
+      REAL(wp) ::   zdepth
+      REAL(wp), DIMENSION(jpi,jpj) :: zrisfdep, zdummy   ! 2D workspace (ISH)
+      !!---------------------------------------------------------------------
+      !
+      ! 2 Compute misfdep for ocean points (i.e. first wet level) 
+      ! find the first ocean level such that the first level thickness 
+      ! is larger than the bot_level of e3zps_min and e3zps_rat * e3t_0 (where 
+      ! e3t_0 is the reference level thickness 
+      !
+      ! 2.0 compute misfdep (taking into account the minimal cell thickness allowed)
+      ! set misfdep to 1 on open water and initialisation beneath ice shelf
+      WHERE( risfdep(:,:) == 0._wp ) ;   misfdep(:,:) = 1   ! open water or grounded : set misfdep to 1  
+      ELSEWHERE                      ;   misfdep(:,:) = 2   ! iceshelf : initialize misfdep to second level 
+      END WHERE  
+      !
+      DO jk = 2, jpkm1 
+         zdepth = gdepw_1d(jk+1) - MIN( e3zps_min, e3t_1d(jk)*e3zps_rat ) 
+         WHERE( risfdep(:,:) > 0._wp .AND. risfdep(:,:) >= zdepth )   misfdep(:,:) = jk+1 
+      END DO 
+      !
+      ! 2.1 fill isolated grid point in the bathymetry
+      ! will be done again later on in zgr_bat_ctl, but need to be done here to adjust misfdep respectively
+      icompt = 0
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            ibtest = MAX(  mbathy(ji-1,jj), mbathy(ji+1,jj),   &
+               &           mbathy(ji,jj-1), mbathy(ji,jj+1)  )
+               IF( ibtest < mbathy(ji,jj) ) THEN
+                  mbathy(ji,jj) = ibtest
+                  icompt = icompt + 1
+               END IF
+         END DO
+      END DO
+      !
+      ! ensure halo correct 
+      zdummy(:,:) = FLOAT( mbathy(:,:) ) ; CALL lbc_lnk('domisf', zdummy, 'T', 1._wp ) ; mbathy(:,:) = INT( zdummy(:,:) )
+      !
+      IF( lk_mpp )   CALL mpp_sum('domisf', icompt )
+      IF( icompt == 0 ) THEN
+         IF(lwp) WRITE(numout,*)'     no isolated ocean grid points'
+      ELSE
+         IF(lwp) WRITE(numout,*)'    ',icompt,' ocean grid points suppressed'
+      ENDIF
+      !
+      ! 2.2 be sure misfdep not below mbathy 
+      ! warning because of condition 4 we could have 'wet cell with misfdep below mbathy
+      ! risfdep of these cells will be fix later on (see 3)
+      WHERE( misfdep > mbathy ) misfdep(:,:) = MAX( 1, mbathy(:,:) )
+      !
+      ! 3.0 Assure 2 wet cells in the water column at T point and along the edge.
+      ! find the deepest isfdep level that fit the 2 wet cell on the water column
+      ! on all the sides (still need 4 pass)
+      ! It need 4 iterations: if un-luky, digging cell U-1 can trigger case for U+1, then V-1, then V+1
+      DO jn = 1, 4
+         imisfdep = misfdep
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               ! ISF cell only
+               IF(  (misfdep(ji,jj) > 1) .AND. (mbathy(ji,jj) > 0) ) THEN
+                  ibathyij  = mbathy(ji  ,jj)
+                  !
+                  ! set ground edge value to jpk to skip it later on
+                  ibathyip1 = mbathy(ji+1,jj) ; IF ( ibathyip1 < misfdep(ji,jj) ) ibathyip1 = jpk ! no wet cell in common on this edge
+                  ibathyim1 = mbathy(ji-1,jj) ; IF ( ibathyim1 < misfdep(ji,jj) ) ibathyim1 = jpk ! no wet cell in common on this edge
+                  ibathyjp1 = mbathy(ji,jj+1) ; IF ( ibathyjp1 < misfdep(ji,jj) ) ibathyjp1 = jpk ! no wet cell in common on this edge
+                  ibathyjm1 = mbathy(ji,jj-1) ; IF ( ibathyjm1 < misfdep(ji,jj) ) ibathyjm1 = jpk ! no wet cell in common on this edge
+                  !
+                  ! find shallowest bathy level among the current cell and the neigbourging cells
+                  ibathy = MIN(ibathyij,ibathyip1,ibathyim1,ibathyjp1,ibathyjm1)
+                  !
+                  ! update misfdep and risfdep if needed
+                  ! misfdep need to be <= zmbathyij-1 to fit 2 wet cell on the water column
+                  jk = MIN(misfdep(ji,jj),ibathy-1)
+                  IF ( jk < misfdep(ji,jj) ) THEN
+                     imisfdep(ji,jj) = jk
+                     risfdep(ji,jj)  = gdepw_1d(jk+1) - MIN( e3zps_min, e3t_1d(jk)*e3zps_rat )
+                  END IF
+               ENDIF
+            END DO
+         END DO
+         misfdep=imisfdep
+         !
+         ! ensure halo correct before new pass 
+         zdummy(:,:) = FLOAT( misfdep(:,:) ); CALL lbc_lnk('domisf', zdummy, 'T', 1. ); misfdep(:,:) = INT( zdummy(:,:) )
+         CALL lbc_lnk('domisf', risfdep, 'T', 1. )
+      END DO ! jn
+      !
+      ! 3.1 condition block to inssure connectivity everywhere beneath an ice shelf
+      IF (ln_isfconnect) THEN
+         imask(:,:) = 1
+         imbathy  = mbathy
+         imisfdep = misfdep
+         zrisfdep = risfdep
+         WHERE ( mbathy(:,:) == 0 )
+            imask(:,:) = 0
+            imbathy(:,:) = jpk
+         END WHERE
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               IF(  (misfdep(ji,jj) > 1) .AND. (mbathy(ji,jj) > 0) ) THEN
+                  !
+                  ! what it should be
+                  imskip1 = imask(ji,jj) * imask(ji+1,jj  )  ! 1 = should be connected
+                  imskim1 = imask(ji,jj) * imask(ji-1,jj  )  ! 1 = should be connected
+                  imskjp1 = imask(ji,jj) * imask(ji  ,jj+1)  ! 1 = should be connected
+                  imskjm1 = imask(ji,jj) * imask(ji  ,jj-1)  ! 1 = should be connected
+                  !
+                  ! what it is
+                  imskip1_r=jpk ; imskim1_r=jpk; imskjp1_r=jpk; imskjm1_r=jpk
+                  IF (misfdep(ji,jj) > imbathy(ji+1,jj  )) imskip1_r=1.0 ! 1 = no effective connection
+                  IF (misfdep(ji,jj) > imbathy(ji-1,jj  )) imskim1_r=1.0 ! 1 = no effective connection
+                  IF (misfdep(ji,jj) > imbathy(ji  ,jj+1)) imskjp1_r=1.0 ! 1 = no effective connection
+                  IF (misfdep(ji,jj) > imbathy(ji  ,jj-1)) imskjm1_r=1.0 ! 1 = no effective connection
+                  !
+                  ! defining level needed for connectivity
+                  ! imskip1 * imskip1_r == 1 means connections need to be enforce
+                  jk=MIN(imbathy(ji+1,jj  ) * imskip1_r * imskip1, &
+                     &   imbathy(ji-1,jj  ) * imskim1_r * imskim1, &
+                     &   imbathy(ji  ,jj+1) * imskjp1_r * imskjp1, &
+                     &   imbathy(ji  ,jj-1) * imskjm1_r * imskjm1, &
+                     &   jpk+1 ) ! add jpk in the MIN to avoid out of boundary later on
+                  !
+                  ! if connectivity is OK or no connection needed (grounding line) or grounded, zmisfdep=misfdep
+                  imisfdep(ji,jj)=MIN(misfdep(ji,jj),jk-1)
+                  !
+                  ! update isf draft if needed (need to be done here because next test is in meter and level)
+                  IF ( imisfdep(ji,jj) < misfdep(ji,jj) ) THEN
+                     jk = imisfdep(ji,jj)
+                     zrisfdep(ji,jj)  = gdepw_1d(jk+1) - MIN( e3zps_min, e3t_1d(jk)*e3zps_rat )
+                  END IF
+   
+                  ! sanity check
+                  ! check if we dig more than nn_kisfmax level or reach the surface
+                  ! check if we dig more than rn_zisfmax meter
+                  ! => if this is the case, undo what has been done before
+                  IF (      (misfdep(ji,jj)-imisfdep(ji,jj) > MIN(nn_kisfmax,misfdep(ji,jj)-2)) &
+                     & .OR. (risfdep(ji,jj)-zrisfdep(ji,jj) > MIN(rn_zisfmax,risfdep(ji,jj)  )) ) THEN
+                     imisfdep(ji,jj)=misfdep(ji,jj) 
+                     zrisfdep(ji,jj)=risfdep(ji,jj)
+                  END IF
+               END IF
+            END DO
+         END DO
+         misfdep=imisfdep
+         risfdep=zrisfdep
+         !
+         ! ensure halo correct 
+         zdummy(:,:) = FLOAT( misfdep(:,:) ); CALL lbc_lnk('domisf', zdummy, 'T', 1. ); misfdep(:,:) = INT( zdummy(:,:) )
+         CALL lbc_lnk('domisf', risfdep, 'T', 1. )
+      END IF
+      !
+      ! 3.2 fill hole in ice shelf (ie cell with no velocity point)
+      !      => misfdep = MIN(misfdep at U, U-1, V, V-1)
+      !         risfdep = gdepw(misfdep) (ie full cell)
+      IF (ln_isfcheminey) THEN
+         imisfdep = misfdep
+         WHERE (mbathy == 0) imisfdep=jpk   ! grounded
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               ibtest    = imisfdep(ji  ,jj  )
+               ibtestim1 = imisfdep(ji-1,jj  ) ; ibtestip1 = imisfdep(ji+1,jj  )
+               ibtestjm1 = imisfdep(ji  ,jj-1) ; ibtestjp1 = imisfdep(ji  ,jj+1)
+               !
+               ! correction in case isfdraft(ii,jj) deeper than bathy U-1/U+1/V-1/V+1
+               IF( imisfdep(ji,jj) > mbathy(ji-1,jj  ) ) ibtestim1 = jpk ! mask at U-1
+               IF( imisfdep(ji,jj) > mbathy(ji+1,jj  ) ) ibtestip1 = jpk ! mask at U+1
+               IF( imisfdep(ji,jj) > mbathy(ji  ,jj-1) ) ibtestjm1 = jpk ! mask at V-1
+               IF( imisfdep(ji,jj) > mbathy(ji  ,jj+1) ) ibtestjp1 = jpk ! mask at V+1
+               !
+               ! correction in case bathy(ii,jj) shallower than isfdraft U-1/U+1/V-1/V+1
+               IF( mbathy(ji,jj) < imisfdep(ji-1,jj  ) ) ibtestim1 = jpk ! mask at U-1
+               IF( mbathy(ji,jj) < imisfdep(ji+1,jj  ) ) ibtestip1 = jpk ! mask at U+1
+               IF( mbathy(ji,jj) < imisfdep(ji  ,jj-1) ) ibtestjm1 = jpk ! mask at V-1
+               IF( mbathy(ji,jj) < imisfdep(ji  ,jj+1) ) ibtestjp1 = jpk ! mask at V+1
+               ! 
+               ! if hole in the ice shelf, set to the min of surrounding (the MIN is doing the job) 
+               ! if misfdep is not changed, nothing is done
+               ibtest = MAX(ibtest,MIN(ibtestim1, ibtestip1, ibtestjm1,ibtestjp1))
+               IF (misfdep(ji,jj) < ibtest) THEN
+                  misfdep(ji,jj) = ibtest
+                  risfdep(ji,jj) = gdepw_1d(ibtest)
+               END IF
+            ENDDO
+         ENDDO
+         !
+         ! if surround is fully masked, we mask it
+         WHERE( misfdep(:,:) == jpk)   ! ground case (1)
+            mbathy(:,:) = 0 ; bathy(:,:) = 0.0_wp ; misfdep(:,:) = 1 ; risfdep(:,:) = 0.0_wp
+         END WHERE
+         !
+         ! ensure halo correct
+         zdummy(:,:) = FLOAT( misfdep(:,:) ); CALL lbc_lnk('domisf', zdummy, 'T', 1. ); misfdep(:,:) = INT( zdummy(:,:) )
+         zdummy(:,:) = FLOAT( mbathy (:,:) ); CALL lbc_lnk('domisf', zdummy, 'T', 1. ); mbathy (:,:) = INT( zdummy(:,:) )
+         CALL lbc_lnk('domisf', risfdep, 'T', 1. )
+         CALL lbc_lnk('domisf', bathy  , 'T', 1. )
+      END IF
+      !
+   END SUBROUTINE zgr_isf_kspace
+
+   SUBROUTINE zgr_isf_subgl
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zps_isf_subg  ***
+      !!   
+      !! ** Purpose :   remove subglacial lakes
+      !!   
+      !! ** Method  :   Use a flood filling algorithm to detect the open ocean
+      !!                and reverse the mask
+      !!   
+      !! ** Action  : - ckeck if seed on land
+      !!              - detect main ocean
+      !!              - mask subglacial lake (closed sea under an ice shelf)
+      !!              - mask properly mbathy, misfdep, bathy, risfdep
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER  :: jk                       ! loop index
+      INTEGER  :: iiseed, ijseed           ! seed for flood filling algorithm
+      INTEGER, DIMENSION(jpi,jpj) :: imask ! 2d mask
+      !
+      REAL(wp)               :: zdist      ! distance between the seed and the nearest neighbourg                
+      REAL(wp), DIMENSION(1) :: zchk       ! sanity check variable
+      !!----------------------------------------------------------------------
+      !
+      ! check closed wet pool
+      CALL dom_ngb(rn_isfsubgllon, rn_isfsubgllat, iiseed, ijseed, zdist, 'T')
+      !
+      ! fill open ocean
+      CALL fill_pool( iiseed, ijseed, 1, tmask, -1._wp )
+      ! at this point tmask:,:,:) can have 3 different values :
+      !              0 where there where already 0
+      !             -1 where the ocean points are connected
+      !              1 where ocean points in tmask are not connected
+      IF (lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)'dom_isf_subg : removal of subglacial lakes '
+         WRITE(numout,*)'~~~~~~~~~~~~'
+         WRITE(numout,*)'Number of disconected points : ', COUNT(  (tmask(:,:,:) == 1) )
+         WRITE(numout,*)'lon/lat seed to detect main ocean is: ', rn_isfsubgllon, rn_isfsubgllat
+         WRITE(numout,*)'i/j     seed to detect main ocean is: ', iiseed, ijseed
+         WRITE(numout,*)
+      END IF
+      !
+      DO jk = 1, jpk
+         ! remove only subglacial lake (ie similar to close sea only below an ice shelf)
+         WHERE (tmask(:,:,jk) > 0 .AND. misfdep(:,:) > 1) tmask(:,:,jk) = 0
+         WHERE (tmask(:,:,jk) < 0) tmask(:,:,jk) = 1
+         !
+      END DO
+      !
+      ! surface mask
+      imask(:,:)   = MAXVAL( tmask(:,:,:), DIM=3 )
+      !
+      ! mask mbathy, misfdep, bathy and risfdep 
+      bathy(:,:)   = bathy(:,:)   * imask(:,:) 
+      mbathy(:,:)  = mbathy(:,:)  * imask(:,:)
+      risfdep(:,:) = risfdep(:,:) * imask(:,:) 
+      misfdep(:,:) = misfdep(:,:) * imask(:,:)
+      !
+      ! sanity check on seed location (land or not)
+      zchk = 0._wp
+      IF (mi0(iiseed) == mi1(iiseed) .AND. mj0(ijseed) == mj1(ijseed)) zchk = tmask(mi0(iiseed),mj0(ijseed),1)
+      CALL mpp_max('domisf',zchk)
+      IF (zchk(1) == 0._wp) CALL ctl_stop( 'STOP', 'open sea seed is on land, please update namelist (rn_lon_opnsea,rn_lat_opnsea)' )
+      !
+   END SUBROUTINE zgr_isf_subgl
+
+
+   SUBROUTINE zps_isf
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zps_isf  ***
+      !!   
+      !! ** Purpose : compute top partial cell
+      !!   
+      !! ** Method  : same method as for the bottom adapted for the top
+      !!   
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER :: jj, ji   ! loop indices
+      INTEGER :: ik       ! local top level
+      INTEGER :: it       ! counter index
+      !
+      REAL(wp) :: zdiff
+      !!----------------------------------------------------------------------
+      !
+      ! compute top partial cell
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ik = misfdep(ji,jj)
+            IF( ik > 1 ) THEN               ! ice shelf point only 
+               IF( risfdep(ji,jj) < gdepw_1d(ik) )  risfdep(ji,jj)= gdepw_1d(ik)
+               gdepw_0(ji,jj,ik) = risfdep(ji,jj)
+!gm Bu check the gdepw_0 
+            !       ... on ik 
+               gdept_0(ji,jj,ik) = gdepw_1d(ik+1) - ( gdepw_1d(ik+1) - gdepw_0(ji,jj,ik) )   &
+                  &                               * ( gdepw_1d(ik+1) - gdept_1d(ik)      )   &
+                  &                               / ( gdepw_1d(ik+1) - gdepw_1d(ik)      )
+               e3t_0  (ji,jj,ik  ) = gdepw_1d(ik+1) - gdepw_0(ji,jj,ik)
+               e3w_0  (ji,jj,ik+1) = gdept_1d(ik+1) - gdept_0(ji,jj,ik)
+
+               IF( ik + 1 == mbathy(ji,jj) ) THEN               ! ice shelf point only (2 cell water column) 
+                  e3w_0  (ji,jj,ik+1) = gdept_0(ji,jj,ik+1) - gdept_0(ji,jj,ik)
+               ENDIF
+         !       ... on ik / ik-1 
+               e3w_0  (ji,jj,ik  ) = e3t_0  (ji,jj,ik) !2._wp * (gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik)) 
+               e3t_0  (ji,jj,ik-1) = gdepw_0(ji,jj,ik) - gdepw_1d(ik-1)
+               gdept_0(ji,jj,ik-1) = gdept_0(ji,jj,ik) - e3w_0(ji,jj,ik)
+               gdepw_0(ji,jj,ik-1) = gdepw_0(ji,jj,ik) - e3t_0(ji,jj,ik-1)
+               IF ( ik > 2 ) THEN
+                  e3w_0  (ji,jj,ik-1) = gdept_0(ji,jj,ik-1) - gdept_0(ji,jj,ik-2)
+               ELSE
+                  e3w_0  (ji,jj,ik-1) = 2.0 * gdept_0(ji,jj,ik-1)
+               END IF
+            ENDIF
+         END DO
+      END DO
+      !
+      it = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ik = misfdep(ji,jj)
+            IF( ik > 1 ) THEN               ! ice shelf point only 
+               e3tp (ji,jj) = e3t_0(ji,jj,ik  )
+               e3wp (ji,jj) = e3w_0(ji,jj,ik+1 )
+            ! test 
+               zdiff= gdept_0(ji,jj,ik) - gdepw_0(ji,jj,ik  )
+               IF( zdiff <= 0. .AND. lwp ) THEN
+                  it = it + 1
+                  WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj
+                  WRITE(numout,*) ' risfdep = ', risfdep(ji,jj)
+                  WRITE(numout,*) ' gdept = ', gdept_0(ji,jj,ik), ' gdepw = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff
+                  WRITE(numout,*) ' e3tp  = ', e3tp(ji,jj), ' e3wp  = ', e3wp(ji,jj)
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      !
+   END SUBROUTINE zps_isf
+
+   SUBROUTINE zps_isf_e3uv_w
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zps_isf  ***
+      !!   
+      !! ** Purpose :   correct e3uw and e3vw for case with 2 wet cell in the water column under an ice shelf
+      !!   
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER :: ji , jj   ! loop indices
+      INTEGER :: ikt, ikb  ! local top/bottom level
+      !!----------------------------------------------------------------------
+      !
+      ! define e3uw (adapted for 2 cells in the water column)
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1   ! vector opt. 
+            ikb = MAX(mbathy (ji,jj),mbathy (ji+1,jj))
+            ikt = MAX(misfdep(ji,jj),misfdep(ji+1,jj))
+            IF (ikb == ikt+1) e3uw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji+1,jj  ,ikb  ) ) &
+                                    &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji+1,jj  ,ikb-1) )
+            ikb = MAX(mbathy (ji,jj),mbathy (ji,jj+1))
+            ikt = MAX(misfdep(ji,jj),misfdep(ji,jj+1))
+            IF (ikb == ikt+1) e3vw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji  ,jj+1,ikb  ) ) &
+                                    &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji  ,jj+1,ikb-1) )
+         END DO
+      END DO
+      !
+   END SUBROUTINE zps_isf_e3uv_w
+
+END MODULE domisf
Index: /utils/tools_ticket2413/DOMAINcfg/src/dommsk.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/dommsk.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/dommsk.F90	(revision 12863)
@@ -0,0 +1,296 @@
+MODULE dommsk
+   !!======================================================================
+   !!                       ***  MODULE dommsk   ***
+   !! Ocean initialization : domain land/sea mask 
+   !!======================================================================
+   !! History :  OPA  ! 1987-07  (G. Madec)  Original code
+   !!            6.0  ! 1993-03  (M. Guyon)  symetrical conditions (M. Guyon)
+   !!            7.0  ! 1996-01  (G. Madec)  suppression of common work arrays
+   !!             -   ! 1996-05  (G. Madec)  mask computed from tmask
+   !!            8.0  ! 1997-02  (G. Madec)  mesh information put in domhgr.F
+   !!            8.1  ! 1997-07  (G. Madec)  modification of kbat and fmask
+   !!             -   ! 1998-05  (G. Roullet)  free surface
+   !!            8.2  ! 2000-03  (G. Madec)  no slip accurate
+   !!             -   ! 2001-09  (J.-M. Molines)  Open boundaries
+   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and module
+   !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
+   !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option
+   !!            3.6  ! 2015-05  (P. Mathiot) ISF: add wmask,wumask and wvmask
+   !!            4.0  ! 2016-06  (G. Madec, S. Flavoni)  domain configuration / user defined interface
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_msk       : compute land/ocean mask
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE domisf         ! domain: ice shelf
+   USE domwri         ! domain: write the meshmask file
+   USE bdy_oce        ! open boundary
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! IOM library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! Massively Parallel Processing library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_msk    ! routine called by inidom.F90
+
+   !                            !!* Namelist namlbc : lateral boundary condition *
+   REAL(wp)        :: rn_shlat   ! type of lateral boundary condition on velocity
+   LOGICAL, PUBLIC :: ln_vorlat  !  consistency of vorticity boundary condition 
+   !                                            with analytical eqs.
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: dommsk.F90 10425 2018-12-19 21:54:16Z smasson $ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_msk
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE dom_msk  ***
+      !!
+      !! ** Purpose :   Compute land/ocean mask arrays at tracer points, hori-
+      !!      zontal velocity points (u & v), vorticity points (f) points.
+      !!
+      !! ** Method  :   The ocean/land mask  at t-point is deduced from ko_top 
+      !!      and ko_bot, the indices of the fist and last ocean t-levels which 
+      !!      are either defined in usrdef_zgr or read in zgr_read.
+      !!                The velocity masks (umask, vmask) 
+      !!      are deduced from a product of the two neighboring tmask.
+      !!                The vorticity mask (fmask) is deduced from tmask taking
+      !!      into account the choice of lateral boundary condition (rn_shlat) :
+      !!         rn_shlat = 0, free slip  (no shear along the coast)
+      !!         rn_shlat = 2, no slip  (specified zero velocity at the coast)
+      !!         0 < rn_shlat < 2, partial slip   | non-linear velocity profile
+      !!         2 < rn_shlat, strong slip        | in the lateral boundary layer
+      !!
+      !!      tmask_i : interior ocean mask at t-point, i.e. excluding duplicated
+      !!                rows/lines due to cyclic or North Fold boundaries as well
+      !!                as MPP halos.
+      !!      tmask_h : halo mask at t-point, i.e. excluding duplicated rows/lines
+      !!                due to cyclic or North Fold boundaries as well as MPP halos.
+      !!
+      !! ** Action :   tmask, umask, vmask, wmask : land/ocean mask 
+      !!                         at t-, u-, v- w, wu-, and wv-points (=0. or 1.)
+      !!               fmask   : land/ocean mask at f-point (=0., or =1., or 
+      !!                         =rn_shlat along lateral boundaries)
+      !!               tmask_i : interior ocean mask 
+      !!               tmask_h : halo mask
+      !!               ssmask , ssumask, ssvmask, ssfmask : 2D ocean mask
+      !!----------------------------------------------------------------------
+      !
+      INTEGER  ::   ji, jj, jk     ! dummy loop indices
+      INTEGER  ::   iif, iil       ! local integers
+      INTEGER  ::   ijf, ijl       !   -       -
+      INTEGER  ::   iktop, ikbot   !   -       -
+      INTEGER  ::   ios, inum
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zwf   ! 2D workspace
+      !!
+      NAMELIST/namlbc/ rn_shlat, ln_vorlat
+      NAMELIST/nambdy/ ln_bdy ,nb_bdy, ln_coords_file, cn_coords_file,         &
+         &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,     &
+         &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             &
+         &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, &
+         &             cn_ice, nn_ice_dta,                                     &
+         &             rn_ice_tem, rn_ice_sal, rn_ice_age,                     &
+         &             ln_vol, nn_volctl, nn_rimwidth, nb_jpk_bdy
+      !!---------------------------------------------------------------------
+      !
+      REWIND( numnam_ref )              ! Namelist namlbc in reference namelist : Lateral momentum boundary condition
+      READ  ( numnam_ref, namlbc, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlbc in reference namelist', lwp )
+      REWIND( numnam_cfg )              ! Namelist namlbc in configuration namelist : Lateral momentum boundary condition
+      READ  ( numnam_cfg, namlbc, IOSTAT = ios, ERR = 902 )
+902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlbc in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namlbc )
+      
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dommsk : ocean mask '
+         WRITE(numout,*) '~~~~~~'
+         WRITE(numout,*) '   Namelist namlbc'
+         WRITE(numout,*) '      lateral momentum boundary cond.    rn_shlat  = ',rn_shlat
+         WRITE(numout,*) '      consistency with analytical form   ln_vorlat = ',ln_vorlat 
+      ENDIF
+      !
+      IF(lwp) WRITE(numout,*)
+      IF     (      rn_shlat == 0.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  free-slip'
+      ELSEIF (      rn_shlat == 2.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  no-slip'
+      ELSEIF ( 0. < rn_shlat .AND. rn_shlat < 2. ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  partial-slip'
+      ELSEIF ( 2. < rn_shlat                     ) THEN   ;   IF(lwp) WRITE(numout,*) '   ==>>>   ocean lateral  strong-slip'
+      ELSE
+         CALL ctl_stop( 'dom_msk: wrong value for rn_shlat (i.e. a negalive value). We stop.' )
+      ENDIF
+
+     ! 1. Ocean/land mask at t-point (computed from mbathy)
+     ! -----------------------------
+     ! N.B. tmask has already the right boundary conditions since mbathy is ok
+     !
+      tmask(:,:,:) = 0._wp
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF(      ( REAL( mbathy (ji,jj) - jk, wp ) + 0.1_wp >= 0._wp )         &
+               &  .AND. ( REAL( misfdep(ji,jj) - jk, wp ) - 0.1_wp <= 0._wp ) ) THEN
+                  tmask(ji,jj,jk) = 1._wp
+               END IF  
+            END DO
+         END DO
+      END DO    
+ 
+      IF ( ln_isfsubgl ) CALL zgr_isf_subgl
+
+!SF  add here lbc_lnk: bug not still understood : cause now domain configuration is read !
+!!gm I don't understand why...  
+      CALL lbc_lnk( 'dommsk', tmask  , 'T', 1._wp )      ! Lateral boundary conditions
+
+     ! Mask corrections for bdy (read in mppini2)
+      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist :Unstructured open boundaries
+      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903)
+903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist', lwp )
+      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist :Unstructured open boundaries
+      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 )
+904   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist', lwp )
+      ! ------------------------
+      IF ( ln_bdy .AND. ln_mask_file ) THEN
+         CALL iom_open( cn_mask_file, inum )
+         CALL iom_get ( inum, jpdom_data, 'bdy_msk', bdytmask(:,:) )
+         CALL iom_close( inum )
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  tmask(ji,jj,jk) = tmask(ji,jj,jk) * bdytmask(ji,jj)
+               END DO
+            END DO
+         END DO
+      ENDIF
+         
+      !  Ocean/land mask at u-, v-, and f-points   (computed from tmask)
+      ! ----------------------------------------
+      ! NB: at this point, fmask is designed for free slip lateral boundary condition
+      DO jk = 1, jpk
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector loop
+               umask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)
+               vmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji  ,jj+1,jk)
+            END DO
+            DO ji = 1, jpim1      ! NO vector opt.
+               fmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)   &
+                  &            * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk)
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk_multi( 'dommsk', umask, 'U', 1., vmask, 'V', 1., fmask, 'F', 1. )      ! Lateral boundary conditions
+ 
+      ! Ocean/land mask at wu-, wv- and w points    (computed from tmask)
+      !-----------------------------------------
+      wmask (:,:,1) = tmask(:,:,1)     ! surface
+      DO jk = 2, jpk                   ! interior values
+         wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1)
+      END DO
+
+
+      ! Ocean/land column mask at t-, u-, and v-points   (i.e. at least 1 wet cell in the vertical)
+      ! ----------------------------------------------
+      ssmask (:,:) = MAXVAL( tmask(:,:,:), DIM=3 )
+      ssumask(:,:) = MAXVAL( umask(:,:,:), DIM=3 )
+      ssvmask(:,:) = MAXVAL( vmask(:,:,:), DIM=3 )
+
+      ! Interior domain mask  (used for global sum)
+      ! --------------------
+      !
+      iif = nn_hls   ;   iil = nlci - nn_hls + 1
+      ijf = nn_hls   ;   ijl = nlcj - nn_hls + 1
+      !
+      !                          ! halo mask : 0 on the halo and 1 elsewhere
+      tmask_h(:,:) = 1._wp                  
+      tmask_h( 1 :iif,   :   ) = 0._wp      ! first columns
+      tmask_h(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns)
+      tmask_h(   :   , 1 :ijf) = 0._wp      ! first rows
+      tmask_h(   :   ,ijl:jpj) = 0._wp      ! last  rows (including mpp extra rows)
+      !
+      !                          ! north fold mask
+      tpol(1:jpiglo) = 1._wp 
+      fpol(1:jpiglo) = 1._wp
+      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot
+         tpol(jpiglo/2+1:jpiglo) = 0._wp
+         fpol(     1    :jpiglo) = 0._wp
+         IF( mjg(nlej) == jpjglo ) THEN                  ! only half of the nlcj-1 row for tmask_h
+            DO ji = iif+1, iil-1
+               tmask_h(ji,nlej-1) = tmask_h(ji,nlej-1) * tpol(mig(ji))
+            END DO
+         ENDIF
+      ENDIF
+      !
+      IF( jperio == 5 .OR. jperio == 6 ) THEN      ! F-point pivot
+         tpol(     1    :jpiglo) = 0._wp
+         fpol(jpiglo/2+1:jpiglo) = 0._wp
+      ENDIF
+      !
+      !                          ! interior mask : 2D ocean mask x halo mask 
+      tmask_i(:,:) = ssmask(:,:) * tmask_h(:,:)
+
+
+      ! Lateral boundary conditions on velocity (modify fmask)
+      ! ---------------------------------------  
+      IF( rn_shlat /= 0 ) THEN      ! Not free-slip lateral boundary condition
+         !
+         ALLOCATE( zwf(jpi,jpj) )
+         !
+         DO jk = 1, jpk
+            zwf(:,:) = fmask(:,:,jk)         
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  IF( fmask(ji,jj,jk) == 0._wp ) THEN
+                     fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1),   &
+                        &                                           zwf(ji-1,jj), zwf(ji,jj-1)  )  )
+                  ENDIF
+               END DO
+            END DO
+            DO jj = 2, jpjm1
+               IF( fmask(1,jj,jk) == 0._wp ) THEN
+                  fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) )
+               ENDIF
+               IF( fmask(jpi,jj,jk) == 0._wp ) THEN
+                  fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) )
+               ENDIF
+            END DO         
+            DO ji = 2, jpim1
+               IF( fmask(ji,1,jk) == 0._wp ) THEN
+                  fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) )
+               ENDIF
+               IF( fmask(ji,jpj,jk) == 0._wp ) THEN
+                  fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) )
+               ENDIF
+            END DO
+#if defined key_agrif 
+            IF( .NOT. AGRIF_Root() ) THEN 
+               IF ((nbondi ==  1).OR.(nbondi == 2)) fmask(nlci-1 , :     ,jk) = 0.e0      ! east 
+               IF ((nbondi == -1).OR.(nbondi == 2)) fmask(1      , :     ,jk) = 0.e0      ! west 
+               IF ((nbondj ==  1).OR.(nbondj == 2)) fmask(:      ,nlcj-1 ,jk) = 0.e0      ! north 
+               IF ((nbondj == -1).OR.(nbondj == 2)) fmask(:      ,1      ,jk) = 0.e0      ! south 
+            ENDIF 
+#endif 
+         END DO
+         !
+         DEALLOCATE( zwf )
+         !
+         CALL lbc_lnk( 'dommsk', fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask
+         !
+         ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 ) depending on ln_vorlat
+         !
+      ENDIF
+      !
+      ! write out mesh mask
+      IF ( nn_msh > 0 ) CALL dom_wri
+      !
+   END SUBROUTINE dom_msk
+   
+   !!======================================================================
+END MODULE dommsk
Index: /utils/tools_ticket2413/DOMAINcfg/src/domngb.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/domngb.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/domngb.F90	(revision 12863)
@@ -0,0 +1,101 @@
+MODULE domngb
+   !!======================================================================
+   !!                       ***  MODULE  domngb  ***
+   !! Grid search:  find the closest grid point from a given on/lat position
+   !!======================================================================
+   !! History : 3.2  !  2009-11  (S. Masson)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_ngb       : find the closest grid point from a given lon/lat position
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE phycst
+   !
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! for mppsum
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_ngb   ! routine called in iom.F90 and domclo.F90 module
+   PUBLIC   dist
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: domngb.F90 10425 2018-12-19 21:54:16Z smasson $ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_ngb( plon, plat, kii, kjj, rdist, cdgrid, kkk )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dom_ngb  ***
+      !!
+      !! ** Purpose :   find the closest grid point from a given lon/lat position
+      !!
+      !! ** Method  :   look for minimum distance in cylindrical projection 
+      !!                -> not good if located at too high latitude...
+      !!----------------------------------------------------------------------
+      REAL(wp)        , INTENT(in   ) ::   plon, plat   ! longitude,latitude of the point
+      REAL(wp)        , INTENT(  out) ::   rdist        ! distance between the located point and the source
+      INTEGER         , INTENT(  out) ::   kii, kjj     ! i-,j-index of the closes grid point
+      INTEGER         , INTENT(in   ), OPTIONAL :: kkk  ! k-index of the mask level used
+      CHARACTER(len=1), INTENT(in   ) ::   cdgrid       ! grid name 'T', 'U', 'V', 'W'
+      !
+      INTEGER :: ik         ! working level
+      INTEGER , DIMENSION(2) ::   iloc
+      REAL(wp), DIMENSION(jpi,jpj) ::   zglam, zgphi, zmask, zdist
+      !!--------------------------------------------------------------------
+      !
+      zmask(:,:) = 0._wp
+      ik = 1
+      IF ( PRESENT(kkk) ) ik=kkk
+      SELECT CASE( cdgrid )
+      CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,ik)
+      CASE( 'V' )  ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej,ik)
+      CASE( 'F' )  ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej,ik)
+      CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej,ik)
+      END SELECT
+
+      zdist = dist(plon, plat, zglam, zgphi)
+
+      IF( lk_mpp ) THEN  
+         CALL mpp_minloc( 'domngb', zdist(:,:), zmask, rdist, iloc)
+         kii = iloc(1) ; kjj = iloc(2)
+      ELSE
+         iloc(:) = MINLOC( zdist(:,:), mask = zmask(:,:) == 1.e0 )
+         rdist = MINVAL( zdist(:,:) )
+         kii = iloc(1) + nimpp - 1
+         kjj = iloc(2) + njmpp - 1
+      ENDIF
+      !
+   END SUBROUTINE dom_ngb
+
+   FUNCTION dist(plonsrc, platsrc, plontrg, plattrg)
+      REAL(wp),                     INTENT(in) :: plonsrc, platsrc ! lat/lon of the source point
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plontrg, plattrg ! lat/lon of the target (2d in this case)
+
+      REAL(wp) :: zxs, zys, zzs
+      REAL(wp), DIMENSION(jpi,jpj) :: zxt, zyt, zzt
+
+      REAL(wp), DIMENSION(jpi,jpj) :: dist ! distance between src and trg
+
+      zxs = COS( rad * platsrc ) * COS( rad * plonsrc )
+      zys = COS( rad * platsrc ) * SIN( rad * plonsrc )
+      zzs = SIN( rad * platsrc )
+
+      zxt = COS( rad * plattrg ) * COS( rad * plontrg )
+      zyt = COS( rad * plattrg ) * SIN( rad * plontrg )
+      zzt = SIN( rad * plattrg )
+
+      dist(:,:) = ( zxs - zxt(:,:) )**2   &
+         &      + ( zys - zyt(:,:) )**2   &
+         &      + ( zzs - zzt(:,:) )**2
+
+      dist(:,:) = ra * SQRT( dist(:,:) )
+
+   END FUNCTION dist
+
+   !!======================================================================
+END MODULE domngb
Index: /utils/tools_ticket2413/DOMAINcfg/src/domutl.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/domutl.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/domutl.F90	(revision 12863)
@@ -0,0 +1,268 @@
+MODULE domutil
+   !!
+   !!======================================================================
+   !!                       ***  MODULE  closea  ***
+   !! modutl : specific module to do
+   !!              - 2d flood filling (closea)
+   !!              - 3d flood filling (zgr_isf)
+   !!
+   !!======================================================================
+   !! History :   4.0  !  03-18  (P. Mathiot) Original code
+   !!----------------------------------------------------------------------
+   !!
+   !!----------------------------------------------------------------------
+   !!   fillpool    : replace all point connected to the seed by a fillvalue 
+   !!----------------------------------------------------------------------
+   !!
+   USE dom_oce         ! ocean space and time domain
+   USE domngb
+   USE in_out_manager    ! I/O manager
+   USE lib_mpp
+   USE lbclnk
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC fill_pool      ! routine called by domain module
+
+   INTERFACE fill_pool
+      MODULE PROCEDURE FillPool2D, FillPool3D
+   END INTERFACE
+
+   TYPE idx
+      INTEGER :: i,j,k
+      TYPE(idx), POINTER :: next
+   END TYPE idx
+
+CONTAINS
+   SUBROUTINE FillPool3D(kiseed, kjseed, kkseed, rdta, rfill)
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE FillPool3D  ***
+      !!
+      !! ** Purpose :  Replace all area surrounding by mask value by kifill value
+      !!
+      !! ** Method  :  flood fill algorithm
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER,                          INTENT(in)    :: kiseed, kjseed, kkseed ! seed
+      REAL(wp),                         INTENT(in)    :: rfill                  ! filling value
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: rdta                   ! input data
+      REAL(wp), DIMENSION(jpi,jpj,jpk)                :: rseedmap, rseedmap_b   ! map of seed (use for processor communication)
+ 
+      INTEGER :: ii  , ij  , ik   , kii, kjj, jj, kk    ! working integer
+      INTEGER :: iip1, ijp1, ikp1                       ! working integer
+      INTEGER :: iim1, ijm1, ikm1                       ! working integer
+      INTEGER :: nseed                                  ! size of the stack
+      TYPE (idx), POINTER :: seed
+      !!---------------------------------------------------------------------- 
+      !
+      ! initialisation seed
+      NULLIFY(seed)
+      !
+      ! create the first seed and update nseed for all processors
+      nseed = 0
+      rseedmap = 0.
+      ii=kiseed; ij=kjseed ; ik=kkseed
+      IF ((mi0(ii) == mi1(ii)) .AND. (mj0(ij) == mj1(ij))) THEN   ! T if seed on the local domain
+         ii = mi0(ii) ; ij = mj0(ij);                             ! conversion to local index
+         IF (rdta(ii,ij,ik) > 0 ) THEN                            ! create seed if not on land
+            CALL add_head_idx(seed,ii,ij,ik)
+            rdta    (ii,ij,ik) = rfill
+            rseedmap(ii,ij,ik) = 1.
+         END IF
+      END IF
+      nseed=SUM(rseedmap); IF( lk_mpp )   CALL mpp_sum('domutil', nseed )  ! nseed =0 means on land => WARNING later on
+      !
+      ! loop until the stack size is 0 or if the pool is larger than the critical size
+      IF (nseed > 0) THEN
+         ! seed on ocean continue
+         DO WHILE ( nseed /= 0 )
+            DO WHILE ( ASSOCIATED(seed) )
+               ii=seed%i; ij=seed%j ; ik=seed%k ; rseedmap(ii,ij,ik)=1.
+               ! 
+               ! update bathy and update stack size
+               CALL del_head_idx(seed) 
+               !
+               ! check neighbour cells
+               iip1=ii+1 ; IF (iip1 == jpi+1 ) iip1=ii
+               iim1=ii-1 ; IF (iim1 == 0     ) iim1=ii
+               ijp1=ij+1 ; IF (ijp1 == jpj+1 ) ijp1=ij
+               ijm1=ij-1 ; IF (ijm1 == 0     ) ijm1=ij
+               ikp1=ik+1 ; IF (ikp1 == jpk+1 ) ikp1=ik
+               ikm1=ik-1 ; IF (ikm1 == 0     ) ikm1=ik
+               !
+               ! ji direction
+               IF (rdta(ii,ijp1,ik) > 0 .AND. rdta(ii,ijp1,ik) /= rfill ) THEN ; CALL add_head_idx(seed,ii,ijp1,ik) ; rdta(ii,ijp1,ik) = rfill ; rseedmap(ii,ijp1,ik)=1. ; END IF
+               IF (rdta(ii,ijm1,ik) > 0 .AND. rdta(ii,ijm1,ik) /= rfill ) THEN ; CALL add_head_idx(seed,ii,ijm1,ik) ; rdta(ii,ijm1,ik) = rfill ; rseedmap(ii,ijm1,ik)=1. ; END IF
+               !
+               ! jj direction
+               IF (rdta(iip1,ij,ik) > 0 .AND. rdta(iip1,ij,ik) /= rfill ) THEN ; CALL add_head_idx(seed,iip1,ij,ik) ; rdta(iip1,ij,ik) = rfill ; rseedmap(iip1,ij,ik)=1. ; END IF
+               IF (rdta(iim1,ij,ik) > 0 .AND. rdta(iim1,ij,ik) /= rfill ) THEN ; CALL add_head_idx(seed,iim1,ij,ik) ; rdta(iim1,ij,ik) = rfill ; rseedmap(iim1,ij,ik)=1. ; END IF
+               !
+               ! jk direction
+               IF (rdta(ii,ij,ikp1) > 0 .AND. rdta(ii,ij,ikp1) /= rfill ) THEN ; CALL add_head_idx(seed,ii,ij,ikp1) ; rdta(ii,ij,ikp1) = rfill ; rseedmap(ii,ij,ik)=1. ; END IF
+               IF (rdta(ii,ij,ikm1) > 0 .AND. rdta(ii,ij,ikm1) /= rfill ) THEN ; CALL add_head_idx(seed,ii,ij,ikm1) ; rdta(ii,ij,ikm1) = rfill ; rseedmap(ii,ij,ik)=1. ; END IF
+            END DO
+            !
+            ! exchange seed
+            nseed=SUM(rseedmap); IF( lk_mpp )   CALL mpp_sum('domutil', nseed )  ! this is the sum of all the point check this iteration
+            !
+            rseedmap_b(:,:,:)=rseedmap(:,:,:)
+            CALL lbc_lnk('domutil', rseedmap, 'T', 1.)
+            !
+            ! build new list of seed
+            DO ii=1,jpi
+               DO jj=1,jpj
+                  DO kk=1,jpk
+                     IF (rseedmap(ii,jj,kk) > 0.0 .AND. rseedmap(ii,jj,kk) /= rseedmap_b(ii,jj,kk) .AND. rdta(ii,jj,kk) > 0 .AND. rdta(ii,jj,kk) /= rfill) THEN
+                        CALL add_head_idx(seed,ii,jj,kk)
+                     END IF
+                  END DO
+               END DO
+            END DO
+            !
+            ! reset map of seed
+            rseedmap(:,:,:)=0.0
+            !
+         END DO
+      ELSE
+         WRITE(numout,*) 'W A R N I N G : SEED (',ii,ij,') is on land, nothing to do'
+      END IF
+ 
+   END SUBROUTINE FillPool3D
+
+   SUBROUTINE FillPool2D(kiseed, kjseed, rdta, rfill)
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE FillPool3D  ***
+      !!
+      !! ** Purpose :  Replace all area surrounding by mask value by kifill value
+      !!
+      !! ** Method  :  flood fill algorithm
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER,                      INTENT(in)    :: kiseed, kjseed ! seed
+      REAL(wp),                     INTENT(in)    :: rfill          ! filling value
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: rdta           ! input data
+      REAL(wp), DIMENSION(jpi,jpj) :: rseedmap                      ! location of new seed (used for processor exchange)
+ 
+      INTEGER :: ii  , ij  , jj, kii, kjj     ! working integer
+      INTEGER :: iip1, ijp1                   ! working integer
+      INTEGER :: iim1, ijm1                   ! working integer
+      INTEGER :: nseed                        ! size of the stack
+      TYPE (idx), POINTER :: seed
+      !!----------------------------------------------------------------------
+      !
+      ! initialisation seed
+      NULLIFY(seed)
+      !
+      ! create the first seed and update nseed for all processors
+      nseed = 0
+      rseedmap = 0.
+      ii = kiseed ; ij = kjseed ;
+      IF ((mi0(ii) == mi1(ii)) .AND. (mj0(ij) == mj1(ij))) THEN   ! T if seed on the local domain
+         ii = mi0(ii) ; ij = mj0(ij)                              ! conversion to local index
+         IF (rdta(ii,ij) > 0 ) THEN                               ! create seed if not on land
+            CALL add_head_idx(seed,ii,ij,1)
+            rdta    (ii,ij) = rfill
+            rseedmap(ii,ij) = 1.
+         END IF
+      END IF
+      nseed=SUM(rseedmap); IF( lk_mpp )   CALL mpp_sum('domutil', nseed )  ! nseed =0 means on land => WARNING later on
+      !
+      ! loop until the stack size is 0 or if the pool is larger than the critical size
+      IF (nseed > 0) THEN
+         ! seed on ocean continue
+         DO WHILE ( nseed .NE. 0 )
+            DO WHILE ( ASSOCIATED(seed) )
+               ii=seed%i; ij=seed%j
+               ! update stack size
+               CALL del_head_idx(seed) 
+               ! 
+               ! check neighbour cells
+               iip1=ii+1 ; IF (iip1 == jpi+1 ) iip1=ii
+               iim1=ii-1 ; IF (iim1 == 0     ) iim1=ii
+               ijp1=ij+1 ; IF (ijp1 == jpj+1 ) ijp1=ij
+               ijm1=ij-1 ; IF (ijm1 == 0     ) ijm1=ij
+               !
+               ! ji direction
+               IF (rdta(ii  ,ijp1) > 0 .AND. rdta(ii  ,ijp1) /= rfill ) THEN ; CALL add_head_idx(seed,ii  ,ijp1,1) ; rdta(ii  ,ijp1) = rfill ; rseedmap(ii  ,ijp1)=1. ; END IF
+               IF (rdta(ii  ,ijm1) > 0 .AND. rdta(ii  ,ijm1) /= rfill ) THEN ; CALL add_head_idx(seed,ii  ,ijm1,1) ; rdta(ii  ,ijm1) = rfill ; rseedmap(ii  ,ijm1)=1. ; END IF
+               !
+               ! jj direction
+               IF (rdta(iip1,ij  ) > 0 .AND. rdta(iip1,ij  ) /= rfill ) THEN ; CALL add_head_idx(seed,iip1,ij  ,1) ; rdta(iip1,ij  ) = rfill ; rseedmap(iip1,ij  )=1. ; END IF
+               IF (rdta(iim1,ij  ) > 0 .AND. rdta(iim1,ij  ) /= rfill ) THEN ; CALL add_head_idx(seed,iim1,ij  ,1) ; rdta(iim1,ij  ) = rfill ; rseedmap(iim1,ij  )=1. ; END IF
+            END DO
+            !
+            ! exchange seed
+            nseed=SUM(rseedmap); IF( lk_mpp )   CALL mpp_sum('domutil', nseed )  ! this is the sum of all the point check this iteration
+            !
+            CALL lbc_lnk('domutil', rseedmap, 'T', 1.)
+            !
+            ! build new list of seed
+            ! new seed only if data > 0 (ie not land), data not already filled and rseedmap > 0
+            DO ii=1,jpi
+               DO jj=1,jpj
+                  IF (rseedmap(ii,jj) > 0.0 .AND. rdta(ii,jj) > 0 .AND. rdta(ii,jj) /= rfill) THEN
+                     CALL add_head_idx(seed, ii, jj, 1)
+                  END IF
+               END DO
+            END DO 
+            !
+            ! reset map of seed
+            rseedmap(:,:)=0.0
+            !
+         END DO
+      ELSE
+         WRITE(numout,*) 'W A R N I N G : SEED (',ii,ij,') is on land, nothing to do', narea
+      END IF
+ 
+   END SUBROUTINE FillPool2D
+   !
+   !
+   ! subroutine to deals with link list
+   !
+   SUBROUTINE add_head_idx(pt_idx, ki, kj, kk)
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE add_head_idx  ***
+      !!
+      !! ** Purpose : add one element in the linked list
+      !!
+      !! ** Method  :  allocate one element, then point %next to the linked list
+      !!----------------------------------------------------------------------
+      TYPE (idx), POINTER :: pt_idx
+      TYPE (idx), POINTER :: zpt_new
+      INTEGER, INTENT(in) :: ki, kj, kk
+      !
+      ! allocate new element
+      ALLOCATE(zpt_new)
+      zpt_new%i=ki ; zpt_new%j=kj ; zpt_new%k=kk ;
+      zpt_new%next => NULL()
+      !
+      ! linked new element to main list
+      zpt_new%next => pt_idx
+      pt_idx => zpt_new
+   END SUBROUTINE add_head_idx
+
+   SUBROUTINE del_head_idx(pt_idx)
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE del_head_idx  ***
+      !!
+      !! ** Purpose : delete one element in the linked list
+      !!
+      !! ** Method  : move the pointer to the next node 
+      !!----------------------------------------------------------------------
+      TYPE (idx), POINTER :: pt_idx
+      TYPE (idx), POINTER :: zpt_tmp
+      !
+      ! delete first element
+      IF (ASSOCIATED(pt_idx%next)) THEN
+         zpt_tmp => pt_idx%next
+         DEALLOCATE(pt_idx)
+         NULLIFY(pt_idx)
+         pt_idx => zpt_tmp
+      ELSE
+         NULLIFY(pt_idx)
+      ENDIF
+   END SUBROUTINE del_head_idx
+   !
+END MODULE domutil
Index: /utils/tools_ticket2413/DOMAINcfg/src/domwri.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/domwri.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/domwri.F90	(revision 12863)
@@ -0,0 +1,292 @@
+MODULE domwri
+   !!======================================================================
+   !!                       ***  MODULE domwri  ***
+   !! Ocean initialization : write the ocean domain mesh file(s)
+   !!======================================================================
+   !! History :  OPA  ! 1997-02  (G. Madec)  Original code
+   !!            8.1  ! 1999-11  (M. Imbard)  NetCDF FORMAT with IOIPSL
+   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90 and several file
+   !!            3.0  ! 2008-01  (S. Masson)  add dom_uniq 
+   !!            4.0  ! 2016-01  (G. Madec)  simplified mesh_mask.nc file
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_wri        : create and write mesh and mask file(s)
+   !!   dom_uniq       : identify unique point of a grid (TUVF)
+   !!   dom_stiff      : diagnose maximum grid stiffness/hydrostatic consistency (s-coordinate)
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE phycst ,   ONLY :   rsmall
+ !  USE wet_dry,   ONLY :   ll_wd  ! Wetting and drying
+   !
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O library
+   USE lbclnk          ! lateral boundary conditions - mpp exchanges
+   USE lib_mpp         ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_wri              ! routine called by inidom.F90
+   PUBLIC   dom_stiff            ! routine called by inidom.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: domwri.F90 10425 2018-12-19 21:54:16Z smasson $ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_wri
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_wri  ***
+      !!                   
+      !! ** Purpose :   Create the NetCDF file(s) which contain(s) all the
+      !!      ocean domain informations (mesh and mask arrays). This (these)
+      !!      file(s) is (are) used for visualisation (SAXO software) and
+      !!      diagnostic computation.
+      !!
+      !! ** Method  :   create a file with all domain related arrays
+      !!
+      !! ** output file :   meshmask.nc  : domain size, horizontal grid-point position,
+      !!                                   masks, depth and vertical scale factors
+      !!----------------------------------------------------------------------
+      INTEGER           ::   inum    ! temprary units for 'mesh_mask.nc' file
+      CHARACTER(len=21) ::   clnam   ! filename (mesh and mask informations)
+      INTEGER           ::   ji, jj, jk   ! dummy loop indices
+      INTEGER           ::   izco, izps, isco, icav
+      !                               
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zprt, zprw     ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdepu, zdepv   ! 3D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'dom_wri : create NetCDF mesh and mask information file(s)'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+      
+      clnam = 'mesh_mask'  ! filename (mesh and mask informations)
+      
+      !                                  ! ============================
+      !                                  !  create 'mesh_mask.nc' file
+      !                                  ! ============================
+      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. )
+      !
+      !                                                         ! global domain size
+      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpkglo, wp), ktype = jp_i4 )
+
+      !                                                         ! domain characteristics
+      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
+      !                                                         ! type of vertical coordinate
+      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
+      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
+      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
+      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
+      !                                                         ! ocean cavities under iceshelves
+      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
+      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
+  
+      !                                                         ! masks
+      CALL iom_rstput( 0, 0, inum, 'tmask', tmask, ktype = jp_i1 )     !    ! land-sea mask
+      CALL iom_rstput( 0, 0, inum, 'umask', umask, ktype = jp_i1 )
+      CALL iom_rstput( 0, 0, inum, 'vmask', vmask, ktype = jp_i1 )
+      CALL iom_rstput( 0, 0, inum, 'fmask', fmask, ktype = jp_i1 )
+      
+      CALL dom_uniq( zprw, 'T' )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zprt(ji,jj) = ssmask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask
+         END DO
+      END DO                             !    ! unique point mask
+      CALL iom_rstput( 0, 0, inum, 'tmaskutil', zprt, ktype = jp_i1 )  
+      CALL dom_uniq( zprw, 'U' )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zprt(ji,jj) = ssumask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask
+         END DO
+      END DO
+      CALL iom_rstput( 0, 0, inum, 'umaskutil', zprt, ktype = jp_i1 )  
+      CALL dom_uniq( zprw, 'V' )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zprt(ji,jj) = ssvmask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask
+         END DO
+      END DO
+      CALL iom_rstput( 0, 0, inum, 'vmaskutil', zprt, ktype = jp_i1 )  
+!!gm  ssfmask has been removed  ==>> find another solution to defined fmaskutil
+!!    Here we just remove the output of fmaskutil.
+!      CALL dom_uniq( zprw, 'F' )
+!      DO jj = 1, jpj
+!         DO ji = 1, jpi
+!            zprt(ji,jj) = ssfmask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask
+!         END DO
+!      END DO
+!      CALL iom_rstput( 0, 0, inum, 'fmaskutil', zprt, ktype = jp_i1 )  
+!!gm
+
+      !                                                         ! horizontal mesh (inum3)
+      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )     !    ! latitude
+      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )     !    ! longitude
+      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum, 'e1t', e1t, ktype = jp_r8 )         !    ! e1 scale factors
+      CALL iom_rstput( 0, 0, inum, 'e1u', e1u, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e1v', e1v, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e1f', e1f, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum, 'e2t', e2t, ktype = jp_r8 )         !    ! e2 scale factors
+      CALL iom_rstput( 0, 0, inum, 'e2u', e2u, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e2v', e2v, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'e2f', e2f, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum, 'ff_f', ff_f, ktype = jp_r8 )       !    ! coriolis factor
+      CALL iom_rstput( 0, 0, inum, 'ff_t', ff_t, ktype = jp_r8 )
+      
+      ! note that mbkt and mikt is set to 1 over land ==> use surface tmask
+      zprt(:,:) = ssmask(:,:) * REAL( mbkt(:,:) , wp )
+      CALL iom_rstput( 0, 0, inum, 'mbathy', zprt, ktype = jp_i4 )                              !    ! nb of ocean T-points
+      CALL iom_rstput( 0, 0, inum, 'bathy_metry', bathy(:,:)   * ssmask(:,:), ktype = jp_r8 )   !    ! bathymetry
+      zprt(:,:) = ssmask(:,:) * REAL( mikt(:,:) , wp )
+      CALL iom_rstput( 0, 0, inum, 'misf', zprt, ktype = jp_i4 )                                !    ! first wet level
+      CALL iom_rstput( 0, 0, inum, 'isfdraft'   , risfdep(:,:) * ssmask(:,:), ktype = jp_r8 )   !    ! ice shelf draft
+      zprt(:,:) = ssmask(:,:) * REAL( mbkt(:,:) - mikt(:,:) + 1, wp )
+      CALL iom_rstput( 0, 0, inum, 'mhw',zprt, ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'hw' ,(bathy-risfdep)*ssmask, ktype = jp_r8 )
+
+      !		             ! vertical mesh
+      CALL iom_rstput( 0, 0, inum, 'e3t_0', e3t_0, ktype = jp_r8  )    !    ! scale factors
+      CALL iom_rstput( 0, 0, inum, 'e3u_0', e3u_0, ktype = jp_r8  )
+      CALL iom_rstput( 0, 0, inum, 'e3v_0', e3v_0, ktype = jp_r8  )
+      CALL iom_rstput( 0, 0, inum, 'e3w_0', e3w_0, ktype = jp_r8  )
+      !
+      CALL iom_rstput( 0, 0, inum, 'gdept_1d' , gdept_1d , ktype = jp_r8 )  ! stretched system
+      CALL iom_rstput( 0, 0, inum, 'gdepw_1d' , gdepw_1d , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'gdept_0'  , gdept_0  , ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum, 'gdepw_0'  , gdepw_0  , ktype = jp_r8 )
+      !
+      IF( ln_sco ) THEN                                         ! s-coordinate stiffness
+         CALL dom_stiff( zprt )
+         CALL iom_rstput( 0, 0, inum, 'stiffness', zprt )       ! Max. grid stiffness ratio
+      ENDIF
+      !
+      !                                     ! ============================
+      CALL iom_close( inum )                !        close the files 
+      !                                     ! ============================
+   END SUBROUTINE dom_wri
+
+
+   SUBROUTINE dom_uniq( puniq, cdgrd )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_uniq  ***
+      !!                   
+      !! ** Purpose :   identify unique point of a grid (TUVF)
+      !!
+      !! ** Method  :   1) aplly lbc_lnk on an array with different values for each element
+      !!                2) check which elements have been changed
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)        , INTENT(in   ) ::   cdgrd   ! 
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   puniq   ! 
+      !
+      REAL(wp) ::  zshift   ! shift value link to the process number
+      INTEGER  ::  ji       ! dummy loop indices
+      LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) ::  lldbl  ! store whether each point is unique or not
+      REAL(wp), DIMENSION(jpi,jpj) ::   ztstref
+      !!----------------------------------------------------------------------
+      !
+      ! build an array with different values for each element 
+      ! in mpp: make sure that these values are different even between process
+      ! -> apply a shift value according to the process number
+      zshift = jpi * jpj * ( narea - 1 )
+      ztstref(:,:) = RESHAPE( (/ (zshift + REAL(ji,wp), ji = 1, jpi*jpj) /), (/ jpi, jpj /) )
+      !
+      puniq(:,:) = ztstref(:,:)                   ! default definition
+      CALL lbc_lnk( 'domwri', puniq, cdgrd, 1. )            ! apply boundary conditions
+      lldbl(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have been changed 
+      !
+      puniq(:,:) = 1.                             ! default definition
+      ! fill only the inner part of the cpu with llbl converted into real 
+      puniq(nldi:nlei,nldj:nlej) = REAL( COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ) , wp )
+      !
+   END SUBROUTINE dom_uniq
+
+
+   SUBROUTINE dom_stiff( px1 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_stiff  ***
+      !!                     
+      !! ** Purpose :   Diagnose maximum grid stiffness/hydrostatic consistency
+      !!
+      !! ** Method  :   Compute Haney (1991) hydrostatic condition ratio
+      !!                Save the maximum in the vertical direction
+      !!                (this number is only relevant in s-coordinates)
+      !!
+      !!                Haney, 1991, J. Phys. Oceanogr., 21, 610-619.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(out), OPTIONAL ::   px1   ! stiffness
+      !
+      INTEGER  ::   ji, jj, jk 
+      REAL(wp) ::   zrxmax
+      REAL(wp), DIMENSION(4) ::   zr1
+      REAL(wp), DIMENSION(jpi,jpj) ::   zx1
+      !!----------------------------------------------------------------------
+      zx1(:,:) = 0._wp
+      zrxmax   = 0._wp
+      zr1(:)   = 0._wp
+      !
+      DO ji = 2, jpim1
+         DO jj = 2, jpjm1
+            DO jk = 1, jpkm1
+!!gm   remark: dk(gdepw) = e3t   ===>>>  possible simplification of the following calculation....
+!!             especially since it is gde3w which is used to compute the pressure gradient
+!!             furthermore, I think gdept_0 should be used below instead of w point in the numerator
+!!             so that the ratio is computed at the same point (i.e. uw and vw) ....
+               zr1(1) = ABS(  ( gdepw_0(ji  ,jj,jk  )-gdepw_0(ji-1,jj,jk  )               & 
+                    &          +gdepw_0(ji  ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) )             &
+                    &       / ( gdepw_0(ji  ,jj,jk  )+gdepw_0(ji-1,jj,jk  )               &
+                    &          -gdepw_0(ji  ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) + rsmall )  ) * umask(ji-1,jj,jk)
+               zr1(2) = ABS(  ( gdepw_0(ji+1,jj,jk  )-gdepw_0(ji  ,jj,jk  )               &
+                    &          +gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji  ,jj,jk+1) )             &
+                    &       / ( gdepw_0(ji+1,jj,jk  )+gdepw_0(ji  ,jj,jk  )               &
+                    &          -gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji  ,jj,jk+1) + rsmall )  ) * umask(ji  ,jj,jk)
+               zr1(3) = ABS(  ( gdepw_0(ji,jj+1,jk  )-gdepw_0(ji,jj  ,jk  )               &
+                    &          +gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj  ,jk+1) )             &
+                    &       / ( gdepw_0(ji,jj+1,jk  )+gdepw_0(ji,jj  ,jk  )               &
+                    &          -gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj  ,jk+1) + rsmall )  ) * vmask(ji,jj  ,jk)
+               zr1(4) = ABS(  ( gdepw_0(ji,jj  ,jk  )-gdepw_0(ji,jj-1,jk  )               &
+                    &          +gdepw_0(ji,jj  ,jk+1)-gdepw_0(ji,jj-1,jk+1) )             &
+                    &       / ( gdepw_0(ji,jj  ,jk  )+gdepw_0(ji,jj-1,jk  )               &
+                    &          -gdepw_0(ji,jj  ,jk+1)-gdepw_0(ji,jj-1,jk+1) + rsmall )  ) * vmask(ji,jj-1,jk)
+               zrxmax = MAXVAL( zr1(1:4) )
+               zx1(ji,jj) = MAX( zx1(ji,jj) , zrxmax )
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( 'domwri', zx1, 'T', 1. )
+      !
+      IF( PRESENT( px1 ) )    px1 = zx1
+      !
+      zrxmax = MAXVAL( zx1 )
+      !
+      CALL mpp_max( 'domwri', zrxmax ) ! max over the global domain
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_stiff : maximum grid stiffness ratio: ', zrxmax
+         WRITE(numout,*) '~~~~~~~~~'
+      ENDIF
+      !
+   END SUBROUTINE dom_stiff
+
+   !!======================================================================
+END MODULE domwri
Index: /utils/tools_ticket2413/DOMAINcfg/src/domzgr.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/domzgr.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/domzgr.F90	(revision 12863)
@@ -0,0 +1,1932 @@
+MODULE domzgr
+   !!==============================================================================
+   !!                       ***  MODULE domzgr   ***
+   !! Ocean domain : definition of the vertical coordinate system
+   !!==============================================================================
+   !! History :  OPA  ! 1995-12  (G. Madec)  Original code : s vertical coordinate
+   !!                 ! 1997-07  (G. Madec)  lbc_lnk call
+   !!                 ! 1997-04  (J.-O. Beismann) 
+   !!            8.5  ! 2002-09  (A. Bozec, G. Madec)  F90: Free form and module
+   !!             -   ! 2002-09  (A. de Miranda)  rigid-lid + islands
+   !!  NEMO      1.0  ! 2003-08  (G. Madec)  F90: Free form and module
+   !!             -   ! 2005-10  (A. Beckmann)  modifications for hybrid s-ccordinates & new stretching function
+   !!            2.0  ! 2006-04  (R. Benshila, G. Madec)  add zgr_zco
+   !!            3.0  ! 2008-06  (G. Madec)  insertion of domzgr_zps.h90 & conding style
+   !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option
+   !!            3.3  ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level
+   !!            3.4  ! 2012-08  (J. Siddorn) added Siddorn and Furner stretching function
+   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  modify C1D case  
+   !!            3.6  ! 2014-11  (P. Mathiot and C. Harris) add ice shelf capability
+   !!            3.?  ! 2015-11  (H. Liu) Modifications for Wetting/Drying
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_zgr          : defined the ocean vertical coordinate system
+   !!       zgr_bat      : bathymetry fields (levels and meters)
+   !!       zgr_bat_zoom : modify the bathymetry field if zoom domain
+   !!       zgr_bat_ctl  : check the bathymetry files
+   !!       zgr_bot_level: deepest ocean level for t-, u, and v-points
+   !!       zgr_z        : reference z-coordinate 
+   !!       zgr_zco      : z-coordinate 
+   !!       zgr_zps      : z-coordinate with partial steps
+   !!       zgr_sco      : s-coordinate
+   !!       fssig        : tanh stretch function
+   !!       fssig1       : Song and Haidvogel 1994 stretch function
+   !!       fgamma       : Siddorn and Furner 2012 stretching function
+   !!---------------------------------------------------------------------
+   USE dom_oce           ! ocean domain
+   !
+   USE in_out_manager    ! I/O manager
+   USE iom               ! I/O library
+   USE lbclnk            ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp           ! distributed memory computing library
+   USE lib_fortran
+   USE dombat
+   USE domisf
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_zgr        ! called by dom_init.F90
+   !
+   !                              !!* Namelist namzgr_sco *
+   LOGICAL  ::   ln_s_sh94         ! use hybrid s-sig Song and Haidvogel 1994 stretching function fssig1 (ln_sco=T)
+   LOGICAL  ::   ln_s_sf12         ! use hybrid s-z-sig Siddorn and Furner 2012 stretching function fgamma (ln_sco=T)
+   !
+   REAL(wp) ::   rn_sbot_min       ! minimum depth of s-bottom surface (>0) (m)
+   REAL(wp) ::   rn_sbot_max       ! maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+   REAL(wp) ::   rn_rmax           ! maximum cut-off r-value allowed (0<rn_rmax<1)
+   REAL(wp) ::   rn_hc             ! Critical depth for transition from sigma to stretched coordinates
+
+   ! Song and Haidvogel 1994 stretching parameters
+   REAL(wp) ::   rn_theta          ! surface control parameter (0<=rn_theta<=20)
+   REAL(wp) ::   rn_thetb          ! bottom control parameter  (0<=rn_thetb<= 1)
+   REAL(wp) ::   rn_bb             ! stretching parameter 
+   !                                        ! ( rn_bb=0; top only, rn_bb =1; top and bottom)
+   ! Siddorn and Furner stretching parameters
+   LOGICAL  ::   ln_sigcrit        ! use sigma coordinates below critical depth (T) or Z coordinates (F) for Siddorn & Furner stretch 
+   REAL(wp) ::   rn_alpha          ! control parameter ( > 1 stretch towards surface, < 1 towards seabed)
+   REAL(wp) ::   rn_efold          !  efold length scale for transition to stretched coord
+   REAL(wp) ::   rn_zs             !  depth of surface grid box
+                           !  bottom cell depth (Zb) is a linear function of water depth Zb = H*a + b
+   REAL(wp) ::   rn_zb_a           !  bathymetry scaling factor for calculating Zb
+   REAL(wp) ::   rn_zb_b           !  offset for calculating Zb
+
+  !! * Substitutions
+   !!----------------------------------------------------------------------
+   !!                   ***  vectopt_loop_substitute  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute the inner loop start/end indices with CPP macro
+   !!                allow unrolling of do-loop (useful with vector processors)
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
+   !! $Id: vectopt_loop_substitute.h90 4990 2014-12-15 16:42:49Z timgraham $ 
+   !! Software governed by the CeCILL licence (./LICENSE)
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3.1 , NEMO Consortium (2011)
+   !! $Id: domzgr.F90 6827 2016-08-01 13:37:15Z flavoni $
+   !! Software governed by the CeCILL licence     (./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS       
+
+   SUBROUTINE dom_zgr
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE dom_zgr  ***
+      !!                   
+      !! ** Purpose :   set the depth of model levels and the resulting 
+      !!              vertical scale factors.
+      !!
+      !! ** Method  : - reference 1D vertical coordinate (gdep._1d, e3._1d)
+      !!              - read/set ocean depth and ocean levels (bathy, mbathy)
+      !!              - vertical coordinate (gdep., e3.) depending on the 
+      !!                coordinate chosen :
+      !!                   ln_zco=T   z-coordinate   
+      !!                   ln_zps=T   z-coordinate with partial steps
+      !!                   ln_zco=T   s-coordinate 
+      !!
+      !! ** Action  :   define gdep., e3., mbathy and bathy
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio, ibat   ! local integer
+      INTEGER ::   ios
+      !
+      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav, ln_linssh
+      !!----------------------------------------------------------------------
+      !
+      !
+      REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate
+      READ  ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : Vertical coordinate
+      READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namzgr )
+
+      IF(lwp) THEN                     ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_zgr : vertical coordinate'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '   Namelist namzgr : set vertical coordinate'
+         WRITE(numout,*) '      z-coordinate - full steps      ln_zco    = ', ln_zco
+         WRITE(numout,*) '      z-coordinate - partial steps   ln_zps    = ', ln_zps
+         WRITE(numout,*) '      s- or hybrid z-s-coordinate    ln_sco    = ', ln_sco
+         WRITE(numout,*) '      ice shelf cavities             ln_isfcav = ', ln_isfcav
+         WRITE(numout,*) '      linear free surface            ln_linssh = ', ln_linssh
+      ENDIF
+
+      IF( ln_linssh .AND. lwp) WRITE(numout,*) '   linear free surface: the vertical mesh does not change in time'
+
+      ioptio = 0                       ! Check Vertical coordinate options
+      IF( ln_zco      )   ioptio = ioptio + 1
+      IF( ln_zps      )   ioptio = ioptio + 1
+      IF( ln_sco      )   ioptio = ioptio + 1
+      IF( ioptio /= 1 )   CALL ctl_stop( ' none or several vertical coordinate options used' )
+      !
+      IF ( ln_isfcav ) CALL zgr_isf_nam
+      ioptio = 0
+      IF ( ln_zco .AND. ln_isfcav ) ioptio = ioptio + 1
+      IF ( ln_sco .AND. ln_isfcav ) ioptio = ioptio + 1
+      IF( ioptio > 0 )   CALL ctl_stop( ' Cavity not tested/compatible with full step (zco) and sigma (ln_sco) ' )
+      !
+      ! Build the vertical coordinate system
+      ! ------------------------------------
+                          CALL zgr_z            ! Reference z-coordinate system (always called)
+                          CALL zgr_bat          ! Bathymetry fields (levels and meters)
+      IF( ln_zco      )   CALL zgr_zco          ! z-coordinate
+      IF( ln_zps      )   CALL zgr_zps          ! Partial step z-coordinate
+      IF( ln_sco      )   CALL zgr_sco          ! s-coordinate or hybrid z-s coordinate
+                          CALL zgr_bat_ctl      ! check bathymetry (mbathy) and suppress isolated ocean points
+      !
+      ! final adjustment of mbathy & check 
+      ! -----------------------------------
+                          CALL zgr_bot_level    ! deepest ocean level for t-, u- and v-points
+                          CALL zgr_top_level    ! shallowest ocean level for T-, U-, V- points
+      !
+      IF( nprint == 1 .AND. lwp )   THEN
+         WRITE(numout,*) ' MIN val mbathy  ', MINVAL(  mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) )
+         WRITE(numout,*) ' MIN val depth t ', MINVAL( gdept_0(:,:,:) ),   &
+            &                          ' w ', MINVAL( gdepw_0(:,:,:) )
+         WRITE(numout,*) ' MIN val e3    t ', MINVAL(   e3t_0(:,:,:) ), ' f ', MINVAL(   e3f_0(:,:,:) ),  &
+            &                          ' u ', MINVAL(   e3u_0(:,:,:) ), ' u ', MINVAL(   e3v_0(:,:,:) ),  &
+            &                          ' uw', MINVAL(  e3uw_0(:,:,:) ), ' vw', MINVAL(  e3vw_0(:,:,:)),   &
+            &                          ' w ', MINVAL(   e3w_0(:,:,:) )
+
+         WRITE(numout,*) ' MAX val depth t ', MAXVAL( gdept_0(:,:,:) ),   &
+            &                          ' w ', MAXVAL( gdepw_0(:,:,:) )
+         WRITE(numout,*) ' MAX val e3    t ', MAXVAL(   e3t_0(:,:,:) ), ' f ', MAXVAL(   e3f_0(:,:,:) ),  &
+            &                          ' u ', MAXVAL(   e3u_0(:,:,:) ), ' u ', MAXVAL(   e3v_0(:,:,:) ),  &
+            &                          ' uw', MAXVAL(  e3uw_0(:,:,:) ), ' vw', MAXVAL(  e3vw_0(:,:,:) ),  &
+            &                          ' w ', MAXVAL(   e3w_0(:,:,:) )
+      ENDIF
+      !
+   END SUBROUTINE dom_zgr
+
+
+   SUBROUTINE zgr_z
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE zgr_z  ***
+      !!                   
+      !! ** Purpose :   set the depth of model levels and the resulting 
+      !!      vertical scale factors.
+      !!
+      !! ** Method  :   z-coordinate system (use in all type of coordinate)
+      !!        The depth of model levels is defined from an analytical
+      !!      function the derivative of which gives the scale factors.
+      !!        both depth and scale factors only depend on k (1d arrays).
+      !!              w-level: gdepw_1d  = gdep(k)
+      !!                       e3w_1d(k) = dk(gdep)(k)     = e3(k)
+      !!              t-level: gdept_1d  = gdep(k+0.5)
+      !!                       e3t_1d(k) = dk(gdep)(k+0.5) = e3(k+0.5)
+      !!
+      !! ** Action  : - gdept_1d, gdepw_1d : depth of T- and W-point (m)
+      !!              - e3t_1d  , e3w_1d   : scale factors at T- and W-levels (m)
+      !!
+      !! Reference : Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766.
+      !!----------------------------------------------------------------------
+      INTEGER  ::   jk                     ! dummy loop indices
+      REAL(wp) ::   zt, zw                 ! temporary scalars
+      REAL(wp) ::   zsur, za0, za1, zkth   ! Values set from parameters in
+      REAL(wp) ::   zacr, zdzmin, zhmax    ! par_CONFIG_Rxx.h90
+      REAL(wp) ::   zrefdep                ! depth of the reference level (~10m)
+      REAL(wp) ::   za2, zkth2, zacr2      ! Values for optional double tanh function set from parameters 
+      !!----------------------------------------------------------------------
+      !
+      ! Set variables from parameters
+      ! ------------------------------
+       zkth = ppkth       ;   zacr = ppacr
+       zdzmin = ppdzmin   ;   zhmax = pphmax
+       zkth2 = ppkth2     ;   zacr2 = ppacr2   ! optional (ldbletanh=T) double tanh parameters
+
+      ! If ppa1 and ppa0 and ppsur are et to pp_to_be_computed
+      !  za0, za1, zsur are computed from ppdzmin , pphmax, ppkth, ppacr
+      IF(   ppa1  == pp_to_be_computed  .AND.  &
+         &  ppa0  == pp_to_be_computed  .AND.  &
+         &  ppsur == pp_to_be_computed           ) THEN
+         !
+         za1  = (  ppdzmin - pphmax / FLOAT(jpkm1)  )                                                      &
+            & / ( TANH((1-ppkth)/ppacr) - ppacr/FLOAT(jpk-1) * (  LOG( COSH( (jpk - ppkth) / ppacr) )      &
+            &                                                   - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
+         za0  = ppdzmin - za1 *              TANH( (1-ppkth) / ppacr )
+         zsur =   - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
+      ELSE
+         za1 = ppa1 ;       za0 = ppa0 ;          zsur = ppsur
+         za2 = ppa2                            ! optional (ldbletanh=T) double tanh parameter
+      ENDIF
+
+      IF(lwp) THEN                         ! Parameter print
+         WRITE(numout,*)
+         WRITE(numout,*) '    zgr_z   : Reference vertical z-coordinates'
+         WRITE(numout,*) '    ~~~~~~~'
+         IF(  ppkth == 0._wp ) THEN              
+              WRITE(numout,*) '            Uniform grid with ',jpk-1,' layers'
+              WRITE(numout,*) '            Total depth    :', zhmax
+              WRITE(numout,*) '            Layer thickness:', zhmax/(jpk-1)
+         ELSE
+            IF( ppa1 == 0._wp .AND. ppa0 == 0._wp .AND. ppsur == 0._wp ) THEN
+               WRITE(numout,*) '         zsur, za0, za1 computed from '
+               WRITE(numout,*) '                 zdzmin = ', zdzmin
+               WRITE(numout,*) '                 zhmax  = ', zhmax
+            ENDIF
+            WRITE(numout,*) '           Value of coefficients for vertical mesh:'
+            WRITE(numout,*) '                 zsur = ', zsur
+            WRITE(numout,*) '                 za0  = ', za0
+            WRITE(numout,*) '                 za1  = ', za1
+            WRITE(numout,*) '                 zkth = ', zkth
+            WRITE(numout,*) '                 zacr = ', zacr
+            IF( ldbletanh ) THEN
+               WRITE(numout,*) ' (Double tanh    za2  = ', za2
+               WRITE(numout,*) '  parameters)    zkth2= ', zkth2
+               WRITE(numout,*) '                 zacr2= ', zacr2
+            ENDIF
+         ENDIF
+      ENDIF
+
+
+      ! Reference z-coordinate (depth - scale factor at T- and W-points)
+      ! ======================
+      IF( ppkth == 0._wp ) THEN            !  uniform vertical grid 
+
+
+
+         za1 = zhmax / FLOAT(jpk-1) 
+
+         DO jk = 1, jpk
+            zw = FLOAT( jk )
+            zt = FLOAT( jk ) + 0.5_wp
+            gdepw_1d(jk) = ( zw - 1 ) * za1
+            gdept_1d(jk) = ( zt - 1 ) * za1
+            e3w_1d  (jk) =  za1
+            e3t_1d  (jk) =  za1
+         END DO
+      ELSE                                ! Madec & Imbard 1996 function
+         IF( .NOT. ldbletanh ) THEN
+            DO jk = 1, jpk
+               zw = REAL( jk , wp )
+               zt = REAL( jk , wp ) + 0.5_wp
+               gdepw_1d(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth) / zacr ) )  )
+               gdept_1d(jk) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth) / zacr ) )  )
+               e3w_1d  (jk) =          za0      + za1        * TANH(       (zw-zkth) / zacr   )
+               e3t_1d  (jk) =          za0      + za1        * TANH(       (zt-zkth) / zacr   )
+            END DO
+         ELSE
+            DO jk = 1, jpk
+               zw = FLOAT( jk )
+               zt = FLOAT( jk ) + 0.5_wp
+               ! Double tanh function
+               gdepw_1d(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth ) / zacr  ) )    &
+                  &                             + za2 * zacr2* LOG ( COSH( (zw-zkth2) / zacr2 ) )  )
+               gdept_1d(jk) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth ) / zacr  ) )    &
+                  &                             + za2 * zacr2* LOG ( COSH( (zt-zkth2) / zacr2 ) )  )
+               e3w_1d  (jk) =          za0      + za1        * TANH(       (zw-zkth ) / zacr  )      &
+                  &                             + za2        * TANH(       (zw-zkth2) / zacr2 )
+               e3t_1d  (jk) =          za0      + za1        * TANH(       (zt-zkth ) / zacr  )      &
+                  &                             + za2        * TANH(       (zt-zkth2) / zacr2 )
+            END DO
+         ENDIF
+         gdepw_1d(1) = 0._wp                    ! force first w-level to be exactly at zero
+      ENDIF
+
+      IF ( ln_isfcav .OR. ln_e3_dep ) THEN      ! e3. = dk[gdep]   
+         !
+         DO jk = 1, jpkm1
+            e3t_1d(jk) = gdepw_1d(jk+1)-gdepw_1d(jk) 
+         END DO
+         e3t_1d(jpk) = e3t_1d(jpk-1)   ! we don't care because this level is masked in NEMO
+
+         DO jk = 2, jpk
+            e3w_1d(jk) = gdept_1d(jk) - gdept_1d(jk-1) 
+         END DO
+         e3w_1d(1  ) = 2._wp * (gdept_1d(1) - gdepw_1d(1)) 
+      END IF
+
+!!gm BUG in s-coordinate this does not work!
+      ! deepest/shallowest W level Above/Below ~10m
+      zrefdep = 10._wp - 0.1_wp * MINVAL( e3w_1d )                   ! ref. depth with tolerance (10% of minimum layer thickness)
+      nlb10 = MINLOC( gdepw_1d, mask = gdepw_1d > zrefdep, dim = 1 ) ! shallowest W level Below ~10m
+      nla10 = nlb10 - 1                                              ! deepest    W level Above ~10m
+!!gm end bug
+
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) '              Reference z-coordinate depth and scale factors:'
+         WRITE(numout, "(9x,' level  gdept_1d  gdepw_1d  e3t_1d   e3w_1d  ')" )
+         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, gdept_1d(jk), gdepw_1d(jk), e3t_1d(jk), e3w_1d(jk), jk = 1, jpk )
+      ENDIF
+      DO jk = 1, jpk                      ! control positivity
+         IF( e3w_1d  (jk) <= 0._wp .OR. e3t_1d  (jk) <= 0._wp )   CALL ctl_stop( 'dom:zgr_z: e3w_1d or e3t_1d =< 0 '    )
+         IF( gdepw_1d(jk) <  0._wp .OR. gdept_1d(jk) <  0._wp )   CALL ctl_stop( 'dom:zgr_z: gdepw_1d or gdept_1d < 0 ' )
+      END DO
+      !
+   END SUBROUTINE zgr_z
+
+
+   SUBROUTINE zgr_bat
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_bat  ***
+      !! 
+      !! ** Purpose :   set bathymetry both in levels and meters
+      !!
+      !! ** Method  :   read or define mbathy and bathy arrays
+      !!       * level bathymetry:
+      !!      The ocean basin geometry is given by a two-dimensional array,
+      !!      mbathy, which is defined as follow :
+      !!            mbathy(ji,jj) = 1, ..., jpk-1, the number of ocean level
+      !!                              at t-point (ji,jj).
+      !!                            = 0  over the continental t-point.
+      !!      The array mbathy is checked to verified its consistency with
+      !!      model option. in particular:
+      !!            mbathy must have at least 1 land grid-points (mbathy<=0)
+      !!                  along closed boundary.
+      !!            mbathy must be cyclic IF jperio=1.
+      !!            mbathy must be lower or equal to jpk-1.
+      !!            isolated ocean grid points are suppressed from mbathy
+      !!                  since they are only connected to remaining
+      !!                  ocean through vertical diffusion.
+      !!      ntopo=-1 :   rectangular channel or bassin with a bump 
+      !!      ntopo= 0 :   flat rectangular channel or basin 
+      !!      ntopo= 1 :   mbathy is read in 'bathy_level.nc' NetCDF file
+      !!                   bathy  is read in 'bathy_meter.nc' NetCDF file
+      !!
+      !! ** Action  : - mbathy: level bathymetry (in level index)
+      !!              - bathy : meter bathymetry (in meters)
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk            ! dummy loop indices
+      INTEGER  ::   inum                      ! temporary logical unit
+      INTEGER  ::   ierror                    ! error flag
+      INTEGER  ::   ii_bump, ij_bump, ih      ! bump center position
+      INTEGER  ::   ii0, ii1, ij0, ij1, ik    ! local indices
+      REAL(wp) ::   r_bump , h_bump , h_oce   ! bump characteristics 
+      REAL(wp) ::   zi, zj, zh, zhmin         ! local scalars
+      INTEGER , ALLOCATABLE, DIMENSION(:,:) ::   idta   ! global domain integer data
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdta   ! global domain scalar data
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_bat : defines level and meter bathymetry'
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~'
+      !                                               ! ================== ! 
+      IF( ntopo == 0 .OR. ntopo == -1 ) THEN          !   defined by hand  !
+         !                                            ! ================== !
+         !                                            ! global domain level and meter bathymetry (idta,zdta)
+         !
+         ALLOCATE( idta(jpiglo,jpjglo), STAT=ierror )
+         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'zgr_bat: unable to allocate idta array' )
+         ALLOCATE( zdta(jpiglo,jpjglo), STAT=ierror )
+         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'zgr_bat: unable to allocate zdta array' )
+         !
+         IF( ntopo == 0 ) THEN                        ! flat basin
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '         bathymetry field: flat basin'
+            IF( rn_bathy > 0.01 ) THEN 
+               IF(lwp) WRITE(numout,*) '         Depth = rn_bathy read in namelist'
+               zdta(:,:) = rn_bathy
+               IF( ln_sco ) THEN                                   ! s-coordinate (zsc       ): idta()=jpk
+                  idta(:,:) = jpkm1
+               ELSE                                                ! z-coordinate (zco or zps): step-like topography
+                  idta(:,:) = jpkm1
+                  DO jk = 1, jpkm1
+                     WHERE( gdept_1d(jk) < zdta(:,:) .AND. zdta(:,:) <= gdept_1d(jk+1) )   idta(:,:) = jk
+                  END DO
+               ENDIF
+            ELSE
+               IF(lwp) WRITE(numout,*) '         Depth = depthw(jpkm1)'
+               idta(:,:) = jpkm1                            ! before last level
+               zdta(:,:) = gdepw_1d(jpk)                     ! last w-point depth
+               h_oce     = gdepw_1d(jpk)
+            ENDIF
+         ELSE                                         ! bump centered in the basin
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '         bathymetry field: flat basin with a bump'
+            ii_bump = jpiglo / 2                           ! i-index of the bump center
+            ij_bump = jpjglo / 2                           ! j-index of the bump center
+            r_bump  = 50000._wp                            ! bump radius (meters)       
+            h_bump  =  2700._wp                            ! bump height (meters)
+            h_oce   = gdepw_1d(jpk)                        ! background ocean depth (meters)
+            IF(lwp) WRITE(numout,*) '            bump characteristics: '
+            IF(lwp) WRITE(numout,*) '               bump center (i,j)   = ', ii_bump, ii_bump
+            IF(lwp) WRITE(numout,*) '               bump height         = ', h_bump , ' meters'
+            IF(lwp) WRITE(numout,*) '               bump radius         = ', r_bump , ' index'
+            IF(lwp) WRITE(numout,*) '            background ocean depth = ', h_oce  , ' meters'
+            !                                        
+            DO jj = 1, jpjglo                              ! zdta :
+               DO ji = 1, jpiglo
+                  zi = FLOAT( ji - ii_bump ) * ppe1_m / r_bump
+                  zj = FLOAT( jj - ij_bump ) * ppe2_m / r_bump
+                  zdta(ji,jj) = h_oce - h_bump * EXP( -( zi*zi + zj*zj ) )
+               END DO
+            END DO
+            !                                              ! idta :
+            IF( ln_sco ) THEN                                   ! s-coordinate (zsc       ): idta()=jpk
+               idta(:,:) = jpkm1
+            ELSE                                                ! z-coordinate (zco or zps): step-like topography
+               idta(:,:) = jpkm1
+               DO jk = 1, jpkm1
+                  WHERE( gdept_1d(jk) < zdta(:,:) .AND. zdta(:,:) <= gdept_1d(jk+1) )   idta(:,:) = jk
+               END DO
+            ENDIF
+         ENDIF
+         !
+         !                                            ! set GLOBAL boundary conditions 
+         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
+            idta( :    , 1    ) = -1                ;      zdta( :    , 1    ) = -1._wp
+            idta( :    ,jpjglo) =  0                ;      zdta( :    ,jpjglo) =  0._wp
+         ELSEIF( jperio == 2 ) THEN
+            idta( :    , 1    ) = idta( : ,  3  )   ;      zdta( :    , 1    ) = zdta( : ,  3  )
+            idta( :    ,jpjglo) = 0                 ;      zdta( :    ,jpjglo) =  0._wp
+            idta( 1    , :    ) = 0                 ;      zdta( 1    , :    ) =  0._wp
+            idta(jpiglo, :    ) = 0                 ;      zdta(jpiglo, :    ) =  0._wp
+         ELSE
+            ih = 0                                  ;      zh = 0._wp
+            IF( ln_sco )   ih = jpkm1               ;      IF( ln_sco )   zh = h_oce
+            idta( :    , 1    ) = ih                ;      zdta( :    , 1    ) =  zh
+            idta( :    ,jpjglo) = ih                ;      zdta( :    ,jpjglo) =  zh
+            idta( 1    , :    ) = ih                ;      zdta( 1    , :    ) =  zh
+            idta(jpiglo, :    ) = ih                ;      zdta(jpiglo, :    ) =  zh
+         ENDIF
+
+         !                                            ! local domain level and meter bathymetries (mbathy,bathy)
+         mbathy(:,:) = 0                                   ! set to zero extra halo points
+         bathy (:,:) = 0._wp                               ! (require for mpp case)
+         DO jj = 1, nlcj                                   ! interior values
+            DO ji = 1, nlci
+               mbathy(ji,jj) = idta( mig(ji), mjg(jj) )
+               bathy (ji,jj) = zdta( mig(ji), mjg(jj) )
+            END DO
+         END DO
+         risfdep(:,:)=0.e0
+         misfdep(:,:)=1
+         !
+         DEALLOCATE( idta, zdta )
+         !
+         !                                            ! ================ !
+      ELSEIF( ntopo == 1 .OR. ntopo ==2 ) THEN                       !   read in file   ! (over the local domain)
+         !                                            ! ================ !
+         !
+         IF( ln_zco )   THEN                          ! zco : read level bathymetry 
+            CALL iom_open ( 'bathy_level.nc', inum )  
+            CALL iom_get  ( inum, jpdom_data, 'Bathy_level', bathy )
+            CALL iom_close( inum )
+            mbathy(:,:) = INT( bathy(:,:) )
+            ! initialisation isf variables
+            risfdep(:,:)=0._wp ; misfdep(:,:)=1             
+            !                                                ! =====================
+            IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
+               !                                             ! =====================
+               !
+               ii0 = 140   ;   ii1 = 140                  ! Gibraltar Strait open 
+               ij0 = 102   ;   ij1 = 102                  ! (Thomson, Ocean Modelling, 1995)
+               DO ji = mi0(ii0), mi1(ii1)
+                  DO jj = mj0(ij0), mj1(ij1)
+                     mbathy(ji,jj) = 15
+                  END DO
+               END DO
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) '      orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0
+               !
+               ii0 = 160   ;   ii1 = 160                  ! Bab el mandeb Strait open
+               ij0 = 88    ;   ij1 = 88                   ! (Thomson, Ocean Modelling, 1995)
+               DO ji = mi0(ii0), mi1(ii1)
+                  DO jj = mj0(ij0), mj1(ij1)
+                     mbathy(ji,jj) = 12
+                  END DO
+               END DO
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) '      orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0
+               !
+            ENDIF
+            !
+         ENDIF
+         IF( ln_zps .OR. ln_sco )   THEN              ! zps or sco : read meter bathymetry
+#if defined key_agrif
+            IF (agrif_root()) THEN
+#endif
+            IF( ntopo == 1) THEN
+               CALL iom_open ( 'bathy_meter.nc', inum ) 
+               IF ( ln_isfcav ) THEN
+                  CALL iom_get  ( inum, jpdom_data, 'Bathymetry_isf', bathy, lrowattr=.false. )
+               ELSE
+                  CALL iom_get  ( inum, jpdom_data, 'Bathymetry'    , bathy, lrowattr=ln_use_jattr  )
+               END IF
+               CALL iom_close( inum )
+            ELSE
+               CALL dom_bat
+            ENDIF       
+#if defined key_agrif
+            ELSE
+               IF( ntopo == 1) THEN
+                  CALL agrif_create_bathy_meter()
+               ELSE 
+                  CALL dom_bat 
+               ENDIF    
+            ENDIF
+#endif
+            !                                                
+            ! initialisation isf variables
+            risfdep(:,:)=0._wp ; misfdep(:,:)=1             
+            !
+            IF ( ln_isfcav ) THEN
+               CALL iom_open ( 'isf_draft_meter.nc', inum ) 
+               CALL iom_get  ( inum, jpdom_data, 'isf_draft', risfdep )
+               CALL iom_close( inum )
+            END IF
+            !       
+            IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
+            !
+              ii0 = 140   ;   ii1 = 140                   ! Gibraltar Strait open 
+              ij0 = 102   ;   ij1 = 102                   ! (Thomson, Ocean Modelling, 1995)
+              DO ji = mi0(ii0), mi1(ii1)
+                 DO jj = mj0(ij0), mj1(ij1)
+                    bathy(ji,jj) = 284._wp
+                 END DO
+               END DO
+              IF(lwp) WRITE(numout,*)     
+              IF(lwp) WRITE(numout,*) '      orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0
+              !
+              ii0 = 160   ;   ii1 = 160                   ! Bab el mandeb Strait open
+              ij0 = 88    ;   ij1 = 88                    ! (Thomson, Ocean Modelling, 1995)
+               DO ji = mi0(ii0), mi1(ii1)
+                 DO jj = mj0(ij0), mj1(ij1)
+                    bathy(ji,jj) = 137._wp
+                 END DO
+              END DO
+              IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) '             orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0
+              !
+           ENDIF
+            !
+        ENDIF
+         !                                            ! =============== !
+      ELSE                                            !      error      !
+         !                                            ! =============== !
+         WRITE(ctmp1,*) 'parameter , ntopo = ', ntopo
+         CALL ctl_stop( '    zgr_bat : '//trim(ctmp1) )
+      ENDIF
+      !
+      IF ( .not. ln_sco ) THEN                                !==  set a minimum depth  ==!
+         IF( rn_hmin < 0._wp ) THEN    ;   ik = - INT( rn_hmin )                                      ! from a nb of level
+         ELSE                          ;   ik = MINLOC( gdepw_1d, mask = gdepw_1d > rn_hmin, dim = 1 )  ! from a depth
+         ENDIF
+         zhmin = gdepw_1d(ik+1)                                                        ! minimum depth = ik+1 w-levels 
+         WHERE( bathy(:,:) <= 0._wp )   ;   bathy(:,:) = 0._wp                         ! min=0     over the lands
+         ELSE WHERE ( risfdep == 0._wp );   bathy(:,:) = MAX(  zhmin , bathy(:,:)  )   ! min=zhmin over the oceans
+         END WHERE
+         IF(lwp) write(numout,*) 'Minimum ocean depth: ', zhmin, ' minimum number of ocean levels : ', ik
+      ENDIF
+      !
+   END SUBROUTINE zgr_bat
+
+   SUBROUTINE zgr_bat_ctl
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_bat_ctl  ***
+      !!
+      !! ** Purpose :   check the bathymetry in levels
+      !!
+      !! ** Method  :   The array mbathy is checked to verified its consistency
+      !!      with the model options. in particular:
+      !!            mbathy must have at least 1 land grid-points (mbathy<=0)
+      !!                  along closed boundary.
+      !!            mbathy must be cyclic IF jperio=1.
+      !!            mbathy must be lower or equal to jpk-1.
+      !!            isolated ocean grid points are suppressed from mbathy
+      !!                  since they are only connected to remaining
+      !!                  ocean through vertical diffusion.
+      !!      C A U T I O N : mbathy will be modified during the initializa-
+      !!      tion phase to become the number of non-zero w-levels of a water
+      !!      column, with a minimum value of 1.
+      !!
+      !! ** Action  : - update mbathy: level bathymetry (in level index)
+      !!              - update bathy : meter bathymetry (in meters)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jl                    ! dummy loop indices
+      INTEGER ::   icompt, ibtest, ikmax         ! temporary integers
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::  zbathy
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE(zbathy(jpi,jpj))
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_bat_ctl : check the bathymetry'
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~'
+      !                                          ! Suppress isolated ocean grid points
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*)'                   suppress isolated ocean grid points'
+      IF(lwp) WRITE(numout,*)'                   -----------------------------------'
+      icompt = 0
+      DO jl = 1, 2
+         IF( l_Iperio ) THEN
+            mbathy( 1 ,:) = mbathy(jpim1,:)           ! local domain is cyclic east-west
+            mbathy(jpi,:) = mbathy(  2  ,:)
+         ENDIF
+         zbathy(:,:) = FLOAT( mbathy(:,:) )
+         CALL lbc_lnk( 'domzgr',zbathy, 'T', 1._wp )
+         mbathy(:,:) = INT( zbathy(:,:) )
+         
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               ibtest = MAX(  mbathy(ji-1,jj), mbathy(ji+1,jj),   &
+                  &           mbathy(ji,jj-1), mbathy(ji,jj+1)  )
+               IF( ibtest < mbathy(ji,jj) ) THEN
+                  IF(lwp) WRITE(numout,*) ' the number of ocean level at ',   &
+                     &   'grid-point (i,j) =  ',ji,jj,' is changed from ', mbathy(ji,jj),' to ', ibtest
+                  mbathy(ji,jj) = ibtest
+                  icompt = icompt + 1
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      IF( lk_mpp )   CALL mpp_sum( 'domzgr', icompt )
+      IF( icompt == 0 ) THEN
+         IF(lwp) WRITE(numout,*)'     no isolated ocean grid points'
+      ELSE
+         IF(lwp) WRITE(numout,*)'    ',icompt,' ocean grid points suppressed'
+      ENDIF
+
+      zbathy(:,:) = FLOAT( mbathy(:,:) )
+      CALL lbc_lnk( 'domzgr',zbathy, 'T', 1._wp )
+      mbathy(:,:) = INT( zbathy(:,:) )
+
+      !                                          ! East-west cyclic boundary conditions
+      IF( jperio == 0 ) THEN
+         IF(lwp) WRITE(numout,*) ' mbathy set to 0 along east and west boundary: jperio = ', jperio
+         IF( lk_mpp ) THEN
+            IF( nbondi == -1 .OR. nbondi == 2 ) THEN
+               IF( jperio /= 1 )   mbathy(1,:) = 0
+            ENDIF
+            IF( nbondi == 1 .OR. nbondi == 2 ) THEN
+               IF( jperio /= 1 )   mbathy(nlci,:) = 0
+            ENDIF
+         ELSE
+            IF( ln_zco .OR. ln_zps ) THEN
+               mbathy( 1 ,:) = 0
+               mbathy(jpi,:) = 0
+            ELSE
+               mbathy( 1 ,:) = jpkm1
+               mbathy(jpi,:) = jpkm1
+            ENDIF
+         ENDIF
+      ELSEIF( l_Iperio ) THEN
+         IF(lwp) WRITE(numout,*)' east-west cyclic boundary conditions on mbathy: jperio = ', jperio
+         mbathy( 1 ,:) = mbathy(jpim1,:)
+         mbathy(jpi,:) = mbathy(  2  ,:)
+      ELSEIF( jperio == 2 ) THEN
+         IF(lwp) WRITE(numout,*) '   equatorial boundary conditions on mbathy: jperio = ', jperio
+      ELSE
+         IF(lwp) WRITE(numout,*) '    e r r o r'
+         IF(lwp) WRITE(numout,*) '    parameter , jperio = ', jperio
+         !         STOP 'dom_mba'
+      ENDIF
+
+      !  Boundary condition on mbathy
+      IF( .NOT.lk_mpp ) THEN 
+!!gm     !!bug ???  think about it !
+         !   ... mono- or macro-tasking: T-point, >0, 2D array, no slab
+         zbathy(:,:) = FLOAT( mbathy(:,:) )
+         CALL lbc_lnk( 'domzgr',zbathy, 'T', 1._wp )
+         mbathy(:,:) = INT( zbathy(:,:) )
+      ENDIF
+
+      ! Number of ocean level inferior or equal to jpkm1
+      zbathy(:,:) = FLOAT( mbathy(:,:) )
+      ikmax = glob_max( 'domzgr', zbathy(:,:) )
+
+      IF( ikmax > jpkm1 ) THEN
+         IF(lwp) WRITE(numout,*) ' maximum number of ocean level = ', ikmax,' >  jpk-1'
+         IF(lwp) WRITE(numout,*) ' change jpk to ',ikmax+1,' to use the exact ead bathymetry'
+      ELSE IF( ikmax < jpkm1 ) THEN
+         IF(lwp) WRITE(numout,*) ' maximum number of ocean level = ', ikmax,' < jpk-1' 
+         IF(lwp) WRITE(numout,*) ' you can decrease jpk to ', ikmax+1
+      ENDIF
+      !
+      DEALLOCATE( zbathy )
+      !
+   END SUBROUTINE zgr_bat_ctl
+
+
+   SUBROUTINE zgr_bot_level
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_bot_level  ***
+      !!
+      !! ** Purpose :   defines the vertical index of ocean bottom (mbk. arrays)
+      !!
+      !! ** Method  :   computes from mbathy with a minimum value of 1 over land
+      !!
+      !! ** Action  :   mbkt, mbku, mbkv :   vertical indices of the deeptest 
+      !!                                     ocean level at t-, u- & v-points
+      !!                                     (min value = 1 over land)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj   ! dummy loop indices
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::  zmbk
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( zmbk(jpi,jpj) )
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_bot_level : ocean bottom k-index of T-, U-, V- and W-levels '
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~'
+      !
+      mbkt(:,:) = MAX( mbathy(:,:) , 1 )    ! bottom k-index of T-level (=1 over land)
+ 
+      !                                     ! bottom k-index of W-level = mbkt+1
+      DO jj = 1, jpjm1                      ! bottom k-index of u- (v-) level
+         DO ji = 1, jpim1
+            mbku(ji,jj) = MIN(  mbkt(ji+1,jj  ) , mbkt(ji,jj)  )
+            mbkv(ji,jj) = MIN(  mbkt(ji  ,jj+1) , mbkt(ji,jj)  )
+         END DO
+      END DO
+      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
+      zmbk(:,:) = REAL( mbku(:,:), wp )   ;   CALL lbc_lnk('domzgr',zmbk,'U',1.)   ;   mbku  (:,:) = MAX( INT( zmbk(:,:) ), 1 )
+      zmbk(:,:) = REAL( mbkv(:,:), wp )   ;   CALL lbc_lnk('domzgr',zmbk,'V',1.)   ;   mbkv  (:,:) = MAX( INT( zmbk(:,:) ), 1 )
+      !
+      DEALLOCATE( zmbk )
+      !
+   END SUBROUTINE zgr_bot_level
+
+
+   SUBROUTINE zgr_top_level
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_top_level  ***
+      !!
+      !! ** Purpose :   defines the vertical index of ocean top (mik. arrays)
+      !!
+      !! ** Method  :   computes from misfdep with a minimum value of 1
+      !!
+      !! ** Action  :   mikt, miku, mikv :   vertical indices of the shallowest 
+      !!                                     ocean level at t-, u- & v-points
+      !!                                     (min value = 1)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj   ! dummy loop indices
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::  zmik
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( zmik(jpi,jpj) )
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_top_level : ocean top k-index of T-, U-, V- and W-levels '
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~'
+      !
+      mikt(:,:) = MAX( misfdep(:,:) , 1 )    ! top k-index of T-level (=1)
+      !                                      ! top k-index of W-level (=mikt)
+      DO jj = 1, jpjm1                       ! top k-index of U- (U-) level
+         DO ji = 1, jpim1
+            miku(ji,jj) = MAX(  mikt(ji+1,jj  ) , mikt(ji,jj)  )
+            mikv(ji,jj) = MAX(  mikt(ji  ,jj+1) , mikt(ji,jj)  )
+            mikf(ji,jj) = MAX(  mikt(ji  ,jj+1) , mikt(ji,jj), mikt(ji+1,jj  ), mikt(ji+1,jj+1)  )
+         END DO
+      END DO
+
+      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
+      zmik(:,:) = REAL( miku(:,:), wp )   ;   CALL lbc_lnk('domzgr',zmik,'U',1.)   ;   miku  (:,:) = MAX( INT( zmik(:,:) ), 1 )
+      zmik(:,:) = REAL( mikv(:,:), wp )   ;   CALL lbc_lnk('domzgr',zmik,'V',1.)   ;   mikv  (:,:) = MAX( INT( zmik(:,:) ), 1 )
+      zmik(:,:) = REAL( mikf(:,:), wp )   ;   CALL lbc_lnk('domzgr',zmik,'F',1.)   ;   mikf  (:,:) = MAX( INT( zmik(:,:) ), 1 )
+      !
+      DEALLOCATE( zmik )
+      !
+   END SUBROUTINE zgr_top_level
+
+
+   SUBROUTINE zgr_zco
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zgr_zco  ***
+      !!
+      !! ** Purpose :   define the reference z-coordinate system
+      !!
+      !! ** Method  :   set 3D coord. arrays to reference 1D array 
+      !!----------------------------------------------------------------------
+      INTEGER  ::   jk
+      !!----------------------------------------------------------------------
+      !
+      DO jk = 1, jpk
+         gdept_0(:,:,jk) = gdept_1d(jk)
+         gdepw_0(:,:,jk) = gdepw_1d(jk)
+         e3t_0  (:,:,jk) = e3t_1d  (jk)
+         e3u_0  (:,:,jk) = e3t_1d  (jk)
+         e3v_0  (:,:,jk) = e3t_1d  (jk)
+         e3f_0  (:,:,jk) = e3t_1d  (jk)
+         e3w_0  (:,:,jk) = e3w_1d  (jk)
+         e3uw_0 (:,:,jk) = e3w_1d  (jk)
+         e3vw_0 (:,:,jk) = e3w_1d  (jk)
+      END DO
+      !
+   END SUBROUTINE zgr_zco
+
+
+   SUBROUTINE zgr_zps
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zgr_zps  ***
+      !!                     
+      !! ** Purpose :   the depth and vertical scale factor in partial step
+      !!              reference z-coordinate case
+      !!
+      !! ** Method  :   Partial steps : computes the 3D vertical scale factors
+      !!      of T-, U-, V-, W-, UW-, VW and F-points that are associated with
+      !!      a partial step representation of bottom topography.
+      !!
+      !!        The reference depth of model levels is defined from an analytical
+      !!      function the derivative of which gives the reference vertical
+      !!      scale factors.
+      !!        From  depth and scale factors reference, we compute there new value
+      !!      with partial steps  on 3d arrays ( i, j, k ).
+      !!
+      !!              w-level: gdepw_0(i,j,k)  = gdep(k)
+      !!                       e3w_0(i,j,k) = dk(gdep)(k)     = e3(i,j,k)
+      !!              t-level: gdept_0(i,j,k)  = gdep(k+0.5)
+      !!                       e3t_0(i,j,k) = dk(gdep)(k+0.5) = e3(i,j,k+0.5)
+      !!
+      !!        With the help of the bathymetric file ( bathymetry_depth_ORCA_R2.nc),
+      !!      we find the mbathy index of the depth at each grid point.
+      !!      This leads us to three cases:
+      !!
+      !!              - bathy = 0 => mbathy = 0
+      !!              - 1 < mbathy < jpkm1    
+      !!              - bathy > gdepw_0(jpk) => mbathy = jpkm1  
+      !!
+      !!        Then, for each case, we find the new depth at t- and w- levels
+      !!      and the new vertical scale factors at t-, u-, v-, w-, uw-, vw- 
+      !!      and f-points.
+      !! 
+      !!        This routine is given as an example, it must be modified
+      !!      following the user s desiderata. nevertheless, the output as
+      !!      well as the way to compute the model levels and scale factors
+      !!      must be respected in order to insure second order accuracy
+      !!      schemes.
+      !!
+      !!         c a u t i o n : gdept_1d, gdepw_1d and e3._1d are positives
+      !!         - - - - - - -   gdept_0, gdepw_0 and e3. are positives
+      !!      
+      !!  Reference :   Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270.
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk       ! dummy loop indices
+      INTEGER  ::   ik, it, ikb, ikt ! temporary integers
+      REAL(wp) ::   ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points
+      REAL(wp) ::   zdepwp, zdepth   ! Ajusted ocean depth to avoid too small e3t
+      REAL(wp) ::   zdiff            ! temporary scalar
+      REAL(wp) ::   zmax             ! temporary scalar
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  zprt
+      !!---------------------------------------------------------------------
+      !
+      ALLOCATE( zprt(jpi,jpj,jpk) )
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_zps : z-coordinate with partial steps'
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~ '
+      IF(lwp) WRITE(numout,*) '              mbathy is recomputed : bathy_level file is NOT used'
+
+      ! compute position of the ice shelf grounding line
+      ! set bathy and isfdraft to 0 where grounded
+      IF ( ln_isfcav ) CALL zgr_isf_zspace
+
+      ! bathymetry in level (from bathy_meter)
+      ! ===================
+      zmax = gdepw_1d(jpk) + e3t_1d(jpk)        ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_1d(jpkm1) )
+      bathy(:,:) = MIN( zmax ,  bathy(:,:) )    ! bounded value of bathy (min already set at the end of zgr_bat)
+      WHERE( bathy(:,:) == 0._wp )   ;   mbathy(:,:) = 0       ! land  : set mbathy to 0
+      ELSE WHERE                     ;   mbathy(:,:) = jpkm1   ! ocean : initialize mbathy to the max ocean level
+      END WHERE
+
+      ! Compute mbathy for ocean points (i.e. the number of ocean levels)
+      ! find the number of ocean levels such that the last level thickness
+      ! is larger than the minimum of e3zps_min and e3zps_rat * e3t_1d (where
+      ! e3t_1d is the reference level thickness
+      DO jk = jpkm1, 1, -1
+         zdepth = gdepw_1d(jk) + MIN( e3zps_min, e3t_1d(jk)*e3zps_rat )
+         WHERE( 0._wp < bathy(:,:) .AND. bathy(:,:) <= zdepth )   mbathy(:,:) = jk-1
+      END DO
+
+      ! Check compatibility between bathy and iceshelf draft
+      ! insure at least 2 wet level on the vertical under an ice shelf
+      ! compute misfdep and adjust isf draft if needed
+      IF ( ln_isfcav ) CALL zgr_isf_kspace
+
+      ! Scale factors and depth at T- and W-points
+      DO jk = 1, jpk                        ! intitialization to the reference z-coordinate
+         gdept_0(:,:,jk) = gdept_1d(jk)
+         gdepw_0(:,:,jk) = gdepw_1d(jk)
+         e3t_0  (:,:,jk) = e3t_1d  (jk)
+         e3w_0  (:,:,jk) = e3w_1d  (jk)
+      END DO
+      
+      ! Scale factors and depth at T- and W-points
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ik = mbathy(ji,jj)
+            IF( ik > 0 ) THEN               ! ocean point only
+               ! max ocean level case
+               IF( ik == jpkm1 ) THEN
+                  zdepwp = bathy(ji,jj)
+                  ze3tp  = bathy(ji,jj) - gdepw_1d(ik)
+                  ze3wp = 0.5_wp * e3w_1d(ik) * ( 1._wp + ( ze3tp/e3t_1d(ik) ) )
+                  e3t_0(ji,jj,ik  ) = ze3tp
+                  e3t_0(ji,jj,ik+1) = ze3tp
+                  e3w_0(ji,jj,ik  ) = ze3wp
+                  e3w_0(ji,jj,ik+1) = ze3tp
+                  gdepw_0(ji,jj,ik+1) = zdepwp
+                  gdept_0(ji,jj,ik  ) = gdept_1d(ik-1) + ze3wp
+                  gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp
+                  !
+               ELSE                         ! standard case
+                  IF( bathy(ji,jj) <= gdepw_1d(ik+1) ) THEN  ;   gdepw_0(ji,jj,ik+1) = bathy(ji,jj)
+                  ELSE                                       ;   gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1)
+                  ENDIF
+!gm Bug?  check the gdepw_1d
+                  !       ... on ik
+                  gdept_0(ji,jj,ik) = gdepw_1d(ik) + ( gdepw_0(ji,jj,ik+1) - gdepw_1d(ik) )   &
+                     &                             * ((gdept_1d(     ik  ) - gdepw_1d(ik) )   &
+                     &                             / ( gdepw_1d(     ik+1) - gdepw_1d(ik) ))
+                  e3t_0  (ji,jj,ik) = e3t_1d  (ik) * ( gdepw_0 (ji,jj,ik+1) - gdepw_1d(ik) )   & 
+                     &                             / ( gdepw_1d(      ik+1) - gdepw_1d(ik) ) 
+                  e3w_0(ji,jj,ik) = 0.5_wp * ( gdepw_0(ji,jj,ik+1) + gdepw_1d(ik+1) - 2._wp * gdepw_1d(ik) )   &
+                     &                     * ( e3w_1d(ik) / ( gdepw_1d(ik+1) - gdepw_1d(ik) ) )
+                  !       ... on ik+1
+                  e3w_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik)
+                  e3t_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik)
+                  gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + e3t_0(ji,jj,ik)
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      !
+      it = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ik = mbathy(ji,jj)
+            IF( ik > 0 ) THEN               ! ocean point only
+               e3tp (ji,jj) = e3t_0(ji,jj,ik)
+               e3wp (ji,jj) = e3w_0(ji,jj,ik)
+               ! test
+               zdiff= gdepw_0(ji,jj,ik+1) - gdept_0(ji,jj,ik  )
+               IF( zdiff <= 0._wp .AND. lwp ) THEN 
+                  it = it + 1
+                  WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj
+                  WRITE(numout,*) ' bathy = ', bathy(ji,jj)
+                  WRITE(numout,*) ' gdept_0 = ', gdept_0(ji,jj,ik), ' gdepw_0 = ', gdepw_0(ji,jj,ik+1), ' zdiff = ', zdiff
+                  WRITE(numout,*) ' e3tp    = ', e3t_0  (ji,jj,ik), ' e3wp    = ', e3w_0  (ji,jj,ik  )
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      !
+      ! compute top scale factor if ice shelf
+      IF (ln_isfcav) CALL zps_isf
+      !
+      ! Scale factors and depth at U-, V-, UW and VW-points
+      DO jk = 1, jpk                        ! initialisation to z-scale factors
+         e3u_0 (:,:,jk) = e3t_1d(jk)
+         e3v_0 (:,:,jk) = e3t_1d(jk)
+         e3uw_0(:,:,jk) = e3w_1d(jk)
+         e3vw_0(:,:,jk) = e3w_1d(jk)
+      END DO
+
+      DO jk = 1,jpk                         ! Computed as the minimum of neighbooring scale factors
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1   ! vector opt.
+               e3u_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji+1,jj,jk) )
+               e3v_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji,jj+1,jk) )
+               e3uw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji+1,jj,jk) )
+               e3vw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji,jj+1,jk) )
+            END DO
+         END DO
+      END DO
+
+      ! update e3uw in case only 2 cells in the water column
+      IF ( ln_isfcav ) CALL zps_isf_e3uv_w
+      !
+      CALL lbc_lnk('domzgr', e3u_0 , 'U', 1._wp )   ;   CALL lbc_lnk('domzgr', e3uw_0, 'U', 1._wp )   ! lateral boundary conditions
+      CALL lbc_lnk('domzgr', e3v_0 , 'V', 1._wp )   ;   CALL lbc_lnk('domzgr', e3vw_0, 'V', 1._wp )
+      !
+      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
+         WHERE( e3u_0 (:,:,jk) == 0._wp )   e3u_0 (:,:,jk) = e3t_1d(jk)
+         WHERE( e3v_0 (:,:,jk) == 0._wp )   e3v_0 (:,:,jk) = e3t_1d(jk)
+         WHERE( e3uw_0(:,:,jk) == 0._wp )   e3uw_0(:,:,jk) = e3w_1d(jk)
+         WHERE( e3vw_0(:,:,jk) == 0._wp )   e3vw_0(:,:,jk) = e3w_1d(jk)
+      END DO
+      
+      ! Scale factor at F-point
+      DO jk = 1, jpk                        ! initialisation to z-scale factors
+         e3f_0(:,:,jk) = e3t_1d(jk)
+      END DO
+      DO jk = 1, jpk                        ! Computed as the minimum of neighbooring V-scale factors
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1   ! vector opt.
+               e3f_0(ji,jj,jk) = MIN( e3v_0(ji,jj,jk), e3v_0(ji+1,jj,jk) )
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk('domzgr', e3f_0, 'F', 1._wp )       ! Lateral boundary conditions
+      !
+      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
+         WHERE( e3f_0(:,:,jk) == 0._wp )   e3f_0(:,:,jk) = e3t_1d(jk)
+      END DO
+!!gm  bug ? :  must be a do loop with mj0,mj1
+      ! 
+      e3t_0(:,mj0(1),:) = e3t_0(:,mj0(2),:)     ! we duplicate factor scales for jj = 1 and jj = 2
+      e3w_0(:,mj0(1),:) = e3w_0(:,mj0(2),:) 
+      e3u_0(:,mj0(1),:) = e3u_0(:,mj0(2),:) 
+      e3v_0(:,mj0(1),:) = e3v_0(:,mj0(2),:) 
+      e3f_0(:,mj0(1),:) = e3f_0(:,mj0(2),:) 
+
+      ! Control of the sign
+      IF( MINVAL( e3t_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3t_0 <= 0' )
+      IF( MINVAL( e3w_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3w_0 <= 0' )
+      IF( MINVAL( gdept_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdept_0 <  0' )
+      IF( MINVAL( gdepw_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw_0 <  0' )
+      !
+      ! if in the future gde3w_0 need to be compute, use the function defined in NEMO
+      ! for now gde3w_0 computation is removed as not an output of domcfg
+
+      DEALLOCATE( zprt )
+      !
+   END SUBROUTINE zgr_zps
+
+   SUBROUTINE zgr_sco
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zgr_sco  ***
+      !!                     
+      !! ** Purpose :   define the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate
+      !!         The depth of model levels is defined as the product of an
+      !!      analytical function by the local bathymetry, while the vertical
+      !!      scale factors are defined as the product of the first derivative
+      !!      of the analytical function by the bathymetry.
+      !!      (this solution save memory as depth and scale factors are not
+      !!      3d fields)
+      !!          - Read bathymetry (in meters) at t-point and compute the
+      !!         bathymetry at u-, v-, and f-points.
+      !!            hbatu = mi( hbatt )
+      !!            hbatv = mj( hbatt )
+      !!            hbatf = mi( mj( hbatt ) )
+      !!          - Compute z_gsigt, z_gsigw, z_esigt, z_esigw from an analytical
+      !!         function and its derivative given as function.
+      !!            z_gsigt(k) = fssig (k    )
+      !!            z_gsigw(k) = fssig (k-0.5)
+      !!            z_esigt(k) = fsdsig(k    )
+      !!            z_esigw(k) = fsdsig(k-0.5)
+      !!      Three options for stretching are give, and they can be modified
+      !!      following the users requirements. Nevertheless, the output as
+      !!      well as the way to compute the model levels and scale factors
+      !!      must be respected in order to insure second order accuracy
+      !!      schemes.
+      !!
+      !!      The three methods for stretching available are:
+      !! 
+      !!           s_sh94 (Song and Haidvogel 1994)
+      !!                a sinh/tanh function that allows sigma and stretched sigma
+      !!
+      !!           s_sf12 (Siddorn and Furner 2012?)
+      !!                allows the maintenance of fixed surface and or
+      !!                bottom cell resolutions (cf. geopotential coordinates) 
+      !!                within an analytically derived stretched S-coordinate framework.
+      !! 
+      !!          s_tanh  (Madec et al 1996)
+      !!                a cosh/tanh function that gives stretched coordinates        
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk, jl           ! dummy loop argument
+      INTEGER  ::   iip1, ijp1, iim1, ijm1   ! temporary integers
+      INTEGER  ::   ios                      ! Local integer output status for namelist read
+      REAL(wp) ::   zrmax, ztaper   ! temporary scalars
+      REAL(wp) ::   zrfact
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) :: ztmpi1, ztmpi2, ztmpj1, ztmpj2
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) :: zenv, ztmp, zmsk, zri, zrj, zhbat
+      !!
+      NAMELIST/namzgr_sco/ln_s_sh94, ln_s_sf12, ln_sigcrit, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax,rn_theta, &
+         &                rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b
+     !!----------------------------------------------------------------------
+      !
+      ALLOCATE( zenv(jpi,jpj), ztmp(jpi,jpj), zmsk(jpi,jpj), zri(jpi,jpj), zrj(jpi,jpj), zhbat(jpi,jpj) , ztmpi1(jpi,jpj), ztmpi2(jpi,jpj), ztmpj1(jpi,jpj), ztmpj2(jpi,jpj) )
+      !
+      REWIND( numnam_ref )              ! Namelist namzgr_sco in reference namelist : Sigma-stretching parameters
+      READ  ( numnam_ref, namzgr_sco, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr_sco in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namzgr_sco in configuration namelist : Sigma-stretching parameters
+      READ  ( numnam_cfg, namzgr_sco, IOSTAT = ios, ERR = 902 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr_sco in configuration namelist', lwp )
+      IF(lwm) WRITE ( numond, namzgr_sco )
+
+      IF(lwp) THEN                           ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr_sco : s-coordinate or hybrid z-s-coordinate'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namzgr_sco'
+         WRITE(numout,*) '     stretching coeffs '
+         WRITE(numout,*) '        maximum depth of s-bottom surface (>0)       rn_sbot_max   = ',rn_sbot_max
+         WRITE(numout,*) '        minimum depth of s-bottom surface (>0)       rn_sbot_min   = ',rn_sbot_min
+         WRITE(numout,*) '        Critical depth                               rn_hc         = ',rn_hc
+         WRITE(numout,*) '        maximum cut-off r-value allowed              rn_rmax       = ',rn_rmax
+         WRITE(numout,*) '     Song and Haidvogel 1994 stretching              ln_s_sh94     = ',ln_s_sh94
+         WRITE(numout,*) '        Song and Haidvogel 1994 stretching coefficients'
+         WRITE(numout,*) '        surface control parameter (0<=rn_theta<=20)  rn_theta      = ',rn_theta
+         WRITE(numout,*) '        bottom  control parameter (0<=rn_thetb<= 1)  rn_thetb      = ',rn_thetb
+         WRITE(numout,*) '        stretching parameter (song and haidvogel)    rn_bb         = ',rn_bb
+         WRITE(numout,*) '     Siddorn and Furner 2012 stretching              ln_s_sf12     = ',ln_s_sf12
+         WRITE(numout,*) '        switching to sigma (T) or Z (F) at H<Hc      ln_sigcrit    = ',ln_sigcrit
+         WRITE(numout,*) '        Siddorn and Furner 2012 stretching coefficients'
+         WRITE(numout,*) '        stretchin parameter ( >1 surface; <1 bottom) rn_alpha      = ',rn_alpha
+         WRITE(numout,*) '        e-fold length scale for transition region    rn_efold      = ',rn_efold
+         WRITE(numout,*) '        Surface cell depth (Zs) (m)                  rn_zs         = ',rn_zs
+         WRITE(numout,*) '        Bathymetry multiplier for Zb                 rn_zb_a       = ',rn_zb_a
+         WRITE(numout,*) '        Offset for Zb                                rn_zb_b       = ',rn_zb_b
+         WRITE(numout,*) '        Bottom cell (Zb) (m) = H*rn_zb_a + rn_zb_b'
+      ENDIF
+
+      hift(:,:) = rn_sbot_min                     ! set the minimum depth for the s-coordinate
+      hifu(:,:) = rn_sbot_min
+      hifv(:,:) = rn_sbot_min
+      hiff(:,:) = rn_sbot_min
+
+      !                                        ! set maximum ocean depth
+      bathy(:,:) = MIN( rn_sbot_max, bathy(:,:) )
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+              IF( bathy(ji,jj) > 0._wp )   bathy(ji,jj) = MAX( rn_sbot_min, bathy(ji,jj) )
+            END DO
+         END DO
+      !                                        ! =============================
+      !                                        ! Define the envelop bathymetry   (hbatt)
+      !                                        ! =============================
+      ! use r-value to create hybrid coordinates
+      zenv(:,:) = bathy(:,:)
+      !
+      ! set first land point adjacent to a wet cell to sbot_min as this needs to be included in smoothing
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( bathy(ji,jj) == 0._wp ) THEN
+                  iip1 = MIN( ji+1, jpi )
+                  ijp1 = MIN( jj+1, jpj )
+                  iim1 = MAX( ji-1, 1 )
+                  ijm1 = MAX( jj-1, 1 )
+!!gm BUG fix see ticket #1617
+                  IF( ( + bathy(iim1,ijm1) + bathy(ji,ijp1) + bathy(iip1,ijp1)              &
+                     &  + bathy(iim1,jj  )                  + bathy(iip1,jj  )              &
+                     &  + bathy(iim1,ijm1) + bathy(ji,ijm1) + bathy(iip1,ijp1)  ) > 0._wp ) &
+                     &    zenv(ji,jj) = rn_sbot_min
+!!gm
+!!gm               IF( ( bathy(iip1,jj  ) + bathy(iim1,jj  ) + bathy(ji,ijp1  ) + bathy(ji,ijm1) +         &
+!!gm                  &  bathy(iip1,ijp1) + bathy(iim1,ijm1) + bathy(iip1,ijp1) + bathy(iim1,ijm1)) > 0._wp ) THEN
+!!gm               zenv(ji,jj) = rn_sbot_min
+!!gm             ENDIF
+!!gm end
+              ENDIF
+            END DO
+         END DO
+
+      ! apply lateral boundary condition   CAUTION: keep the value when the lbc field is zero
+      CALL lbc_lnk( 'domzgr',zenv, 'T', 1._wp, 'no0' )
+      ! 
+      ! smooth the bathymetry (if required)
+      scosrf(:,:) = 0._wp             ! ocean surface depth (here zero: no under ice-shelf sea)
+      scobot(:,:) = bathy(:,:)        ! ocean bottom  depth
+      !
+      jl = 0
+      zrmax = 1._wp
+      !   
+      !     
+      ! set scaling factor used in reducing vertical gradients
+      zrfact = ( 1._wp - rn_rmax ) / ( 1._wp + rn_rmax )
+      !
+      ! initialise temporary evelope depth arrays
+      ztmpi1(:,:) = zenv(:,:)
+      ztmpi2(:,:) = zenv(:,:)
+      ztmpj1(:,:) = zenv(:,:)
+      ztmpj2(:,:) = zenv(:,:)
+      !
+      ! initialise temporary r-value arrays
+      zri(:,:) = 1._wp
+      zrj(:,:) = 1._wp
+      !                                                            ! ================ !
+      DO WHILE( jl <= 10000 .AND. ( zrmax - rn_rmax ) > 1.e-8_wp ) !  Iterative loop  !
+         !                                                         ! ================ !
+         jl = jl + 1
+         zrmax = 0._wp
+         ! we set zrmax from previous r-values (zri and zrj) first
+         ! if set after current r-value calculation (as previously)
+         ! we could exit DO WHILE prematurely before checking r-value
+         ! of current zenv
+         DO jj = 1, nlcj
+            DO ji = 1, nlci
+               zrmax = MAX( zrmax, ABS(zri(ji,jj)), ABS(zrj(ji,jj)) )
+            END DO
+         END DO
+         zri(:,:) = 0._wp
+         zrj(:,:) = 0._wp
+         DO jj = 1, nlcj
+            DO ji = 1, nlci
+               iip1 = MIN( ji+1, nlci )      ! force zri = 0 on last line (ji=ncli+1 to jpi)
+               ijp1 = MIN( jj+1, nlcj )      ! force zrj = 0 on last raw  (jj=nclj+1 to jpj)
+               IF( (zenv(ji,jj) > 0._wp) .AND. (zenv(iip1,jj) > 0._wp)) THEN
+                  zri(ji,jj) = ( zenv(iip1,jj  ) - zenv(ji,jj) ) / ( zenv(iip1,jj  ) + zenv(ji,jj) )
+               END IF
+               IF( (zenv(ji,jj) > 0._wp) .AND. (zenv(ji,ijp1) > 0._wp)) THEN
+                  zrj(ji,jj) = ( zenv(ji  ,ijp1) - zenv(ji,jj) ) / ( zenv(ji  ,ijp1) + zenv(ji,jj) )
+               END IF
+               IF( zri(ji,jj) >  rn_rmax )   ztmpi1(ji  ,jj  ) = zenv(iip1,jj  ) * zrfact
+               IF( zri(ji,jj) < -rn_rmax )   ztmpi2(iip1,jj  ) = zenv(ji  ,jj  ) * zrfact
+               IF( zrj(ji,jj) >  rn_rmax )   ztmpj1(ji  ,jj  ) = zenv(ji  ,ijp1) * zrfact
+               IF( zrj(ji,jj) < -rn_rmax )   ztmpj2(ji  ,ijp1) = zenv(ji  ,jj  ) * zrfact
+            END DO
+         END DO
+  !       IF( lk_mpp )   CALL mpp_max( zrmax )   ! max over the global domain
+         !
+         IF(lwp)WRITE(numout,*) 'zgr_sco :   iter= ',jl, ' rmax= ', zrmax
+         !
+         DO jj = 1, nlcj
+            DO ji = 1, nlci
+               zenv(ji,jj) = MAX(zenv(ji,jj), ztmpi1(ji,jj), ztmpi2(ji,jj), ztmpj1(ji,jj), ztmpj2(ji,jj) )
+            END DO
+         END DO
+         ! apply lateral boundary condition   CAUTION: keep the value when the lbc field is zero
+         CALL lbc_lnk( 'domzgr',zenv, 'T', 1._wp, 'no0' )
+         !                                                  ! ================ !
+      END DO                                                !     End loop     !
+      !                                                     ! ================ !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zenv(ji,jj) = MAX( zenv(ji,jj), rn_sbot_min ) ! set all points to avoid undefined scale value warnings
+         END DO
+      END DO
+      !
+      ! Envelope bathymetry saved in hbatt
+      hbatt(:,:) = zenv(:,:) 
+      IF( MINVAL( gphit(:,:) ) * MAXVAL( gphit(:,:) ) <= 0._wp ) THEN
+         CALL ctl_warn( ' s-coordinates are tapered in vicinity of the Equator' )
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ztaper = EXP( -(gphit(ji,jj)/8._wp)**2._wp )
+               hbatt(ji,jj) = rn_sbot_max * ztaper + hbatt(ji,jj) * ( 1._wp - ztaper )
+            END DO
+         END DO
+      ENDIF
+      !
+      !                                        ! ==============================
+      !                                        !   hbatu, hbatv, hbatf fields
+      !                                        ! ==============================
+      IF(lwp) THEN
+         WRITE(numout,*)
+           WRITE(numout,*) ' zgr_sco: minimum depth of the envelop topography set to : ', rn_sbot_min
+      ENDIF
+      hbatu(:,:) = rn_sbot_min
+      hbatv(:,:) = rn_sbot_min
+      hbatf(:,:) = rn_sbot_min
+      DO jj = 1, jpjm1
+        DO ji = 1, jpim1   ! NO vector opt.
+           hbatu(ji,jj) = 0.50_wp * ( hbatt(ji  ,jj) + hbatt(ji+1,jj  ) )
+           hbatv(ji,jj) = 0.50_wp * ( hbatt(ji  ,jj) + hbatt(ji  ,jj+1) )
+           hbatf(ji,jj) = 0.25_wp * ( hbatt(ji  ,jj) + hbatt(ji  ,jj+1)   &
+              &                     + hbatt(ji+1,jj) + hbatt(ji+1,jj+1) )
+        END DO
+      END DO
+
+      ! 
+      ! Apply lateral boundary condition
+!!gm  ! CAUTION: retain non zero value in the initial file this should be OK for orca cfg, not for EEL
+      zhbat(:,:) = hbatu(:,:)   ;   CALL lbc_lnk('domzgr', hbatu, 'U', 1._wp )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( hbatu(ji,jj) == 0._wp ) THEN
+               !No worries about the following line when ln_wd == .true.
+               IF( zhbat(ji,jj) == 0._wp )   hbatu(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0._wp )   hbatu(ji,jj) = zhbat(ji,jj)
+            ENDIF
+         END DO
+      END DO
+      zhbat(:,:) = hbatv(:,:)   ;   CALL lbc_lnk('domzgr', hbatv, 'V', 1._wp )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( hbatv(ji,jj) == 0._wp ) THEN
+               IF( zhbat(ji,jj) == 0._wp )   hbatv(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0._wp )   hbatv(ji,jj) = zhbat(ji,jj)
+            ENDIF
+         END DO
+      END DO
+      zhbat(:,:) = hbatf(:,:)   ;   CALL lbc_lnk('domzgr', hbatf, 'F', 1._wp )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( hbatf(ji,jj) == 0._wp ) THEN
+               IF( zhbat(ji,jj) == 0._wp )   hbatf(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0._wp )   hbatf(ji,jj) = zhbat(ji,jj)
+            ENDIF
+         END DO
+      END DO
+
+!!bug:  key_helsinki a verifer
+        hift(:,:) = MIN( hift(:,:), hbatt(:,:) )
+        hifu(:,:) = MIN( hifu(:,:), hbatu(:,:) )
+        hifv(:,:) = MIN( hifv(:,:), hbatv(:,:) )
+        hiff(:,:) = MIN( hiff(:,:), hbatf(:,:) )
+
+      IF( nprint == 1 .AND. lwp )   THEN
+         WRITE(numout,*) ' MAX val hif   t ', MAXVAL( hift (:,:) ), ' f ', MAXVAL( hiff (:,:) ),  &
+            &                        ' u ',   MAXVAL( hifu (:,:) ), ' v ', MAXVAL( hifv (:,:) )
+         WRITE(numout,*) ' MIN val hif   t ', MINVAL( hift (:,:) ), ' f ', MINVAL( hiff (:,:) ),  &
+            &                        ' u ',   MINVAL( hifu (:,:) ), ' v ', MINVAL( hifv (:,:) )
+         WRITE(numout,*) ' MAX val hbat  t ', MAXVAL( hbatt(:,:) ), ' f ', MAXVAL( hbatf(:,:) ),  &
+            &                        ' u ',   MAXVAL( hbatu(:,:) ), ' v ', MAXVAL( hbatv(:,:) )
+         WRITE(numout,*) ' MIN val hbat  t ', MINVAL( hbatt(:,:) ), ' f ', MINVAL( hbatf(:,:) ),  &
+            &                        ' u ',   MINVAL( hbatu(:,:) ), ' v ', MINVAL( hbatv(:,:) )
+      ENDIF
+!! helsinki
+
+      !                                            ! =======================
+      !                                            !   s-ccordinate fields     (gdep., e3.)
+      !                                            ! =======================
+      !
+      ! non-dimensional "sigma" for model level depth at w- and t-levels
+
+
+!========================================================================
+! Song and Haidvogel  1994 (ln_s_sh94=T)
+! Siddorn and Furner 2012 (ln_sf12=T)
+! or  tanh function       (both false)                    
+!========================================================================
+      IF      ( ln_s_sh94 ) THEN 
+                           CALL s_sh94()
+      ELSE IF ( ln_s_sf12 ) THEN
+                           CALL s_sf12()
+      ELSE                 
+                           CALL s_tanh()
+      ENDIF 
+
+      CALL lbc_lnk( 'domzgr',e3t_0 , 'T', 1._wp )
+      CALL lbc_lnk( 'domzgr',e3u_0 , 'U', 1._wp )
+      CALL lbc_lnk( 'domzgr',e3v_0 , 'V', 1._wp )
+      CALL lbc_lnk( 'domzgr',e3f_0 , 'F', 1._wp )
+      CALL lbc_lnk( 'domzgr',e3w_0 , 'W', 1._wp )
+      CALL lbc_lnk( 'domzgr',e3uw_0, 'U', 1._wp )
+      CALL lbc_lnk('domzgr', e3vw_0, 'V', 1._wp )
+      !
+        WHERE( e3t_0 (:,:,:) == 0._wp )   e3t_0 (:,:,:) = 1._wp
+        WHERE( e3u_0 (:,:,:) == 0._wp )   e3u_0 (:,:,:) = 1._wp
+        WHERE( e3v_0 (:,:,:) == 0._wp )   e3v_0 (:,:,:) = 1._wp
+        WHERE( e3f_0 (:,:,:) == 0._wp )   e3f_0 (:,:,:) = 1._wp
+        WHERE( e3w_0 (:,:,:) == 0._wp )   e3w_0 (:,:,:) = 1._wp
+        WHERE( e3uw_0(:,:,:) == 0._wp )   e3uw_0(:,:,:) = 1._wp
+        WHERE( e3vw_0(:,:,:) == 0._wp )   e3vw_0(:,:,:) = 1._wp
+!!
+      ! HYBRID : 
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpkm1
+               IF( scobot(ji,jj) >= gdept_0(ji,jj,jk) )   mbathy(ji,jj) = MAX( 2, jk )
+            END DO
+         END DO
+      END DO
+      IF( nprint == 1 .AND. lwp ) WRITE(numout,*) ' MIN val mbathy h90 ', MINVAL( mbathy(:,:) ),   &
+         &                                                       ' MAX ', MAXVAL( mbathy(:,:) )
+
+      IF( nprint == 1  .AND. lwp )   THEN         ! min max values over the local domain
+         WRITE(numout,*) ' MIN val mbathy  ', MINVAL( mbathy(:,:)    ), ' MAX ', MAXVAL( mbathy(:,:) )
+         WRITE(numout,*) ' MIN val depth t ', MINVAL( gdept_0(:,:,:) ),   &
+            &                          ' w ', MINVAL( gdepw_0(:,:,:) )
+         WRITE(numout,*) ' MIN val e3    t ', MINVAL( e3t_0  (:,:,:) ), ' f '  , MINVAL( e3f_0  (:,:,:) ),   &
+            &                          ' u ', MINVAL( e3u_0  (:,:,:) ), ' u '  , MINVAL( e3v_0  (:,:,:) ),   &
+            &                          ' uw', MINVAL( e3uw_0 (:,:,:) ), ' vw'  , MINVAL( e3vw_0 (:,:,:) ),   &
+            &                          ' w ', MINVAL( e3w_0  (:,:,:) )
+
+         WRITE(numout,*) ' MAX val depth t ', MAXVAL( gdept_0(:,:,:) ),   &
+            &                          ' w ', MAXVAL( gdepw_0(:,:,:) )
+         WRITE(numout,*) ' MAX val e3    t ', MAXVAL( e3t_0  (:,:,:) ), ' f '  , MAXVAL( e3f_0  (:,:,:) ),   &
+            &                          ' u ', MAXVAL( e3u_0  (:,:,:) ), ' u '  , MAXVAL( e3v_0  (:,:,:) ),   &
+            &                          ' uw', MAXVAL( e3uw_0 (:,:,:) ), ' vw'  , MAXVAL( e3vw_0 (:,:,:) ),   &
+            &                          ' w ', MAXVAL( e3w_0  (:,:,:) )
+      ENDIF
+      !  END DO
+      IF(lwp) THEN                                  ! selected vertical profiles
+         WRITE(numout,*)
+         WRITE(numout,*) ' domzgr: vertical coordinates : point (1,1,k) bathy = ', bathy(1,1), hbatt(1,1)
+         WRITE(numout,*) ' ~~~~~~  --------------------'
+         WRITE(numout,"(9x,' level  gdept_0   gdepw_0   e3t_0    e3w_0')")
+         WRITE(numout,"(10x,i4,4f9.2)") ( jk, gdept_0(1,1,jk), gdepw_0(1,1,jk),     &
+            &                                 e3t_0 (1,1,jk) , e3w_0 (1,1,jk) , jk=1,jpk )
+         DO jj = mj0(20), mj1(20)
+            DO ji = mi0(20), mi1(20)
+               WRITE(numout,*)
+               WRITE(numout,*) ' domzgr: vertical coordinates : point (20,20,k)   bathy = ', bathy(ji,jj), hbatt(ji,jj)
+               WRITE(numout,*) ' ~~~~~~  --------------------'
+               WRITE(numout,"(9x,' level  gdept_0   gdepw_0   e3t_0    e3w_0')")
+               WRITE(numout,"(10x,i4,4f9.2)") ( jk, gdept_0(ji,jj,jk), gdepw_0(ji,jj,jk),     &
+                  &                                 e3t_0 (ji,jj,jk) , e3w_0 (ji,jj,jk) , jk=1,jpk )
+            END DO
+         END DO
+         DO jj = mj0(74), mj1(74)
+            DO ji = mi0(100), mi1(100)
+               WRITE(numout,*)
+               WRITE(numout,*) ' domzgr: vertical coordinates : point (100,74,k)   bathy = ', bathy(ji,jj), hbatt(ji,jj)
+               WRITE(numout,*) ' ~~~~~~  --------------------'
+               WRITE(numout,"(9x,' level  gdept_0   gdepw_0   e3t_0    e3w_0')")
+               WRITE(numout,"(10x,i4,4f9.2)") ( jk, gdept_0(ji,jj,jk), gdepw_0(ji,jj,jk),     &
+                  &                                 e3t_0 (ji,jj,jk) , e3w_0 (ji,jj,jk) , jk=1,jpk )
+            END DO
+         END DO
+      ENDIF
+      !
+      !================================================================================
+      ! check the coordinate makes sense
+      !================================================================================
+      DO ji = 1, jpi
+         DO jj = 1, jpj
+            !
+            IF( hbatt(ji,jj) > 0._wp) THEN
+               DO jk = 1, mbathy(ji,jj)
+                 ! check coordinate is monotonically increasing
+                 IF (e3w_0(ji,jj,jk) <= 0._wp .OR. e3t_0(ji,jj,jk) <= 0._wp ) THEN
+                    WRITE(ctmp1,*) 'ERROR zgr_sco :   e3w   or e3t   =< 0  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'ERROR zgr_sco :   e3w   or e3t   =< 0  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'e3w',e3w_0(ji,jj,:)
+                    WRITE(numout,*) 'e3t',e3t_0(ji,jj,:)
+                    CALL ctl_stop( ctmp1 )
+                 ENDIF
+                 ! and check it has never gone negative
+                 IF( gdepw_0(ji,jj,jk) < 0._wp .OR. gdept_0(ji,jj,jk) < 0._wp ) THEN
+                    WRITE(ctmp1,*) 'ERROR zgr_sco :   gdepw or gdept =< 0  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'ERROR zgr_sco :   gdepw   or gdept   =< 0  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'gdepw',gdepw_0(ji,jj,:)
+                    WRITE(numout,*) 'gdept',gdept_0(ji,jj,:)
+                    CALL ctl_stop( ctmp1 )
+                 ENDIF
+                 ! and check it never exceeds the total depth
+                 IF( gdepw_0(ji,jj,jk) > hbatt(ji,jj) ) THEN
+                    WRITE(ctmp1,*) 'ERROR zgr_sco :   gdepw > hbatt  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'ERROR zgr_sco :   gdepw > hbatt  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'gdepw',gdepw_0(ji,jj,:)
+                    CALL ctl_stop( ctmp1 )
+                 ENDIF
+               END DO
+               !
+               DO jk = 1, mbathy(ji,jj)-1
+                 ! and check it never exceeds the total depth
+                IF( gdept_0(ji,jj,jk) > hbatt(ji,jj) ) THEN
+                    WRITE(ctmp1,*) 'ERROR zgr_sco :   gdept > hbatt  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'ERROR zgr_sco :   gdept > hbatt  at point (i,j,k)= ', ji, jj, jk
+                    WRITE(numout,*) 'gdept',gdept_0(ji,jj,:)
+                    CALL ctl_stop( ctmp1 )
+                 ENDIF
+               END DO
+            ENDIF
+         END DO
+      END DO
+      !
+      DEALLOCATE( zenv, ztmp, zmsk, zri, zrj, zhbat , ztmpi1, ztmpi2, ztmpj1, ztmpj2 )
+      !
+   END SUBROUTINE zgr_sco
+
+
+   SUBROUTINE s_sh94()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE s_sh94  ***
+      !!                     
+      !! ** Purpose :   stretch the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate stretch using the Song and Haidvogel 1994
+      !!                mixed S/sigma coordinate
+      !!
+      !! Reference : Song and Haidvogel 1994. 
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk           ! dummy loop argument
+      REAL(wp) ::   zcoeft, zcoefw   ! temporary scalars
+      REAL(wp) ::   ztmpu,  ztmpv,  ztmpf
+      REAL(wp) ::   ztmpu1, ztmpv1, ztmpf1
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z_gsigw3, z_gsigt3
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3           
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( z_gsigw3 (jpi,jpj,jpk), z_gsigt3 (jpi,jpj,jpk) )
+      ALLOCATE( z_esigt3 (jpi,jpj,jpk), z_esigw3 (jpi,jpj,jpk), z_esigtu3(jpi,jpj,jpk), z_esigtv3(jpi,jpj,jpk) )
+      ALLOCATE( z_esigtf3(jpi,jpj,jpk), z_esigwu3(jpi,jpj,jpk), z_esigwv3(jpi,jpj,jpk) )
+
+      z_gsigw3  = 0._wp   ;   z_gsigt3  = 0._wp
+      z_esigt3  = 0._wp   ;   z_esigw3  = 0._wp 
+      z_esigtu3 = 0._wp   ;   z_esigtv3 = 0._wp   ;   z_esigtf3 = 0._wp
+      z_esigwu3 = 0._wp   ;   z_esigwv3 = 0._wp
+      !
+      DO ji = 1, jpi
+         DO jj = 1, jpj
+            !
+            IF( hbatt(ji,jj) > rn_hc ) THEN    !deep water, stretched sigma
+               DO jk = 1, jpk
+                  z_gsigw3(ji,jj,jk) = -fssig1( REAL(jk,wp)-0.5_wp, rn_bb )
+                  z_gsigt3(ji,jj,jk) = -fssig1( REAL(jk,wp)       , rn_bb )
+               END DO
+            ELSE ! shallow water, uniform sigma
+               DO jk = 1, jpk
+                  z_gsigw3(ji,jj,jk) =   REAL(jk-1,wp)            / REAL(jpk-1,wp)
+                  z_gsigt3(ji,jj,jk) = ( REAL(jk-1,wp) + 0.5_wp ) / REAL(jpk-1,wp)
+                  END DO
+            ENDIF
+            !
+            DO jk = 1, jpkm1
+               z_esigt3(ji,jj,jk  ) = z_gsigw3(ji,jj,jk+1) - z_gsigw3(ji,jj,jk)
+               z_esigw3(ji,jj,jk+1) = z_gsigt3(ji,jj,jk+1) - z_gsigt3(ji,jj,jk)
+            END DO
+            z_esigw3(ji,jj,1  ) = 2._wp * ( z_gsigt3(ji,jj,1  ) - z_gsigw3(ji,jj,1  ) )
+            z_esigt3(ji,jj,jpk) = 2._wp * ( z_gsigt3(ji,jj,jpk) - z_gsigw3(ji,jj,jpk) )
+            !
+            DO jk = 1, jpk
+               zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp)
+               zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp)
+               gdept_0(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigt3(ji,jj,jk)+rn_hc*zcoeft )
+               gdepw_0(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigw3(ji,jj,jk)+rn_hc*zcoefw )
+            END DO
+           !
+         END DO   ! for all jj's
+      END DO    ! for all ji's
+
+      DO ji = 1, jpim1
+         DO jj = 1, jpjm1
+            ! extended for Wetting/Drying case
+            ztmpu  = hbatt(ji,jj)+hbatt(ji+1,jj)
+            ztmpv  = hbatt(ji,jj)+hbatt(ji,jj+1)
+            ztmpf  = hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1)
+            ztmpu1 = hbatt(ji,jj)*hbatt(ji+1,jj)
+            ztmpv1 = hbatt(ji,jj)*hbatt(ji,jj+1)
+            ztmpf1 = MIN(hbatt(ji,jj), hbatt(ji+1,jj), hbatt(ji,jj+1), hbatt(ji+1,jj+1)) * &
+                   & MAX(hbatt(ji,jj), hbatt(ji+1,jj), hbatt(ji,jj+1), hbatt(ji+1,jj+1))
+            DO jk = 1, jpk
+                 z_esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) ) &
+                        &              / ztmpu
+                 z_esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj,jk) ) &
+                        &              / ztmpu
+
+                 z_esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk) ) &
+                        &              / ztmpv
+                 z_esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1,jk) ) &
+                        &              / ztmpv
+
+                 z_esigtf3(ji,jj,jk) = ( hbatt(ji  ,jj  )*z_esigt3(ji  ,jj  ,jk)                               &
+                        &            +   hbatt(ji+1,jj  )*z_esigt3(ji+1,jj  ,jk)                               &
+                        &            +   hbatt(ji  ,jj+1)*z_esigt3(ji  ,jj+1,jk)                               &
+                        &            +   hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1,jk) ) / ztmpf
+
+               !
+               e3t_0(ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*z_esigt3 (ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+               e3u_0(ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*z_esigtu3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+               e3v_0(ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*z_esigtv3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+               e3f_0(ji,jj,jk) = ( (hbatf(ji,jj)-rn_hc)*z_esigtf3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+               !
+               e3w_0 (ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*z_esigw3 (ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+               e3uw_0(ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*z_esigwu3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+               e3vw_0(ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*z_esigwv3(ji,jj,jk) + rn_hc/REAL(jpkm1,wp) )
+            END DO
+        END DO
+      END DO
+      !
+      DEALLOCATE( z_gsigw3, z_gsigt3                                                        )
+      DEALLOCATE( z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )
+      !
+   END SUBROUTINE s_sh94
+
+
+   SUBROUTINE s_sf12
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE s_sf12 *** 
+      !!                     
+      !! ** Purpose :   stretch the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate stretch using the Siddorn and Furner 2012?
+      !!                mixed S/sigma/Z coordinate
+      !!
+      !!                This method allows the maintenance of fixed surface and or
+      !!                bottom cell resolutions (cf. geopotential coordinates) 
+      !!                within an analytically derived stretched S-coordinate framework.
+      !!
+      !!
+      !! Reference : Siddorn and Furner 2012 (submitted Ocean modelling).
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk           ! dummy loop argument
+      REAL(wp) ::   zsmth               ! smoothing around critical depth
+      REAL(wp) ::   zzs, zzb           ! Surface and bottom cell thickness in sigma space
+      REAL(wp) ::   ztmpu, ztmpv, ztmpf
+      REAL(wp) ::   ztmpu1, ztmpv1, ztmpf1
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z_gsigw3, z_gsigt3
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3           
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( z_gsigw3 (jpi,jpj,jpk), z_gsigt3 (jpi,jpj,jpk) )
+      ALLOCATE( z_esigt3 (jpi,jpj,jpk), z_esigw3 (jpi,jpj,jpk), z_esigtu3(jpi,jpj,jpk), z_esigtv3(jpi,jpj,jpk))
+      ALLOCATE( z_esigtf3(jpi,jpj,jpk), z_esigwu3(jpi,jpj,jpk), z_esigwv3(jpi,jpj,jpk) )
+
+      z_gsigw3  = 0._wp   ;   z_gsigt3  = 0._wp
+      z_esigt3  = 0._wp   ;   z_esigw3  = 0._wp 
+      z_esigtu3 = 0._wp   ;   z_esigtv3 = 0._wp   ;   z_esigtf3 = 0._wp
+      z_esigwu3 = 0._wp   ;   z_esigwv3 = 0._wp
+
+      DO ji = 1, jpi
+         DO jj = 1, jpj
+
+          IF (hbatt(ji,jj)>rn_hc) THEN !deep water, stretched sigma
+              
+              zzb = hbatt(ji,jj)*rn_zb_a + rn_zb_b   ! this forces a linear bottom cell depth relationship with H,.
+                                                     ! could be changed by users but care must be taken to do so carefully
+              zzb = 1.0_wp-(zzb/hbatt(ji,jj))
+            
+              zzs = rn_zs / hbatt(ji,jj) 
+              
+              IF (rn_efold /= 0.0_wp) THEN
+                zsmth   = tanh( (hbatt(ji,jj)- rn_hc ) / rn_efold )
+              ELSE
+                zsmth = 1.0_wp 
+              ENDIF
+               
+              DO jk = 1, jpk
+                z_gsigw3(ji,jj,jk) =  REAL(jk-1,wp)        /REAL(jpk-1,wp)
+                z_gsigt3(ji,jj,jk) = (REAL(jk-1,wp)+0.5_wp)/REAL(jpk-1,wp)
+              ENDDO
+              z_gsigw3(ji,jj,:) = fgamma( z_gsigw3(ji,jj,:), zzb, zzs, zsmth  )
+              z_gsigt3(ji,jj,:) = fgamma( z_gsigt3(ji,jj,:), zzb, zzs, zsmth  )
+ 
+          ELSE IF (ln_sigcrit) THEN ! shallow water, uniform sigma
+
+            DO jk = 1, jpk
+              z_gsigw3(ji,jj,jk) =  REAL(jk-1,wp)     /REAL(jpk-1,wp)
+              z_gsigt3(ji,jj,jk) = (REAL(jk-1,wp)+0.5)/REAL(jpk-1,wp)
+            END DO
+
+          ELSE  ! shallow water, z coordinates
+
+            DO jk = 1, jpk
+              z_gsigw3(ji,jj,jk) =  REAL(jk-1,wp)        /REAL(jpk-1,wp)*(rn_hc/hbatt(ji,jj))
+              z_gsigt3(ji,jj,jk) = (REAL(jk-1,wp)+0.5_wp)/REAL(jpk-1,wp)*(rn_hc/hbatt(ji,jj))
+            END DO
+
+          ENDIF
+
+          DO jk = 1, jpkm1
+             z_esigt3(ji,jj,jk) = z_gsigw3(ji,jj,jk+1) - z_gsigw3(ji,jj,jk)
+             z_esigw3(ji,jj,jk+1) = z_gsigt3(ji,jj,jk+1) - z_gsigt3(ji,jj,jk)
+          END DO
+          z_esigw3(ji,jj,1  ) = 2.0_wp * (z_gsigt3(ji,jj,1  ) - z_gsigw3(ji,jj,1  ))
+          z_esigt3(ji,jj,jpk) = 2.0_wp * (z_gsigt3(ji,jj,jpk) - z_gsigw3(ji,jj,jpk))
+
+          DO jk = 1, jpk
+             gdept_0(ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigt3(ji,jj,jk)
+             gdepw_0(ji,jj,jk) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigw3(ji,jj,jk)
+          END DO
+
+        ENDDO   ! for all jj's
+      ENDDO    ! for all ji's
+
+      DO ji=1,jpi-1
+        DO jj=1,jpj-1
+
+           ! extend to suit for Wetting/Drying case
+           ztmpu  = hbatt(ji,jj)+hbatt(ji+1,jj)
+           ztmpv  = hbatt(ji,jj)+hbatt(ji,jj+1)
+           ztmpf  = hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1)
+           ztmpu1 = hbatt(ji,jj)*hbatt(ji+1,jj)
+           ztmpv1 = hbatt(ji,jj)*hbatt(ji,jj+1)
+           ztmpf1 = MIN(hbatt(ji,jj), hbatt(ji+1,jj), hbatt(ji,jj+1), hbatt(ji+1,jj+1)) * &
+                  & MAX(hbatt(ji,jj), hbatt(ji+1,jj), hbatt(ji,jj+1), hbatt(ji+1,jj+1))
+           DO jk = 1, jpk
+                z_esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) ) &
+                       &              / ztmpu
+                z_esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj,jk) ) &
+                       &              / ztmpu
+                z_esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk) ) &
+                       &              / ztmpv
+                z_esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1,jk) ) &
+                       &              / ztmpv
+
+                z_esigtf3(ji,jj,jk) = ( hbatt(ji  ,jj  )*z_esigt3(ji  ,jj  ,jk)                               &
+                       &              + hbatt(ji+1,jj  )*z_esigt3(ji+1,jj  ,jk)                               &
+                       &              + hbatt(ji  ,jj+1)*z_esigt3(ji  ,jj+1,jk)                               &
+                       &              + hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1,jk) ) / ztmpf
+
+             ! Code prior to wetting and drying option (for reference)
+             !z_esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj,jk) )   &
+             !                     /( hbatt(ji,jj)+hbatt(ji+1,jj) )
+             !
+             !z_esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj,jk) )   &
+             !                     /( hbatt(ji,jj)+hbatt(ji+1,jj) )
+             !
+             !z_esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigt3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1,jk) )   &
+             !                     /( hbatt(ji,jj)+hbatt(ji,jj+1) )
+             !
+             !z_esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*z_esigw3(ji,jj,jk)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1,jk) )   &
+             !                     /( hbatt(ji,jj)+hbatt(ji,jj+1) )
+             !
+             !z_esigtf3(ji,jj,jk) = ( hbatt(ji  ,jj  )*z_esigt3(ji  ,jj  ,jk)                                 &
+             !                    &  +hbatt(ji+1,jj  )*z_esigt3(ji+1,jj  ,jk)                                 &
+             !                       +hbatt(ji  ,jj+1)*z_esigt3(ji  ,jj+1,jk)                                 &
+             !                    &  +hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1,jk) )                               &
+             !                     /( hbatt(ji  ,jj  )+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) )
+
+             e3t_0(ji,jj,jk)=(scosrf(ji,jj)+hbatt(ji,jj))*z_esigt3(ji,jj,jk)
+             e3u_0(ji,jj,jk)=(scosrf(ji,jj)+hbatu(ji,jj))*z_esigtu3(ji,jj,jk)
+             e3v_0(ji,jj,jk)=(scosrf(ji,jj)+hbatv(ji,jj))*z_esigtv3(ji,jj,jk)
+             e3f_0(ji,jj,jk)=(scosrf(ji,jj)+hbatf(ji,jj))*z_esigtf3(ji,jj,jk)
+             !
+             e3w_0 (ji,jj,jk)=hbatt(ji,jj)*z_esigw3(ji,jj,jk)
+             e3uw_0(ji,jj,jk)=hbatu(ji,jj)*z_esigwu3(ji,jj,jk)
+             e3vw_0(ji,jj,jk)=hbatv(ji,jj)*z_esigwv3(ji,jj,jk)
+          END DO
+
+        ENDDO
+      ENDDO
+      !
+      CALL lbc_lnk('domzgr',e3t_0 ,'T',1.) ; CALL lbc_lnk('domzgr',e3u_0 ,'T',1.)
+      CALL lbc_lnk('domzgr',e3v_0 ,'T',1.) ; CALL lbc_lnk('domzgr',e3f_0 ,'T',1.)
+      CALL lbc_lnk('domzgr',e3w_0 ,'T',1.)
+      CALL lbc_lnk('domzgr',e3uw_0,'T',1.) ; CALL lbc_lnk('domzgr',e3vw_0,'T',1.)
+      !
+      DEALLOCATE( z_gsigw3, z_gsigt3                                                        )
+      DEALLOCATE( z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )
+      !
+   END SUBROUTINE s_sf12
+
+
+   SUBROUTINE s_tanh()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE s_tanh*** 
+      !!                     
+      !! ** Purpose :   stretch the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate stretch 
+      !!
+      !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408.
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk       ! dummy loop argument
+      REAL(wp) ::   zcoeft, zcoefw   ! temporary scalars
+      REAL(wp), ALLOCATABLE, DIMENSION(:) :: z_gsigw, z_gsigt
+      REAL(wp), ALLOCATABLE, DIMENSION(:) :: z_esigt, z_esigw
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( z_gsigw(jpk), z_gsigt(jpk) )
+      ALLOCATE( z_esigt(jpk), z_esigw(jpk) )
+
+      z_gsigw  = 0._wp   ;   z_gsigt  = 0._wp
+      z_esigt  = 0._wp   ;   z_esigw  = 0._wp 
+
+      DO jk = 1, jpk
+        z_gsigw(jk) = -fssig( REAL(jk,wp)-0.5_wp )
+        z_gsigt(jk) = -fssig( REAL(jk,wp)        )
+      END DO
+      IF( nprint == 1 .AND. lwp )   WRITE(numout,*) 'z_gsigw 1 jpk    ', z_gsigw(1), z_gsigw(jpk)
+      !
+      ! Coefficients for vertical scale factors at w-, t- levels
+!!gm bug :  define it from analytical function, not like juste bellow....
+!!gm        or betteroffer the 2 possibilities....
+      DO jk = 1, jpkm1
+         z_esigt(jk  ) = z_gsigw(jk+1) - z_gsigw(jk)
+         z_esigw(jk+1) = z_gsigt(jk+1) - z_gsigt(jk)
+      END DO
+      z_esigw( 1 ) = 2._wp * ( z_gsigt(1  ) - z_gsigw(1  ) ) 
+      z_esigt(jpk) = 2._wp * ( z_gsigt(jpk) - z_gsigw(jpk) )
+      !
+      DO jk = 1, jpk
+         zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp)
+         zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp)
+         gdept_0(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsigt(jk) + hift(:,:)*zcoeft )
+         gdepw_0(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*z_gsigw(jk) + hift(:,:)*zcoefw )
+      END DO
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpk
+              e3t_0(ji,jj,jk) = ( (hbatt(ji,jj)-hift(ji,jj))*z_esigt(jk) + hift(ji,jj)/REAL(jpkm1,wp) )
+              e3u_0(ji,jj,jk) = ( (hbatu(ji,jj)-hifu(ji,jj))*z_esigt(jk) + hifu(ji,jj)/REAL(jpkm1,wp) )
+              e3v_0(ji,jj,jk) = ( (hbatv(ji,jj)-hifv(ji,jj))*z_esigt(jk) + hifv(ji,jj)/REAL(jpkm1,wp) )
+              e3f_0(ji,jj,jk) = ( (hbatf(ji,jj)-hiff(ji,jj))*z_esigt(jk) + hiff(ji,jj)/REAL(jpkm1,wp) )
+              !
+              e3w_0 (ji,jj,jk) = ( (hbatt(ji,jj)-hift(ji,jj))*z_esigw(jk) + hift(ji,jj)/REAL(jpkm1,wp) )
+              e3uw_0(ji,jj,jk) = ( (hbatu(ji,jj)-hifu(ji,jj))*z_esigw(jk) + hifu(ji,jj)/REAL(jpkm1,wp) )
+              e3vw_0(ji,jj,jk) = ( (hbatv(ji,jj)-hifv(ji,jj))*z_esigw(jk) + hifv(ji,jj)/REAL(jpkm1,wp) )
+            END DO
+         END DO
+      END DO
+      !
+      DEALLOCATE( z_gsigw, z_gsigt )
+      DEALLOCATE( z_esigt, z_esigw )
+      !
+   END SUBROUTINE s_tanh
+
+
+   FUNCTION fssig( pk ) RESULT( pf )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE fssig ***
+      !!       
+      !! ** Purpose :   provide the analytical function in s-coordinate
+      !!          
+      !! ** Method  :   the function provide the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and jpk)
+      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in) ::   pk   ! continuous "k" coordinate
+      REAL(wp)             ::   pf   ! sigma value
+      !!----------------------------------------------------------------------
+      !
+      pf =   (   TANH( rn_theta * ( -(pk-0.5_wp) / REAL(jpkm1) + rn_thetb )  )   &
+         &     - TANH( rn_thetb * rn_theta                                )  )   &
+         & * (   COSH( rn_theta                           )                      &
+         &     + COSH( rn_theta * ( 2._wp * rn_thetb - 1._wp ) )  )              &
+         & / ( 2._wp * SINH( rn_theta ) )
+      !
+   END FUNCTION fssig
+
+
+   FUNCTION fssig1( pk1, pbb ) RESULT( pf1 )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE fssig1 ***
+      !!
+      !! ** Purpose :   provide the Song and Haidvogel version of the analytical function in s-coordinate
+      !!
+      !! ** Method  :   the function provides the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and jpk)
+      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in) ::   pk1   ! continuous "k" coordinate
+      REAL(wp), INTENT(in) ::   pbb   ! Stretching coefficient
+      REAL(wp)             ::   pf1   ! sigma value
+      !!----------------------------------------------------------------------
+      !
+      IF ( rn_theta == 0 ) then      ! uniform sigma
+         pf1 = - ( pk1 - 0.5_wp ) / REAL( jpkm1 )
+      ELSE                        ! stretched sigma
+         pf1 =   ( 1._wp - pbb ) * ( SINH( rn_theta*(-(pk1-0.5_wp)/REAL(jpkm1)) ) ) / SINH( rn_theta )              &
+            &  + pbb * (  (TANH( rn_theta*( (-(pk1-0.5_wp)/REAL(jpkm1)) + 0.5_wp) ) - TANH( 0.5_wp * rn_theta )  )  &
+            &        / ( 2._wp * TANH( 0.5_wp * rn_theta ) )  )
+      ENDIF
+      !
+   END FUNCTION fssig1
+
+
+   FUNCTION fgamma( pk1, pzb, pzs, psmth) RESULT( p_gamma )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE fgamma  ***
+      !!
+      !! ** Purpose :   provide analytical function for the s-coordinate
+      !!
+      !! ** Method  :   the function provides the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and jpk)
+      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+      !!
+      !!                This method allows the maintenance of fixed surface and or
+      !!                bottom cell resolutions (cf. geopotential coordinates) 
+      !!                within an analytically derived stretched S-coordinate framework.
+      !!
+      !! Reference  :   Siddorn and Furner, in prep
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in   ) ::   pk1(jpk)       ! continuous "k" coordinate
+      REAL(wp)                ::   p_gamma(jpk)   ! stretched coordinate
+      REAL(wp), INTENT(in   ) ::   pzb            ! Bottom box depth
+      REAL(wp), INTENT(in   ) ::   pzs            ! surface box depth
+      REAL(wp), INTENT(in   ) ::   psmth          ! Smoothing parameter
+      !
+      INTEGER  ::   jk             ! dummy loop index
+      REAL(wp) ::   za1,za2,za3    ! local scalar
+      REAL(wp) ::   zn1,zn2        !   -      - 
+      REAL(wp) ::   za,zb,zx       !   -      - 
+      !!----------------------------------------------------------------------
+      !
+      zn1  =  1._wp / REAL( jpkm1, wp )
+      zn2  =  1._wp -  zn1
+      !
+      za1 = (rn_alpha+2.0_wp)*zn1**(rn_alpha+1.0_wp)-(rn_alpha+1.0_wp)*zn1**(rn_alpha+2.0_wp) 
+      za2 = (rn_alpha+2.0_wp)*zn2**(rn_alpha+1.0_wp)-(rn_alpha+1.0_wp)*zn2**(rn_alpha+2.0_wp)
+      za3 = (zn2**3.0_wp - za2)/( zn1**3.0_wp - za1)
+      !
+      za = pzb - za3*(pzs-za1)-za2
+      za = za/( zn2-0.5_wp*(za2+zn2**2.0_wp) - za3*(zn1-0.5_wp*(za1+zn1**2.0_wp) ) )
+      zb = (pzs - za1 - za*( zn1-0.5_wp*(za1+zn1**2.0_wp ) ) ) / (zn1**3.0_wp - za1)
+      zx = 1.0_wp-za/2.0_wp-zb
+      !
+      DO jk = 1, jpk
+         p_gamma(jk) = za*(pk1(jk)*(1.0_wp-pk1(jk)/2.0_wp))+zb*pk1(jk)**3.0_wp +  &
+            &          zx*( (rn_alpha+2.0_wp)*pk1(jk)**(rn_alpha+1.0_wp)- &
+            &               (rn_alpha+1.0_wp)*pk1(jk)**(rn_alpha+2.0_wp) )
+        p_gamma(jk) = p_gamma(jk)*psmth+pk1(jk)*(1.0_wp-psmth)
+      END DO
+      !
+   END FUNCTION fgamma
+
+   !!======================================================================
+END MODULE domzgr
Index: /utils/tools_ticket2413/DOMAINcfg/src/errioipsl.f90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/errioipsl.f90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/errioipsl.f90	(revision 12863)
@@ -0,0 +1,215 @@
+MODULE errioipsl
+!-
+!$Id: errioipsl.f90 2281 2010-10-15 14:21:13Z smasson $
+!-
+! 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: /utils/tools_ticket2413/DOMAINcfg/src/fliocom.f90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/fliocom.f90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/fliocom.f90	(revision 12863)
@@ -0,0 +1,5173 @@
+MODULE fliocom
+!-
+!$Id: fliocom.f90 2512 2010-12-23 15:27:09Z smasson $
+!-
+! 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: /utils/tools_ticket2413/DOMAINcfg/src/in_out_manager.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/in_out_manager.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/in_out_manager.F90	(revision 12863)
@@ -0,0 +1,186 @@
+MODULE in_out_manager   
+   !!======================================================================
+   !!                       ***  MODULE  in_out_manager  ***
+   !! I/O manager utilities : Defines run parameters together with logical units
+   !!=====================================================================
+   !! History :   1.0  !  2002-06  (G. Madec)   original code
+   !!             2.0  !  2006-07  (S. Masson)  iom, add ctl_stop, ctl_warn
+   !!             3.0  !  2008-06  (G. Madec)   add ctmp4 to ctmp10
+   !!             3.2  !  2009-08  (S. MAsson)  add new ctl_opn
+   !!             3.3  !  2010-10  (A. Coward)  add NetCDF4 usage
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   USE par_oce       ! ocean parameter
+   USE nc4interface  ! NetCDF4 interface
+
+   IMPLICIT NONE
+   PUBLIC
+
+   !!----------------------------------------------------------------------
+   !!                   namrun namelist parameters
+   !!----------------------------------------------------------------------
+   CHARACTER(lc) ::   cn_exp           !: experiment name used for output filename
+   CHARACTER(lc) ::   cn_ocerst_in     !: suffix of ocean restart name (input)
+   CHARACTER(lc) ::   cn_ocerst_indir  !: restart input directory
+   CHARACTER(lc) ::   cn_ocerst_out    !: suffix of ocean restart name (output)
+   CHARACTER(lc) ::   cn_ocerst_outdir !: restart output directory
+   LOGICAL       ::   ln_rstart        !: start from (F) rest or (T) a restart file
+   LOGICAL       ::   ln_rst_list      !: output restarts at list of times (T) or by frequency (F)
+   INTEGER       ::   nn_rstctl        !: control of the time step (0, 1 or 2)
+   INTEGER       ::   nn_rstssh   = 0  !: hand made initilization of ssh or not (1/0)
+   INTEGER       ::   nn_it000         !: index of the first time step
+   INTEGER       ::   nn_itend         !: index of the last time step
+   INTEGER       ::   nn_date0         !: initial calendar date aammjj
+   INTEGER       ::   nn_time0         !: initial time of day in hhmm
+   INTEGER       ::   nn_leapy         !: Leap year calendar flag (0/1 or 30)
+   INTEGER       ::   nn_istate        !: initial state output flag (0/1)
+   INTEGER       ::   nn_write         !: model standard output frequency
+   INTEGER       ::   nn_stock         !: restart file frequency
+   INTEGER, DIMENSION(10) :: nn_stocklist  !: restart dump times
+   LOGICAL       ::   ln_mskland       !: mask land points in NetCDF outputs (costly: + ~15%)
+   LOGICAL       ::   ln_cfmeta        !: output additional data to netCDF files required for compliance with the CF metadata standard
+   LOGICAL       ::   ln_clobber       !: clobber (overwrite) an existing file
+   INTEGER       ::   nn_chunksz       !: chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
+   LOGICAL       ::   ln_xios_read     !: use xios to read single file restart
+   INTEGER       ::   nn_wxios         !: write resart using xios 0 - no, 1 - single, 2 - multiple file output
+   INTEGER       ::   nn_no            !: Assimilation cycle
+
+#if defined key_netcdf4
+   !!----------------------------------------------------------------------
+   !!                   namnc4 namelist parameters                         (key_netcdf4)
+   !!----------------------------------------------------------------------
+   ! The following four values determine the partitioning of the output fields
+   ! into netcdf4 chunks. They are unrelated to the nn_chunk_sz setting which is
+   ! for runtime optimisation. The individual netcdf4 chunks can be optionally 
+   ! gzipped (recommended) leading to significant reductions in I/O volumes 
+   !                         !!!**  variables only used with iom_nf90 routines and key_netcdf4 **
+   INTEGER ::   nn_nchunks_i   !: number of chunks required in the i-dimension 
+   INTEGER ::   nn_nchunks_j   !: number of chunks required in the j-dimension 
+   INTEGER ::   nn_nchunks_k   !: number of chunks required in the k-dimension 
+   INTEGER ::   nn_nchunks_t   !: number of chunks required in the t-dimension 
+   LOGICAL ::   ln_nc4zip      !: netcdf4 usage: (T) chunk and compress output using the HDF5 sublayers of netcdf4
+   !                           !                 (F) ignore chunking request and use the netcdf4 library 
+   !                           !                     to produce netcdf3-compatible files 
+#endif
+
+!$AGRIF_DO_NOT_TREAT
+   TYPE(snc4_ctl)     :: snc4set        !: netcdf4 chunking control structure (always needed for decision making)
+!$AGRIF_END_DO_NOT_TREAT
+
+
+   !! conversion of DOCTOR norm namelist name into model name
+   !! (this should disappear in a near futur)
+
+   CHARACTER(lc) ::   cexper                      !: experiment name used for output filename
+   INTEGER       ::   nrstdt                      !: control of the time step (0, 1 or 2)
+   INTEGER       ::   nit000                      !: index of the first time step
+   INTEGER       ::   nitend                      !: index of the last time step
+   INTEGER       ::   ndate0                      !: initial calendar date aammjj
+   INTEGER       ::   nleapy                      !: Leap year calendar flag (0/1 or 30)
+   INTEGER       ::   ninist                      !: initial state output flag (0/1)
+   INTEGER       ::   nwrite                      !: model standard output frequency
+   INTEGER       ::   nstock                      !: restart file frequency
+   INTEGER, DIMENSION(10) :: nstocklist           !: restart dump times
+
+   !!----------------------------------------------------------------------
+   !! was in restart but moved here because of the OFF line... better solution should be found...
+   !!----------------------------------------------------------------------
+   INTEGER ::   nitrst                !: time step at which restart file should be written
+   LOGICAL ::   lrst_oce              !: logical to control the oce restart write 
+   LOGICAL ::   lrst_ice              !: logical to control the ice restart write 
+   INTEGER ::   numror = 0            !: logical unit for ocean restart (read). Init to 0 is needed for SAS (in daymod.F90)
+   INTEGER ::   numrir                !: logical unit for ice   restart (read)
+   INTEGER ::   numrow                !: logical unit for ocean restart (write)
+   INTEGER ::   numriw                !: logical unit for ice   restart (write)
+   INTEGER ::   nrst_lst              !: number of restart to output next
+
+   !!----------------------------------------------------------------------
+   !!                    output monitoring
+   !!----------------------------------------------------------------------
+   LOGICAL ::   ln_ctl           !: run control for debugging
+   TYPE :: sn_ctl                !: optional use structure for finer control over output selection
+      LOGICAL :: l_config  = .FALSE.  !: activate/deactivate finer control
+                                      !  Note if l_config is True then ln_ctl is ignored.
+                                      !  Otherwise setting ln_ctl True is equivalent to setting
+                                      !  all the following logicals in this structure True
+      LOGICAL :: l_runstat = .FALSE.  !: Produce/do not produce run.stat file (T/F)
+      LOGICAL :: l_trcstat = .FALSE.  !: Produce/do not produce tracer.stat file (T/F)
+      LOGICAL :: l_oceout  = .FALSE.  !: Produce all ocean.outputs    (T) or just one (F)
+      LOGICAL :: l_layout  = .FALSE.  !: Produce all layout.dat files (T) or just one (F)
+      LOGICAL :: l_mppout  = .FALSE.  !: Produce/do not produce mpp.output_XXXX files (T/F)
+      LOGICAL :: l_mpptop  = .FALSE.  !: Produce/do not produce mpp.top.output_XXXX files (T/F)
+                                      !  Optional subsetting of processor report files
+                                      !  Default settings of 0/1000000/1 should ensure all areas report.
+                                      !  Set to a more restrictive range to select specific areas
+      INTEGER :: procmin   = 0        !: Minimum narea to output
+      INTEGER :: procmax   = 1000000  !: Maximum narea to output
+      INTEGER :: procincr  = 1        !: narea increment to output
+      INTEGER :: ptimincr  = 1        !: timestep increment to output (time.step and run.stat)
+   END TYPE sn_ctl
+
+   TYPE (sn_ctl) :: sn_cfctl     !: run control structure for selective output
+   LOGICAL ::   ln_timing        !: run control for timing
+   LOGICAL ::   ln_diacfl        !: flag whether to create CFL diagnostics
+   INTEGER ::   nn_print         !: level of print (0 no print)
+   INTEGER ::   nn_ictls         !: Start i indice for the SUM control
+   INTEGER ::   nn_ictle         !: End   i indice for the SUM control
+   INTEGER ::   nn_jctls         !: Start j indice for the SUM control
+   INTEGER ::   nn_jctle         !: End   j indice for the SUM control
+   INTEGER ::   nn_isplt         !: number of processors following i
+   INTEGER ::   nn_jsplt         !: number of processors following j
+   INTEGER ::   nn_bench         !: benchmark parameter (0/1)
+   INTEGER ::   nn_bit_cmp = 0   !: bit reproducibility  (0/1)
+   !                                          
+   INTEGER ::   nprint, nictls, nictle, njctls, njctle, isplt, jsplt    !: OLD namelist names
+
+   INTEGER ::   ijsplt     =    1      !: nb of local domain = nb of processors
+
+   !!----------------------------------------------------------------------
+   !!                        logical units
+   !!----------------------------------------------------------------------
+   INTEGER ::   numstp          =   -1      !: logical unit for time step
+   INTEGER ::   numtime         =   -1      !: logical unit for timing
+   INTEGER ::   numout          =    6      !: logical unit for output print; Set to stdout to ensure any
+   INTEGER ::   numnul          =   -1      !: logical unit for /dev/null
+      !                                     !  early output can be collected; do not change
+   INTEGER ::   numnam_ref      =   -1      !: logical unit for reference namelist
+   INTEGER ::   numnam_cfg      =   -1      !: logical unit for configuration specific namelist
+   INTEGER ::   numond          =   -1      !: logical unit for Output Namelist Dynamics
+   INTEGER ::   numnam_ice_ref  =   -1      !: logical unit for ice reference namelist
+   INTEGER ::   numnam_ice_cfg  =   -1      !: logical unit for ice reference namelist
+   INTEGER ::   numoni          =   -1      !: logical unit for Output Namelist Ice
+   INTEGER ::   numevo_ice      =   -1      !: logical unit for ice variables (temp. evolution)
+   INTEGER ::   numrun          =   -1      !: logical unit for run statistics
+   INTEGER ::   numdct_in       =   -1      !: logical unit for transports computing
+   INTEGER ::   numdct_vol      =   -1      !: logical unit for voulume transports output
+   INTEGER ::   numdct_heat     =   -1      !: logical unit for heat    transports output
+   INTEGER ::   numdct_salt     =   -1      !: logical unit for salt    transports output
+   INTEGER ::   numfl           =   -1      !: logical unit for floats ascii output
+   INTEGER ::   numflo          =   -1      !: logical unit for floats ascii output
+
+   !!----------------------------------------------------------------------
+   !!                          Run control  
+   !!----------------------------------------------------------------------
+   INTEGER       ::   no_print = 0          !: optional argument of fld_fill (if present, suppress some control print)
+   INTEGER       ::   nstop = 0             !: error flag (=number of reason for a premature stop run)
+   INTEGER       ::   nwarn = 0             !: warning flag (=number of warning found during the run)
+   CHARACTER(lc) ::   ctmp1, ctmp2, ctmp3   !: temporary characters 1 to 3
+   CHARACTER(lc) ::   ctmp4, ctmp5, ctmp6   !: temporary characters 4 to 6
+   CHARACTER(lc) ::   ctmp7, ctmp8, ctmp9   !: temporary characters 7 to 9
+   CHARACTER(lc) ::   ctmp10                !: temporary character 10
+   CHARACTER(lc) ::   cform_err = "(/,' ===>>> : E R R O R',     /,'         ===========',/)"       !:
+   CHARACTER(lc) ::   cform_war = "(/,' ===>>> : W A R N I N G', /,'         ===============',/)"   !:
+   LOGICAL       ::   lwm      = .FALSE.    !: boolean : true on the 1st processor only (always)
+   LOGICAL       ::   lwp      = .FALSE.    !: boolean : true on the 1st processor only .OR. ln_ctl
+   LOGICAL       ::   lsp_area = .TRUE.     !: to make a control print over a specific area
+   CHARACTER(lc) ::   cxios_context         !: context name used in xios
+   CHARACTER(lc) ::   crxios_context         !: context name used in xios to read restart
+   CHARACTER(lc) ::   cwxios_context        !: context name used in xios to write restart file
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: in_out_manager.F90 10570 2019-01-24 15:14:49Z acc $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!=====================================================================
+END MODULE in_out_manager
Index: /utils/tools_ticket2413/DOMAINcfg/src/ioipsl.f90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/ioipsl.f90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/ioipsl.f90	(revision 12863)
@@ -0,0 +1,13 @@
+MODULE ioipsl
+!
+!$Id: ioipsl.f90 2281 2010-10-15 14:21:13Z smasson $
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!
+  USE errioipsl   
+  USE calendar   
+  USE stringop
+  USE fliocom    
+
+END MODULE ioipsl
Index: /utils/tools_ticket2413/DOMAINcfg/src/iom.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/iom.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/iom.F90	(revision 12863)
@@ -0,0 +1,2392 @@
+MODULE iom
+   !!======================================================================
+   !!                    ***  MODULE  iom ***
+   !! Input/Output manager :  Library to read input files
+   !!======================================================================
+   !! History :  2.0  ! 2005-12  (J. Belier) Original code
+   !!            2.0  ! 2006-02  (S. Masson) Adaptation to NEMO
+   !!            3.0  ! 2007-07  (D. Storkey) Changes to iom_gettime
+   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  add C1D case  
+   !!            3.6  ! 2014-15  DIMG format removed
+   !!            3.6  ! 2015-15  (J. Harle) Added procedure to read REAL attributes
+   !!            4.0  ! 2017-11  (M. Andrejczuk) Extend IOM interface to write any 3D fields
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   iom_open       : open a file read only
+   !!   iom_close      : close a file or all files opened by iom
+   !!   iom_get        : read a field (interfaced to several routines)
+   !!   iom_varid      : get the id of a variable in a file
+   !!   iom_rstput     : write a field in a restart file (interfaced to several routines)
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE lbclnk          ! lateal boundary condition / mpp exchanges
+   USE iom_def         ! iom variables definitions
+   USE iom_nf90        ! NetCDF format with native NetCDF library
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp           ! MPP library
+#if defined key_iomput
+   USE sbc_oce  , ONLY :   nn_fsbc         ! ocean space and time domain
+   USE trc_oce  , ONLY :   nn_dttrc        !  !: frequency of step on passive tracers
+   USE icb_oce  , ONLY :   nclasses, class_num       !  !: iceberg classes
+#if defined key_si3
+   USE ice      , ONLY :   jpl
+#endif
+   USE domngb          ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE xios
+# endif
+   USE ioipsl, ONLY :  ju2ymds    ! for calendar
+#if defined key_top
+   USE trc, ONLY    :  profsed
+#endif
+   USE lib_fortran 
+
+   IMPLICIT NONE
+   PUBLIC   !   must be public to be able to access iom_def through iom
+   
+#if defined key_iomput
+   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .TRUE.        !: iom_put flag
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .FALSE.       !: iom_put flag
+#endif
+   PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get
+   PUBLIC iom_chkatt, iom_getatt, iom_putatt, iom_getszuld, iom_rstput, iom_delay_rst, iom_put
+   PUBLIC iom_use, iom_context_finalize
+
+   PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
+   PRIVATE iom_g0d, iom_g1d, iom_g2d, iom_g3d, iom_get_123d
+   PRIVATE iom_p1d, iom_p2d, iom_p3d
+#if defined key_iomput
+   PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr
+   PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate
+   PRIVATE iom_set_rst_context, iom_set_rstw_active, iom_set_rstr_active
+# endif
+   PUBLIC iom_set_rstw_var_active, iom_set_rst_vars
+
+   INTERFACE iom_get
+      MODULE PROCEDURE iom_g0d, iom_g1d, iom_g2d, iom_g3d
+   END INTERFACE
+   INTERFACE iom_getatt
+      MODULE PROCEDURE iom_g0d_iatt, iom_g1d_iatt, iom_g0d_ratt, iom_g1d_ratt, iom_g0d_catt
+   END INTERFACE
+   INTERFACE iom_putatt
+      MODULE PROCEDURE iom_p0d_iatt, iom_p1d_iatt, iom_p0d_ratt, iom_p1d_ratt, iom_p0d_catt
+   END INTERFACE
+   INTERFACE iom_rstput
+      MODULE PROCEDURE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
+   END INTERFACE
+   INTERFACE iom_put
+      MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d
+   END INTERFACE iom_put
+  
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: iom.F90 10523 2019-01-16 09:36:03Z smasson $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE iom_init( cdname, fname, ld_tmppatch ) 
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE   ***
+      !!
+      !! ** Purpose :   
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*),           INTENT(in)  :: cdname
+      CHARACTER(len=*), OPTIONAL, INTENT(in)  :: fname
+      LOGICAL         , OPTIONAL, INTENT(in)  :: ld_tmppatch
+#if defined key_iomput
+      !
+      TYPE(xios_duration) :: dtime    = xios_duration(0, 0, 0, 0, 0, 0)
+      TYPE(xios_date)     :: start_date
+      CHARACTER(len=lc) :: clname
+      INTEGER           :: ji, jkmin
+      LOGICAL :: llrst_context              ! is context related to restart
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds
+      LOGICAL ::   ll_tmppatch = .TRUE.    !: seb: patch before we remove periodicity
+      INTEGER ::   nldi_save, nlei_save    !:      and close boundaries in output files
+      INTEGER ::   nldj_save, nlej_save    !:
+      !!----------------------------------------------------------------------
+      !
+      ! seb: patch before we remove periodicity and close boundaries in output files
+      IF( PRESENT(ld_tmppatch) ) THEN   ;   ll_tmppatch = ld_tmppatch
+      ELSE                              ;   ll_tmppatch = .TRUE.
+      ENDIF
+      IF ( ll_tmppatch ) THEN
+         nldi_save = nldi   ;   nlei_save = nlei
+         nldj_save = nldj   ;   nlej_save = nlej
+         IF( nimpp           ==      1 ) nldi = 1
+         IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi
+         IF( njmpp           ==      1 ) nldj = 1
+         IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj
+      ENDIF
+      !
+      ALLOCATE( zt_bnds(2,jpk), zw_bnds(2,jpk) )
+      !
+      clname = cdname
+      IF( TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(cdname)
+      CALL xios_context_initialize(TRIM(clname), mpi_comm_oce)
+      CALL iom_swap( cdname )
+      llrst_context =  (TRIM(cdname) == TRIM(crxios_context) .OR. TRIM(cdname) == TRIM(cwxios_context))
+
+      ! Calendar type is now defined in xml file 
+      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
+      CASE ( 1)   ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(1900,01,01,00,00,00), &
+          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) )
+      CASE ( 0)   ; CALL xios_define_calendar( TYPE = "NoLeap"   , time_origin = xios_date(1900,01,01,00,00,00), &
+          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) )
+      CASE (30)   ; CALL xios_define_calendar( TYPE = "D360"     , time_origin = xios_date(1900,01,01,00,00,00), &
+          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) )
+      END SELECT
+
+      ! horizontal grid definition
+      IF(.NOT.llrst_context) CALL set_scalar
+      !
+      IF( TRIM(cdname) == TRIM(cxios_context) ) THEN  
+         CALL set_grid( "T", glamt, gphit, .FALSE., .FALSE. ) 
+         CALL set_grid( "U", glamu, gphiu, .FALSE., .FALSE. )
+         CALL set_grid( "V", glamv, gphiv, .FALSE., .FALSE. )
+         CALL set_grid( "W", glamt, gphit, .FALSE., .FALSE. )
+         CALL set_grid_znl( gphit )
+         !
+         IF( ln_cfmeta ) THEN   ! Add additional grid metadata
+            CALL iom_set_domain_attr("grid_T", area = e1e2t(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_U", area = e1e2u(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_V", area = e1e2v(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_W", area = e1e2t(nldi:nlei, nldj:nlej))
+            CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit )
+            CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu )
+            CALL set_grid_bounds( "V", glamu, gphiu, glamv, gphiv )
+            CALL set_grid_bounds( "W", glamf, gphif, glamt, gphit )
+         ENDIF
+      ENDIF
+      !
+      IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN  
+         CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
+         !
+         CALL set_grid( "T", glamt_crs, gphit_crs, .FALSE., .FALSE. ) 
+         CALL set_grid( "U", glamu_crs, gphiu_crs, .FALSE., .FALSE. ) 
+         CALL set_grid( "V", glamv_crs, gphiv_crs, .FALSE., .FALSE. ) 
+         CALL set_grid( "W", glamt_crs, gphit_crs, .FALSE., .FALSE. ) 
+         CALL set_grid_znl( gphit_crs )
+          !
+         CALL dom_grid_glo   ! Return to parent grid domain
+         !
+         IF( ln_cfmeta .AND. .NOT. llrst_context) THEN   ! Add additional grid metadata
+            CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_V", area = e1v_crs(nldi:nlei, nldj:nlej) * e2v_crs(nldi:nlei, nldj:nlej))
+            CALL iom_set_domain_attr("grid_W", area = e1e2t_crs(nldi:nlei, nldj:nlej))
+            CALL set_grid_bounds( "T", glamf_crs, gphif_crs, glamt_crs, gphit_crs )
+            CALL set_grid_bounds( "U", glamv_crs, gphiv_crs, glamu_crs, gphiu_crs )
+            CALL set_grid_bounds( "V", glamu_crs, gphiu_crs, glamv_crs, gphiv_crs )
+            CALL set_grid_bounds( "W", glamf_crs, gphif_crs, glamt_crs, gphit_crs )
+         ENDIF
+      ENDIF
+      !
+      ! vertical grid definition
+      IF(.NOT.llrst_context) THEN
+          CALL iom_set_axis_attr( "deptht",  paxis = gdept_1d )
+          CALL iom_set_axis_attr( "depthu",  paxis = gdept_1d )
+          CALL iom_set_axis_attr( "depthv",  paxis = gdept_1d )
+          CALL iom_set_axis_attr( "depthw",  paxis = gdepw_1d )
+
+          ! Add vertical grid bounds
+          jkmin = MIN(2,jpk)  ! in case jpk=1 (i.e. sas2D)
+          zt_bnds(2,:        ) = gdept_1d(:)
+          zt_bnds(1,jkmin:jpk) = gdept_1d(1:jpkm1)
+          zt_bnds(1,1        ) = gdept_1d(1) - e3w_1d(1)
+          zw_bnds(1,:        ) = gdepw_1d(:)
+          zw_bnds(2,1:jpkm1  ) = gdepw_1d(jkmin:jpk)
+          zw_bnds(2,jpk:     ) = gdepw_1d(jpk) + e3t_1d(jpk)
+          CALL iom_set_axis_attr( "deptht", bounds=zw_bnds )
+          CALL iom_set_axis_attr( "depthu", bounds=zw_bnds )
+          CALL iom_set_axis_attr( "depthv", bounds=zw_bnds )
+          CALL iom_set_axis_attr( "depthw", bounds=zt_bnds )
+          !
+# if defined key_floats
+          CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,jpnfl) /) )
+# endif
+# if defined key_si3
+          CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) )
+          ! SIMIP diagnostics (4 main arctic straits)
+          CALL iom_set_axis_attr( "nstrait", (/ (REAL(ji,wp), ji=1,4) /) )
+# endif
+#if defined key_top
+          CALL iom_set_axis_attr( "profsed", paxis = profsed )
+#endif
+          CALL iom_set_axis_attr( "icbcla", class_num )
+          CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) )
+          CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) )
+      ENDIF
+      !
+      ! automatic definitions of some of the xml attributs
+      IF( TRIM(cdname) == TRIM(crxios_context) ) THEN
+!set names of the fields in restart file IF using XIOS to read data
+          CALL iom_set_rst_context(.TRUE.)
+          CALL iom_set_rst_vars(rst_rfields)
+!set which fields are to be read from restart file
+          CALL iom_set_rstr_active()
+      ELSE IF( TRIM(cdname) == TRIM(cwxios_context) ) THEN
+!set names of the fields in restart file IF using XIOS to write data
+          CALL iom_set_rst_context(.FALSE.)
+          CALL iom_set_rst_vars(rst_wfields)
+!set which fields are to be written to a restart file
+          CALL iom_set_rstw_active(fname)
+      ELSE
+          CALL set_xmlatt
+      ENDIF
+      !
+      ! end file definition
+      dtime%second = rdt
+      CALL xios_set_timestep( dtime )
+      CALL xios_close_context_definition()
+      CALL xios_update_calendar( 0 )
+      !
+      DEALLOCATE( zt_bnds, zw_bnds )
+      !
+      IF ( ll_tmppatch ) THEN
+         nldi = nldi_save   ;   nlei = nlei_save
+         nldj = nldj_save   ;   nlej = nlej_save
+      ENDIF
+#endif
+      !
+   END SUBROUTINE iom_init
+
+   SUBROUTINE iom_set_rstw_var_active(field)
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_set_rstw_var_active  ***
+      !!
+      !! ** Purpose :  enable variable in restart file when writing with XIOS 
+      !!---------------------------------------------------------------------
+   CHARACTER(len = *), INTENT(IN) :: field
+   INTEGER :: i
+   LOGICAL :: llis_set
+   CHARACTER(LEN=256) :: clinfo    ! info character
+
+#if defined key_iomput
+   llis_set = .FALSE.
+
+   DO i = 1, max_rst_fields
+       IF(TRIM(rst_wfields(i)%vname) == field) THEN 
+          rst_wfields(i)%active = .TRUE.
+          llis_set = .TRUE.
+          EXIT
+       ENDIF
+   ENDDO
+!Warn if variable is not in defined in rst_wfields
+   IF(.NOT.llis_set) THEN
+      WRITE(ctmp1,*) 'iom_set_rstw_var_active: variable ', field ,' is available for writing but not defined' 
+      CALL ctl_stop( 'iom_set_rstw_var_active:', ctmp1 )
+   ENDIF
+#else
+        clinfo = 'iom_set_rstw_var_active: key_iomput is needed to use XIOS restart read/write functionality'
+        CALL ctl_stop('STOP', TRIM(clinfo))
+#endif
+
+   END SUBROUTINE iom_set_rstw_var_active
+
+   SUBROUTINE iom_set_rstr_active()
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_set_rstr_active  ***
+      !!
+      !! ** Purpose :  define file name in XIOS context for reading restart file,
+      !!               enable variables present in restart file for reading with XIOS 
+      !!---------------------------------------------------------------------
+
+!sets enabled = .TRUE. for each field in restart file
+   CHARACTER(len=256) :: rst_file
+
+#if defined key_iomput
+   TYPE(xios_field) :: field_hdl
+   TYPE(xios_file) :: file_hdl
+   TYPE(xios_filegroup) :: filegroup_hdl
+   INTEGER :: i
+   CHARACTER(lc)  ::   clpath
+
+        clpath = TRIM(cn_ocerst_indir)
+        IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'
+        IF( TRIM(Agrif_CFixed()) == '0' ) THEN
+           rst_file = TRIM(clpath)//TRIM(cn_ocerst_in)
+        ELSE
+           rst_file = TRIM(clpath)//'1_'//TRIM(cn_ocerst_in)
+        ENDIF
+!set name of the restart file and enable available fields
+        if(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS) to: ',rst_file
+        CALL xios_get_handle("file_definition", filegroup_hdl )
+        CALL xios_add_child(filegroup_hdl, file_hdl, 'rrestart')
+        CALL xios_set_file_attr( "rrestart", name=trim(rst_file), type="one_file", &
+             par_access="collective", enabled=.TRUE., mode="read",                 &
+             output_freq=xios_timestep)
+!define variables for restart context
+        DO i = 1, max_rst_fields
+         IF( TRIM(rst_rfields(i)%vname) /= "NO_NAME") THEN
+           IF( iom_varid( numror, TRIM(rst_rfields(i)%vname), ldstop = .FALSE. ) > 0 ) THEN
+                CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_rfields(i)%vname))
+                SELECT CASE (TRIM(rst_rfields(i)%grid))
+                 CASE ("grid_N_3D")
+                    CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), &
+                        domain_ref="grid_N", axis_ref="nav_lev", operation = "instant")
+                 CASE ("grid_N")
+                    CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), &
+                        domain_ref="grid_N", operation = "instant") 
+                CASE ("grid_vector")
+                    CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), &
+                         axis_ref="nav_lev", operation = "instant")
+                 CASE ("grid_scalar")
+                    CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), &
+                        scalar_ref = "grid_scalar", operation = "instant")
+                END SELECT
+                IF(lwp) WRITE(numout,*) 'XIOS read: ', TRIM(rst_rfields(i)%vname), ' enabled in ', TRIM(rst_file)
+           ENDIF
+         ENDIF
+        END DO
+#endif
+   END SUBROUTINE iom_set_rstr_active
+
+   SUBROUTINE iom_set_rst_vars(fields)
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE iom_set_rst_vars   ***
+      !!
+      !! ** Purpose :  Fill array fields with the information about all 
+      !!               possible variables and corresponding grids definition 
+      !!               for reading/writing restart with XIOS
+      !!---------------------------------------------------------------------
+   TYPE(RST_FIELD), INTENT(INOUT) :: fields(max_rst_fields)
+   INTEGER :: i
+
+        i = 0
+        i = i + 1; fields(i)%vname="rdt";            fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="un";             fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="ub";             fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="vn";             fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="vb";             fields(i)%grid="grid_N_3D"  
+        i = i + 1; fields(i)%vname="tn";             fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="tb";             fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="sn";             fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="sb";             fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="sshn";           fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="sshb";           fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="rhop";           fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="kt";             fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="ndastp";         fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="adatrj";         fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="utau_b";         fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="vtau_b";         fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="qns_b";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="emp_b";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="sfx_b";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="en" ;            fields(i)%grid="grid_N_3D" 
+        i = i + 1; fields(i)%vname="avt_k";            fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="avm_k";            fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="dissl";          fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="sbc_hc_b";       fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="sbc_sc_b";       fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="qsr_hc_b";       fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="fraqsr_1lev";    fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="greenland_icesheet_mass"
+                                               fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="greenland_icesheet_timelapsed"
+                                               fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="greenland_icesheet_mass_roc"
+                                               fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="antarctica_icesheet_mass"
+                                               fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="antarctica_icesheet_timelapsed"
+                                               fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="antarctica_icesheet_mass_roc"
+                                               fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="frc_v";          fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="frc_t";          fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="frc_s";          fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="frc_wn_t";       fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="frc_wn_s";       fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="ssh_ini";        fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="e3t_ini";        fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="hc_loc_ini";     fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="sc_loc_ini";     fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="ssh_hc_loc_ini"; fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="ssh_sc_loc_ini"; fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="tilde_e3t_b";    fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="tilde_e3t_n";    fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="hdiv_lf";        fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="ub2_b";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="vb2_b";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="sshbb_e";        fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="ubb_e";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="vbb_e";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="sshb_e";         fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="ub_e";           fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="vb_e";           fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="fwf_isf_b";      fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="isf_sc_b";       fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="isf_hc_b";       fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="ssh_ibb";        fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="rnf_b";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="rnf_hc_b";       fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="rnf_sc_b";       fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="nn_fsbc";        fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="ssu_m";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="ssv_m";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="sst_m";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="sss_m";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="ssh_m";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="e3t_m";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="frq_m";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="avmb";           fields(i)%grid="grid_vector"
+        i = i + 1; fields(i)%vname="avtb";           fields(i)%grid="grid_vector"
+        i = i + 1; fields(i)%vname="ub2_i_b";        fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="vb2_i_b";        fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="ntime";          fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="Dsst";           fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="tmask";          fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="umask";          fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="vmask";          fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="smask";          fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="gdepw_n";        fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="e3t_n";          fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="e3u_n";          fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="e3v_n";          fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="surf_ini";       fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="e3t_b";          fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="hmxl_n";         fields(i)%grid="grid_N_3D"
+        i = i + 1; fields(i)%vname="un_bf";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="vn_bf";          fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="hbl";            fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="hbli";           fields(i)%grid="grid_N"
+        i = i + 1; fields(i)%vname="wn";             fields(i)%grid="grid_N_3D"
+
+        IF( i-1 > max_rst_fields) THEN
+           WRITE(ctmp1,*) 'E R R O R : iom_set_rst_vars SIZE of RST_FIELD array is too small'
+           CALL ctl_stop( 'iom_set_rst_vars:', ctmp1 )
+        ENDIF
+   END SUBROUTINE iom_set_rst_vars
+
+
+   SUBROUTINE iom_set_rstw_active(cdrst_file)
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE iom_set_rstw_active   ***
+      !!
+      !! ** Purpose :  define file name in XIOS context for writing restart
+      !!               enable variables present in restart file for writing
+      !!---------------------------------------------------------------------
+!sets enabled = .TRUE. for each field in restart file
+   CHARACTER(len=*) :: cdrst_file
+#if defined key_iomput
+   TYPE(xios_field) :: field_hdl
+   TYPE(xios_file) :: file_hdl
+   TYPE(xios_filegroup) :: filegroup_hdl
+   INTEGER :: i
+   CHARACTER(lc)  ::   clpath
+
+!set name of the restart file and enable available fields
+        IF(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS write) to: ',cdrst_file
+        CALL xios_get_handle("file_definition", filegroup_hdl )
+        CALL xios_add_child(filegroup_hdl, file_hdl, 'wrestart')
+        IF(nxioso.eq.1) THEN 
+           CALL xios_set_file_attr( "wrestart", type="one_file", enabled=.TRUE.,& 
+                                    mode="write", output_freq=xios_timestep) 
+           if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in one_file mode' 
+        ELSE  
+           CALL xios_set_file_attr( "wrestart", type="multiple_file", enabled=.TRUE.,& 
+                                    mode="write", output_freq=xios_timestep) 
+           if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in multiple_file mode' 
+        ENDIF 
+        CALL xios_set_file_attr( "wrestart", name=trim(cdrst_file))
+!define fields for restart context
+        DO i = 1, max_rst_fields
+         IF( rst_wfields(i)%active ) THEN
+                CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_wfields(i)%vname))
+                SELECT CASE (TRIM(rst_wfields(i)%grid))
+                 CASE ("grid_N_3D")
+                    CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), &
+                        domain_ref="grid_N", axis_ref="nav_lev", prec = 8, operation = "instant")
+                 CASE ("grid_N")
+                    CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), &
+                        domain_ref="grid_N", prec = 8, operation = "instant") 
+                 CASE ("grid_vector")
+                    CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), &
+                         axis_ref="nav_lev", prec = 8, operation = "instant")
+                 CASE ("grid_scalar")
+                    CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), &
+                        scalar_ref = "grid_scalar", prec = 8, operation = "instant")
+                END SELECT
+         ENDIF
+        END DO
+#endif
+   END SUBROUTINE iom_set_rstw_active
+
+   SUBROUTINE iom_set_rst_context(ld_rstr) 
+     !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_set_rst_context  ***
+      !!
+      !! ** Purpose : Define domain, axis and grid for restart (read/write) 
+      !!              context 
+      !!               
+      !!---------------------------------------------------------------------
+   LOGICAL, INTENT(IN)               :: ld_rstr
+!ld_rstr is true for restart context. There is no need to define grid for 
+!restart read, because it's read from file
+#if defined key_iomput
+   TYPE(xios_domaingroup)            :: domaingroup_hdl 
+   TYPE(xios_domain)                 :: domain_hdl 
+   TYPE(xios_axisgroup)              :: axisgroup_hdl 
+   TYPE(xios_axis)                   :: axis_hdl 
+   TYPE(xios_scalar)                 :: scalar_hdl 
+   TYPE(xios_scalargroup)            :: scalargroup_hdl 
+
+     CALL xios_get_handle("domain_definition",domaingroup_hdl) 
+     CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N") 
+     CALL set_grid("N", glamt, gphit, .TRUE., ld_rstr) 
+ 
+     CALL xios_get_handle("axis_definition",axisgroup_hdl) 
+     CALL xios_add_child(axisgroup_hdl, axis_hdl, "nav_lev") 
+!AGRIF fails to compile when unit= is in call to xios_set_axis_attr
+!    CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels",  unit="m", positive="down") 
+     CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels in meters", positive="down")
+     CALL iom_set_axis_attr( "nav_lev", paxis = gdept_1d ) 
+
+     CALL xios_get_handle("scalar_definition", scalargroup_hdl) 
+     CALL xios_add_child(scalargroup_hdl, scalar_hdl, "grid_scalar") 
+#endif
+   END SUBROUTINE iom_set_rst_context
+
+   SUBROUTINE iom_swap( cdname )
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_swap  ***
+      !!
+      !! ** Purpose :  swap context between different agrif grid for xmlio_server
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in) :: cdname
+#if defined key_iomput
+      TYPE(xios_context) :: nemo_hdl
+
+      IF( TRIM(Agrif_CFixed()) == '0' ) THEN
+        CALL xios_get_handle(TRIM(cdname),nemo_hdl)
+      ELSE
+        CALL xios_get_handle(TRIM(Agrif_CFixed())//"_"//TRIM(cdname),nemo_hdl)
+      ENDIF
+      !
+      CALL xios_set_current_context(nemo_hdl)
+#endif
+      !
+   END SUBROUTINE iom_swap
+
+
+   SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, lagrif, ldstop, ldiof, kdlev )
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_open  ***
+      !!
+      !! ** Purpose :  open an input file (return 0 if not found)
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in   )           ::   cdname   ! File name
+      INTEGER         , INTENT(  out)           ::   kiomid   ! iom identifier of the opened file
+      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldwrt    ! open in write modeb          (default = .FALSE.)
+      INTEGER         , INTENT(in   ), OPTIONAL ::   kdom     ! Type of domain to be written (default = jpdom_local_noovlap)
+      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.)
+      LOGICAL         , INTENT(in   ), OPTIONAL ::   lagrif   ! add 1_ prefix for AGRIF (default = .TRUE.
+      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldiof    ! Interp On the Fly, needed for AGRIF (default = .FALSE.)
+      INTEGER         , INTENT(in   ), OPTIONAL ::   kdlev    ! number of vertical levels
+      !
+      CHARACTER(LEN=256)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu]
+      CHARACTER(LEN=256)    ::   cltmpn    ! tempory name to store clname (in writting mode)
+      CHARACTER(LEN=10)     ::   clsuffix  ! ".nc" 
+      CHARACTER(LEN=15)     ::   clcpu     ! the cpu number (max jpmax_digits digits)
+      CHARACTER(LEN=256)    ::   clinfo    ! info character
+      LOGICAL               ::   llok      ! check the existence 
+      LOGICAL               ::   llwrt     ! local definition of ldwrt
+      LOGICAL               ::   llnoov    ! local definition to read overlap
+      LOGICAL               ::   llstop    ! local definition of ldstop
+      LOGICAL               ::   lliof     ! local definition of ldiof
+      LOGICAL               ::   llagrif   ! local definition of lagrif
+      INTEGER               ::   icnt      ! counter for digits in clcpu (max = jpmax_digits)
+      INTEGER               ::   iln, ils  ! lengths of character
+      INTEGER               ::   idom      ! type of domain
+      INTEGER               ::   istop     ! 
+      INTEGER, DIMENSION(2,5) ::   idompar ! domain parameters: 
+      ! local number of points for x,y dimensions
+      ! position of first local point for x,y dimensions
+      ! position of last local point for x,y dimensions
+      ! start halo size for x,y dimensions
+      ! end halo size for x,y dimensions
+      !
+      INTEGER ::   nldi_save, nlei_save    !:patch before we remove periodicity and close boundaries in output files
+      INTEGER ::   nldj_save, nlej_save    !:
+      !
+      !---------------------------------------------------------------------
+      ! Initializations and control
+      ! =============
+      kiomid = -1
+      clinfo = '                    iom_open ~~~  '
+      istop = nstop
+
+      ! use patch to force the writing off periodicity and close boundaries
+      ! without this, issue in some model decomposition
+      ! seb: patch before we remove periodicity and close boundaries in output files
+      nldi_save = nldi   ;   nlei_save = nlei
+      nldj_save = nldj   ;   nlej_save = nlej
+      IF( nimpp           ==      1 ) nldi = 1
+      IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi
+      IF( njmpp           ==      1 ) nldj = 1
+      IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj
+
+      ! if iom_open is called for the first time: initialize iom_file(:)%nfid to 0
+      ! (could be done when defining iom_file in f95 but not in f90)
+      IF( Agrif_Root() ) THEN
+         IF( iom_open_init == 0 ) THEN
+            iom_file(:)%nfid = 0
+            iom_open_init = 1
+         ENDIF
+      ENDIF
+      ! do we read or write the file?
+      IF( PRESENT(ldwrt) ) THEN   ;   llwrt = ldwrt
+      ELSE                        ;   llwrt = .FALSE.
+      ENDIF
+      ! do we call ctl_stop if we try to open a non-existing file in read mode?
+      IF( PRESENT(ldstop) ) THEN   ;   llstop = ldstop
+      ELSE                         ;   llstop = .TRUE.
+      ENDIF
+      ! do we add agrif suffix
+      IF( PRESENT(lagrif) ) THEN   ;   llagrif = lagrif
+      ELSE                         ;   llagrif = .TRUE.
+      ENDIF
+      ! are we using interpolation on the fly?
+      IF( PRESENT(ldiof) ) THEN   ;   lliof = ldiof
+      ELSE                        ;   lliof = .FALSE.
+      ENDIF
+      ! do we read the overlap 
+      ! ugly patch SM+JMM+RB to overwrite global definition in some cases
+      !llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif
+      ! for domain_cfg, force to read the full domain
+      llnoov = .FALSE.
+      ! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix)
+      ! =============
+      clname   = trim(cdname)
+      IF ( .NOT. Agrif_Root() .AND. .NOT. lliof .AND. llagrif) THEN
+         iln    = INDEX(clname,'/') 
+         cltmpn = clname(1:iln)
+         clname = clname(iln+1:LEN_TRIM(clname))
+         clname=TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname)
+      ENDIF
+      ! which suffix should we use?
+      clsuffix = '.nc'
+      ! Add the suffix if needed
+      iln = LEN_TRIM(clname)
+      ils = LEN_TRIM(clsuffix)
+      IF( iln <= ils .OR. INDEX( TRIM(clname), TRIM(clsuffix), back = .TRUE. ) /= iln - ils + 1 )   &
+         &   clname = TRIM(clname)//TRIM(clsuffix)
+      cltmpn = clname   ! store this name
+      ! try to find if the file to be opened already exist
+      ! =============
+      INQUIRE( FILE = clname, EXIST = llok )
+      IF( .NOT.llok ) THEN
+         ! we try to add the cpu number to the name
+         WRITE(clcpu,*) narea-1
+
+         clcpu  = TRIM(ADJUSTL(clcpu))
+         iln = INDEX(clname,TRIM(clsuffix), back = .TRUE.)
+         clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
+         icnt = 0
+         INQUIRE( FILE = clname, EXIST = llok ) 
+         ! we try different formats for the cpu number by adding 0
+         DO WHILE( .NOT.llok .AND. icnt < jpmax_digits )
+            clcpu  = "0"//trim(clcpu)
+            clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
+            INQUIRE( FILE = clname, EXIST = llok )
+            icnt = icnt + 1
+         END DO
+      ELSE
+         lxios_sini = .TRUE.
+      ENDIF
+      IF( llwrt ) THEN
+         ! check the domain definition
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!         idom = jpdom_local_noovlap   ! default definition
+         IF( llnoov ) THEN   ;   idom = jpdom_local_noovlap   ! default definition
+         ELSE                ;   idom = jpdom_local_full      ! default definition
+         ENDIF
+         IF( PRESENT(kdom) )   idom = kdom
+         ! create the domain informations
+         ! =============
+         SELECT CASE (idom)
+         CASE (jpdom_local_full)
+            idompar(:,1) = (/ jpi             , jpj              /)
+            idompar(:,2) = (/ nimpp           , njmpp            /)
+            idompar(:,3) = (/ nimpp + jpi - 1 , njmpp + jpj - 1  /)
+            idompar(:,4) = (/ nldi - 1        , nldj - 1         /)
+            idompar(:,5) = (/ jpi - nlei      , jpj - nlej       /)
+         CASE (jpdom_local_noextra)
+            idompar(:,1) = (/ nlci            , nlcj             /)
+            idompar(:,2) = (/ nimpp           , njmpp            /)
+            idompar(:,3) = (/ nimpp + nlci - 1, njmpp + nlcj - 1 /)
+            idompar(:,4) = (/ nldi - 1        , nldj - 1         /)
+            idompar(:,5) = (/ nlci - nlei     , nlcj - nlej      /)
+         CASE (jpdom_local_noovlap)
+            idompar(:,1) = (/ nlei  - nldi + 1, nlej  - nldj + 1 /)
+            idompar(:,2) = (/ nimpp + nldi - 1, njmpp + nldj - 1 /)
+            idompar(:,3) = (/ nimpp + nlei - 1, njmpp + nlej - 1 /)
+            idompar(:,4) = (/ 0               , 0                /)
+            idompar(:,5) = (/ 0               , 0                /)
+         CASE DEFAULT
+            CALL ctl_stop( TRIM(clinfo), 'wrong value of kdom, only jpdom_local* cases are accepted' )
+         END SELECT
+      ENDIF
+      ! Open the NetCDF file
+      ! =============
+      ! do we have some free file identifier?
+      IF( MINVAL(iom_file(:)%nfid) /= 0 )   &
+         &   CALL ctl_stop( TRIM(clinfo), 'No more free file identifier', 'increase jpmax_files in iom_def' )
+      ! if no file was found...
+      IF( .NOT. llok ) THEN
+         IF( .NOT. llwrt ) THEN   ! we are in read mode 
+            IF( llstop ) THEN   ;   CALL ctl_stop( TRIM(clinfo), 'File '//TRIM(cltmpn)//'* not found' )
+            ELSE                ;   istop = nstop + 1   ! make sure that istop /= nstop so we don't open the file
+            ENDIF
+         ELSE                     ! we are in write mode so we 
+            clname = cltmpn       ! get back the file name without the cpu number
+         ENDIF
+      ELSE
+         IF( llwrt .AND. .NOT. ln_clobber ) THEN   ! we stop as we want to write in a new file 
+            CALL ctl_stop( TRIM(clinfo), 'We want to write in a new file but '//TRIM(clname)//' already exists...' )
+            istop = nstop + 1                      ! make sure that istop /= nstop so we don't open the file
+         ELSEIF( llwrt ) THEN     ! the file exists and we are in write mode with permission to 
+            clname = cltmpn       ! overwrite so get back the file name without the cpu number
+         ENDIF
+      ENDIF
+      IF( istop == nstop ) THEN   ! no error within this routine
+         CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, kdlev = kdlev )
+      ENDIF
+
+      nldi = nldi_save   ;   nlei = nlei_save
+      nldj = nldj_save   ;   nlej = nlej_save
+      !
+   END SUBROUTINE iom_open
+
+
+   SUBROUTINE iom_close( kiomid )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_close  ***
+      !!
+      !! ** Purpose : close an input file, or all files opened by iom
+      !!--------------------------------------------------------------------
+      INTEGER, INTENT(inout), OPTIONAL ::   kiomid   ! iom identifier of the file to be closed
+      !                                              ! return 0 when file is properly closed
+      !                                              ! No argument: all files opened by iom are closed
+
+      INTEGER ::   jf         ! dummy loop indices
+      INTEGER ::   i_s, i_e   ! temporary integer
+      CHARACTER(LEN=100)    ::   clinfo    ! info character
+      !---------------------------------------------------------------------
+      !
+      clinfo = '                    iom_close ~~~  '
+      IF( PRESENT(kiomid) ) THEN
+         i_s = kiomid
+         i_e = kiomid
+      ELSE
+         i_s = 1
+         i_e = jpmax_files
+      ENDIF
+
+      IF( i_s > 0 ) THEN
+         DO jf = i_s, i_e
+            IF( iom_file(jf)%nfid > 0 ) THEN
+               CALL iom_nf90_close( jf )
+               iom_file(jf)%nfid       = 0          ! free the id 
+               IF( PRESENT(kiomid) )   kiomid = 0   ! return 0 as id to specify that the file was closed
+               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' close file: '//TRIM(iom_file(jf)%name)//' ok'
+            ELSEIF( PRESENT(kiomid) ) THEN
+               WRITE(ctmp1,*) '--->',  kiomid
+               CALL ctl_stop( TRIM(clinfo)//' Invalid file identifier', ctmp1 )
+            ENDIF
+         END DO
+      ENDIF
+      !    
+   END SUBROUTINE iom_close
+
+
+   FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, ldstop )  
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  iom_varid  ***
+      !!
+      !! ** Purpose : get the id of a variable in a file (return 0 if not found)
+      !!-----------------------------------------------------------------------
+      INTEGER              , INTENT(in   )           ::   kiomid   ! file Identifier
+      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable
+      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of each dimension
+      INTEGER,               INTENT(  out), OPTIONAL ::   kndims   ! size of the dimensions
+      LOGICAL              , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if looking for non-existing variable (default = .TRUE.)
+      !
+      INTEGER                        ::   iom_varid, iiv, i_nvd
+      LOGICAL                        ::   ll_fnd
+      CHARACTER(LEN=100)             ::   clinfo                   ! info character
+      LOGICAL                        ::   llstop                   ! local definition of ldstop
+      !!-----------------------------------------------------------------------
+      iom_varid = 0                         ! default definition
+      ! do we call ctl_stop if we look for non-existing variable?
+      IF( PRESENT(ldstop) ) THEN   ;   llstop = ldstop
+      ELSE                         ;   llstop = .TRUE.
+      ENDIF
+      !
+      IF( kiomid > 0 ) THEN
+         clinfo = 'iom_varid, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(cdvar)
+         IF( iom_file(kiomid)%nfid == 0 ) THEN 
+            CALL ctl_stop( trim(clinfo), 'the file is not open' )
+         ELSE
+            ll_fnd  = .FALSE.
+            iiv = 0
+            !
+            DO WHILE ( .NOT.ll_fnd .AND. iiv < iom_file(kiomid)%nvars )
+               iiv = iiv + 1
+               ll_fnd  = ( TRIM(cdvar) == TRIM(iom_file(kiomid)%cn_var(iiv)) )
+            END DO
+            !
+            IF( .NOT.ll_fnd ) THEN
+               iiv = iiv + 1
+               IF( iiv <= jpmax_vars ) THEN
+                  iom_varid = iom_nf90_varid( kiomid, cdvar, iiv, kdimsz, kndims )
+               ELSE
+                  CALL ctl_stop( trim(clinfo), 'Too many variables in the file '//iom_file(kiomid)%name,   &
+                        &                      'increase the parameter jpmax_vars')
+               ENDIF
+               IF( llstop .AND. iom_varid == -1 )   CALL ctl_stop( TRIM(clinfo)//' not found' ) 
+            ELSE
+               iom_varid = iiv
+               IF( PRESENT(kdimsz) ) THEN 
+                  i_nvd = iom_file(kiomid)%ndims(iiv)
+                  IF( i_nvd <= size(kdimsz) ) THEN
+                     kdimsz(1:i_nvd) = iom_file(kiomid)%dimsz(1:i_nvd,iiv)
+                  ELSE
+                     WRITE(ctmp1,*) i_nvd, size(kdimsz)
+                     CALL ctl_stop( trim(clinfo), 'error in kdimsz size'//trim(ctmp1) )
+                  ENDIF
+               ENDIF
+               IF( PRESENT(kndims) )  kndims = iom_file(kiomid)%ndims(iiv)
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+   END FUNCTION iom_varid
+
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_get
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime, ldxios )
+      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   )                 ::   cdvar     ! Name of the variable
+      REAL(wp)        , INTENT(  out)                 ::   pvar      ! read field
+      INTEGER         , INTENT(in   ),     OPTIONAL   ::   ktime     ! record number
+      LOGICAL         , INTENT(in   ),     OPTIONAL   ::   ldxios    ! use xios to read restart
+      !
+      INTEGER                                         ::   idvar     ! variable id
+      INTEGER                                         ::   idmspc    ! number of spatial dimensions
+      INTEGER         , DIMENSION(1)                  ::   itime     ! record number
+      CHARACTER(LEN=100)                              ::   clinfo    ! info character
+      CHARACTER(LEN=100)                              ::   clname    ! file name
+      CHARACTER(LEN=1)                                ::   cldmspc   !
+      LOGICAL                                         ::   llxios
+      !
+      llxios = .FALSE.
+      IF( PRESENT(ldxios) ) llxios = ldxios
+
+      IF(.NOT.llxios) THEN  ! read data using default library
+         itime = 1
+         IF( PRESENT(ktime) ) itime = ktime
+         !
+         clname = iom_file(kiomid)%name
+         clinfo = '          iom_g0d, file: '//trim(clname)//', var: '//trim(cdvar)
+         !
+         IF( kiomid > 0 ) THEN
+            idvar = iom_varid( kiomid, cdvar )
+            IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN
+               idmspc = iom_file ( kiomid )%ndims( idvar )
+               IF( iom_file(kiomid)%luld(idvar) )  idmspc = idmspc - 1
+               WRITE(cldmspc , fmt='(i1)') idmspc
+               IF( idmspc > 0 )  CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', &
+                                    &                         'with 1 or more spatial dimensions: '//cldmspc//' were found.' , &
+                                    &                         'Use ncwa -a to suppress the unnecessary dimensions' )
+               CALL iom_nf90_get( kiomid, idvar, pvar, itime )
+            ENDIF
+         ENDIF
+      ELSE
+#if defined key_iomput
+         IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar)
+         CALL iom_swap( TRIM(crxios_context) )
+         CALL xios_recv_field( trim(cdvar), pvar)
+         CALL iom_swap( TRIM(cxios_context) )
+#else
+         WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar)
+         CALL ctl_stop( 'iom_g0d', ctmp1 )
+#endif
+      ENDIF
+   END SUBROUTINE iom_g0d
+
+   SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, ldxios )
+      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file
+      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read
+      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable
+      REAL(wp)        , INTENT(  out), DIMENSION(:)           ::   pvar      ! read field
+      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number
+      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kstart    ! start axis position of the reading 
+      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kcount    ! number of points in each axis
+      LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios    ! read data using XIOS
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r1d=pvar,   &
+              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, &
+              &                                                     ldxios=ldxios )
+      ENDIF
+   END SUBROUTINE iom_g1d
+
+   SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios)
+      INTEGER         , INTENT(in   )                           ::   kiomid    ! Identifier of the file
+      INTEGER         , INTENT(in   )                           ::   kdom      ! Type of domain to be read
+      CHARACTER(len=*), INTENT(in   )                           ::   cdvar     ! Name of the variable
+      REAL(wp)        , INTENT(  out), DIMENSION(:,:)           ::   pvar      ! read field
+      INTEGER         , INTENT(in   )                , OPTIONAL ::   ktime     ! record number
+      INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kstart    ! start axis position of the reading 
+      INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kcount    ! number of points in each axis
+      LOGICAL         , INTENT(in   )                , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to
+                                                                               ! look for and use a file attribute
+                                                                               ! called open_ocean_jstart to set the start
+                                                                               ! value for the 2nd dimension (netcdf only)
+      LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios      ! read data using XIOS
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r2d=pvar,   &
+              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, &
+              &                                                     lrowattr=lrowattr,  ldxios=ldxios)
+      ENDIF
+   END SUBROUTINE iom_g2d
+
+   SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios )
+      INTEGER         , INTENT(in   )                             ::   kiomid    ! Identifier of the file
+      INTEGER         , INTENT(in   )                             ::   kdom      ! Type of domain to be read
+      CHARACTER(len=*), INTENT(in   )                             ::   cdvar     ! Name of the variable
+      REAL(wp)        , INTENT(  out), DIMENSION(:,:,:)           ::   pvar      ! read field
+      INTEGER         , INTENT(in   )                  , OPTIONAL ::   ktime     ! record number
+      INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kstart    ! start axis position of the reading 
+      INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kcount    ! number of points in each axis
+      LOGICAL         , INTENT(in   )                  , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to
+                                                                                 ! look for and use a file attribute
+                                                                                 ! called open_ocean_jstart to set the start
+                                                                                 ! value for the 2nd dimension (netcdf only)
+      LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios        ! read data using XIOS
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r3d=pvar,   &
+              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, &
+              &                                                     lrowattr=lrowattr, ldxios=ldxios )
+      ENDIF
+   END SUBROUTINE iom_g3d
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE iom_get_123d( kiomid, kdom  , cdvar ,   &
+         &                  pv_r1d, pv_r2d, pv_r3d,   &
+         &                  ktime , kstart, kcount,   &
+         &                  lrowattr, ldxios        )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_get_123d  ***
+      !!
+      !! ** Purpose : read a 1D/2D/3D variable
+      !!
+      !! ** Method : read ONE record at each CALL
+      !!-----------------------------------------------------------------------
+      INTEGER                    , INTENT(in   )           ::   kiomid     ! Identifier of the file
+      INTEGER                    , INTENT(in   )           ::   kdom       ! Type of domain to be read
+      CHARACTER(len=*)           , INTENT(in   )           ::   cdvar      ! Name of the variable
+      REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d     ! read field (1D case)
+      REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d     ! read field (2D case)
+      REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d     ! read field (3D case)
+      INTEGER                    , INTENT(in   ), OPTIONAL ::   ktime      ! record number
+      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart     ! start position of the reading in each axis 
+      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kcount     ! number of points to be read in each axis
+      LOGICAL                    , INTENT(in   ), OPTIONAL ::   lrowattr   ! logical flag telling iom_get to
+                                                                           ! look for and use a file attribute
+                                                                           ! called open_ocean_jstart to set the start
+                                                                           ! value for the 2nd dimension (netcdf only)
+      LOGICAL                    , INTENT(in   ), OPTIONAL ::   ldxios     ! use XIOS to read restart
+      !
+      LOGICAL                        ::   llxios       ! local definition for XIOS read
+      LOGICAL                        ::   llnoov      ! local definition to read overlap
+      LOGICAL                        ::   luse_jattr  ! local definition to read open_ocean_jstart file attribute
+      INTEGER                        ::   jstartrow   ! start point for 2nd dimension optionally set by file attribute
+      INTEGER                        ::   jl          ! loop on number of dimension 
+      INTEGER                        ::   idom        ! type of domain
+      INTEGER                        ::   idvar       ! id of the variable
+      INTEGER                        ::   inbdim      ! number of dimensions of the variable
+      INTEGER                        ::   idmspc      ! number of spatial dimensions 
+      INTEGER                        ::   itime       ! record number
+      INTEGER                        ::   istop       ! temporary value of nstop
+      INTEGER                        ::   ix1, ix2, iy1, iy2   ! subdomain indexes
+      INTEGER                        ::   ji, jj      ! loop counters
+      INTEGER                        ::   irankpv     ! 
+      INTEGER                        ::   ind1, ind2  ! substring index
+      INTEGER, DIMENSION(jpmax_dims) ::   istart      ! starting point to read for each axis
+      INTEGER, DIMENSION(jpmax_dims) ::   icnt        ! number of value to read along each axis 
+      INTEGER, DIMENSION(jpmax_dims) ::   idimsz      ! size of the dimensions of the variable
+      INTEGER, DIMENSION(jpmax_dims) ::   ishape      ! size of the dimensions of the variable
+      REAL(wp)                       ::   zscf, zofs  ! sacle_factor and add_offset
+      INTEGER                        ::   itmp        ! temporary integer
+      CHARACTER(LEN=256)             ::   clinfo      ! info character
+      CHARACTER(LEN=256)             ::   clname      ! file name
+      CHARACTER(LEN=1)               ::   clrankpv, cldmspc      ! 
+      LOGICAL                        ::   ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension.
+      INTEGER                        ::   inlev       ! number of levels for 3D data
+      REAL(wp)                       ::   gma, gmi
+      !---------------------------------------------------------------------
+      !
+      inlev = -1
+      IF( PRESENT(pv_r3d) )   inlev = SIZE(pv_r3d, 3)
+      !
+      llxios = .FALSE.
+      if(PRESENT(ldxios)) llxios = ldxios
+      idvar = iom_varid( kiomid, cdvar ) 
+      idom = kdom
+      !
+      IF(.NOT.llxios) THEN
+         clname = iom_file(kiomid)%name   !   esier to read
+         clinfo = '          iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar)
+         ! local definition of the domain ?
+         ! do we read the overlap 
+         ! ugly patch SM+JMM+RB to overwrite global definition in some cases
+         ! 
+         !llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 
+         ! for domain_cfg tools force to read the full domain
+         llnoov = .FALSE.
+         ! check kcount and kstart optionals parameters...
+         IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present')
+         IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present')
+         IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND.  idom /= jpdom_autoglo_xy  ) &
+     &          CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy')
+
+         luse_jattr = .false.
+         IF( PRESENT(lrowattr) ) THEN
+            IF( lrowattr .AND. idom /= jpdom_data   ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data')
+            IF( lrowattr .AND. idom == jpdom_data   ) luse_jattr = .true.
+         ENDIF
+
+         ! Search for the variable in the data base (eventually actualize data)
+         istop = nstop
+         !
+         IF( idvar > 0 ) THEN
+            ! to write iom_file(kiomid)%dimsz in a shorter way !
+            idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) 
+            inbdim = iom_file(kiomid)%ndims(idvar)            ! number of dimensions in the file
+            idmspc = inbdim                                   ! number of spatial dimensions in the file
+            IF( iom_file(kiomid)%luld(idvar) )   idmspc = inbdim - 1
+            IF( idmspc > 3 )   CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 
+            !
+            ! update idom definition...
+            ! Identify the domain in case of jpdom_auto(glo/dta) definition
+            IF( idom == jpdom_autoglo_xy ) THEN
+               ll_depth_spec = .TRUE.
+               idom = jpdom_autoglo
+            ELSE
+               ll_depth_spec = .FALSE.
+            ENDIF
+            IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN            
+               IF( idom == jpdom_autoglo ) THEN   ;   idom = jpdom_global 
+               ELSE                               ;   idom = jpdom_data
+               ENDIF
+               ind1 = INDEX( clname, '_', back = .TRUE. ) + 1
+               ind2 = INDEX( clname, '.', back = .TRUE. ) - 1
+               IF( ind2 > ind1 ) THEN   ;   IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 )   idom = jpdom_local   ;   ENDIF
+            ENDIF
+            ! Identify the domain in case of jpdom_local definition
+            IF( idom == jpdom_local ) THEN
+               IF(     idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN   ;   idom = jpdom_local_full
+               ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN   ;   idom = jpdom_local_noextra
+               ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN   ;   idom = jpdom_local_noovlap
+               ELSE   ;   CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' )
+               ENDIF
+            ENDIF
+            !
+            ! check the consistency between input array and data rank in the file
+            !
+            ! initializations
+            itime = 1
+            IF( PRESENT(ktime) ) itime = ktime
+            !
+            irankpv = 1 * COUNT( (/PRESENT(pv_r1d)/) ) + 2 * COUNT( (/PRESENT(pv_r2d)/) ) + 3 * COUNT( (/PRESENT(pv_r3d)/) )
+            WRITE(clrankpv, fmt='(i1)') irankpv
+            WRITE(cldmspc , fmt='(i1)') idmspc
+            !
+            IF(     idmspc <  irankpv ) THEN 
+               CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   &
+                  &                         'it is impossible to read a '//clrankpv//'D array from this file...' )
+            ELSEIF( idmspc == irankpv ) THEN
+               IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown )   &
+                  &   CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' )
+            ELSEIF( idmspc >  irankpv ) THEN
+                  IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN
+                     CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...'              ,   &
+                           &         'As the size of the z dimension is 1 and as we try to read the first record, ',   &
+                           &         'we accept this case, even if there is a possible mix-up between z and time dimension' )   
+                     idmspc = idmspc - 1
+                  ELSE
+                     CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,'         ,   &
+                        &                         'we do not accept data with '//cldmspc//' spatial dimensions',   &
+                        &                         'Use ncwa -a to suppress the unnecessary dimensions' )
+                  ENDIF
+            ENDIF
+            !
+            ! definition of istart and icnt
+            !
+            icnt  (:) = 1
+            istart(:) = 1
+            istart(idmspc+1) = itime
+   
+            IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN 
+               istart(1:idmspc) = kstart(1:idmspc) 
+               icnt  (1:idmspc) = kcount(1:idmspc)
+            ELSE
+               IF(idom == jpdom_unknown ) THEN
+                  icnt(1:idmspc) = idimsz(1:idmspc)
+               ELSE 
+                  IF( .NOT. PRESENT(pv_r1d) ) THEN   !   not a 1D array
+                     IF(     idom == jpdom_data    ) THEN
+                        jstartrow = 1
+                        IF( luse_jattr ) THEN
+                           CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found
+                           jstartrow = MAX(1,jstartrow)
+                        ENDIF
+                        istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /)  ! icnt(1:2) done below
+                     ELSEIF( idom == jpdom_global  ) THEN ; istart(1:2) = (/ nimpp , njmpp  /)  ! icnt(1:2) done below
+                     ENDIF
+                     ! we do not read the overlap                     -> we start to read at nldi, nldj
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!                  IF( idom /= jpdom_local_noovlap )   istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
+                     IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
+                  ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej 
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!                  icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
+                     IF( llnoov ) THEN   ;   icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
+                     ELSE                ;   icnt(1:2) = (/ nlci           , nlcj            /)
+                     ENDIF
+                     IF( PRESENT(pv_r3d) ) THEN
+                        IF( idom == jpdom_data ) THEN                        ;                               icnt(3) = inlev
+                        ELSEIF( ll_depth_spec .AND. PRESENT(kstart) ) THEN   ;   istart(3) = kstart(3)   ;   icnt(3) = kcount(3)
+                        ELSE                                                 ;                               icnt(3) = inlev
+                        ENDIF
+                     ENDIF
+                  ENDIF
+               ENDIF
+            ENDIF
+
+            ! check that istart and icnt can be used with this file
+            !-
+            DO jl = 1, jpmax_dims
+               itmp = istart(jl)+icnt(jl)-1
+               IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN
+                  WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp
+                  WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)"         ) jl, idimsz(jl)
+                  CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 )     
+               ENDIF
+            END DO
+
+            ! check that icnt matches the input array
+            !-     
+            IF( idom == jpdom_unknown ) THEN
+               IF( irankpv == 1 )        ishape(1:1) = SHAPE(pv_r1d)
+               IF( irankpv == 2 )        ishape(1:2) = SHAPE(pv_r2d)
+               IF( irankpv == 3 )        ishape(1:3) = SHAPE(pv_r3d)
+               ctmp1 = 'd'
+            ELSE
+               IF( irankpv == 2 ) THEN
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!               ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej  ))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej)'
+                  IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej  )) ; ctmp1='d(nldi:nlei,nldj:nlej)'
+                  ELSE              ; ishape(1:2)=SHAPE(pv_r2d(1   :nlci,1   :nlcj  )) ; ctmp1='d(1:nlci,1:nlcj)'
+                  ENDIF
+               ENDIF
+               IF( irankpv == 3 ) THEN 
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!               ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej,:)'
+                  IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)'
+                  ELSE              ; ishape(1:3)=SHAPE(pv_r3d(1   :nlci,1   :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)'
+                  ENDIF
+               ENDIF
+            ENDIF
+         
+            DO jl = 1, irankpv
+               WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl)
+               IF( ishape(jl) /= icnt(jl) )   CALL ctl_stop( TRIM(clinfo), 'size(pv_r'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) )
+            END DO
+
+         ENDIF
+
+         ! read the data
+         !-     
+         IF( idvar > 0 .AND. istop == nstop ) THEN   ! no additional errors until this point...
+            !
+         ! find the right index of the array to be read
+! JMM + SM: ugly patch before getting the new version of lib_mpp)
+!         IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej
+!         ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
+!         ENDIF
+            IF( llnoov ) THEN
+               IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej
+               ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
+               ENDIF
+            ELSE
+               IF( idom /= jpdom_unknown ) THEN   ;   ix1 = 1      ;   ix2 = nlci      ;   iy1 = 1      ;   iy2 = nlcj
+               ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
+               ENDIF
+            ENDIF
+
+            CALL iom_nf90_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, pv_r1d, pv_r2d, pv_r3d )
+
+            IF( istop == nstop ) THEN   ! no additional errors until this point...
+               IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name)
+             
+               !--- overlap areas and extra hallows (mpp)
+               IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN
+                  CALL lbc_lnk( 'iom', pv_r2d,'Z',-999.,'no0' )
+               ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN
+                  ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension
+                  IF( icnt(3) == inlev ) THEN
+                     CALL lbc_lnk( 'iom', pv_r3d,'Z',-999.,'no0' )
+                  ELSE   ! put some arbitrary value (a call to lbc_lnk will be done later...)
+                     DO jj = nlcj+1, jpj   ;   pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :)   ;   END DO
+                     DO ji = nlci+1, jpi   ;   pv_r3d(ji    , : , :) = pv_r3d(nlei  , :   , :)   ;   END DO
+                  ENDIF
+               ENDIF
+               !
+            ELSE
+               ! return if istop == nstop is false
+               RETURN
+            ENDIF
+         ELSE
+            ! return if statment idvar > 0 .AND. istop == nstop is false
+            RETURN
+         ENDIF
+         !
+      ELSE        ! read using XIOS. Only if KEY_IOMPUT is defined
+#if defined key_iomput
+!would be good to be able to check which context is active and swap only if current is not restart
+         CALL iom_swap( TRIM(crxios_context) ) 
+         IF( PRESENT(pv_r3d) ) THEN
+            pv_r3d(:, :, :) = 0.
+            if(lwp) write(numout,*) 'XIOS RST READ (3D): ',trim(cdvar)
+            CALL xios_recv_field( trim(cdvar), pv_r3d)
+            IF(idom /= jpdom_unknown ) then
+                CALL lbc_lnk( 'iom', pv_r3d,'Z',-999.,'no0' )
+            ENDIF
+         ELSEIF( PRESENT(pv_r2d) ) THEN
+            pv_r2d(:, :) = 0.
+            if(lwp) write(numout,*) 'XIOS RST READ (2D): ', trim(cdvar)
+            CALL xios_recv_field( trim(cdvar), pv_r2d)
+            IF(idom /= jpdom_unknown ) THEN
+                CALL lbc_lnk('iom', pv_r2d,'Z',-999.,'no0')
+            ENDIF
+         ELSEIF( PRESENT(pv_r1d) ) THEN
+            pv_r1d(:) = 0.
+            if(lwp) write(numout,*) 'XIOS RST READ (1D): ', trim(cdvar)
+            CALL xios_recv_field( trim(cdvar), pv_r1d)
+         ENDIF
+         CALL iom_swap( TRIM(cxios_context) )
+#else
+         istop = istop + 1 
+         clinfo = 'Can not use XIOS in iom_get_123d, file: '//trim(clname)//', var:'//trim(cdvar)
+#endif
+      ENDIF
+!some final adjustments
+      ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain
+
+      !--- Apply scale_factor and offset
+      zscf = iom_file(kiomid)%scf(idvar)      ! scale factor
+      zofs = iom_file(kiomid)%ofs(idvar)      ! offset
+      IF(     PRESENT(pv_r1d) ) THEN
+         IF( zscf /= 1. )   pv_r1d(:) = pv_r1d(:) * zscf 
+         IF( zofs /= 0. )   pv_r1d(:) = pv_r1d(:) + zofs
+      ELSEIF( PRESENT(pv_r2d) ) THEN
+         IF( zscf /= 1.)   pv_r2d(:,:) = pv_r2d(:,:) * zscf
+         IF( zofs /= 0.)   pv_r2d(:,:) = pv_r2d(:,:) + zofs
+      ELSEIF( PRESENT(pv_r3d) ) THEN
+         IF( zscf /= 1.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf
+         IF( zofs /= 0.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs
+      ENDIF
+      !
+   END SUBROUTINE iom_get_123d
+
+
+   FUNCTION iom_getszuld ( kiomid )  
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  iom_getszuld  ***
+      !!
+      !! ** Purpose : get the size of the unlimited dimension in a file
+      !!              (return -1 if not found)
+      !!-----------------------------------------------------------------------
+      INTEGER, INTENT(in   ) ::   kiomid   ! file Identifier
+      !
+      INTEGER                ::   iom_getszuld
+      !!-----------------------------------------------------------------------
+      iom_getszuld = -1
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%iduld > 0 )   iom_getszuld = iom_file(kiomid)%lenuld
+      ENDIF
+   END FUNCTION iom_getszuld
+   
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_chkatt
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_chkatt( kiomid, cdatt, llok, ksize, cdvar )
+      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute
+      LOGICAL         , INTENT(  out)                 ::   llok      ! Error code
+      INTEGER         , INTENT(  out), OPTIONAL       ::   ksize     ! Size of the attribute array
+      CHARACTER(len=*), INTENT(in   ), OPTIONAL       ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_chkatt( kiomid, cdatt, llok, ksize=ksize, cdvar=cdvar )
+      ENDIF
+      !
+   END SUBROUTINE iom_chkatt
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_getatt
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_g0d_iatt( kiomid, cdatt, katt0d, cdvar )
+      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
+      INTEGER               , INTENT(  out)           ::   katt0d    ! read field
+      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_getatt( kiomid, cdatt,  katt0d =  katt0d, cdvar=cdvar )
+      ENDIF
+   END SUBROUTINE iom_g0d_iatt
+
+   SUBROUTINE iom_g1d_iatt( kiomid, cdatt, katt1d, cdvar )
+      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
+      INTEGER, DIMENSION(:) , INTENT(  out)           ::   katt1d    ! read field
+      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_getatt( kiomid, cdatt,  katt1d =  katt1d, cdvar=cdvar )
+      ENDIF
+   END SUBROUTINE iom_g1d_iatt
+
+   SUBROUTINE iom_g0d_ratt( kiomid, cdatt, patt0d, cdvar )
+      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
+      REAL(wp)              , INTENT(  out)           ::   patt0d    ! read field
+      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_getatt( kiomid, cdatt,  patt0d =  patt0d, cdvar=cdvar )
+      ENDIF
+   END SUBROUTINE iom_g0d_ratt
+
+   SUBROUTINE iom_g1d_ratt( kiomid, cdatt, patt1d, cdvar )
+      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
+      REAL(wp), DIMENSION(:), INTENT(  out)           ::   patt1d    ! read field
+      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_getatt( kiomid, cdatt,  patt1d =  patt1d, cdvar=cdvar )
+      ENDIF
+   END SUBROUTINE iom_g1d_ratt
+   
+   SUBROUTINE iom_g0d_catt( kiomid, cdatt, cdatt0d, cdvar )
+      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
+      CHARACTER(len=*)      , INTENT(  out)           ::   cdatt0d   ! read field
+      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_getatt( kiomid, cdatt, cdatt0d = cdatt0d, cdvar=cdvar )
+      ENDIF
+   END SUBROUTINE iom_g0d_catt
+
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_putatt
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_p0d_iatt( kiomid, cdatt, katt0d, cdvar )
+      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
+      INTEGER               , INTENT(in   )           ::   katt0d    ! written field
+      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_putatt( kiomid, cdatt,  katt0d =  katt0d, cdvar=cdvar )
+      ENDIF
+   END SUBROUTINE iom_p0d_iatt
+
+   SUBROUTINE iom_p1d_iatt( kiomid, cdatt, katt1d, cdvar )
+      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
+      INTEGER, DIMENSION(:) , INTENT(in   )           ::   katt1d    ! written field
+      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_putatt( kiomid, cdatt,  katt1d =  katt1d, cdvar=cdvar )
+      ENDIF
+   END SUBROUTINE iom_p1d_iatt
+
+   SUBROUTINE iom_p0d_ratt( kiomid, cdatt, patt0d, cdvar )
+      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
+      REAL(wp)              , INTENT(in   )           ::   patt0d    ! written field
+      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_putatt( kiomid, cdatt,  patt0d =  patt0d, cdvar=cdvar )
+      ENDIF
+   END SUBROUTINE iom_p0d_ratt
+
+   SUBROUTINE iom_p1d_ratt( kiomid, cdatt, patt1d, cdvar )
+      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
+      REAL(wp), DIMENSION(:), INTENT(in   )           ::   patt1d    ! written field
+      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_putatt( kiomid, cdatt,  patt1d =  patt1d, cdvar=cdvar )
+      ENDIF
+   END SUBROUTINE iom_p1d_ratt
+   
+   SUBROUTINE iom_p0d_catt( kiomid, cdatt, cdatt0d, cdvar )
+      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
+      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt0d   ! written field
+      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_putatt( kiomid, cdatt, cdatt0d = cdatt0d, cdvar=cdvar )
+      ENDIF
+   END SUBROUTINE iom_p0d_catt
+
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_rstput
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios )
+      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
+      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
+      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
+      REAL(wp)        , INTENT(in)                         ::   pvar     ! written field
+      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
+      LOGICAL, OPTIONAL :: ldxios   ! xios write flag
+      LOGICAL :: llx                ! local xios write flag
+      INTEGER :: ivid   ! variable id
+
+      llx = .FALSE.
+      IF(PRESENT(ldxios)) llx = ldxios
+      IF( llx ) THEN
+#ifdef key_iomput
+      IF( kt == kwrite ) THEN
+          IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar)
+          CALL xios_send_field(trim(cdvar), pvar)
+      ENDIF
+#endif
+      ELSE
+         IF( kiomid > 0 ) THEN
+            IF( iom_file(kiomid)%nfid > 0 ) THEN
+               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
+               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar )
+            ENDIF
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_rp0d
+
+   SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios )
+      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
+      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
+      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
+      REAL(wp)        , INTENT(in), DIMENSION(          :) ::   pvar     ! written field
+      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
+      LOGICAL, OPTIONAL                                    ::   ldxios   ! xios write flag
+      LOGICAL :: llx                ! local xios write flag
+      INTEGER :: ivid   ! variable id
+
+      llx = .FALSE.
+      IF(PRESENT(ldxios)) llx = ldxios
+      IF( llx ) THEN
+#ifdef key_iomput
+      IF( kt == kwrite ) THEN
+         IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar)
+         CALL xios_send_field(trim(cdvar), pvar)
+      ENDIF
+#endif
+      ELSE
+         IF( kiomid > 0 ) THEN
+            IF( iom_file(kiomid)%nfid > 0 ) THEN
+               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
+               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar )
+            ENDIF
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_rp1d
+
+   SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios )
+      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
+      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
+      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
+      REAL(wp)        , INTENT(in), DIMENSION(:,    :    ) ::   pvar     ! written field
+      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
+      LOGICAL, OPTIONAL :: ldxios   ! xios write flag
+      LOGICAL :: llx
+      INTEGER :: ivid   ! variable id
+
+      llx = .FALSE.
+      IF(PRESENT(ldxios)) llx = ldxios
+      IF( llx ) THEN
+#ifdef key_iomput
+      IF( kt == kwrite ) THEN
+         IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar)
+         CALL xios_send_field(trim(cdvar), pvar)
+      ENDIF
+#endif
+      ELSE
+         IF( kiomid > 0 ) THEN
+            IF( iom_file(kiomid)%nfid > 0 ) THEN
+               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
+               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar )
+            ENDIF
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_rp2d
+
+   SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios )
+      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
+      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
+      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
+      REAL(wp)        , INTENT(in),       DIMENSION(:,:,:) ::   pvar     ! written field
+      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
+      LOGICAL, OPTIONAL :: ldxios   ! xios write flag
+      LOGICAL :: llx                 ! local xios write flag
+      INTEGER :: ivid   ! variable id
+
+      llx = .FALSE.
+      IF(PRESENT(ldxios)) llx = ldxios
+      IF( llx ) THEN
+#ifdef key_iomput
+      IF( kt == kwrite ) THEN
+         IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar)
+         CALL xios_send_field(trim(cdvar), pvar)
+      ENDIF
+#endif
+      ELSE
+         IF( kiomid > 0 ) THEN
+            IF( iom_file(kiomid)%nfid > 0 ) THEN
+               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
+               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar )
+            ENDIF
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_rp3d
+
+
+  SUBROUTINE iom_delay_rst( cdaction, cdcpnt, kncid )
+      !!---------------------------------------------------------------------
+      !!   Routine iom_delay_rst: used read/write restart related to mpp_delay
+      !!
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in   ) ::   cdaction        !
+      CHARACTER(len=*), INTENT(in   ) ::   cdcpnt
+      INTEGER         , INTENT(in   ) ::   kncid
+      !
+      INTEGER  :: ji
+      INTEGER  :: indim
+      LOGICAL  :: llattexist
+      REAL(wp), ALLOCATABLE, DIMENSION(:) ::   zreal1d
+      !!---------------------------------------------------------------------
+      !
+      !                                      ===================================
+      IF( TRIM(cdaction) == 'READ' ) THEN   ! read restart related to mpp_delay !
+         !                                   ===================================
+         DO ji = 1, nbdelay
+            IF ( c_delaycpnt(ji) == cdcpnt ) THEN
+               CALL iom_chkatt( kncid, 'DELAY_'//c_delaylist(ji), llattexist, indim )
+               IF( llattexist )  THEN
+                  ALLOCATE( todelay(ji)%z1d(indim) )
+                  CALL iom_getatt( kncid, 'DELAY_'//c_delaylist(ji), todelay(ji)%z1d(:) )
+                  ndelayid(ji) = 0   ! set to 0 to specify that the value was read in the restart
+               ENDIF
+           ENDIF
+         END DO
+         !                                   ====================================
+      ELSE                                  ! write restart related to mpp_delay !
+         !                                   ====================================
+         DO ji = 1, nbdelay   ! save only ocean delayed global communication variables
+            IF ( c_delaycpnt(ji) == cdcpnt ) THEN
+               IF( ASSOCIATED(todelay(ji)%z1d) ) THEN
+                  CALL mpp_delay_rcv(ji)   ! make sure %z1d is received
+                  CALL iom_putatt( kncid, 'DELAY_'//c_delaylist(ji), todelay(ji)%z1d(:) )
+               ENDIF
+            ENDIF
+         END DO
+         !
+      ENDIF
+      
+   END SUBROUTINE iom_delay_rst
+  
+   
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_put
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_p0d( cdname, pfield0d )
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+      REAL(wp)        , INTENT(in) ::   pfield0d
+      REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson
+#if defined key_iomput
+      zz(:,:)=pfield0d
+      CALL xios_send_field(cdname, zz)
+      !CALL xios_send_field(cdname, (/pfield0d/)) 
+#else
+      IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings
+#endif
+   END SUBROUTINE iom_p0d
+
+   SUBROUTINE iom_p1d( cdname, pfield1d )
+      CHARACTER(LEN=*)          , INTENT(in) ::   cdname
+      REAL(wp),     DIMENSION(:), INTENT(in) ::   pfield1d
+#if defined key_iomput
+      CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) )
+#else
+      IF( .FALSE. )   WRITE(numout,*) cdname, pfield1d   ! useless test to avoid compilation warnings
+#endif
+   END SUBROUTINE iom_p1d
+
+   SUBROUTINE iom_p2d( cdname, pfield2d )
+      CHARACTER(LEN=*)            , INTENT(in) ::   cdname
+      REAL(wp),     DIMENSION(:,:), INTENT(in) ::   pfield2d
+#if defined key_iomput
+      CALL xios_send_field(cdname, pfield2d)
+#else
+      IF( .FALSE. )   WRITE(numout,*) cdname, pfield2d   ! useless test to avoid compilation warnings
+#endif
+   END SUBROUTINE iom_p2d
+
+   SUBROUTINE iom_p3d( cdname, pfield3d )
+      CHARACTER(LEN=*)                , INTENT(in) ::   cdname
+      REAL(wp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d
+#if defined key_iomput
+      CALL xios_send_field( cdname, pfield3d )
+#else
+      IF( .FALSE. )   WRITE(numout,*) cdname, pfield3d   ! useless test to avoid compilation warnings
+#endif
+   END SUBROUTINE iom_p3d
+
+#if defined key_iomput
+   !!----------------------------------------------------------------------
+   !!   'key_iomput'                                         XIOS interface
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj,                                               &
+      &                                    data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask,     &
+      &                                    nvertex, bounds_lon, bounds_lat, area )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*)                  , INTENT(in) ::   cdid
+      INTEGER                 , OPTIONAL, INTENT(in) ::   ni_glo, nj_glo, ibegin, jbegin, ni, nj
+      INTEGER                 , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj
+      INTEGER                 , OPTIONAL, INTENT(in) ::   nvertex
+      REAL(wp), DIMENSION(:)  , OPTIONAL, INTENT(in) ::   lonvalue, latvalue
+      REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds_lon, bounds_lat, area
+      LOGICAL , DIMENSION(:)  , OPTIONAL, INTENT(in) ::   mask
+      !!----------------------------------------------------------------------
+      !
+      IF( xios_is_valid_domain     (cdid) ) THEN
+         CALL xios_set_domain_attr     ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   &
+            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   &
+            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,      &
+            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear')
+      ENDIF
+      IF( xios_is_valid_domaingroup(cdid) ) THEN
+         CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   &
+            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   &
+            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,      &
+            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear' )
+      ENDIF
+      !
+      CALL xios_solve_inheritance()
+      !
+   END SUBROUTINE iom_set_domain_attr
+
+
+   SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*), INTENT(in) ::   cdid
+      INTEGER         , INTENT(in) ::   ibegin, jbegin, ni, nj
+      !
+      TYPE(xios_gridgroup) :: gridgroup_hdl
+      TYPE(xios_grid)      :: grid_hdl
+      TYPE(xios_domain)    :: domain_hdl 
+      TYPE(xios_axis)      :: axis_hdl 
+      CHARACTER(LEN=64)    :: cldomrefid   ! domain_ref name
+      CHARACTER(len=1)     :: cl1          ! last character of this name
+      !!----------------------------------------------------------------------
+      !
+      IF( xios_is_valid_zoom_domain(cdid) ) THEN
+         ! define the zoom_domain attributs
+         CALL xios_set_zoom_domain_attr( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj )
+         ! define a new 2D grid with this new domain
+         CALL xios_get_handle("grid_definition", gridgroup_hdl )
+         CALL xios_add_child(gridgroup_hdl, grid_hdl, TRIM(cdid)//'_2D' )   ! add a new 2D grid to grid_definition
+         CALL xios_add_child(grid_hdl, domain_hdl, TRIM(cdid) )             ! add its domain
+         ! define a new 3D grid with this new domain
+         CALL xios_add_child(gridgroup_hdl, grid_hdl, TRIM(cdid)//'_3D' )   ! add a new 3D grid to grid_definition
+         CALL xios_add_child(grid_hdl, domain_hdl, TRIM(cdid) )             ! add its domain
+         ! vertical axis
+         cl1 = cdid(LEN_TRIM(cdid):)                                        ! last letter of cdid
+         cl1 = CHAR(ICHAR(cl1)+32)                                          ! from upper to lower case
+         CALL xios_add_child(grid_hdl, axis_hdl, 'depth'//cl1)              ! add its axis
+      ENDIF
+      !      
+   END SUBROUTINE iom_set_zoom_domain_attr
+
+
+   SUBROUTINE iom_set_axis_attr( cdid, paxis, bounds )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*)      , INTENT(in) ::   cdid
+      REAL(wp), DIMENSION(:)  , OPTIONAL, INTENT(in) ::   paxis
+      REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds
+      !!----------------------------------------------------------------------
+      IF( PRESENT(paxis) ) THEN
+         IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, n_glo=SIZE(paxis), value=paxis )
+         IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis )
+      ENDIF
+      IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, bounds=bounds )
+      IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, bounds=bounds )
+      CALL xios_solve_inheritance()
+   END SUBROUTINE iom_set_axis_attr
+
+
+   SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*)             , INTENT(in) ::   cdid
+      TYPE(xios_duration), OPTIONAL, INTENT(in) ::   freq_op
+      TYPE(xios_duration), OPTIONAL, INTENT(in) ::   freq_offset
+      !!----------------------------------------------------------------------
+      IF( xios_is_valid_field     (cdid) )   CALL xios_set_field_attr     ( cdid, freq_op=freq_op, freq_offset=freq_offset )
+      IF( xios_is_valid_fieldgroup(cdid) )   CALL xios_set_fieldgroup_attr( cdid, freq_op=freq_op, freq_offset=freq_offset )
+      CALL xios_solve_inheritance()
+   END SUBROUTINE iom_set_field_attr
+
+
+   SUBROUTINE iom_set_file_attr( cdid, name, name_suffix )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*)          , INTENT(in) ::   cdid
+      CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   name, name_suffix
+      !!----------------------------------------------------------------------
+      IF( xios_is_valid_file     (cdid) )   CALL xios_set_file_attr     ( cdid, name=name, name_suffix=name_suffix )
+      IF( xios_is_valid_filegroup(cdid) )   CALL xios_set_filegroup_attr( cdid, name=name, name_suffix=name_suffix )
+      CALL xios_solve_inheritance()
+   END SUBROUTINE iom_set_file_attr
+
+
+   SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*)          , INTENT(in ) ::   cdid
+      CHARACTER(LEN=*),OPTIONAL , INTENT(out) ::   name, name_suffix
+      TYPE(xios_duration), OPTIONAL , INTENT(out) :: output_freq
+      LOGICAL                                 ::   llexist1,llexist2,llexist3
+      !---------------------------------------------------------------------
+      IF( PRESENT( name        ) )   name = ''          ! default values
+      IF( PRESENT( name_suffix ) )   name_suffix = ''
+      IF( PRESENT( output_freq ) )   output_freq = xios_duration(0,0,0,0,0,0)
+      IF( xios_is_valid_file     (cdid) ) THEN
+         CALL xios_solve_inheritance()
+         CALL xios_is_defined_file_attr     ( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3)
+         IF(llexist1)   CALL xios_get_file_attr     ( cdid, name = name )
+         IF(llexist2)   CALL xios_get_file_attr     ( cdid, name_suffix = name_suffix )
+         IF(llexist3)   CALL xios_get_file_attr     ( cdid, output_freq = output_freq )
+      ENDIF
+      IF( xios_is_valid_filegroup(cdid) ) THEN
+         CALL xios_solve_inheritance()
+         CALL xios_is_defined_filegroup_attr( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3)
+         IF(llexist1)   CALL xios_get_filegroup_attr( cdid, name = name )
+         IF(llexist2)   CALL xios_get_filegroup_attr( cdid, name_suffix = name_suffix )
+         IF(llexist3)   CALL xios_get_filegroup_attr( cdid, output_freq = output_freq )
+      ENDIF
+   END SUBROUTINE iom_get_file_attr
+
+
+   SUBROUTINE iom_set_grid_attr( cdid, mask )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*)                   , INTENT(in) ::   cdid
+      LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) ::   mask
+      !!----------------------------------------------------------------------
+      IF( xios_is_valid_grid     (cdid) )   CALL xios_set_grid_attr     ( cdid, mask_3D=mask )
+      IF( xios_is_valid_gridgroup(cdid) )   CALL xios_set_gridgroup_attr( cdid, mask_3D=mask )
+      CALL xios_solve_inheritance()
+   END SUBROUTINE iom_set_grid_attr
+
+   SUBROUTINE iom_setkt( kt, cdname )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(in) ::   kt 
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+      !!----------------------------------------------------------------------
+      CALL iom_swap( cdname )   ! swap to cdname context
+      CALL xios_update_calendar(kt)
+      IF( cdname /= TRIM(cxios_context) )   CALL iom_swap( TRIM(cxios_context) )   ! return back to nemo context
+   END SUBROUTINE iom_setkt
+
+   SUBROUTINE iom_context_finalize( cdname )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*), INTENT(in) :: cdname
+      CHARACTER(LEN=120)           :: clname
+      !!----------------------------------------------------------------------
+      clname = cdname
+      IF( TRIM(Agrif_CFixed()) .NE. '0' ) clname = TRIM(Agrif_CFixed())//"_"//clname 
+      IF( xios_is_valid_context(clname) ) THEN
+         CALL iom_swap( cdname )   ! swap to cdname context
+         CALL xios_context_finalize() ! finalize the context
+         IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) )   ! return back to nemo context
+      ENDIF
+      !
+   END SUBROUTINE iom_context_finalize
+
+
+   SUBROUTINE set_grid( cdgrd, plon, plat, ldxios, ldrxios )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE set_grid  ***
+      !!
+      !! ** Purpose :   define horizontal grids
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=1)            , INTENT(in) ::   cdgrd
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plon
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat
+      !
+      INTEGER  :: ni, nj
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmask
+      LOGICAL, INTENT(IN) :: ldxios, ldrxios
+      !!----------------------------------------------------------------------
+      !
+      ni = nlei-nldi+1
+      nj = nlej-nldj+1
+      !
+      CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj)
+      CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
+!don't define lon and lat for restart reading context. 
+      IF ( .NOT.ldrxios ) &
+         CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)),   &
+         &                                     latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))  
+      !
+      IF ( ln_mskland .AND. (.NOT.ldxios) ) THEN
+         ! mask land points, keep values on coast line -> specific mask for U, V and W points
+         SELECT CASE ( cdgrd )
+         CASE('T')   ;   zmask(:,:,:)       = tmask(:,:,:)
+         CASE('U')   ;   zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:)   ;   CALL lbc_lnk( 'iom', zmask, 'U', 1. )
+         CASE('V')   ;   zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:)   ;   CALL lbc_lnk( 'iom', zmask, 'V', 1. )
+         CASE('W')   ;   zmask(:,:,2:jpk  ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk)   ;   zmask(:,:,1) = tmask(:,:,1)
+         END SELECT
+         !
+         CALL iom_set_domain_attr( "grid_"//cdgrd       , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni*nj    /)) /= 0. )
+         CALL iom_set_grid_attr  ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. )
+      ENDIF
+      !
+   END SUBROUTINE set_grid
+
+
+   SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE set_grid_bounds  ***
+      !!
+      !! ** Purpose :   define horizontal grid corners
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=1)                      , INTENT(in) :: cdgrd
+      REAL(wp), DIMENSION(jpi,jpj)          , INTENT(in) :: plon_cnr, plat_cnr  ! Lat/lon coord. of a contiguous vertex of cell (i,j)
+      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt  ! Lat/lon coord. of the point of cell (i,j)
+      !
+      INTEGER :: ji, jj, jn, ni, nj
+      INTEGER :: icnr, jcnr                                    ! Offset such that the vertex coordinate (i+icnr,j+jcnr)
+      !                                                        ! represents the bottom-left corner of cell (i,j)
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds      ! Lat/lon coordinates of the vertices of cell (i,j)
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: z_fld       ! Working array to determine where to rotate cells
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: z_rot       ! Lat/lon working array for rotation of cells
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( z_bnds(4,jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2)  )
+      !
+      ! Offset of coordinate representing bottom-left corner
+      SELECT CASE ( TRIM(cdgrd) )
+      CASE ('T', 'W')   ;   icnr = -1   ;   jcnr = -1
+      CASE ('U')        ;   icnr =  0   ;   jcnr = -1
+      CASE ('V')        ;   icnr = -1   ;   jcnr =  0
+      END SELECT
+      !
+      ni = nlei-nldi+1   ! Dimensions of subdomain interior
+      nj = nlej-nldj+1
+      !
+      z_fld(:,:) = 1._wp
+      CALL lbc_lnk( 'iom', z_fld, cdgrd, -1. )    ! Working array for location of northfold
+      !
+      ! Cell vertices that can be defined
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left
+            z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right
+            z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right
+            z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr+1) ! Top-left
+            z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left
+            z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right
+            z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right
+            z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr+1) ! Top-left
+         END DO
+      END DO
+      !
+      ! Cell vertices on boundries
+      DO jn = 1, 4
+         CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1., pval=999._wp )
+         CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp )
+      END DO
+      !
+      ! Zero-size cells at closed boundaries if cell points provided,
+      ! otherwise they are closed cells with unrealistic bounds
+      IF( PRESENT(plon_pnt) .AND. PRESENT(plat_pnt) ) THEN
+         IF( (nbondi == -1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN
+            DO jn = 1, 4        ! (West or jpni = 1), closed E-W
+               z_bnds(jn,1,:,1) = plat_pnt(1,:)  ;  z_bnds(jn,1,:,2) = plon_pnt(1,:)
+            END DO
+         ENDIF
+         IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN
+            DO jn = 1, 4        ! (East or jpni = 1), closed E-W
+               z_bnds(jn,nlci,:,1) = plat_pnt(nlci,:)  ;  z_bnds(jn,nlci,:,2) = plon_pnt(nlci,:)
+            END DO
+         ENDIF
+         IF( nbondj == -1 .OR. (nbondj == 2 .AND. jperio /= 2) ) THEN
+            DO jn = 1, 4        ! South or (jpnj = 1, not symmetric)
+               z_bnds(jn,:,1,1) = plat_pnt(:,1)  ;  z_bnds(jn,:,1,2) = plon_pnt(:,1)
+            END DO
+         ENDIF
+         IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio  < 3 ) THEN
+            DO jn = 1, 4        ! (North or jpnj = 1), no north fold
+               z_bnds(jn,:,nlcj,1) = plat_pnt(:,nlcj)  ;  z_bnds(jn,:,nlcj,2) = plon_pnt(:,nlcj)
+            END DO
+         ENDIF
+      ENDIF
+      !
+      IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN    ! Rotate cells at the north fold
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( z_fld(ji,jj) == -1. ) THEN
+                  z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:)
+                  z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:)
+                  z_bnds(:,ji,jj,:) = z_rot(:,:)
+               ENDIF
+            END DO
+         END DO
+      ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN                  ! Invert cells at the symmetric equator
+         DO ji = 1, jpi
+            z_rot(1:2,:) = z_bnds(3:4,ji,1,:)
+            z_rot(3:4,:) = z_bnds(1:2,ji,1,:)
+            z_bnds(:,ji,1,:) = z_rot(:,:)
+         END DO
+      ENDIF
+      !
+      CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)),           &
+          &                                    bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 )
+      !
+      DEALLOCATE( z_bnds, z_fld, z_rot ) 
+      !
+   END SUBROUTINE set_grid_bounds
+
+
+   SUBROUTINE set_grid_znl( plat )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE set_grid_znl  ***
+      !!
+      !! ** Purpose :   define grids for zonal mean
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat
+      !
+      INTEGER  :: ni, nj, ix, iy
+      REAL(wp), DIMENSION(:), ALLOCATABLE  ::   zlon
+      !!----------------------------------------------------------------------
+      !
+      ni=nlei-nldi+1       ! define zonal mean domain (jpj*jpk)
+      nj=nlej-nldj+1
+      ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0._wp
+      !
+      CALL dom_ngb( -168.53, 65.03, ix, iy, 'T' ) !  i-line that passes through Bering Strait: Reference latitude (used in plots)
+!      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots)
+      CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj)
+      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
+      CALL iom_set_domain_attr("gznl", lonvalue = zlon,   &
+         &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))  
+      CALL iom_set_zoom_domain_attr("znl_T", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo)
+      CALL iom_set_zoom_domain_attr("znl_W", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo)
+      !
+      CALL iom_update_file_name('ptr')
+      !
+   END SUBROUTINE set_grid_znl
+
+
+   SUBROUTINE set_scalar
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE set_scalar  ***
+      !!
+      !! ** Purpose :   define fake grids for scalar point
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(1)   ::   zz = 1.
+      !!----------------------------------------------------------------------
+      !
+      CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea-1, jbegin=0, ni=1, nj=1)
+      CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1)
+      !
+      zz = REAL( narea, wp )
+      CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz)
+      !
+   END SUBROUTINE set_scalar
+
+
+   SUBROUTINE set_xmlatt
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE set_xmlatt  ***
+      !!
+      !! ** Purpose :   automatic definitions of some of the xml attributs...
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1),DIMENSION( 3) ::   clgrd                    ! suffix name
+      CHARACTER(len=256)             ::   clsuff                   ! suffix name
+      CHARACTER(len=1)               ::   cl1                      ! 1 character
+      CHARACTER(len=2)               ::   cl2                      ! 2 characters
+      CHARACTER(len=3)               ::   cl3                      ! 3 characters
+      INTEGER                        ::   ji, jg                   ! loop counters
+      INTEGER                        ::   ix, iy                   ! i-,j- index
+      REAL(wp)        ,DIMENSION(11) ::   zlontao                  ! longitudes of tao    moorings
+      REAL(wp)        ,DIMENSION( 7) ::   zlattao                  ! latitudes  of tao    moorings
+      REAL(wp)        ,DIMENSION( 4) ::   zlonrama                 ! longitudes of rama   moorings
+      REAL(wp)        ,DIMENSION(11) ::   zlatrama                 ! latitudes  of rama   moorings
+      REAL(wp)        ,DIMENSION( 3) ::   zlonpira                 ! longitudes of pirata moorings
+      REAL(wp)        ,DIMENSION( 9) ::   zlatpira                 ! latitudes  of pirata moorings
+      TYPE(xios_duration)            ::   f_op, f_of
+      !!----------------------------------------------------------------------
+      ! 
+      ! frequency of the call of iom_put (attribut: freq_op)
+      f_op%timestep = 1        ;  f_of%timestep =  0  ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of)
+      f_op%timestep = 2        ;  f_of%timestep =  0  ; CALL iom_set_field_attr('trendT_even'     , freq_op=f_op, freq_offset=f_of)
+      f_op%timestep = 2        ;  f_of%timestep = -1  ; CALL iom_set_field_attr('trendT_odd'      , freq_op=f_op, freq_offset=f_of)
+      f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('SBC'             , freq_op=f_op, freq_offset=f_of)
+      f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('SBC_scalar'      , freq_op=f_op, freq_offset=f_of)
+      f_op%timestep = nn_dttrc ;  f_of%timestep =  0  ; CALL iom_set_field_attr('ptrc_T'          , freq_op=f_op, freq_offset=f_of)
+      f_op%timestep = nn_dttrc ;  f_of%timestep =  0  ; CALL iom_set_field_attr('diad_T'          , freq_op=f_op, freq_offset=f_of)
+
+      ! output file names (attribut: name)
+      DO ji = 1, 9
+         WRITE(cl1,'(i1)') ji 
+         CALL iom_update_file_name('file'//cl1)
+      END DO
+      DO ji = 1, 99
+         WRITE(cl2,'(i2.2)') ji 
+         CALL iom_update_file_name('file'//cl2)
+      END DO
+      DO ji = 1, 999
+         WRITE(cl3,'(i3.3)') ji 
+         CALL iom_update_file_name('file'//cl3)
+      END DO
+
+      ! Zooms...
+      clgrd = (/ 'T', 'U', 'W' /) 
+      DO jg = 1, SIZE(clgrd)                                                                   ! grid type
+         cl1 = clgrd(jg)
+         ! Equatorial section (attributs: jbegin, ni, name_suffix)
+         CALL dom_ngb( 0., 0., ix, iy, cl1 )
+         CALL iom_set_zoom_domain_attr('Eq'//cl1, ibegin=0, jbegin=iy-1, ni=jpiglo, nj=1 )
+         CALL iom_get_file_attr   ('Eq'//cl1, name_suffix = clsuff             )
+         CALL iom_set_file_attr   ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq')
+         CALL iom_update_file_name('Eq'//cl1)
+      END DO
+      ! TAO moorings (attributs: ibegin, jbegin, name_suffix)
+      zlontao = (/ 137.0, 147.0, 156.0, 165.0, -180.0, -170.0, -155.0, -140.0, -125.0, -110.0, -95.0 /)
+      zlattao = (/  -8.0,  -5.0,  -2.0,   0.0,    2.0,    5.0,    8.0 /)
+      CALL set_mooring( zlontao, zlattao )
+      ! RAMA moorings (attributs: ibegin, jbegin, name_suffix)
+      zlonrama = (/  55.0,  67.0, 80.5, 90.0 /)
+      zlatrama = (/ -16.0, -12.0, -8.0, -4.0, -1.5, 0.0, 1.5, 4.0, 8.0, 12.0, 15.0 /)
+      CALL set_mooring( zlonrama, zlatrama )
+      ! PIRATA moorings (attributs: ibegin, jbegin, name_suffix)
+      zlonpira = (/ -38.0, -23.0, -10.0 /)
+      zlatpira = (/ -19.0, -14.0,  -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /)
+      CALL set_mooring( zlonpira, zlatpira )
+      !
+   END SUBROUTINE set_xmlatt
+
+
+   SUBROUTINE set_mooring( plon, plat )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE set_mooring  ***
+      !!
+      !! ** Purpose :   automatic definitions of moorings xml attributs...
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:), INTENT(in) ::   plon, plat   ! longitudes/latitudes oft the mooring
+      !
+!!$      CHARACTER(len=1),DIMENSION(4) ::   clgrd = (/ 'T', 'U', 'V', 'W' /)   ! suffix name
+      CHARACTER(len=1),DIMENSION(1) ::   clgrd = (/ 'T' /)        ! suffix name
+      CHARACTER(len=256)            ::   clname                   ! file name
+      CHARACTER(len=256)            ::   clsuff                   ! suffix name
+      CHARACTER(len=1)              ::   cl1                      ! 1 character
+      CHARACTER(len=6)              ::   clon,clat                ! name of longitude, latitude
+      INTEGER                       ::   ji, jj, jg               ! loop counters
+      INTEGER                       ::   ix, iy                   ! i-,j- index
+      REAL(wp)                      ::   zlon, zlat
+      !!----------------------------------------------------------------------
+      DO jg = 1, SIZE(clgrd)
+         cl1 = clgrd(jg)
+         DO ji = 1, SIZE(plon)
+            DO jj = 1, SIZE(plat)
+               zlon = plon(ji)
+               zlat = plat(jj)
+               ! modifications for RAMA moorings
+               IF( zlon ==  67. .AND. zlat ==  15. )   zlon =  65.
+               IF( zlon ==  90. .AND. zlat <=  -4. )   zlon =  95.
+               IF( zlon ==  95. .AND. zlat ==  -4. )   zlat =  -5.
+               ! modifications for PIRATA moorings
+               IF( zlon == -38. .AND. zlat == -19. )   zlon = -34.
+               IF( zlon == -38. .AND. zlat == -14. )   zlon = -32.
+               IF( zlon == -38. .AND. zlat ==  -8. )   zlon = -30.
+               IF( zlon == -38. .AND. zlat ==   0. )   zlon = -35.
+               IF( zlon == -23. .AND. zlat ==  20. )   zlat =  21.
+               IF( zlon == -10. .AND. zlat == -14. )   zlat = -10.
+               IF( zlon == -10. .AND. zlat ==  -8. )   zlat =  -6.
+               IF( zlon == -10. .AND. zlat ==   4. ) THEN   ;   zlon = 0.   ;   zlat = 0.   ;   ENDIF
+               CALL dom_ngb( zlon, zlat, ix, iy, cl1 )
+               IF( zlon >= 0. ) THEN  
+                  IF( zlon == REAL(NINT(zlon), wp) ) THEN   ;   WRITE(clon, '(i3,  a)') NINT( zlon), 'e'
+                  ELSE                                      ;   WRITE(clon, '(f5.1,a)')       zlon , 'e'
+                  ENDIF
+               ELSE             
+                  IF( zlon == REAL(NINT(zlon), wp) ) THEN   ;   WRITE(clon, '(i3,  a)') NINT(-zlon), 'w'
+                  ELSE                                      ;   WRITE(clon, '(f5.1,a)')      -zlon , 'w'
+                  ENDIF
+               ENDIF
+               IF( zlat >= 0. ) THEN  
+                  IF( zlat == REAL(NINT(zlat), wp) ) THEN   ;   WRITE(clat, '(i2,  a)') NINT( zlat), 'n'
+                  ELSE                                      ;   WRITE(clat, '(f4.1,a)')       zlat , 'n'
+                  ENDIF
+               ELSE             
+                  IF( zlat == REAL(NINT(zlat), wp) ) THEN   ;   WRITE(clat, '(i2,  a)') NINT(-zlat), 's'
+                  ELSE                                      ;   WRITE(clat, '(f4.1,a)')      -zlat , 's'
+                  ENDIF
+               ENDIF
+               clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon))
+               CALL iom_set_zoom_domain_attr(TRIM(clname)//cl1, ibegin= ix-1, jbegin= iy-1, ni=1, nj=1)
+
+               CALL iom_get_file_attr   (TRIM(clname)//cl1, name_suffix = clsuff                         )
+               CALL iom_set_file_attr   (TRIM(clname)//cl1, name_suffix = TRIM(clsuff)//'_'//TRIM(clname))
+               CALL iom_update_file_name(TRIM(clname)//cl1)
+            END DO
+         END DO
+      END DO
+      
+   END SUBROUTINE set_mooring
+
+   
+   SUBROUTINE iom_update_file_name( cdid )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE iom_update_file_name  ***
+      !!
+      !! ** Purpose :   
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*)          , INTENT(in) ::   cdid
+      !
+      CHARACTER(LEN=256) ::   clname
+      CHARACTER(LEN=20)  ::   clfreq
+      CHARACTER(LEN=20)  ::   cldate
+      INTEGER            ::   idx
+      INTEGER            ::   jn
+      INTEGER            ::   itrlen
+      INTEGER            ::   iyear, imonth, iday, isec
+      REAL(wp)           ::   zsec
+      LOGICAL            ::   llexist
+      TYPE(xios_duration)   ::   output_freq 
+      !!----------------------------------------------------------------------
+      !
+      DO jn = 1, 2
+         !
+         output_freq = xios_duration(0,0,0,0,0,0)
+         IF( jn == 1 )   CALL iom_get_file_attr( cdid, name        = clname, output_freq = output_freq )
+         IF( jn == 2 )   CALL iom_get_file_attr( cdid, name_suffix = clname )
+         !
+         IF ( TRIM(clname) /= '' ) THEN 
+            !
+            idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@')
+            DO WHILE ( idx /= 0 ) 
+               clname = clname(1:idx-1)//TRIM(cexper)//clname(idx+9:LEN_TRIM(clname))
+               idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@')
+            END DO
+            !
+            idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
+            DO WHILE ( idx /= 0 ) 
+              IF ( output_freq%timestep /= 0) THEN
+                  WRITE(clfreq,'(I18,A2)')INT(output_freq%timestep),'ts' 
+                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
+              ELSE IF ( output_freq%second /= 0 ) THEN
+                  WRITE(clfreq,'(I19,A1)')INT(output_freq%second),'s' 
+                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
+              ELSE IF ( output_freq%minute /= 0 ) THEN
+                  WRITE(clfreq,'(I18,A2)')INT(output_freq%minute),'mi' 
+                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
+              ELSE IF ( output_freq%hour /= 0 ) THEN
+                  WRITE(clfreq,'(I19,A1)')INT(output_freq%hour),'h' 
+                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
+              ELSE IF ( output_freq%day /= 0 ) THEN
+                  WRITE(clfreq,'(I19,A1)')INT(output_freq%day),'d' 
+                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
+              ELSE IF ( output_freq%month /= 0 ) THEN   
+                  WRITE(clfreq,'(I19,A1)')INT(output_freq%month),'m' 
+                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
+              ELSE IF ( output_freq%year /= 0 ) THEN   
+                  WRITE(clfreq,'(I19,A1)')INT(output_freq%year),'y' 
+                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
+              ELSE
+                  CALL ctl_stop('error in the name of file id '//TRIM(cdid),   &
+                     & ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) )
+              ENDIF
+              clname = clname(1:idx-1)//TRIM(ADJUSTL(clfreq))//clname(idx+6:LEN_TRIM(clname))
+              idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
+            END DO
+            !
+            idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
+            DO WHILE ( idx /= 0 ) 
+               cldate = iom_sdate( fjulday - rdt / rday )
+               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname))
+               idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
+            END DO
+            !
+            idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@')
+            DO WHILE ( idx /= 0 ) 
+               cldate = iom_sdate( fjulday - rdt / rday, ldfull = .TRUE. )
+               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname))
+               idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@')
+            END DO
+            !
+            idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@')
+            DO WHILE ( idx /= 0 ) 
+               cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. )
+               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname))
+               idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@')
+            END DO
+            !
+            idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@')
+            DO WHILE ( idx /= 0 ) 
+               cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. )
+               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname))
+               idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@')
+            END DO
+            !
+            IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
+            IF( jn == 1 )   CALL iom_set_file_attr( cdid, name        = clname )
+            IF( jn == 2 )   CALL iom_set_file_attr( cdid, name_suffix = clname )
+            !
+         ENDIF
+         !
+      END DO
+      !
+   END SUBROUTINE iom_update_file_name
+
+
+   FUNCTION iom_sdate( pjday, ld24, ldfull )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE iom_sdate  ***
+      !!
+      !! ** Purpose :   send back the date corresponding to the given julian day
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in   )           ::   pjday    ! julian day
+      LOGICAL , INTENT(in   ), OPTIONAL ::   ld24     ! true to force 24:00 instead of 00:00
+      LOGICAL , INTENT(in   ), OPTIONAL ::   ldfull   ! true to get the compleate date: yyyymmdd_hh:mm:ss
+      !
+      CHARACTER(LEN=20) ::   iom_sdate
+      CHARACTER(LEN=50) ::   clfmt                         !  format used to write the date 
+      INTEGER           ::   iyear, imonth, iday, ihour, iminute, isec
+      REAL(wp)          ::   zsec
+      LOGICAL           ::   ll24, llfull
+      !!----------------------------------------------------------------------
+      !
+      IF( PRESENT(ld24) ) THEN   ;   ll24 = ld24
+      ELSE                       ;   ll24 = .FALSE.
+      ENDIF
+      !
+      IF( PRESENT(ldfull) ) THEN   ;   llfull = ldfull
+      ELSE                         ;   llfull = .FALSE.
+      ENDIF
+      !
+      CALL ju2ymds( pjday, iyear, imonth, iday, zsec )
+      isec = NINT(zsec)
+      !
+      IF ( ll24 .AND. isec == 0 ) THEN   ! 00:00 of the next day -> move to 24:00 of the current day
+         CALL ju2ymds( pjday - 1., iyear, imonth, iday, zsec )
+         isec = 86400
+      ENDIF
+      !
+      IF( iyear < 10000 ) THEN   ;   clfmt = "i4.4,2i2.2"                ! format used to write the date 
+      ELSE                       ;   WRITE(clfmt, "('i',i1,',2i2.2')") INT(LOG10(REAL(iyear,wp))) + 1
+      ENDIF
+      !
+!$AGRIF_DO_NOT_TREAT      
+      ! needed in the conv
+      IF( llfull ) THEN 
+         clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2"
+         ihour   = isec / 3600
+         isec    = MOD(isec, 3600)
+         iminute = isec / 60
+         isec    = MOD(isec, 60)
+         WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday, ihour, iminute, isec    ! date of the end of run
+      ELSE
+         WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday                          ! date of the end of run
+      ENDIF
+!$AGRIF_END_DO_NOT_TREAT      
+      !
+   END FUNCTION iom_sdate
+
+#else
+   !!----------------------------------------------------------------------
+   !!   NOT 'key_iomput'                               a few dummy routines
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE iom_setkt( kt, cdname )
+      INTEGER         , INTENT(in)::   kt 
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+      IF( .FALSE. )   WRITE(numout,*) kt, cdname   ! useless test to avoid compilation warnings
+   END SUBROUTINE iom_setkt
+
+   SUBROUTINE iom_context_finalize( cdname )
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+      IF( .FALSE. )   WRITE(numout,*)  cdname   ! useless test to avoid compilation warnings
+   END SUBROUTINE iom_context_finalize
+
+#endif
+
+   LOGICAL FUNCTION iom_use( cdname )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+      !!----------------------------------------------------------------------
+#if defined key_iomput
+      iom_use = xios_field_is_active( cdname )
+#else
+      iom_use = .FALSE.
+#endif
+   END FUNCTION iom_use
+   
+   !!======================================================================
+END MODULE iom
Index: /utils/tools_ticket2413/DOMAINcfg/src/iom_def.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/iom_def.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/iom_def.F90	(revision 12863)
@@ -0,0 +1,84 @@
+MODULE iom_def
+   !!======================================================================
+   !!                    ***  MODULE  iom_def ***
+   !! IOM variables definitions
+   !!======================================================================
+   !! History :  9.0  ! 2006 09  (S. Masson) Original code
+   !!             -   ! 2007 07  (D. Storkey) Add uldname
+   !!            4.0  ! 2017-11 (M. Andrejczuk) Extend IOM interface to write any 3D fields
+   !!----------------------------------------------------------------------
+   USE par_kind
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_data          = 1   !: ( 1  :jpiglo, 1  :jpjglo)    !!gm to be suppressed
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_global        = 2   !: ( 1  :jpiglo, 1  :jpjglo)
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_local         = 3   !: One of the 3 following cases
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_local_full    = 4   !: ( 1  :jpi   , 1  :jpi   )
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_local_noextra = 5   !: ( 1  :nlci  , 1  :nlcj  )
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_local_noovlap = 6   !: (nldi:nlei  ,nldj:nlej  )
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_unknown       = 7   !: No dimension checking
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_autoglo       = 8   !: 
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_autoglo_xy    = 9   !: Automatically set horizontal dimensions only
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_autodta       = 10  !: 
+
+   INTEGER, PARAMETER, PUBLIC ::   jp_r8    = 200      !: write REAL(8)
+   INTEGER, PARAMETER, PUBLIC ::   jp_r4    = 201      !: write REAL(4)
+   INTEGER, PARAMETER, PUBLIC ::   jp_i4    = 202      !: write INTEGER(4)
+   INTEGER, PARAMETER, PUBLIC ::   jp_i2    = 203      !: write INTEGER(2)
+   INTEGER, PARAMETER, PUBLIC ::   jp_i1    = 204      !: write INTEGER(1)
+
+   INTEGER, PARAMETER, PUBLIC ::   jpmax_files  = 100  !: maximum number of simultaneously opened file
+   INTEGER, PARAMETER, PUBLIC ::   jpmax_vars   = 1200 !: maximum number of variables in one file
+   INTEGER, PARAMETER, PUBLIC ::   jpmax_dims   =  4   !: maximum number of dimensions for one variable
+   INTEGER, PARAMETER, PUBLIC ::   jpmax_digits =  5   !: maximum number of digits for the cpu number in the file name
+
+
+!$AGRIF_DO_NOT_TREAT
+   INTEGER, PUBLIC            ::   iom_open_init = 0   !: used to initialize iom_file(:)%nfid to 0
+!XIOS write restart   
+   LOGICAL, PUBLIC            ::   lwxios          !: write single file restart using XIOS
+   INTEGER, PUBLIC            ::   nxioso          !: type of restart file when writing using XIOS 1 - single, 2 - multiple
+!XIOS read restart   
+   LOGICAL, PUBLIC            ::   lrxios          !: read single file restart using XIOS
+   LOGICAL, PUBLIC            ::   lxios_sini = .FALSE. ! is restart in a single file
+   LOGICAL, PUBLIC            ::   lxios_set  = .FALSE. 
+
+
+
+   TYPE, PUBLIC ::   file_descriptor
+      CHARACTER(LEN=240)                        ::   name     !: name of the file
+      INTEGER                                   ::   nfid     !: identifier of the file (0 if closed)
+                                                              !: jpioipsl option has been removed)
+      INTEGER                                   ::   nvars    !: number of identified varibles in the file
+      INTEGER                                   ::   iduld    !: id of the unlimited dimension
+      INTEGER                                   ::   lenuld   !: length of the unlimited dimension (number of records in file)
+      INTEGER                                   ::   irec     !: writing record position  
+      CHARACTER(LEN=32)                         ::   uldname  !: name of the unlimited dimension
+      CHARACTER(LEN=32), DIMENSION(jpmax_vars)  ::   cn_var   !: names of the variables
+      INTEGER, DIMENSION(jpmax_vars)            ::   nvid     !: id of the variables
+      INTEGER, DIMENSION(jpmax_vars)            ::   ndims    !: number of dimensions of the variables
+      LOGICAL, DIMENSION(jpmax_vars)            ::   luld     !: variable using the unlimited dimension
+      INTEGER, DIMENSION(jpmax_dims,jpmax_vars) ::   dimsz    !: size of variables dimensions 
+      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   scf      !: scale_factor of the variables
+      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   ofs      !: add_offset of the variables
+      INTEGER                                   ::   nlev     ! number of vertical levels
+   END TYPE file_descriptor
+   TYPE(file_descriptor), DIMENSION(jpmax_files), PUBLIC ::   iom_file !: array containing the info for all opened files
+   INTEGER, PARAMETER, PUBLIC                   :: max_rst_fields = 95 !: maximum number of restart variables defined in iom_set_rst_vars
+   TYPE, PUBLIC :: RST_FIELD  
+    CHARACTER(len=30) :: vname = "NO_NAME" ! names of variables in restart file
+    CHARACTER(len=30) :: grid = "NO_GRID"
+    LOGICAL           :: active =.FALSE. ! for restart write only: true - write field, false do not write field
+   END TYPE RST_FIELD
+!$AGRIF_END_DO_NOT_TREAT
+   !
+   TYPE(RST_FIELD), PUBLIC, SAVE :: rst_wfields(max_rst_fields), rst_rfields(max_rst_fields)
+   !
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: iom_def.F90 10425 2018-12-19 21:54:16Z smasson $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!======================================================================
+END MODULE iom_def
Index: /utils/tools_ticket2413/DOMAINcfg/src/iom_nf90.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/iom_nf90.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/iom_nf90.F90	(revision 12863)
@@ -0,0 +1,740 @@
+MODULE iom_nf90
+   !!======================================================================
+   !!                    ***  MODULE  iom_nf90 ***
+   !! Input/Output manager :  Library to read input files with NF90 (only fliocom module)
+   !!======================================================================
+   !! History :  9.0  ! 05 12  (J. Belier) Original code
+   !!            9.0  ! 06 02  (S. Masson) Adaptation to NEMO
+   !!             "   ! 07 07  (D. Storkey) Changes to iom_nf90_gettime
+   !!            3.6  ! 2015-15  (J. Harle) Added procedure to read REAL attributes
+   !!            4.0  ! 2017-11 (M. Andrejczuk) Extend IOM interface to write any 3D fields
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   iom_open       : open a file read only
+   !!   iom_close      : close a file or all files opened by iom
+   !!   iom_get        : read a field (interfaced to several routines)
+   !!   iom_varid      : get the id of a variable in a file
+   !!   iom_rstput     : write a field in a restart file (interfaced to several routines)
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE lbclnk          ! lateal boundary condition / mpp exchanges
+   USE iom_def         ! iom variables definitions
+   USE netcdf          ! NetCDF library
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC iom_nf90_open  , iom_nf90_close, iom_nf90_varid, iom_nf90_get, iom_nf90_rstput
+   PUBLIC iom_nf90_chkatt, iom_nf90_getatt, iom_nf90_putatt
+
+   INTERFACE iom_nf90_get
+      MODULE PROCEDURE iom_nf90_g0d, iom_nf90_g123d
+   END INTERFACE
+   INTERFACE iom_nf90_rstput
+      MODULE PROCEDURE iom_nf90_rp0123d
+   END INTERFACE
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: iom_nf90.F90 10522 2019-01-16 08:35:15Z smasson $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar, kdlev )
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_open  ***
+      !!
+      !! ** Purpose : open an input file with NF90
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*)       , INTENT(inout)           ::   cdname      ! File name
+      INTEGER                , INTENT(  out)           ::   kiomid      ! nf90 identifier of the opened file
+      LOGICAL                , INTENT(in   )           ::   ldwrt       ! read or write the file?
+      LOGICAL                , INTENT(in   )           ::   ldok        ! check the existence 
+      INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters: 
+      INTEGER                , INTENT(in   ), OPTIONAL ::   kdlev       ! size of the third dimension
+
+      CHARACTER(LEN=256) ::   clinfo           ! info character
+      CHARACTER(LEN=256) ::   cltmp            ! temporary character
+      INTEGER            ::   iln              ! lengths of character
+      INTEGER            ::   istop            ! temporary storage of nstop
+      INTEGER            ::   if90id           ! nf90 identifier of the opened file
+      INTEGER            ::   idmy             ! dummy variable
+      INTEGER            ::   jl               ! loop variable
+      INTEGER            ::   ichunk           ! temporary storage of nn_chunksz
+      INTEGER            ::   imode            ! creation mode flag: NF90_CLOBBER or NF90_NOCLOBBER or NF90_HDF5
+      INTEGER            ::   ihdf5            ! local variable for retrieval of value for NF90_HDF5
+      LOGICAL            ::   llclobber        ! local definition of ln_clobber
+      INTEGER            ::   ilevels           ! vertical levels
+      !---------------------------------------------------------------------
+      !
+      clinfo = '                    iom_nf90_open ~~~  '
+      istop = nstop     ! store the actual value of nstop
+      !
+      !                 !number of vertical levels
+      IF( PRESENT(kdlev) ) THEN   ;   ilevels = kdlev    ! use input value (useful for sea-ice)
+      ELSE                        ;   ilevels = jpk      ! by default jpk
+      ENDIF
+      !
+      IF( nn_chunksz > 0 ) THEN   ;   ichunk = nn_chunksz
+      ELSE                        ;   ichunk = NF90_SIZEHINT_DEFAULT
+      ENDIF
+      !
+      llclobber = ldwrt .AND. ln_clobber
+      IF( ldok .AND. .NOT. llclobber ) THEN      !==  Open existing file ==!
+         !                                       !=========================!
+         IF( ldwrt ) THEN  ! ... in write mode
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in WRITE mode'
+            IF( snc4set%luse ) THEN
+               CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_WRITE  , if90id ), clinfo)
+            ELSE
+               CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_WRITE  , if90id, chunksize = ichunk ), clinfo)
+            ENDIF
+            CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL, idmy                          ), clinfo)
+         ELSE              ! ... in read mode
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in READ mode'
+            CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_NOWRITE, if90id, chunksize = ichunk ), clinfo)
+         ENDIF
+      ELSE                                       !== the file doesn't exist ==!   (or we overwrite it)
+         !                                       !============================!
+         iln = INDEX( cdname, '.nc' )
+         IF( ldwrt ) THEN              !* the file should be open in write mode so we create it...
+            IF( jpnij > 1 ) THEN
+               WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea-1, '.nc'
+               cdname = TRIM(cltmp)
+            ENDIF
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//TRIM(cdname)//' in WRITE mode'
+
+            IF( llclobber ) THEN   ;   imode = IOR( NF90_64BIT_OFFSET, NF90_CLOBBER   )
+            ELSE                   ;   imode = IOR( NF90_64BIT_OFFSET, NF90_NOCLOBBER ) 
+            ENDIF
+            IF( snc4set%luse ) THEN
+               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' creating file: '//TRIM(cdname)//' in hdf5 (netcdf4) mode'
+               CALL GET_NF90_SYMBOL("NF90_HDF5", ihdf5)
+               IF( llclobber ) THEN   ;   imode = IOR(ihdf5, NF90_CLOBBER)
+               ELSE                   ;   imode = IOR(ihdf5, NF90_NOCLOBBER)
+               ENDIF
+               CALL iom_nf90_check(NF90_CREATE( TRIM(cdname), imode, if90id ), clinfo)
+            ELSE
+               CALL iom_nf90_check(NF90_CREATE( TRIM(cdname), imode, if90id, chunksize = ichunk ), clinfo)
+            ENDIF
+            CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL,                   idmy ), clinfo)
+            ! define dimensions
+            CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'x',   kdompar(1,1), idmy ), clinfo)
+            CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'y',   kdompar(2,1), idmy ), clinfo)
+            CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev',            jpk, idmy ), clinfo)
+            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo)
+            IF( PRESENT(kdlev) )   &
+               CALL iom_nf90_check(NF90_DEF_DIM( if90id,    'numcat',          kdlev, idmy ), clinfo)
+            ! global attributes
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij              ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number'         , narea-1            ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/1     , 2     /) ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_global'    , (/jpiglo, jpjglo/) ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_local'     , kdompar(:,1)       ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_first' , kdompar(:,2)       ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_last'  , kdompar(:,3)       ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_start', kdompar(:,4)       ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_end'  , kdompar(:,5)       ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_type'           , 'BOX'              ), clinfo)
+         ELSE                          !* the file should be open for read mode so it must exist...
+            CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' )
+         ENDIF
+      ENDIF
+      !
+      ! start to fill file informations
+      ! =============
+      IF( istop == nstop ) THEN   ! no error within this routine
+!does not work with some compilers         kiomid = MINLOC(iom_file(:)%nfid, dim = 1)
+         kiomid = 0
+         DO jl = jpmax_files, 1, -1
+            IF( iom_file(jl)%nfid == 0 )   kiomid = jl
+         ENDDO
+         iom_file(kiomid)%name   = TRIM(cdname)
+         iom_file(kiomid)%nfid   = if90id
+         iom_file(kiomid)%nvars  = 0
+         iom_file(kiomid)%irec   = -1   ! useless for NetCDF files, used to know if the file is in define mode 
+         iom_file(kiomid)%nlev   = ilevels
+         CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo)
+         IF( iom_file(kiomid)%iduld .GE. 0 ) THEN
+            CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld,    & 
+               &                                       name = iom_file(kiomid)%uldname,   &
+               &                                       len  = iom_file(kiomid)%lenuld ), clinfo )
+         ENDIF
+         IF(lwp) WRITE(numout,*) '                   ---> '//TRIM(cdname)//' OK'
+      ELSE
+         kiomid = 0               ! return error flag
+      ENDIF
+      !
+   END SUBROUTINE iom_nf90_open
+
+
+   SUBROUTINE iom_nf90_close( kiomid )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_nf90_close  ***
+      !!
+      !! ** Purpose : close an input file with NF90
+      !!--------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kiomid   ! iom identifier of the file to be closed
+      CHARACTER(LEN=100)  ::   clinfo   ! info character
+      !---------------------------------------------------------------------
+      clinfo = '      iom_nf90_close    , file: '//TRIM(iom_file(kiomid)%name)
+      CALL iom_nf90_check(NF90_CLOSE(iom_file(kiomid)%nfid), clinfo)
+   END SUBROUTINE iom_nf90_close
+
+
+   FUNCTION iom_nf90_varid ( kiomid, cdvar, kiv, kdimsz, kndims )  
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  iom_varid  ***
+      !!
+      !! ** Purpose : get the id of a variable in a file with NF90
+      !!-----------------------------------------------------------------------
+      INTEGER              , INTENT(in   )           ::   kiomid   ! file Identifier
+      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable
+      INTEGER              , INTENT(in   )           ::   kiv   ! 
+      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions
+      INTEGER,               INTENT(  out), OPTIONAL ::   kndims   ! size of the dimensions
+      !
+      INTEGER                        ::   iom_nf90_varid   ! iom variable Id
+      INTEGER                        ::   if90id           ! nf90 file identifier
+      INTEGER                        ::   ji               ! dummy loop index
+      INTEGER                        ::   ivarid           ! NetCDF  variable Id
+      INTEGER                        ::   i_nvd            ! number of dimension of the variable
+      INTEGER, DIMENSION(jpmax_dims) ::   idimid           ! dimension ids of the variable
+      LOGICAL                        ::   llok             ! ok  test
+      CHARACTER(LEN=100)             ::   clinfo           ! info character
+      !!-----------------------------------------------------------------------
+      clinfo = '          iom_nf90_varid, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar)
+      iom_nf90_varid = 0                    ! default definition
+      IF( PRESENT(kdimsz) ) kdimsz(:) = 0   ! default definition
+      if90id = iom_file(kiomid)%nfid        ! get back NetCDF file id
+      !
+      llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr   ! does the variable exist in the file
+      IF( llok ) THEN
+         iom_nf90_varid = kiv
+         iom_file(kiomid)%nvars       = kiv
+         iom_file(kiomid)%nvid(kiv)   = ivarid
+         iom_file(kiomid)%cn_var(kiv) = TRIM(cdvar)
+         CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, ndims = i_nvd), clinfo)   ! number of dimensions
+         iom_file(kiomid)%ndims(kiv)  = i_nvd
+         CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, dimids = idimid(1:i_nvd)), clinfo)   ! dimensions ids
+         iom_file(kiomid)%luld(kiv) = .FALSE.   ! default value
+         iom_file(kiomid)%dimsz(:,kiv) = 0      ! reset dimsz in case previously used
+         DO ji = 1, i_nvd                       ! dimensions size
+            CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, idimid(ji), len = iom_file(kiomid)%dimsz(ji,kiv)), clinfo)   
+            IF( idimid(ji) == iom_file(kiomid)%iduld ) iom_file(kiomid)%luld(kiv) = .TRUE.   ! unlimited dimension? 
+         END DO
+         !---------- Deal with scale_factor and add_offset
+         llok = NF90_Inquire_attribute(if90id, ivarid, 'scale_factor') == nf90_noerr
+         IF( llok) THEN
+            CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'scale_factor', iom_file(kiomid)%scf(kiv)), clinfo)
+         ELSE
+            iom_file(kiomid)%scf(kiv) = 1.
+         END IF
+         llok = NF90_Inquire_attribute(if90id, ivarid, 'add_offset') == nf90_noerr
+         IF( llok ) THEN
+            CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'add_offset', iom_file(kiomid)%ofs(kiv)), clinfo)
+         ELSE
+            iom_file(kiomid)%ofs(kiv) = 0.
+         END IF
+         ! return the simension size
+         IF( PRESENT(kdimsz) ) THEN 
+            IF( i_nvd <= SIZE(kdimsz) ) THEN
+               kdimsz(1:i_nvd) = iom_file(kiomid)%dimsz(1:i_nvd,kiv)
+            ELSE
+               WRITE(ctmp1,*) i_nvd, SIZE(kdimsz)
+               CALL ctl_stop( TRIM(clinfo), 'error in kdimsz size'//TRIM(ctmp1) )
+            ENDIF
+         ENDIF
+         IF( PRESENT(kndims) )  kndims = iom_file(kiomid)%ndims(kiv)
+      ELSE  
+         iom_nf90_varid = -1   !   variable not found, return error code: -1
+      ENDIF
+      !
+   END FUNCTION iom_nf90_varid
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_nf90_get
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE iom_nf90_g0d( kiomid, kvid, pvar, kstart )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_nf90_g0d  ***
+      !!
+      !! ** Purpose : read a scalar with NF90
+      !!-----------------------------------------------------------------------
+      INTEGER ,               INTENT(in   )            ::   kiomid   ! Identifier of the file
+      INTEGER ,               INTENT(in   )            ::   kvid     ! variable id
+      REAL(wp),               INTENT(  out)            ::   pvar     ! read field
+      INTEGER , DIMENSION(1), INTENT(in   ), OPTIONAL  ::   kstart   ! start position of the reading in each axis
+      !
+      CHARACTER(LEN=100)      ::   clinfo   ! info character
+      !---------------------------------------------------------------------
+      clinfo = 'iom_nf90_g0d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid))
+      CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), pvar, start = kstart), clinfo )
+   END SUBROUTINE iom_nf90_g0d
+
+
+   SUBROUTINE iom_nf90_g123d( kiomid, kvid, knbdim, kstart, kcount, kx1, kx2, ky1, ky2,   &
+         &                    pv_r1d, pv_r2d, pv_r3d )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_nf90_g123d  ***
+      !!
+      !! ** Purpose : read a 1D/2D/3D variable with NF90
+      !!
+      !! ** Method : read ONE record at each CALL
+      !!-----------------------------------------------------------------------
+      INTEGER                    , INTENT(in   )           ::   kiomid    ! iom identifier of the file
+      INTEGER                    , INTENT(in   )           ::   kvid      ! Name of the variable
+      INTEGER                    , INTENT(in   )           ::   knbdim    ! number of dimensions of the variable
+      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kstart    ! start position of the reading in each axis 
+      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kcount    ! number of points to be read in each axis
+      INTEGER ,                    INTENT(in   )           ::   kx1, kx2, ky1, ky2   ! subdomain indexes
+      REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d    ! read field (1D case)
+      REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d    ! read field (2D case)
+      REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d    ! read field (3D case)
+      !
+      CHARACTER(LEN=100) ::   clinfo               ! info character
+      INTEGER            ::   if90id               ! nf90 identifier of the opened file
+      INTEGER            ::   ivid                 ! nf90 variable id
+      !---------------------------------------------------------------------
+      clinfo = 'iom_nf90_g123d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid))
+      if90id = iom_file(kiomid)%nfid         ! get back NetCDF file id
+      ivid   = iom_file(kiomid)%nvid(kvid)   ! get back NetCDF var id
+      !
+      IF(     PRESENT(pv_r1d) ) THEN
+         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r1d(:                ), start = kstart(1:knbdim),   &
+            &                                                                       count = kcount(1:knbdim)), clinfo )
+      ELSEIF( PRESENT(pv_r2d) ) THEN
+         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r2d(kx1:kx2,ky1:ky2  ), start = kstart(1:knbdim),   &
+            &                                                                       count = kcount(1:knbdim)), clinfo )
+      ELSEIF( PRESENT(pv_r3d) ) THEN
+         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r3d(kx1:kx2,ky1:ky2,:), start = kstart(1:knbdim),   &
+            &                                                                       count = kcount(1:knbdim)), clinfo )
+      ENDIF
+      !
+   END SUBROUTINE iom_nf90_g123d
+
+
+   SUBROUTINE iom_nf90_chkatt( kiomid, cdatt, llok, ksize, cdvar )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_nf90_chkatt  ***
+      !!
+      !! ** Purpose : check existence of attribute with NF90
+      !!              (either a global attribute (default) or a variable
+      !!               attribute if optional variable name is supplied (cdvar))
+      !!-----------------------------------------------------------------------
+      INTEGER         , INTENT(in   ) ::   kiomid   ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   ) ::   cdatt    ! attribute name
+      LOGICAL         , INTENT(  out) ::   llok     ! error code
+      INTEGER         , INTENT(  out), OPTIONAL     &
+                      &               ::   ksize    ! attribute size
+      CHARACTER(len=*), INTENT(in   ), OPTIONAL     &
+                      &               ::   cdvar    ! name of the variable
+      !
+      INTEGER                         ::   if90id   ! temporary integer
+      INTEGER                         ::   isize    ! temporary integer
+      INTEGER                         ::   ivarid   ! NetCDF variable Id
+      !---------------------------------------------------------------------
+      !
+      if90id = iom_file(kiomid)%nfid
+      IF( PRESENT(cdvar) ) THEN
+         ! check the variable exists in the file
+         llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr
+         IF( llok ) &
+            ! check the variable has the attribute required
+            llok = NF90_Inquire_attribute(if90id, ivarid, cdatt, len=isize ) == nf90_noerr
+      ELSE
+         llok = NF90_Inquire_attribute(if90id, NF90_GLOBAL, cdatt, len=isize ) == nf90_noerr
+      ENDIF
+      !
+      IF( PRESENT(ksize) ) ksize = isize
+      !
+      IF( .not. llok) &
+         CALL ctl_warn('iom_nf90_chkatt: no attribute '//cdatt//' found')
+      !
+   END SUBROUTINE iom_nf90_chkatt
+
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_nf90_getatt
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE iom_nf90_getatt( kiomid, cdatt, katt0d, katt1d, patt0d, patt1d, cdatt0d, cdvar)
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_nf90_getatt  ***
+      !!
+      !! ** Purpose : read an attribute with NF90
+      !!              (either a global attribute (default) or a variable
+      !!               attribute if optional variable name is supplied (cdvar))
+      !!-----------------------------------------------------------------------
+      INTEGER               , INTENT(in   )           ::   kiomid   ! Identifier of the file
+      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt    ! attribute name
+      INTEGER               , INTENT(  out), OPTIONAL ::   katt0d   ! read scalar integer
+      INTEGER, DIMENSION(:) , INTENT(  out), OPTIONAL ::   katt1d   ! read 1d array integer
+      REAL(wp)              , INTENT(  out), OPTIONAL ::   patt0d   ! read scalar  real
+      REAL(wp), DIMENSION(:), INTENT(  out), OPTIONAL ::   patt1d   ! read 1d array real
+      CHARACTER(len=*)      , INTENT(  out), OPTIONAL ::   cdatt0d  ! read character
+      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar    ! name of the variable
+      !
+      INTEGER                         ::   if90id   ! temporary integer
+      INTEGER                         ::   ivarid   ! NetCDF variable Id
+      LOGICAL                         ::   llok     ! temporary logical
+      CHARACTER(LEN=100)              ::   clinfo   ! info character
+      !---------------------------------------------------------------------
+      !
+      if90id = iom_file(kiomid)%nfid
+      IF( PRESENT(cdvar) ) THEN
+         ! check the variable exists in the file
+         llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr
+         IF( llok ) THEN
+            ! check the variable has the attribute required
+            llok = NF90_Inquire_attribute(if90id, ivarid, cdatt) == nf90_noerr
+         ELSE
+            CALL ctl_warn('iom_nf90_getatt: no variable '//TRIM(cdvar)//' found')
+         ENDIF
+      ELSE
+         llok = NF90_Inquire_attribute(if90id, NF90_GLOBAL, cdatt) == nf90_noerr
+         ivarid = NF90_GLOBAL
+      ENDIF
+      !
+      IF( llok) THEN
+         clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', att: '//TRIM(cdatt)
+         IF(PRESENT( katt0d))   CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, cdatt, values =  katt0d), clinfo)
+         IF(PRESENT( katt1d))   CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, cdatt, values =  katt1d), clinfo)
+         IF(PRESENT( patt0d))   CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, cdatt, values =  patt0d), clinfo)
+         IF(PRESENT( patt1d))   CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, cdatt, values =  patt1d), clinfo)
+         IF(PRESENT(cdatt0d))   CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, cdatt, values = cdatt0d), clinfo)
+      ELSE
+         CALL ctl_warn('iom_nf90_getatt: no attribute '//TRIM(cdatt)//' found')
+         IF(PRESENT( katt0d))    katt0d    = -999
+         IF(PRESENT( katt1d))    katt1d(:) = -999
+         IF(PRESENT( patt0d))    patt0d    = -999._wp
+         IF(PRESENT( patt1d))    patt1d(:) = -999._wp
+         IF(PRESENT(cdatt0d))   cdatt0d    = '!'
+      ENDIF
+      !
+   END SUBROUTINE iom_nf90_getatt
+
+
+   SUBROUTINE iom_nf90_putatt( kiomid, cdatt, katt0d, katt1d, patt0d, patt1d, cdatt0d, cdvar)
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_nf90_putatt  ***
+      !!
+      !! ** Purpose : write an attribute with NF90
+      !!              (either a global attribute (default) or a variable
+      !!               attribute if optional variable name is supplied (cdvar))
+      !!-----------------------------------------------------------------------
+      INTEGER               , INTENT(in   )           ::   kiomid   ! Identifier of the file
+      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt    ! attribute name
+      INTEGER               , INTENT(in   ), OPTIONAL ::   katt0d   ! read scalar integer
+      INTEGER, DIMENSION(:) , INTENT(in   ), OPTIONAL ::   katt1d   ! read 1d array integer
+      REAL(wp)              , INTENT(in   ), OPTIONAL ::   patt0d   ! read scalar  real
+      REAL(wp), DIMENSION(:), INTENT(in   ), OPTIONAL ::   patt1d   ! read 1d array real
+      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdatt0d  ! read character
+      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar    ! name of the variable
+      !
+      INTEGER                         ::   if90id   ! temporary integer
+      INTEGER                         ::   ivarid   ! NetCDF variable Id
+      INTEGER                         ::   isize    ! Attribute size
+      INTEGER                         ::   itype    ! Attribute type
+      LOGICAL                         ::   llok     ! temporary logical
+      LOGICAL                         ::   llatt     ! temporary logical
+      LOGICAL                         ::   lldata   ! temporary logical
+      CHARACTER(LEN=100)              ::   clinfo   ! info character
+      !---------------------------------------------------------------------
+      !
+      if90id = iom_file(kiomid)%nfid
+      IF( PRESENT(cdvar) ) THEN
+         llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr   ! is the variable in the file?
+         IF( .NOT. llok ) THEN
+            CALL ctl_warn('iom_nf90_putatt: no variable '//TRIM(cdvar)//' found'   &
+               &        , '                 no attribute '//cdatt//' written' )
+            RETURN
+         ENDIF
+      ELSE
+         ivarid = NF90_GLOBAL
+      ENDIF
+      llatt = NF90_Inquire_attribute(if90id, ivarid, cdatt, len = isize, xtype = itype ) == nf90_noerr
+      !
+      ! trick: irec used to know if the file is in define mode or not
+      lldata = iom_file(kiomid)%irec /= -1   ! default: go back in define mode if in data mode
+      IF( lldata .AND. llatt ) THEN          ! attribute already there. Do we really need to go back in define mode?
+         ! do we have the appropriate type?
+         IF(PRESENT( katt0d) .OR. PRESENT( katt1d))   llok = itype == NF90_INT
+         IF(PRESENT( patt0d) .OR. PRESENT( patt1d))   llok = itype == NF90_DOUBLE
+         IF(PRESENT(cdatt0d)                      )   llok = itype == NF90_CHAR
+         ! and do we have the appropriate size?
+         IF(PRESENT( katt0d))   llok = llok .AND. isize == 1
+         IF(PRESENT( katt1d))   llok = llok .AND. isize == SIZE(katt1d)
+         IF(PRESENT( patt0d))   llok = llok .AND. isize == 1
+         IF(PRESENT( patt1d))   llok = llok .AND. isize == SIZE(patt1d)
+         IF(PRESENT(cdatt0d))   llok = llok .AND. isize == LEN_TRIM(cdatt0d)
+         !
+         lldata = .NOT. llok
+      ENDIF
+      !
+      clinfo = 'iom_nf90_putatt, file: '//TRIM(iom_file(kiomid)%name)//', att: '//TRIM(cdatt)
+      IF(lldata)   CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo)   ! leave data mode to define mode
+      !
+      IF(PRESENT( katt0d))   CALL iom_nf90_check(NF90_PUT_ATT(if90id, ivarid, cdatt, values =       katt0d) , clinfo)
+      IF(PRESENT( katt1d))   CALL iom_nf90_check(NF90_PUT_ATT(if90id, ivarid, cdatt, values =       katt1d) , clinfo)
+      IF(PRESENT( patt0d))   CALL iom_nf90_check(NF90_PUT_ATT(if90id, ivarid, cdatt, values =       patt0d) , clinfo)
+      IF(PRESENT( patt1d))   CALL iom_nf90_check(NF90_PUT_ATT(if90id, ivarid, cdatt, values =       patt1d) , clinfo)
+      IF(PRESENT(cdatt0d))   CALL iom_nf90_check(NF90_PUT_ATT(if90id, ivarid, cdatt, values = trim(cdatt0d)), clinfo)
+      !
+      IF(lldata)   CALL iom_nf90_check(NF90_ENDDEF( if90id ), clinfo)   ! leave define mode to data mode
+      !
+   END SUBROUTINE iom_nf90_putatt
+
+
+   SUBROUTINE iom_nf90_rp0123d( kt, kwrite, kiomid, cdvar , kvid  , ktype,   &
+         &                                  pv_r0d, pv_r1d, pv_r2d, pv_r3d )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_nf90_rstput  ***
+      !!
+      !! ** Purpose : read the time axis cdvar in the file 
+      !!--------------------------------------------------------------------
+      INTEGER                     , INTENT(in)           ::   kt       ! ocean time-step
+      INTEGER                     , INTENT(in)           ::   kwrite   ! writing time-step
+      INTEGER                     , INTENT(in)           ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*)            , INTENT(in)           ::   cdvar    ! variable name
+      INTEGER                     , INTENT(in)           ::   kvid     ! variable id
+      INTEGER                     , INTENT(in), OPTIONAL ::   ktype    ! variable type (default R8)
+      REAL(wp)                    , INTENT(in), OPTIONAL ::   pv_r0d   ! written Od field
+      REAL(wp), DIMENSION(      :), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field
+      REAL(wp), DIMENSION(:, :   ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field
+      REAL(wp), DIMENSION(:, :, :), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field
+      !
+      INTEGER               :: idims                ! number of dimension
+      INTEGER               :: idvar                ! variable id
+      INTEGER               :: jd                   ! dimension loop counter   
+      INTEGER               :: ix1, ix2, iy1, iy2   ! subdomain indexes   
+      INTEGER, DIMENSION(4) :: idimsz               ! dimensions size  
+      INTEGER, DIMENSION(4) :: idimid               ! dimensions id
+      CHARACTER(LEN=256)    :: clinfo               ! info character
+      CHARACTER(LEN= 12), DIMENSION(5) :: cltmp     ! temporary character
+      INTEGER               :: if90id               ! nf90 file identifier
+      INTEGER               :: idmy                 ! dummy variable
+      INTEGER               :: itype                ! variable type
+      INTEGER, DIMENSION(4) :: ichunksz             ! NetCDF4 chunk sizes. Will be computed using
+      !                                             ! nn_nchunks_[i,j,k,t] namelist parameters
+      INTEGER               :: ichunkalg, ishuffle, ideflate, ideflate_level
+      !                                             ! NetCDF4 internally fixed parameters
+      LOGICAL               :: lchunk               ! logical switch to activate chunking and compression
+      !                                             ! when appropriate (currently chunking is applied to 4d fields only)
+      INTEGER               :: idlv                 ! local variable
+      INTEGER               :: idim3                ! id of the third dimension
+      !
+      INTEGER ::   nldi_save, nlei_save    !:patch before we remove periodicity and close boundaries in output files
+      INTEGER ::   nldj_save, nlej_save    !:
+      !---------------------------------------------------------------------
+      !
+      clinfo = '          iom_nf90_rp0123d, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar)
+      if90id = iom_file(kiomid)%nfid
+      !
+      ! use patch to force the writing off periodicity and close boundaries
+      ! without this, issue in some model decomposition
+      ! seb: patch before we remove periodicity and close boundaries in output files
+      nldi_save = nldi   ;   nlei_save = nlei
+      nldj_save = nldj   ;   nlej_save = nlej
+      IF( nimpp           ==      1 ) nldi = 1
+      IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi
+      IF( njmpp           ==      1 ) nldj = 1
+      IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj
+      !
+      ! define dimension variables if it is not already done
+      ! ==========================
+      IF( iom_file(kiomid)%nvars == 0 ) THEN
+         ! are we in define mode?
+         IF( iom_file(kiomid)%irec /= -1 ) THEN   ! trick: irec used to know if the file is in define mode or not
+            CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo)   ;   iom_file(kiomid)%irec = -1
+         ENDIF
+         ! define the dimension variables if it is not already done
+         ! Warning: we must use the same character length in an array constructor (at least for gcc compiler)
+         cltmp = (/ 'nav_lon     ', 'nav_lat     ', 'nav_lev     ', 'time_counter', 'numcat      ' /)   
+         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(1)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(1) ), clinfo)
+         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(2)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(2) ), clinfo)
+         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(3)), NF90_FLOAT , (/ 3    /), iom_file(kiomid)%nvid(3) ), clinfo)
+         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(4)), NF90_DOUBLE, (/ 4    /), iom_file(kiomid)%nvid(4) ), clinfo)
+         ! update informations structure related the dimension variable we just added...
+         iom_file(kiomid)%nvars       = 4
+         iom_file(kiomid)%luld(1:4)   = (/ .FALSE., .FALSE., .FALSE., .TRUE. /)
+         iom_file(kiomid)%cn_var(1:4) = cltmp(1:4)
+         iom_file(kiomid)%ndims(1:4)  = (/ 2, 2, 1, 1 /)
+         IF( NF90_INQ_DIMID( if90id, 'numcat', idmy ) == nf90_noerr ) THEN   ! add a 5th variable corresponding to the 5th dimension
+            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(5)), NF90_FLOAT , (/ 5 /), iom_file(kiomid)%nvid(5) ), clinfo)
+            iom_file(kiomid)%nvars     = 5
+            iom_file(kiomid)%luld(5)   = .FALSE.
+            iom_file(kiomid)%cn_var(5) = cltmp(5)
+            iom_file(kiomid)%ndims(5)  = 1
+         ENDIF
+         ! trick: defined to 0 to say that dimension variables are defined but not yet written
+         iom_file(kiomid)%dimsz(1, 1)  = 0   
+         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' define dimension variables done'
+      ENDIF
+      ! define the data if it is not already done
+      ! ===============
+      IF( kvid <= 0 ) THEN
+         !
+         ! NetCDF4 chunking and compression fixed settings
+         ichunkalg = 0
+         ishuffle = 1
+         ideflate = 1
+         ideflate_level = 1
+         !
+         idvar = iom_file(kiomid)%nvars + 1
+         ! are we in define mode?
+         IF( iom_file(kiomid)%irec /= -1 ) THEN   ! trick: irec used to know if the file is in define mode or not
+            CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo)   ;   iom_file(kiomid)%irec = -1
+         ENDIF
+         ! variable definition
+         IF(     PRESENT(pv_r0d) ) THEN   ;   idims = 0
+         ELSEIF( PRESENT(pv_r1d) ) THEN
+            IF( SIZE(pv_r1d,1) == jpk ) THEN   ;   idim3 = 3
+            ELSE                               ;   idim3 = 5
+            ENDIF
+                                              idims = 2   ;   idimid(1:idims) = (/idim3,4/)
+         ELSEIF( PRESENT(pv_r2d) ) THEN   ;   idims = 3   ;   idimid(1:idims) = (/1,2  ,4/)
+         ELSEIF( PRESENT(pv_r3d) ) THEN
+            IF( SIZE(pv_r3d,3) == jpk ) THEN   ;   idim3 = 3
+            ELSE                               ;   idim3 = 5
+            ENDIF
+                                              idims = 4   ;   idimid(1:idims) = (/1,2,idim3,4/)
+         ENDIF
+         IF( PRESENT(ktype) ) THEN   ! variable external type
+            SELECT CASE (ktype)
+            CASE (jp_r8)   ;   itype = NF90_DOUBLE
+            CASE (jp_r4)   ;   itype = NF90_FLOAT
+            CASE (jp_i4)   ;   itype = NF90_INT
+            CASE (jp_i2)   ;   itype = NF90_SHORT
+            CASE (jp_i1)   ;   itype = NF90_BYTE
+            CASE DEFAULT   ;   CALL ctl_stop( TRIM(clinfo)//' unknown variable type' )
+            END SELECT
+         ELSE
+            itype = NF90_DOUBLE
+         ENDIF
+         IF( PRESENT(pv_r0d) ) THEN
+            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cdvar), itype,                    &
+               &                              iom_file(kiomid)%nvid(idvar) ), clinfo )
+         ELSE
+            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cdvar), itype, idimid(1:idims),   &
+               &                              iom_file(kiomid)%nvid(idvar) ), clinfo )
+         ENDIF
+         lchunk = .false.
+         IF( snc4set%luse .AND. idims == 4 )   lchunk = .true.
+         ! update informations structure related the new variable we want to add...
+         iom_file(kiomid)%nvars         = idvar
+         iom_file(kiomid)%cn_var(idvar) = TRIM(cdvar)
+         iom_file(kiomid)%scf(idvar)    = 1.
+         iom_file(kiomid)%ofs(idvar)    = 0.
+         iom_file(kiomid)%ndims(idvar)  = idims
+         IF( .NOT. PRESENT(pv_r0d) ) THEN   ;   iom_file(kiomid)%luld(idvar) = .TRUE.
+         ELSE                               ;   iom_file(kiomid)%luld(idvar) = .FALSE.
+         ENDIF
+         DO jd = 1, idims
+            CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, idimid(jd), len = iom_file(kiomid)%dimsz(jd,idvar) ), clinfo)
+            IF ( lchunk ) ichunksz(jd) = iom_file(kiomid)%dimsz(jd,idvar)
+         END DO
+         IF ( lchunk ) THEN
+            ! Calculate chunk sizes by partitioning each dimension as requested in namnc4 namelist
+            ! Disallow very small chunk sizes and prevent chunk sizes larger than each individual dimension
+            ichunksz(1) = MIN( ichunksz(1),MAX( (ichunksz(1)-1)/snc4set%ni + 1 ,16 ) ) ! Suggested default nc4set%ni=4
+            ichunksz(2) = MIN( ichunksz(2),MAX( (ichunksz(2)-1)/snc4set%nj + 1 ,16 ) ) ! Suggested default nc4set%nj=2
+            ichunksz(3) = MIN( ichunksz(3),MAX( (ichunksz(3)-1)/snc4set%nk + 1 , 1 ) ) ! Suggested default nc4set%nk=6
+            ichunksz(4) = 1                                                            ! Do not allow chunks to span the
+            !                                                                          ! unlimited dimension
+            CALL iom_nf90_check(SET_NF90_DEF_VAR_CHUNKING(if90id, idvar, ichunkalg, ichunksz), clinfo)
+            CALL iom_nf90_check(SET_NF90_DEF_VAR_DEFLATE(if90id, idvar, ishuffle, ideflate, ideflate_level), clinfo)
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' chunked ok. Chunks sizes: ', ichunksz
+         ENDIF
+         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' defined ok'
+      ELSE
+         idvar = kvid
+      ENDIF
+      !
+      ! time step kwrite : write the variable
+      IF( kt == kwrite ) THEN
+         ! are we in write mode?
+         IF( iom_file(kiomid)%irec == -1 ) THEN   ! trick: irec used to know if the file is in define mode or not
+            CALL iom_nf90_check(NF90_ENDDEF( if90id ), clinfo)   ;   iom_file(kiomid)%irec = 0
+         ENDIF
+         ! on what kind of domain must the data be written?
+         IF( PRESENT(pv_r2d) .OR. PRESENT(pv_r3d) ) THEN
+            idimsz(1:2) = iom_file(kiomid)%dimsz(1:2,idvar)
+            IF(     idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN
+               ix1 = nldi   ;   ix2 = nlei   ;   iy1 = nldj   ;   iy2 = nlej
+            ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN
+               ix1 = 1      ;   ix2 = nlci   ;   iy1 = 1      ;   iy2 = nlcj
+            ELSEIF( idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN
+               ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj
+            ELSE 
+               CALL ctl_stop( 'iom_nf90_rp0123d: should have been an impossible case...' )
+            ENDIF
+
+            ! write dimension variables if it is not already done
+            ! =============
+            ! trick: is defined to 0 => dimension variable are defined but not yet written
+            IF( iom_file(kiomid)%dimsz(1, 1) == 0 ) THEN
+               CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lon'     , idmy )         , clinfo )
+               CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, glamt(ix1:ix2, iy1:iy2) ), clinfo )
+               CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lat'     , idmy )         , clinfo )
+               CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo )
+               CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lev'     , idmy ), clinfo )
+               CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, gdept_1d       ), clinfo )
+               IF( NF90_INQ_VARID( if90id, 'numcat', idmy ) == nf90_noerr ) THEN
+                  CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, (/ (idlv, idlv = 1,iom_file(kiomid)%nlev) /)), clinfo )
+               ENDIF
+               ! +++ WRONG VALUE: to be improved but not really useful...
+               CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'time_counter', idmy ), clinfo )
+               CALL iom_nf90_check( NF90_PUT_VAR( if90id, idmy, kt                      ), clinfo )   
+               ! update the values of the variables dimensions size
+               CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 1, len = iom_file(kiomid)%dimsz(1,1) ), clinfo )
+               CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 2, len = iom_file(kiomid)%dimsz(2,1) ), clinfo )
+               iom_file(kiomid)%dimsz(1:2, 2) = iom_file(kiomid)%dimsz(1:2, 1)
+               CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 3, len = iom_file(kiomid)%dimsz(1,3) ), clinfo )
+               iom_file(kiomid)%dimsz(1  , 4) = 1   ! unlimited dimension
+               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done'
+            ENDIF
+         ENDIF
+
+         ! write the data
+         ! =============
+         IF(     PRESENT(pv_r0d) ) THEN
+            CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r0d                    ), clinfo )
+         ELSEIF( PRESENT(pv_r1d) ) THEN
+            CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r1d(:)                 ), clinfo )
+         ELSEIF( PRESENT(pv_r2d) ) THEN
+            CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r2d(ix1:ix2,iy1:iy2)   ), clinfo )
+         ELSEIF( PRESENT(pv_r3d) ) THEN
+            CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r3d(ix1:ix2,iy1:iy2,:) ), clinfo )
+         ENDIF
+         ! add 1 to the size of the temporal dimension (not really useful...)
+         IF( iom_file(kiomid)%luld(idvar) )   iom_file(kiomid)%dimsz(iom_file(kiomid)%ndims(idvar), idvar)    &
+               &                            = iom_file(kiomid)%dimsz(iom_file(kiomid)%ndims(idvar), idvar) + 1
+         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' written ok'
+      ENDIF
+      !
+      nldi = nldi_save   ;   nlei = nlei_save
+      nldj = nldj_save   ;   nlej = nlej_save
+      !     
+   END SUBROUTINE iom_nf90_rp0123d
+
+
+   SUBROUTINE iom_nf90_check( kstatus, cdinfo )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE iom_nf90_check  ***
+      !!
+      !! ** Purpose :   check nf90 errors
+      !!--------------------------------------------------------------------
+      INTEGER,          INTENT(in) :: kstatus
+      CHARACTER(LEN=*), INTENT(in) :: cdinfo
+      !---------------------------------------------------------------------
+      IF(kstatus /= nf90_noerr)   CALL ctl_stop( 'iom_nf90_check : '//TRIM(nf90_strerror(kstatus)), TRIM(cdinfo) )
+   END SUBROUTINE iom_nf90_check
+
+   !!======================================================================
+END MODULE iom_nf90
Index: /utils/tools_ticket2413/DOMAINcfg/src/lbc_lnk_generic.h90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/lbc_lnk_generic.h90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/lbc_lnk_generic.h90	(revision 12863)
@@ -0,0 +1,117 @@
+#if defined MULTI
+#   define NAT_IN(k)                cd_nat(k)   
+#   define SGN_IN(k)                psgn(k)
+#   define F_SIZE(ptab)             kfld
+#   define OPT_K(k)                 ,ipf
+#   if defined DIM_2d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D)                , INTENT(inout) ::   ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
+#      define K_SIZE(ptab)             1
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D),INTENT(inout)::ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3)
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D),INTENT(inout)::ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
+#      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4)
+#   endif
+#else
+#   define ARRAY_TYPE(i,j,k,l,f)    REAL(wp)                    , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f)
+#   define NAT_IN(k)                cd_nat
+#   define SGN_IN(k)                psgn
+#   define F_SIZE(ptab)             1
+#   define OPT_K(k)                 
+#   if defined DIM_2d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
+#      define K_SIZE(ptab)          1
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          SIZE(ptab,4)
+#   endif
+#endif
+
+#if defined MULTI
+   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn, kfld, cd_mpp, pval )
+      INTEGER                     , INTENT(in   ) ::   kfld        ! number of pt3d arrays
+#else
+   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn      , cd_mpp, pval )
+#endif
+      CHARACTER(len=*)            , INTENT(in   ) ::   cdname      ! name of the calling subroutine
+      ARRAY_TYPE(:,:,:,:,:)                                        ! array or pointer of arrays on which the boundary condition is applied
+      CHARACTER(len=1)            , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
+      REAL(wp)                    , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
+      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp      ! fill the overlap area only
+      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval        ! background value (used at closed boundaries)
+      !
+      INTEGER  ::    ji,  jj,  jk,  jl, jh, jf   ! dummy loop indices
+      INTEGER  ::   ipi, ipj, ipk, ipl, ipf      ! dimension of the input array
+      REAL(wp) ::   zland
+      LOGICAL  ::   ll_nfd
+      !!----------------------------------------------------------------------
+      !
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      ipl = L_SIZE(ptab)   ! 4th    -
+      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
+      !
+      ll_nfd    = jperio==3 .OR. jperio==4 .OR. jperio==5 .OR. jperio==6
+      !
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0._wp     ! zero by default
+      ENDIF
+
+      ! ------------------------------- !
+      !   standard boundary treatment   !    ! CAUTION: semi-column notation is often impossible
+      ! ------------------------------- !
+      !
+      IF( .NOT. PRESENT( cd_mpp ) ) THEN  !==  standard close or cyclic treatment  ==!
+         !
+         DO jf = 1, ipf                   ! number of arrays to be treated
+            !
+            !                                ! East-West boundaries
+            IF( l_Iperio ) THEN                   !* cyclic
+               ARRAY_IN( 1 ,:,:,:,jf) = ARRAY_IN(jpim1,:,:,:,jf)
+               ARRAY_IN(jpi,:,:,:,jf) = ARRAY_IN(  2  ,:,:,:,jf)
+            ELSE                                   !* closed
+               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN( 1 ,:,:,:,jf) = zland    ! east except F-point
+                                               ARRAY_IN(jpi,:,:,:,jf) = zland    ! west
+            ENDIF
+            !                                ! North-South boundaries
+            IF( l_Jperio ) THEN                   !* cyclic
+               ARRAY_IN(:, 1 ,:,:,jf) = ARRAY_IN(:, jpjm1,:,:,jf)
+               ARRAY_IN(:,jpj,:,:,jf) = ARRAY_IN(:,   2  ,:,:,jf)
+            ELSEIF( ll_nfd ) THEN                  !* north fold
+               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(:, 1 ,:,:,jf) = zland    ! south except F-point
+               CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:) OPT_K(:) )                       ! north fold treatment         
+            ELSE                                   !* closed
+               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(:, 1 ,:,:,jf) = zland    ! south except F-point
+                                               ARRAY_IN(:,jpj,:,:,jf) = zland    ! north
+            ENDIF
+            !
+         END DO
+         !
+      ENDIF
+      !
+   END SUBROUTINE ROUTINE_LNK
+
+#undef ARRAY_TYPE
+#undef NAT_IN
+#undef SGN_IN
+#undef ARRAY_IN
+#undef K_SIZE
+#undef L_SIZE
+#undef F_SIZE
+#undef OPT_K
Index: /utils/tools_ticket2413/DOMAINcfg/src/lbc_lnk_multi_generic.h90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/lbc_lnk_multi_generic.h90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/lbc_lnk_multi_generic.h90	(revision 12863)
@@ -0,0 +1,76 @@
+#if defined DIM_2d
+#   define ARRAY_TYPE(i,j,k,l)   REAL(wp), DIMENSION(i,j)
+#   define PTR_TYPE              TYPE(PTR_2D)
+#   define PTR_ptab              pt2d
+#endif
+#if defined DIM_3d
+#   define ARRAY_TYPE(i,j,k,l)   REAL(wp), DIMENSION(i,j,k)
+#   define PTR_TYPE              TYPE(PTR_3D)
+#   define PTR_ptab              pt3d
+#endif
+#if defined DIM_4d
+#   define ARRAY_TYPE(i,j,k,l)   REAL(wp), DIMENSION(i,j,k,l)
+#   define PTR_TYPE              TYPE(PTR_4D)
+#   define PTR_ptab              pt4d
+#endif
+   SUBROUTINE ROUTINE_MULTI( cdname                                                    &
+      &                    , pt1, cdna1, psgn1, pt2, cdna2, psgn2, pt3, cdna3, psgn3   &
+      &                    , pt4, cdna4, psgn4, pt5, cdna5, psgn5, pt6, cdna6, psgn6   &
+      &                    , pt7, cdna7, psgn7, pt8, cdna8, psgn8, pt9, cdna9, psgn9, cd_mpp, pval)
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*)   ,                   INTENT(in   ) ::   cdname  ! name of the calling subroutine
+      ARRAY_TYPE(:,:,:,:)          , TARGET, INTENT(inout) ::   pt1     ! arrays on which the lbc is applied
+      ARRAY_TYPE(:,:,:,:), OPTIONAL, TARGET, INTENT(inout) ::   pt2  ,  pt3  , pt4  , pt5  , pt6  , pt7  , pt8  , pt9
+      CHARACTER(len=1)                     , INTENT(in   ) ::   cdna1   ! nature of pt2D. array grid-points
+      CHARACTER(len=1)   , OPTIONAL        , INTENT(in   ) ::   cdna2,  cdna3, cdna4, cdna5, cdna6, cdna7, cdna8, cdna9
+      REAL(wp)                             , INTENT(in   ) ::   psgn1   ! sign used across the north fold
+      REAL(wp)           , OPTIONAL        , INTENT(in   ) ::   psgn2,  psgn3, psgn4, psgn5, psgn6, psgn7, psgn8, psgn9   
+      CHARACTER(len=3)   , OPTIONAL        , INTENT(in   ) ::   cd_mpp  ! fill the overlap area only
+      REAL(wp)           , OPTIONAL        , INTENT(in   ) ::   pval    ! background value (used at closed boundaries)
+      !!
+      INTEGER                         ::   kfld        ! number of elements that will be attributed
+      PTR_TYPE         , DIMENSION(9) ::   ptab_ptr    ! pointer array
+      CHARACTER(len=1) , DIMENSION(9) ::   cdna_ptr    ! nature of ptab_ptr grid-points
+      REAL(wp)         , DIMENSION(9) ::   psgn_ptr    ! sign used across the north fold boundary
+      !!---------------------------------------------------------------------
+      !
+      kfld = 0          ! initial array of pointer size
+      !
+      !                 ! Load the first array
+      CALL ROUTINE_LOAD( pt1, cdna1, psgn1, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      !
+      !                 ! Look if more arrays are added
+      IF( PRESENT(psgn2) )   CALL ROUTINE_LOAD( pt2, cdna2, psgn2, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn3) )   CALL ROUTINE_LOAD( pt3, cdna3, psgn3, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn4) )   CALL ROUTINE_LOAD( pt4, cdna4, psgn4, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn5) )   CALL ROUTINE_LOAD( pt5, cdna5, psgn5, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn6) )   CALL ROUTINE_LOAD( pt6, cdna6, psgn6, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn7) )   CALL ROUTINE_LOAD( pt7, cdna7, psgn7, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn8) )   CALL ROUTINE_LOAD( pt8, cdna8, psgn8, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn9) )   CALL ROUTINE_LOAD( pt9, cdna9, psgn9, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      !
+      CALL lbc_lnk_ptr( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, cd_mpp, pval )
+      !
+   END SUBROUTINE ROUTINE_MULTI
+
+
+   SUBROUTINE ROUTINE_LOAD( ptab, cdna, psgn, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      !!---------------------------------------------------------------------
+      ARRAY_TYPE(:,:,:,:)   , TARGET, INTENT(inout) ::   ptab       ! arrays on which the lbc is applied
+      CHARACTER(len=1)              , INTENT(in   ) ::   cdna       ! nature of pt2d array grid-points
+      REAL(wp)                      , INTENT(in   ) ::   psgn       ! sign used across the north fold boundary
+      PTR_TYPE        , DIMENSION(:), INTENT(inout) ::   ptab_ptr   ! array of pointers
+      CHARACTER(len=1), DIMENSION(:), INTENT(inout) ::   cdna_ptr   ! nature of pt2d_array array grid-points
+      REAL(wp)        , DIMENSION(:), INTENT(inout) ::   psgn_ptr   ! sign used across the north fold boundary
+      INTEGER                       , INTENT(inout) ::   kfld       ! number of elements that has been attributed
+      !!---------------------------------------------------------------------
+      !
+      kfld                    =  kfld + 1
+      ptab_ptr(kfld)%PTR_ptab => ptab
+      cdna_ptr(kfld)          =  cdna
+      psgn_ptr(kfld)          =  psgn
+      !
+   END SUBROUTINE ROUTINE_LOAD
+#undef ARRAY_TYPE
+#undef PTR_TYPE
+#undef PTR_ptab
Index: /utils/tools_ticket2413/DOMAINcfg/src/lbc_nfd_ext_generic.h90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/lbc_nfd_ext_generic.h90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/lbc_nfd_ext_generic.h90	(revision 12863)
@@ -0,0 +1,157 @@
+!                          !==  IN: ptab is an array  ==!
+#define NAT_IN(k)                cd_nat
+#define SGN_IN(k)                psgn
+#define F_SIZE(ptab)             1
+#if defined DIM_2d
+#   define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
+#   define K_SIZE(ptab)          1
+#   define L_SIZE(ptab)          1
+#endif
+#define ARRAY_TYPE(i,j,k,l,f)    REAL(wp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
+
+   SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kextj )
+      !!----------------------------------------------------------------------
+      INTEGER          , INTENT(in   ) ::   kextj       ! extra halo width at north fold, declared before its use in ARRAY_TYPE
+      ARRAY_TYPE(:,1-kextj:,:,:,:)                      ! array or pointer of arrays on which the boundary condition is applied
+      CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
+      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
+      !
+      INTEGER  ::    ji,  jj,  jk,  jl, jh,  jf   ! dummy loop indices
+      INTEGER  ::   ipi, ipj, ipk, ipl,     ipf   ! dimension of the input array
+      INTEGER  ::   ijt, iju, ipjm1
+      !!----------------------------------------------------------------------
+      !
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      ipl = L_SIZE(ptab)   ! 4th    -
+      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
+      !
+      !
+      SELECT CASE ( jpni )
+      CASE ( 1 )     ;   ipj = nlcj       ! 1 proc only  along the i-direction
+      CASE DEFAULT   ;   ipj = 4          ! several proc along the i-direction
+      END SELECT
+      !
+      ipjm1 = ipj-1
+
+      !
+      DO jf = 1, ipf                      ! Loop on the number of arrays to be treated
+         !
+         SELECT CASE ( npolj )
+         !
+         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
+            !
+            SELECT CASE ( NAT_IN(jf)  )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO jh = 0, kextj
+                  DO ji = 2, jpiglo
+                     ijt = jpiglo-ji+2
+                     ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2-jh,:,:,jf)
+                  END DO
+                  ARRAY_IN(1,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(3,ipj-2-jh,:,:,jf)
+               END DO
+               DO ji = jpiglo/2+1, jpiglo
+                  ijt = jpiglo-ji+2
+                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipjm1,:,:,jf)
+               END DO
+            CASE ( 'U' )                               ! U-point
+               DO jh = 0, kextj
+                  DO ji = 2, jpiglo-1
+                     iju = jpiglo-ji+1
+                     ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2-jh,:,:,jf)
+                  END DO
+                 ARRAY_IN(   1  ,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(    2   ,ipj-2-jh,:,:,jf)
+                 ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-1,ipj-2-jh,:,:,jf) 
+               END DO
+               DO ji = jpiglo/2, jpiglo-1
+                  iju = jpiglo-ji+1
+                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipjm1,:,:,jf)
+               END DO
+            CASE ( 'V' )                               ! V-point
+               DO jh = 0, kextj
+                  DO ji = 2, jpiglo
+                     ijt = jpiglo-ji+2
+                     ARRAY_IN(ji,ipj-1+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2-jh,:,:,jf)
+                     ARRAY_IN(ji,ipj+jh  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-3-jh,:,:,jf)
+                  END DO
+                  ARRAY_IN(1,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(3,ipj-3-jh,:,:,jf) 
+               END DO
+            CASE ( 'F' )                               ! F-point
+               DO jh = 0, kextj
+                  DO ji = 1, jpiglo-1
+                     iju = jpiglo-ji+1
+                     ARRAY_IN(ji,ipj-1+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2-jh,:,:,jf)
+                     ARRAY_IN(ji,ipj+jh  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-3-jh,:,:,jf)
+                  END DO
+               END DO
+               DO jh = 0, kextj
+                  ARRAY_IN(   1  ,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(    2   ,ipj-3-jh,:,:,jf)
+                  ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-1,ipj-3-jh,:,:,jf)
+               END DO
+            END SELECT
+            !
+         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
+            !
+            SELECT CASE ( NAT_IN(jf)  )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO jh = 0, kextj
+                  DO ji = 1, jpiglo
+                     ijt = jpiglo-ji+1
+                     ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-1-jh,:,:,jf)
+                  END DO
+               END DO
+            CASE ( 'U' )                               ! U-point
+               DO jh = 0, kextj
+                  DO ji = 1, jpiglo-1
+                     iju = jpiglo-ji
+                     ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-1-jh,:,:,jf)
+                  END DO
+                  ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-2,ipj-1-jh,:,:,jf)
+               END DO
+            CASE ( 'V' )                               ! V-point
+               DO jh = 0, kextj
+                  DO ji = 1, jpiglo
+                     ijt = jpiglo-ji+1
+                     ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2-jh,:,:,jf)
+                  END DO
+               END DO
+               DO ji = jpiglo/2+1, jpiglo
+                  ijt = jpiglo-ji+1
+                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipjm1,:,:,jf)
+               END DO
+            CASE ( 'F' )                               ! F-point
+               DO jh = 0, kextj
+                  DO ji = 1, jpiglo-1
+                     iju = jpiglo-ji
+                     ARRAY_IN(ji,ipj+jh  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2-jh,:,:,jf)
+                  END DO
+                  ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-2,ipj-2-jh,:,:,jf)
+               END DO
+               DO ji = jpiglo/2+1, jpiglo-1
+                  iju = jpiglo-ji
+                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipjm1,:,:,jf)
+               END DO
+            END SELECT
+            !
+         CASE DEFAULT                           ! *  closed : the code probably never go through
+            !
+            SELECT CASE ( NAT_IN(jf) )
+            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+               ARRAY_IN(:,  1:1-kextj  ,:,:,jf) = 0._wp
+               ARRAY_IN(:,ipj:ipj+kextj,:,:,jf) = 0._wp
+            CASE ( 'F' )                               ! F-point
+               ARRAY_IN(:,ipj:ipj+kextj,:,:,jf) = 0._wp
+            END SELECT
+            !
+         END SELECT     !  npolj
+         !
+      END DO
+      !
+   END SUBROUTINE ROUTINE_NFD
+
+#undef ARRAY_TYPE
+#undef ARRAY_IN
+#undef NAT_IN
+#undef SGN_IN
+#undef K_SIZE
+#undef L_SIZE
+#undef F_SIZE
Index: /utils/tools_ticket2413/DOMAINcfg/src/lbc_nfd_generic.h90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/lbc_nfd_generic.h90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/lbc_nfd_generic.h90	(revision 12863)
@@ -0,0 +1,175 @@
+#if defined MULTI
+#   define NAT_IN(k)                cd_nat(k)   
+#   define SGN_IN(k)                psgn(k)
+#   define F_SIZE(ptab)             kfld
+#   if defined DIM_2d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D),INTENT(inout)::ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
+#      define K_SIZE(ptab)             1
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D),INTENT(inout)::ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3)
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D),INTENT(inout)::ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
+#      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4)
+#   endif
+#else
+!                          !==  IN: ptab is an array  ==!
+#   define NAT_IN(k)                cd_nat
+#   define SGN_IN(k)                psgn
+#   define F_SIZE(ptab)             1
+#   if defined DIM_2d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
+#      define K_SIZE(ptab)          1
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          SIZE(ptab,4)
+#   endif
+#   define ARRAY_TYPE(i,j,k,l,f)    REAL(wp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
+#endif
+
+#if defined MULTI
+   SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kfld )
+      INTEGER          , INTENT(in   ) ::   kfld        ! number of pt3d arrays
+#else
+   SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn       )
+#endif
+      ARRAY_TYPE(:,:,:,:,:)                             ! array or pointer of arrays on which the boundary condition is applied
+      CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
+      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
+      !
+      INTEGER  ::    ji,  jj,  jk,  jl, jh,  jf   ! dummy loop indices
+      INTEGER  ::   ipi, ipj, ipk, ipl,     ipf   ! dimension of the input array
+      INTEGER  ::   ijt, iju, ipjm1
+      !!----------------------------------------------------------------------
+      !
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      ipl = L_SIZE(ptab)   ! 4th    -
+      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
+      !
+      !
+      SELECT CASE ( jpni )
+      CASE ( 1 )     ;   ipj = nlcj       ! 1 proc only  along the i-direction
+      CASE DEFAULT   ;   ipj = 4          ! several proc along the i-direction
+      END SELECT
+      ipjm1 = ipj-1
+
+      !
+      DO jf = 1, ipf                      ! Loop on the number of arrays to be treated
+         !
+         SELECT CASE ( npolj )
+         !
+         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
+            !
+            SELECT CASE ( NAT_IN(jf)  )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO ji = 2, jpiglo
+                  ijt = jpiglo-ji+2
+                  ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2,:,:,jf)
+               END DO
+               ARRAY_IN(1,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(3,ipj-2,:,:,jf)
+               DO ji = jpiglo/2+1, jpiglo
+                  ijt = jpiglo-ji+2
+                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipjm1,:,:,jf)
+               END DO
+            CASE ( 'U' )                               ! U-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji+1
+                  ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2,:,:,jf)
+               END DO
+               ARRAY_IN(   1  ,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(    2   ,ipj-2,:,:,jf)
+               ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-1,ipj-2,:,:,jf) 
+               DO ji = jpiglo/2, jpiglo-1
+                  iju = jpiglo-ji+1
+                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipjm1,:,:,jf)
+               END DO
+            CASE ( 'V' )                               ! V-point
+               DO ji = 2, jpiglo
+                  ijt = jpiglo-ji+2
+                  ARRAY_IN(ji,ipj-1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2,:,:,jf)
+                  ARRAY_IN(ji,ipj  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-3,:,:,jf)
+               END DO
+               ARRAY_IN(1,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(3,ipj-3,:,:,jf) 
+            CASE ( 'F' )                               ! F-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji+1
+                  ARRAY_IN(ji,ipj-1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2,:,:,jf)
+                  ARRAY_IN(ji,ipj  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-3,:,:,jf)
+               END DO
+               ARRAY_IN(   1  ,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(    2   ,ipj-3,:,:,jf)
+               ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-1,ipj-3,:,:,jf) 
+            END SELECT
+            !
+         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
+            !
+            SELECT CASE ( NAT_IN(jf)  )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO ji = 1, jpiglo
+                  ijt = jpiglo-ji+1
+                  ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-1,:,:,jf)
+               END DO
+            CASE ( 'U' )                               ! U-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji
+                  ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-1,:,:,jf)
+               END DO
+               ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpiglo-2,ipj-1,:,:,jf)
+            CASE ( 'V' )                               ! V-point
+               DO ji = 1, jpiglo
+                  ijt = jpiglo-ji+1
+                  ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2,:,:,jf)
+               END DO
+               DO ji = jpiglo/2+1, jpiglo
+                  ijt = jpiglo-ji+1
+                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipjm1,:,:,jf)
+               END DO
+            CASE ( 'F' )                               ! F-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji
+                  ARRAY_IN(ji,ipj  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2,:,:,jf)
+               END DO
+               ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf)   * ARRAY_IN(jpiglo-2,ipj-2,:,:,jf)
+               DO ji = jpiglo/2+1, jpiglo-1
+                  iju = jpiglo-ji
+                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipjm1,:,:,jf)
+               END DO
+            END SELECT
+            !
+         CASE DEFAULT                           ! *  closed : the code probably never go through
+            !
+            SELECT CASE ( NAT_IN(jf) )
+            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+               ARRAY_IN(:, 1 ,:,:,jf) = 0._wp
+               ARRAY_IN(:,ipj,:,:,jf) = 0._wp
+            CASE ( 'F' )                               ! F-point
+               ARRAY_IN(:,ipj,:,:,jf) = 0._wp
+            END SELECT
+            !
+         END SELECT     !  npolj
+         !
+      END DO
+      !
+   END SUBROUTINE ROUTINE_NFD
+
+#undef ARRAY_TYPE
+#undef ARRAY_IN
+#undef NAT_IN
+#undef SGN_IN
+#undef K_SIZE
+#undef L_SIZE
+#undef F_SIZE
Index: /utils/tools_ticket2413/DOMAINcfg/src/lbc_nfd_nogather_generic.h90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/lbc_nfd_nogather_generic.h90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/lbc_nfd_nogather_generic.h90	(revision 12863)
@@ -0,0 +1,360 @@
+#if defined MULTI
+#   define NAT_IN(k)                cd_nat(k)   
+#   define SGN_IN(k)                psgn(k)
+#   define F_SIZE(ptab)             kfld
+#   if defined DIM_2d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D),INTENT(inout)::ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
+#      define K_SIZE(ptab)             1
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D),INTENT(inout)::ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3)
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D),INTENT(inout)::ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
+#      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4)
+#   endif
+#   define ARRAY2_TYPE(i,j,k,l,f)   TYPE(PTR_4D),INTENT(inout)::ptab2(f)
+#   define J_SIZE(ptab2)            SIZE(ptab2(1)%pt4d,2)
+#   define ARRAY2_IN(i,j,k,l,f)     ptab2(f)%pt4d(i,j,k,l)
+#else
+!                          !==  IN: ptab is an array  ==!
+#   define NAT_IN(k)                cd_nat
+#   define SGN_IN(k)                psgn
+#   define F_SIZE(ptab)             1
+#   if defined DIM_2d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
+#      define K_SIZE(ptab)          1
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          SIZE(ptab,4)
+#   endif
+#   define ARRAY2_IN(i,j,k,l,f)  ptab2(i,j,k,l)
+#   define J_SIZE(ptab2)             SIZE(ptab2,2)
+#   define ARRAY_TYPE(i,j,k,l,f)     REAL(wp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
+#   define ARRAY2_TYPE(i,j,k,l,f)    REAL(wp),INTENT(inout)::ARRAY2_IN(i,j,k,l,f)
+#endif
+
+   SUBROUTINE ROUTINE_NFD( ptab, ptab2, cd_nat, psgn, kfld )
+      !!----------------------------------------------------------------------
+      !!
+      !! ** Purpose :   lateral boundary condition : North fold treatment
+      !!                without allgather exchanges. 
+      !!
+      !!----------------------------------------------------------------------
+      ARRAY_TYPE(:,:,:,:,:)                             ! array or pointer of arrays on which the boundary condition is applied
+      ARRAY2_TYPE(:,:,:,:,:)                            ! array or pointer of arrays on which the boundary condition is applied
+      CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
+      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
+      INTEGER, OPTIONAL, INTENT(in   ) ::   kfld        ! number of pt3d arrays
+      !
+      INTEGER  ::    ji,  jj,   jk,     jl,   jh,  jf   ! dummy loop indices
+      INTEGER  ::   ipi, ipj,  ipk,    ipl,  ipf        ! dimension of the input array
+      INTEGER  ::   ijt, iju, ijpj, ijpjp1, ijta, ijua, jia, startloop, endloop
+      LOGICAL  ::   l_fast_exchanges
+      !!----------------------------------------------------------------------
+      ipj = J_SIZE(ptab2)  ! 2nd dimension of input array
+      ipk = K_SIZE(ptab)   ! 3rd dimension of output array
+      ipl = L_SIZE(ptab)   ! 4th    -
+      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
+      !
+      ! Security check for further developments
+      IF ( ipf > 1 ) THEN
+        write(6,*) 'lbc_nfd_nogather: multiple fields not allowed. Revise implementation' 
+        write(6,*) 'You should not be there...' 
+        STOP
+      ENDIF
+      !
+      ijpj   = 1    ! index of first modified line 
+      ijpjp1 = 2    ! index + 1
+      
+      ! 2nd dimension determines exchange speed
+      IF (ipj == 1 ) THEN
+        l_fast_exchanges = .TRUE.
+      ELSE
+        l_fast_exchanges = .FALSE.
+      ENDIF
+      !
+      DO jf = 1, ipf                      ! Loop over the number of arrays to be processed
+         !
+         SELECT CASE ( npolj )
+         !
+         CASE ( 3, 4 )                       ! *  North fold  T-point pivot
+            !
+            SELECT CASE ( NAT_IN(jf) )
+            !
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               IF ( nimpp /= 1 ) THEN   ;   startloop = 1
+               ELSE                     ;   startloop = 2
+               ENDIF
+               !
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  DO ji = startloop, nlci
+                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf)
+                  END DO
+               END DO; END DO
+               IF( nimpp == 1 ) THEN
+                  DO jl = 1, ipl; DO jk = 1, ipk
+                     ARRAY_IN(1,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(3,nlcj-2,jk,jl,jf)
+                  END DO; END DO
+               ENDIF
+               !
+               IF ( .NOT. l_fast_exchanges ) THEN
+                  IF( nimpp >= jpiglo/2+1 ) THEN
+                     startloop = 1
+                  ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN
+                     startloop = jpiglo/2+1 - nimpp + 1
+                  ELSE
+                     startloop = nlci + 1
+                  ENDIF
+                  IF( startloop <= nlci ) THEN
+                     DO jl = 1, ipl; DO jk = 1, ipk
+                        DO ji = startloop, nlci
+                           ijt  = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                           jia  = ji + nimpp - 1
+                           ijta = jpiglo - jia + 2
+                           IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN
+                              ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+1,nlcj-1,jk,jl,jf)
+                           ELSE
+                              ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjp1,jk,jl,jf)
+                           ENDIF
+                        END DO
+                     END DO; END DO
+                  ENDIF
+               ENDIF
+
+            CASE ( 'U' )                                     ! U-point
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  DO ji = 1, endloop
+                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf)
+                  END DO
+               END DO; END DO
+               IF (nimpp .eq. 1) THEN
+                  ARRAY_IN(1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2,nlcj-2,:,:,jf)
+               ENDIF
+               IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+                  ARRAY_IN(nlci,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,nlcj-2,:,:,jf)
+               ENDIF
+               !
+               IF ( .NOT. l_fast_exchanges ) THEN
+                  IF( nimpp + nlci - 1 /= jpiglo ) THEN
+                     endloop = nlci
+                  ELSE
+                     endloop = nlci - 1
+                  ENDIF
+                  IF( nimpp >= jpiglo/2 ) THEN
+                     startloop = 1
+                     ELSEIF( ( nimpp+nlci-1 >= jpiglo/2 ) .AND. ( nimpp < jpiglo/2 ) ) THEN
+                     startloop = jpiglo/2 - nimpp + 1
+                  ELSE
+                     startloop = endloop + 1
+                  ENDIF
+                  IF( startloop <= endloop ) THEN
+                  DO jl = 1, ipl; DO jk = 1, ipk
+                     DO ji = startloop, endloop
+                        iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                        jia = ji + nimpp - 1
+                        ijua = jpiglo - jia + 1
+                        IF( ijua >= startloop+nimpp-1 .AND. ijua < jia ) THEN
+                           ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+1,nlcj-1,jk,jl,jf)
+                        ELSE
+                           ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjp1,jk,jl,jf)
+                        ENDIF
+                     END DO
+                  END DO; END DO
+                  ENDIF
+               ENDIF
+               !
+            CASE ( 'V' )                                     ! V-point
+               IF( nimpp /= 1 ) THEN
+                 startloop = 1
+               ELSE
+                 startloop = 2
+               ENDIF
+               IF ( .NOT. l_fast_exchanges ) THEN
+                  DO jl = 1, ipl; DO jk = 1, ipk
+                     DO ji = startloop, nlci
+                        ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                        ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjp1,jk,jl,jf)
+                     END DO
+                  END DO; END DO
+               ENDIF
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  DO ji = startloop, nlci
+                     ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf)
+                  END DO
+               END DO; END DO
+               IF (nimpp .eq. 1) THEN
+                  ARRAY_IN(1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,nlcj-3,:,:,jf)
+               ENDIF
+            CASE ( 'F' )                                     ! F-point
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               IF ( .NOT. l_fast_exchanges ) THEN
+                  DO jl = 1, ipl; DO jk = 1, ipk
+                     DO ji = 1, endloop
+                        iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                        ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjp1,jk,jl,jf)
+                     END DO
+                  END DO; END DO
+               ENDIF
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  DO ji = 1, endloop
+                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf)
+                  END DO
+               END DO; END DO
+               IF (nimpp .eq. 1) THEN
+                  ARRAY_IN(1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2,nlcj-3,:,:,jf)
+                  IF ( .NOT. l_fast_exchanges ) &
+                     ARRAY_IN(1,nlcj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2,nlcj-2,:,:,jf)
+               ENDIF
+               IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+                  ARRAY_IN(nlci,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,nlcj-3,:,:,jf)
+                  IF ( .NOT. l_fast_exchanges ) &
+                     ARRAY_IN(nlci,nlcj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,nlcj-2,:,:,jf)
+               ENDIF
+               !
+            END SELECT
+            !
+         CASE ( 5, 6 )                        ! *  North fold  F-point pivot
+            !
+            SELECT CASE ( NAT_IN(jf) )
+            CASE ( 'T' , 'W' )                               ! T-, W-point
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  DO ji = 1, nlci
+                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf)
+                  END DO
+               END DO; END DO
+               !
+            CASE ( 'U' )                                     ! U-point
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  DO ji = 1, endloop
+                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
+                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf)
+                  END DO
+               END DO; END DO
+               IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+                  DO jl = 1, ipl; DO jk = 1, ipk
+                     ARRAY_IN(nlci,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2,nlcj-1,jk,jl,jf)
+                  END DO; END DO
+               ENDIF
+               !
+            CASE ( 'V' )                                     ! V-point
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  DO ji = 1, nlci
+                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf)
+                  END DO
+               END DO; END DO
+
+               IF ( .NOT. l_fast_exchanges ) THEN
+                  IF( nimpp >= jpiglo/2+1 ) THEN
+                     startloop = 1
+                  ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN
+                     startloop = jpiglo/2+1 - nimpp + 1
+                  ELSE
+                     startloop = nlci + 1
+                  ENDIF
+                  IF( startloop <= nlci ) THEN
+                  DO jl = 1, ipl; DO jk = 1, ipk
+                     DO ji = startloop, nlci
+                        ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
+                        ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjp1,jk,jl,jf)
+                     END DO
+                  END DO; END DO
+                  ENDIF
+               ENDIF
+               !
+            CASE ( 'F' )                               ! F-point
+               IF( nimpp + nlci - 1 /= jpiglo ) THEN
+                  endloop = nlci
+               ELSE
+                  endloop = nlci - 1
+               ENDIF
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  DO ji = 1, endloop
+                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
+                     ARRAY_IN(ji,nlcj ,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf)
+                  END DO
+               END DO; END DO
+               IF((nimpp + nlci - 1) .eq. jpiglo) THEN
+                  DO jl = 1, ipl; DO jk = 1, ipk
+                     ARRAY_IN(nlci,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2,nlcj-2,jk,jl,jf)
+                  END DO; END DO
+               ENDIF
+               !
+               IF ( .NOT. l_fast_exchanges ) THEN
+                  IF( nimpp + nlci - 1 /= jpiglo ) THEN
+                     endloop = nlci
+                  ELSE
+                     endloop = nlci - 1
+                  ENDIF
+                  IF( nimpp >= jpiglo/2+1 ) THEN
+                     startloop = 1
+                  ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN
+                     startloop = jpiglo/2+1 - nimpp + 1
+                  ELSE
+                     startloop = endloop + 1
+                  ENDIF
+                  IF( startloop <= endloop ) THEN
+                     DO jl = 1, ipl; DO jk = 1, ipk
+                        DO ji = startloop, endloop
+                           iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
+                           ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjp1,jk,jl,jf)
+                        END DO
+                     END DO; END DO
+                  ENDIF
+               ENDIF
+               !
+            END SELECT
+            !
+         CASE DEFAULT                           ! *  closed : the code probably never go through
+            !
+            WRITE(*,*) 'lbc_nfd_nogather_generic: You should not have seen this print! error?', npolj
+            !
+         END SELECT     !  npolj
+         !
+      END DO            ! End jf loop
+   END SUBROUTINE ROUTINE_NFD
+#undef ARRAY_TYPE
+#undef ARRAY_IN
+#undef NAT_IN
+#undef SGN_IN
+#undef J_SIZE
+#undef K_SIZE
+#undef L_SIZE
+#undef F_SIZE
+#undef ARRAY2_TYPE
+#undef ARRAY2_IN
Index: /utils/tools_ticket2413/DOMAINcfg/src/lbclnk.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/lbclnk.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/lbclnk.F90	(revision 12863)
@@ -0,0 +1,284 @@
+MODULE lbclnk
+   !!======================================================================
+   !!                       ***  MODULE  lbclnk  ***
+   !! NEMO        : lateral boundary conditions
+   !!=====================================================================
+   !! History :  OPA  ! 1997-06  (G. Madec)  Original code
+   !!   NEMO     1.0  ! 2002-09  (G. Madec)  F90: Free form and module
+   !!            3.2  ! 2009-03  (R. Benshila)  External north fold treatment  
+   !!            3.5  ! 2012     (S.Mocavero, I. Epicoco)  optimization of BDY comm. via lbc_bdy_lnk and lbc_obc_lnk
+   !!            3.4  ! 2012-12  (R. Bourdalle-Badie, G. Reffray)  add a C1D case  
+   !!            3.6  ! 2015-06  (O. Tintó and M. Castrillo)  add lbc_lnk_multi  
+   !!            4.0  ! 2017-03  (G. Madec) automatique allocation of array size (use with any 3rd dim size)
+   !!             -   ! 2017-04  (G. Madec) remove duplicated routines (lbc_lnk_2d_9, lbc_lnk_2d_multiple, lbc_lnk_3d_gather)
+   !!             -   ! 2017-05  (G. Madec) create generic.h90 files to generate all lbc and north fold routines
+   !!----------------------------------------------------------------------
+#if defined key_mpp_mpi
+   !!----------------------------------------------------------------------
+   !!   'key_mpp_mpi'             MPI massively parallel processing library
+   !!----------------------------------------------------------------------
+   !!           define the generic interfaces of lib_mpp routines
+   !!----------------------------------------------------------------------
+   !!   lbc_lnk       : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp
+   !!   lbc_bdy_lnk   : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean dynamics and tracers   
+   USE lib_mpp        ! distributed memory computing library
+   USE lbcnfd         ! north fold
+
+   INTERFACE lbc_lnk
+      MODULE PROCEDURE   mpp_lnk_2d      , mpp_lnk_3d      , mpp_lnk_4d
+   END INTERFACE
+   INTERFACE lbc_lnk_ptr
+      MODULE PROCEDURE   mpp_lnk_2d_ptr  , mpp_lnk_3d_ptr  , mpp_lnk_4d_ptr
+   END INTERFACE
+   INTERFACE lbc_lnk_multi
+      MODULE PROCEDURE   lbc_lnk_2d_multi, lbc_lnk_3d_multi, lbc_lnk_4d_multi
+   END INTERFACE
+   !
+   INTERFACE lbc_bdy_lnk
+      MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d, mpp_lnk_bdy_4d
+   END INTERFACE
+   !
+   INTERFACE lbc_lnk_icb
+      MODULE PROCEDURE mpp_lnk_2d_icb
+   END INTERFACE
+
+   PUBLIC   lbc_lnk       ! ocean/ice lateral boundary conditions
+   PUBLIC   lbc_lnk_multi ! modified ocean/ice lateral boundary conditions
+   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
+   PUBLIC   lbc_lnk_icb   ! iceberg lateral boundary conditions
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: lbclnk.F90 10425 2018-12-19 21:54:16Z smasson $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                              shared memory computing
+   !!----------------------------------------------------------------------
+   !!                routines setting the appropriate values
+   !!         on first and last row and column of the global domain
+   !!----------------------------------------------------------------------
+   !!   lbc_lnk_sum_3d: compute sum over the halos on a 3D variable on ocean mesh
+   !!   lbc_lnk_sum_3d: compute sum over the halos on a 2D variable on ocean mesh
+   !!   lbc_lnk       : generic interface for lbc_lnk_3d and lbc_lnk_2d
+   !!   lbc_lnk_3d    : set the lateral boundary condition on a 3D variable on ocean mesh
+   !!   lbc_lnk_2d    : set the lateral boundary condition on a 2D variable on ocean mesh
+   !!   lbc_bdy_lnk   : set the lateral BDY boundary condition
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain 
+   USE in_out_manager ! I/O manager
+   USE lbcnfd         ! north fold
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTERFACE lbc_lnk
+      MODULE PROCEDURE   lbc_lnk_2d      , lbc_lnk_3d      , lbc_lnk_4d
+   END INTERFACE
+   INTERFACE lbc_lnk_ptr
+      MODULE PROCEDURE   lbc_lnk_2d_ptr  , lbc_lnk_3d_ptr  , lbc_lnk_4d_ptr
+   END INTERFACE
+   INTERFACE lbc_lnk_multi
+      MODULE PROCEDURE   lbc_lnk_2d_multi, lbc_lnk_3d_multi, lbc_lnk_4d_multi
+   END INTERFACE
+   !
+   INTERFACE lbc_bdy_lnk
+      MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d, lbc_bdy_lnk_4d
+   END INTERFACE
+   !
+   INTERFACE lbc_lnk_icb
+      MODULE PROCEDURE lbc_lnk_2d_icb
+   END INTERFACE
+   
+   PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions
+   PUBLIC   lbc_lnk_multi ! modified ocean/ice lateral boundary conditions
+   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
+   PUBLIC   lbc_lnk_icb   ! iceberg lateral boundary conditions
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: lbclnk.F90 10425 2018-12-19 21:54:16Z smasson $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   !!======================================================================
+   !!   Default option                           3D shared memory computing
+   !!======================================================================
+   !!          routines setting land point, or east-west cyclic,
+   !!             or north-south cyclic, or north fold values
+   !!         on first and last row and column of the global domain
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!                   ***  routine lbc_lnk_(2,3,4)d  ***
+   !!
+   !!   * Argument : dummy argument use in lbc_lnk_... routines
+   !!                ptab   :   array or pointer of arrays on which the boundary condition is applied
+   !!                cd_nat :   nature of array grid-points
+   !!                psgn   :   sign used across the north fold boundary
+   !!                kfld   :   optional, number of pt3d arrays
+   !!                cd_mpp :   optional, fill the overlap area only
+   !!                pval   :   optional, background value (used at closed boundaries)
+   !!----------------------------------------------------------------------
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+#  define DIM_2d
+#     define ROUTINE_LNK           lbc_lnk_2d
+#     include "lbc_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           lbc_lnk_2d_ptr
+#     include "lbc_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     undef MULTI
+#  undef DIM_2d
+   !
+   !                       !==  3D array and array of 3D pointer  ==!
+   !
+#  define DIM_3d
+#     define ROUTINE_LNK           lbc_lnk_3d
+#     include "lbc_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           lbc_lnk_3d_ptr
+#     include "lbc_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     undef MULTI
+#  undef DIM_3d
+   !
+   !                       !==  4D array and array of 4D pointer  ==!
+   !
+#  define DIM_4d
+#     define ROUTINE_LNK           lbc_lnk_4d
+#     include "lbc_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           lbc_lnk_4d_ptr
+#     include "lbc_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     undef MULTI
+#  undef DIM_4d
+   
+   !!======================================================================
+   !!   identical routines in both C1D and shared memory computing
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!                   ***  routine lbc_bdy_lnk_(2,3,4)d  ***
+   !!
+   !!   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
+   !!   to maintain the same interface with regards to the mpp case
+   !!----------------------------------------------------------------------
+   
+   SUBROUTINE lbc_bdy_lnk_4d( cdname, pt4d, cd_type, psgn, ib_bdy )
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*)          , INTENT(in   ) ::   cdname      ! name of the calling subroutine
+      REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) ::   pt4d      ! 3D array on which the lbc is applied
+      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp)                  , INTENT(in   ) ::   psgn      ! sign used across north fold 
+      INTEGER                   , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
+      !!----------------------------------------------------------------------
+      CALL lbc_lnk_4d( cdname, pt4d, cd_type, psgn)
+   END SUBROUTINE lbc_bdy_lnk_4d
+
+   SUBROUTINE lbc_bdy_lnk_3d( cdname, pt3d, cd_type, psgn, ib_bdy )
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*)          , INTENT(in   ) ::   cdname      ! name of the calling subroutine
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3d      ! 3D array on which the lbc is applied
+      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp)                  , INTENT(in   ) ::   psgn      ! sign used across north fold 
+      INTEGER                   , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
+      !!----------------------------------------------------------------------
+      CALL lbc_lnk_3d( cdname, pt3d, cd_type, psgn)
+   END SUBROUTINE lbc_bdy_lnk_3d
+
+
+   SUBROUTINE lbc_bdy_lnk_2d( cdname, pt2d, cd_type, psgn, ib_bdy )
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*)        , INTENT(in   ) ::   cdname      ! name of the calling subroutine
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 3D array on which the lbc is applied
+      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp)                , INTENT(in   ) ::   psgn      ! sign used across north fold 
+      INTEGER                 , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
+      !!----------------------------------------------------------------------
+      CALL lbc_lnk_2d( cdname, pt2d, cd_type, psgn)
+   END SUBROUTINE lbc_bdy_lnk_2d
+
+
+!!gm  This routine should be removed with an optional halos size added in argument of generic routines
+
+   SUBROUTINE lbc_lnk_2d_icb( cdname, pt2d, cd_type, psgn, ki, kj )
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*)        , INTENT(in   ) ::   cdname      ! name of the calling subroutine
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 2D array on which the lbc is applied
+      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp)                , INTENT(in   ) ::   psgn      ! sign used across north fold 
+      INTEGER                 , INTENT(in   ) ::   ki, kj    ! sizes of extra halo (not needed in non-mpp)
+      !!----------------------------------------------------------------------
+      CALL lbc_lnk_2d( cdname, pt2d, cd_type, psgn )
+   END SUBROUTINE lbc_lnk_2d_icb
+!!gm end
+
+#endif
+
+   !!======================================================================
+   !!   identical routines in both distributed and shared memory computing
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!                   ***   load_ptr_(2,3,4)d   ***
+   !!
+   !!   * Dummy Argument :
+   !!       in    ==>   ptab       ! array to be loaded (2D, 3D or 4D)
+   !!                   cd_nat     ! nature of pt2d array grid-points
+   !!                   psgn       ! sign used across the north fold boundary
+   !!       inout <=>   ptab_ptr   ! array of 2D, 3D or 4D pointers
+   !!                   cdna_ptr   ! nature of ptab array grid-points
+   !!                   psgn_ptr   ! sign used across the north fold boundary
+   !!                   kfld       ! number of elements that has been attributed
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!                  ***   lbc_lnk_(2,3,4)d_multi   ***
+   !!                     ***   load_ptr_(2,3,4)d   ***
+   !!
+   !!   * Argument : dummy argument use in lbc_lnk_multi_... routines
+   !!
+   !!----------------------------------------------------------------------
+
+#  define DIM_2d
+#     define ROUTINE_MULTI          lbc_lnk_2d_multi
+#     define ROUTINE_LOAD           load_ptr_2d
+#     include "lbc_lnk_multi_generic.h90"
+#     undef ROUTINE_MULTI
+#     undef ROUTINE_LOAD
+#  undef DIM_2d
+
+
+#  define DIM_3d
+#     define ROUTINE_MULTI          lbc_lnk_3d_multi
+#     define ROUTINE_LOAD           load_ptr_3d
+#     include "lbc_lnk_multi_generic.h90"
+#     undef ROUTINE_MULTI
+#     undef ROUTINE_LOAD
+#  undef DIM_3d
+
+
+#  define DIM_4d
+#     define ROUTINE_MULTI          lbc_lnk_4d_multi
+#     define ROUTINE_LOAD           load_ptr_4d
+#     include "lbc_lnk_multi_generic.h90"
+#     undef ROUTINE_MULTI
+#     undef ROUTINE_LOAD
+#  undef DIM_4d
+
+   !!======================================================================
+END MODULE lbclnk
+
Index: /utils/tools_ticket2413/DOMAINcfg/src/lbcnfd.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/lbcnfd.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/lbcnfd.F90	(revision 12863)
@@ -0,0 +1,168 @@
+MODULE lbcnfd
+   !!======================================================================
+   !!                       ***  MODULE  lbcnfd  ***
+   !! Ocean        : north fold  boundary conditions
+   !!======================================================================
+   !! History :  3.2  ! 2009-03  (R. Benshila)  Original code 
+   !!            3.5  ! 2013-07  (I. Epicoco, S. Mocavero - CMCC) MPP optimization
+   !!            4.0  ! 2017-04  (G. Madec) automatique allocation of array argument (use any 3rd dimension)
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   lbc_nfd       : generic interface for lbc_nfd_3d and lbc_nfd_2d routines
+   !!   lbc_nfd_3d    : lateral boundary condition: North fold treatment for a 3D arrays   (lbc_nfd)
+   !!   lbc_nfd_2d    : lateral boundary condition: North fold treatment for a 2D arrays   (lbc_nfd)
+   !!   lbc_nfd_nogather       : generic interface for lbc_nfd_nogather_3d and 
+   !!                            lbc_nfd_nogather_2d routines (designed for use
+   !!                            with ln_nnogather to avoid global width arrays
+   !!                            mpi all gather operations)
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain 
+   USE in_out_manager ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTERFACE lbc_nfd
+      MODULE PROCEDURE   lbc_nfd_2d    , lbc_nfd_3d    , lbc_nfd_4d
+      MODULE PROCEDURE   lbc_nfd_2d_ptr, lbc_nfd_3d_ptr, lbc_nfd_4d_ptr
+      MODULE PROCEDURE   lbc_nfd_2d_ext
+   END INTERFACE
+   !
+   INTERFACE lbc_nfd_nogather
+!                        ! Currently only 4d array version is needed
+     MODULE PROCEDURE   lbc_nfd_nogather_2d    , lbc_nfd_nogather_3d
+     MODULE PROCEDURE   lbc_nfd_nogather_4d
+     MODULE PROCEDURE   lbc_nfd_nogather_2d_ptr, lbc_nfd_nogather_3d_ptr
+!     MODULE PROCEDURE   lbc_nfd_nogather_4d_ptr
+   END INTERFACE
+
+   TYPE, PUBLIC ::   PTR_2D   !: array of 2D pointers (also used in lib_mpp)
+      REAL(wp), DIMENSION (:,:)    , POINTER ::   pt2d
+   END TYPE PTR_2D
+   TYPE, PUBLIC ::   PTR_3D   !: array of 3D pointers (also used in lib_mpp)
+      REAL(wp), DIMENSION (:,:,:)  , POINTER ::   pt3d
+   END TYPE PTR_3D
+   TYPE, PUBLIC ::   PTR_4D   !: array of 4D pointers (also used in lib_mpp)
+      REAL(wp), DIMENSION (:,:,:,:), POINTER ::   pt4d
+   END TYPE PTR_4D
+
+   PUBLIC   lbc_nfd            ! north fold conditions
+   PUBLIC   lbc_nfd_nogather   ! north fold conditions (no allgather case)
+
+   INTEGER, PUBLIC, PARAMETER            ::   jpmaxngh = 3               !:
+   INTEGER, PUBLIC                       ::   nsndto, nfsloop, nfeloop   !:
+   INTEGER, PUBLIC, DIMENSION (jpmaxngh) ::   isendto                    !: processes to which communicate
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: lbcnfd.F90 10425 2018-12-19 21:54:16Z smasson $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   !!----------------------------------------------------------------------
+   !!                   ***  routine lbc_nfd_(2,3,4)d  ***
+   !!----------------------------------------------------------------------
+   !!
+   !! ** Purpose :   lateral boundary condition 
+   !!                North fold treatment without processor exchanges. 
+   !!
+   !! ** Method  :   
+   !!
+   !! ** Action  :   ptab with updated values along the north fold
+   !!----------------------------------------------------------------------
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+#  define DIM_2d
+#     define ROUTINE_NFD           lbc_nfd_2d
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           lbc_nfd_2d_ptr
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_2d
+   !
+   !                       !==  2D array with extra haloes  ==!
+   !
+#  define DIM_2d
+#     define ROUTINE_NFD           lbc_nfd_2d_ext
+#     include "lbc_nfd_ext_generic.h90"
+#     undef ROUTINE_NFD
+#  undef DIM_2d
+   !
+   !                       !==  3D array and array of 3D pointer  ==!
+   !
+#  define DIM_3d
+#     define ROUTINE_NFD           lbc_nfd_3d
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           lbc_nfd_3d_ptr
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_3d
+   !
+   !                       !==  4D array and array of 4D pointer  ==!
+   !
+#  define DIM_4d
+#     define ROUTINE_NFD           lbc_nfd_4d
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           lbc_nfd_4d_ptr
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_4d
+   !
+   !  lbc_nfd_nogather routines
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+#  define DIM_2d
+#     define ROUTINE_NFD           lbc_nfd_nogather_2d
+#     include "lbc_nfd_nogather_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           lbc_nfd_nogather_2d_ptr
+#     include "lbc_nfd_nogather_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_2d
+   !
+   !                       !==  3D array and array of 3D pointer  ==!
+   !
+#  define DIM_3d
+#     define ROUTINE_NFD           lbc_nfd_nogather_3d
+#     include "lbc_nfd_nogather_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           lbc_nfd_nogather_3d_ptr
+#     include "lbc_nfd_nogather_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_3d
+   !
+   !                       !==  4D array and array of 4D pointer  ==!
+   !
+#  define DIM_4d
+#     define ROUTINE_NFD           lbc_nfd_nogather_4d
+#     include "lbc_nfd_nogather_generic.h90"
+#     undef ROUTINE_NFD
+!#     define MULTI
+!#     define ROUTINE_NFD           lbc_nfd_nogather_4d_ptr
+!#     include "lbc_nfd_nogather_generic.h90"
+!#     undef ROUTINE_NFD
+!#     undef MULTI
+#  undef DIM_4d
+
+   !!----------------------------------------------------------------------
+
+
+   !!======================================================================
+END MODULE lbcnfd
Index: /utils/tools_ticket2413/DOMAINcfg/src/lib_fortran.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/lib_fortran.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/lib_fortran.F90	(revision 12863)
@@ -0,0 +1,489 @@
+MODULE lib_fortran
+   !!======================================================================
+   !!                       ***  MODULE  lib_fortran  ***
+   !! Fortran utilities:  includes some low levels fortran functionality
+   !!======================================================================
+   !! History :  3.2  !  2010-05  (M. Dunphy, R. Benshila)  Original code
+   !!            3.4  !  2013-06  (C. Rousset)  add glob_min, glob_max 
+   !!                                           + 3d dim. of input is fexible (jpk, jpl...) 
+   !!            4.0  !  2016-06  (T. Lovato)  double precision global sum by default 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   glob_sum    : generic interface for global masked summation over
+   !!                 the interior domain for 1 or 2 2D or 3D arrays
+   !!                 it works only for T points
+   !!   SIGN        : generic interface for SIGN to overwrite f95 behaviour
+   !!                 of intrinsinc sign function
+   !!----------------------------------------------------------------------
+   USE par_oce         ! Ocean parameter
+   USE dom_oce         ! ocean domain
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distributed memory computing
+   USE lbclnk          ! ocean lateral boundary conditions
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   glob_sum      ! used in many places (masked with tmask_i)
+   PUBLIC   glob_sum_full ! used in many places (masked with tmask_h, ie only over the halos)
+   PUBLIC   local_sum     ! used in trcrad, local operation before glob_sum_delay
+   PUBLIC   sum3x3        ! used in trcrad, do a sum over 3x3 boxes
+   PUBLIC   DDPDD         ! also used in closea module
+   PUBLIC   glob_min, glob_max
+#if defined key_nosignedzero
+   PUBLIC SIGN
+#endif
+
+   INTERFACE glob_sum
+      MODULE PROCEDURE glob_sum_1d, glob_sum_2d, glob_sum_3d
+   END INTERFACE
+   INTERFACE glob_sum_full
+      MODULE PROCEDURE glob_sum_full_2d, glob_sum_full_3d
+   END INTERFACE
+   INTERFACE local_sum
+      MODULE PROCEDURE local_sum_2d, local_sum_3d
+   END INTERFACE
+   INTERFACE sum3x3
+      MODULE PROCEDURE sum3x3_2d, sum3x3_3d
+   END INTERFACE
+   INTERFACE glob_min
+      MODULE PROCEDURE glob_min_2d, glob_min_3d
+   END INTERFACE
+   INTERFACE glob_max
+      MODULE PROCEDURE glob_max_2d, glob_max_3d
+   END INTERFACE
+
+#if defined key_nosignedzero
+   INTERFACE SIGN
+      MODULE PROCEDURE SIGN_SCALAR, SIGN_ARRAY_1D, SIGN_ARRAY_2D, SIGN_ARRAY_3D,   &
+         &             SIGN_ARRAY_1D_A, SIGN_ARRAY_2D_A, SIGN_ARRAY_3D_A,          &
+         &             SIGN_ARRAY_1D_B, SIGN_ARRAY_2D_B, SIGN_ARRAY_3D_B
+   END INTERFACE
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: lib_fortran.F90 10425 2018-12-19 21:54:16Z smasson $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+#  define GLOBSUM_CODE
+
+#     define DIM_1d
+#     define FUNCTION_GLOBSUM           glob_sum_1d
+#     include "lib_fortran_generic.h90"
+#     undef FUNCTION_GLOBSUM
+#     undef DIM_1d
+
+#     define DIM_2d
+#     define OPERATION_GLOBSUM
+#     define FUNCTION_GLOBSUM           glob_sum_2d
+#     include "lib_fortran_generic.h90"
+#     undef FUNCTION_GLOBSUM
+#     undef OPERATION_GLOBSUM
+#     define OPERATION_FULL_GLOBSUM
+#     define FUNCTION_GLOBSUM           glob_sum_full_2d
+#     include "lib_fortran_generic.h90"
+#     undef FUNCTION_GLOBSUM
+#     undef OPERATION_FULL_GLOBSUM
+#     undef DIM_2d
+
+#     define DIM_3d
+#     define OPERATION_GLOBSUM
+#     define FUNCTION_GLOBSUM           glob_sum_3d
+#     include "lib_fortran_generic.h90"
+#     undef FUNCTION_GLOBSUM
+#     undef OPERATION_GLOBSUM
+#     define OPERATION_FULL_GLOBSUM
+#     define FUNCTION_GLOBSUM           glob_sum_full_3d
+#     include "lib_fortran_generic.h90"
+#     undef FUNCTION_GLOBSUM
+#     undef OPERATION_FULL_GLOBSUM
+#     undef DIM_3d
+
+#  undef GLOBSUM_CODE
+
+
+#  define GLOBMINMAX_CODE
+
+#     define DIM_2d
+#     define OPERATION_GLOBMIN
+#     define FUNCTION_GLOBMINMAX           glob_min_2d
+#     include "lib_fortran_generic.h90"
+#     undef FUNCTION_GLOBMINMAX
+#     undef OPERATION_GLOBMIN
+#     define OPERATION_GLOBMAX
+#     define FUNCTION_GLOBMINMAX           glob_max_2d
+#     include "lib_fortran_generic.h90"
+#     undef FUNCTION_GLOBMINMAX
+#     undef OPERATION_GLOBMAX
+#     undef DIM_2d
+
+#     define DIM_3d
+#     define OPERATION_GLOBMIN
+#     define FUNCTION_GLOBMINMAX           glob_min_3d
+#     include "lib_fortran_generic.h90"
+#     undef FUNCTION_GLOBMINMAX
+#     undef OPERATION_GLOBMIN
+#     define OPERATION_GLOBMAX
+#     define FUNCTION_GLOBMINMAX           glob_max_3d
+#     include "lib_fortran_generic.h90"
+#     undef FUNCTION_GLOBMINMAX
+#     undef OPERATION_GLOBMAX
+#     undef DIM_3d
+#  undef GLOBMINMAX_CODE
+
+!                          ! FUNCTION local_sum !
+
+   FUNCTION local_sum_2d( ptab )
+      !!----------------------------------------------------------------------
+      REAL(wp),  INTENT(in   ) ::   ptab(:,:) ! array on which operation is applied
+      COMPLEX(wp)              ::  local_sum_2d
+      !
+      !!-----------------------------------------------------------------------
+      !
+      COMPLEX(wp)::   ctmp
+      REAL(wp)   ::   ztmp
+      INTEGER    ::   ji, jj    ! dummy loop indices
+      INTEGER    ::   ipi, ipj  ! dimensions
+      !!-----------------------------------------------------------------------
+      !
+      ipi = SIZE(ptab,1)   ! 1st dimension
+      ipj = SIZE(ptab,2)   ! 2nd dimension
+      !
+      ctmp = CMPLX( 0.e0, 0.e0, wp )   ! warning ctmp is cumulated
+
+      DO jj = 1, ipj
+         DO ji = 1, ipi
+            ztmp =  ptab(ji,jj) * tmask_i(ji,jj)
+            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+         END DO
+      END DO
+      !
+      local_sum_2d = ctmp
+       
+   END FUNCTION local_sum_2d
+
+   FUNCTION local_sum_3d( ptab )
+      !!----------------------------------------------------------------------
+      REAL(wp),  INTENT(in   ) ::   ptab(:,:,:) ! array on which operation is applied
+      COMPLEX(wp)              ::  local_sum_3d
+      !
+      !!-----------------------------------------------------------------------
+      !
+      COMPLEX(wp)::   ctmp
+      REAL(wp)   ::   ztmp
+      INTEGER    ::   ji, jj, jk   ! dummy loop indices
+      INTEGER    ::   ipi, ipj, ipk    ! dimensions
+      !!-----------------------------------------------------------------------
+      !
+      ipi = SIZE(ptab,1)   ! 1st dimension
+      ipj = SIZE(ptab,2)   ! 2nd dimension
+      ipk = SIZE(ptab,3)   ! 3rd dimension
+      !
+      ctmp = CMPLX( 0.e0, 0.e0, wp )   ! warning ctmp is cumulated
+
+      DO jk = 1, ipk
+        DO jj = 1, ipj
+          DO ji = 1, ipi
+             ztmp =  ptab(ji,jj,jk) * tmask_i(ji,jj)
+             CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+          END DO
+        END DO
+      END DO
+      !
+      local_sum_3d = ctmp
+       
+   END FUNCTION local_sum_3d
+
+!                          ! FUNCTION sum3x3 !
+
+   SUBROUTINE sum3x3_2d( p2d )
+      !!-----------------------------------------------------------------------
+      !!                  ***  routine sum3x3_2d  ***
+      !!
+      !! ** Purpose : sum over 3x3 boxes
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION (:,:), INTENT(inout) ::   p2d
+      !
+      INTEGER ::   ji, ji2, jj, jj2     ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      IF( SIZE(p2d,1) /= jpi ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_2d, the first dimension is not equal to jpi' ) 
+      IF( SIZE(p2d,2) /= jpj ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_2d, the second dimension is not equal to jpj' ) 
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi 
+            IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN   ! bottom left corber of a 3x3 box
+               ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1                  ! right position of the box
+               jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1                  ! upper position of the box
+               IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN                    ! the box is fully included in the local mpi domain
+                  p2d(ji:ji2,jj:jj2) = SUM(p2d(ji:ji2,jj:jj2))
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1. )
+      IF( nbondi /= -1 ) THEN
+         IF( MOD(mig(    1), 3) == 1 )   p2d(    1,:) = p2d(    2,:)
+         IF( MOD(mig(    1), 3) == 2 )   p2d(    2,:) = p2d(    1,:)
+      ENDIF
+      IF( nbondi /=  1 ) THEN
+         IF( MOD(mig(jpi-2), 3) == 1 )   p2d(  jpi,:) = p2d(jpi-1,:)
+         IF( MOD(mig(jpi-2), 3) == 0 )   p2d(jpi-1,:) = p2d(  jpi,:)
+      ENDIF
+      IF( nbondj /= -1 ) THEN
+         IF( MOD(mjg(    1), 3) == 1 )   p2d(:,    1) = p2d(:,    2)
+         IF( MOD(mjg(    1), 3) == 2 )   p2d(:,    2) = p2d(:,    1)
+      ENDIF
+      IF( nbondj /=  1 ) THEN
+         IF( MOD(mjg(jpj-2), 3) == 1 )   p2d(:,  jpj) = p2d(:,jpj-1)
+         IF( MOD(mjg(jpj-2), 3) == 0 )   p2d(:,jpj-1) = p2d(:,  jpj)
+      ENDIF
+      CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1. )
+
+   END SUBROUTINE sum3x3_2d
+
+   SUBROUTINE sum3x3_3d( p3d )
+      !!-----------------------------------------------------------------------
+      !!                  ***  routine sum3x3_3d  ***
+      !!
+      !! ** Purpose : sum over 3x3 boxes
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION (:,:,:), INTENT(inout) ::   p3d
+      !
+      INTEGER ::   ji, ji2, jj, jj2, jn     ! dummy loop indices
+      INTEGER ::   ipn                      ! Third dimension size
+      !!----------------------------------------------------------------------
+      !
+      IF( SIZE(p3d,1) /= jpi ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_3d, the first dimension is not equal to jpi' ) 
+      IF( SIZE(p3d,2) /= jpj ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_3d, the second dimension is not equal to jpj' ) 
+      ipn = SIZE(p3d,3)
+      !
+      DO jn = 1, ipn
+         DO jj = 1, jpj
+            DO ji = 1, jpi 
+               IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN   ! bottom left corber of a 3x3 box
+                  ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1                  ! right position of the box
+                  jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1                  ! upper position of the box
+                  IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN                    ! the box is fully included in the local mpi domain
+                     p3d(ji:ji2,jj:jj2,jn) = SUM(p3d(ji:ji2,jj:jj2,jn))
+                  ENDIF
+               ENDIF
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1. )
+      IF( nbondi /= -1 ) THEN
+         IF( MOD(mig(    1), 3) == 1 )   p3d(    1,:,:) = p3d(    2,:,:)
+         IF( MOD(mig(    1), 3) == 2 )   p3d(    2,:,:) = p3d(    1,:,:)
+      ENDIF
+      IF( nbondi /=  1 ) THEN
+         IF( MOD(mig(jpi-2), 3) == 1 )   p3d(  jpi,:,:) = p3d(jpi-1,:,:)
+         IF( MOD(mig(jpi-2), 3) == 0 )   p3d(jpi-1,:,:) = p3d(  jpi,:,:)
+      ENDIF
+      IF( nbondj /= -1 ) THEN
+         IF( MOD(mjg(    1), 3) == 1 )   p3d(:,    1,:) = p3d(:,    2,:)
+         IF( MOD(mjg(    1), 3) == 2 )   p3d(:,    2,:) = p3d(:,    1,:)
+      ENDIF
+      IF( nbondj /=  1 ) THEN
+         IF( MOD(mjg(jpj-2), 3) == 1 )   p3d(:,  jpj,:) = p3d(:,jpj-1,:)
+         IF( MOD(mjg(jpj-2), 3) == 0 )   p3d(:,jpj-1,:) = p3d(:,  jpj,:)
+      ENDIF
+      CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1. )
+
+   END SUBROUTINE sum3x3_3d
+
+
+   SUBROUTINE DDPDD( ydda, yddb )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE DDPDD ***
+      !!
+      !! ** Purpose : Add a scalar element to a sum
+      !!
+      !!
+      !! ** Method  : The code uses the compensated summation with doublet
+      !!              (sum,error) emulated useing complex numbers. ydda is the
+      !!               scalar to add to the summ yddb
+      !!
+      !! ** Action  : This does only work for MPI.
+      !!
+      !! References : Using Acurate Arithmetics to Improve Numerical
+      !!              Reproducibility and Sability in Parallel Applications
+      !!              Yun HE and Chris H. Q. DING, Journal of Supercomputing 18, 259-277, 2001
+      !!----------------------------------------------------------------------
+      COMPLEX(wp), INTENT(in   ) ::   ydda
+      COMPLEX(wp), INTENT(inout) ::   yddb
+      !
+      REAL(wp) :: zerr, zt1, zt2  ! local work variables
+      !!-----------------------------------------------------------------------
+      !
+      ! Compute ydda + yddb using Knuth's trick.
+      zt1  = REAL(ydda) + REAL(yddb)
+      zerr = zt1 - REAL(ydda)
+      zt2  = ( (REAL(yddb) - zerr) + (REAL(ydda) - (zt1 - zerr)) )   &
+         &   + AIMAG(ydda)         + AIMAG(yddb)
+      !
+      ! The result is t1 + t2, after normalization.
+      yddb = CMPLX( zt1 + zt2, zt2 - ((zt1 + zt2) - zt1), wp )
+      !
+   END SUBROUTINE DDPDD
+
+#if defined key_nosignedzero
+   !!----------------------------------------------------------------------
+   !!   'key_nosignedzero'                                         F90 SIGN
+   !!----------------------------------------------------------------------
+
+   FUNCTION SIGN_SCALAR( pa, pb )
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_SCALAR  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa,pb          ! input
+      REAL(wp) :: SIGN_SCALAR    ! result
+      !!-----------------------------------------------------------------------
+      IF ( pb >= 0.e0) THEN   ;   SIGN_SCALAR = ABS(pa)
+      ELSE                    ;   SIGN_SCALAR =-ABS(pa)
+      ENDIF
+   END FUNCTION SIGN_SCALAR
+
+
+   FUNCTION SIGN_ARRAY_1D( pa, pb )
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_1D  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa,pb(:)                   ! input
+      REAL(wp) :: SIGN_ARRAY_1D(SIZE(pb,1))  ! result
+      !!-----------------------------------------------------------------------
+      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_1D = ABS(pa)
+      ELSEWHERE              ;   SIGN_ARRAY_1D =-ABS(pa)
+      END WHERE
+   END FUNCTION SIGN_ARRAY_1D
+
+
+   FUNCTION SIGN_ARRAY_2D(pa,pb)
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_2D  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa,pb(:,:)      ! input
+      REAL(wp) :: SIGN_ARRAY_2D(SIZE(pb,1),SIZE(pb,2))  ! result
+      !!-----------------------------------------------------------------------
+      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_2D = ABS(pa)
+      ELSEWHERE              ;   SIGN_ARRAY_2D =-ABS(pa)
+      END WHERE
+   END FUNCTION SIGN_ARRAY_2D
+
+   FUNCTION SIGN_ARRAY_3D(pa,pb)
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_3D  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa,pb(:,:,:)      ! input
+      REAL(wp) :: SIGN_ARRAY_3D(SIZE(pb,1),SIZE(pb,2),SIZE(pb,3))  ! result
+      !!-----------------------------------------------------------------------
+      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_3D = ABS(pa)
+      ELSEWHERE              ;   SIGN_ARRAY_3D =-ABS(pa)
+      END WHERE
+   END FUNCTION SIGN_ARRAY_3D
+
+
+   FUNCTION SIGN_ARRAY_1D_A(pa,pb)
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_1D_A  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa(:),pb(:)      ! input
+      REAL(wp) :: SIGN_ARRAY_1D_A(SIZE(pb,1))  ! result
+      !!-----------------------------------------------------------------------
+      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_1D_A = ABS(pa)
+      ELSEWHERE              ;   SIGN_ARRAY_1D_A =-ABS(pa)
+      END WHERE
+   END FUNCTION SIGN_ARRAY_1D_A
+
+
+   FUNCTION SIGN_ARRAY_2D_A(pa,pb)
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_2D_A  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa(:,:),pb(:,:)      ! input
+      REAL(wp) :: SIGN_ARRAY_2D_A(SIZE(pb,1),SIZE(pb,2))  ! result
+      !!-----------------------------------------------------------------------
+      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_2D_A = ABS(pa)
+      ELSEWHERE              ;   SIGN_ARRAY_2D_A =-ABS(pa)
+      END WHERE
+   END FUNCTION SIGN_ARRAY_2D_A
+
+
+   FUNCTION SIGN_ARRAY_3D_A(pa,pb)
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_3D_A  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa(:,:,:),pb(:,:,:)  ! input
+      REAL(wp) :: SIGN_ARRAY_3D_A(SIZE(pb,1),SIZE(pb,2),SIZE(pb,3)) ! result
+      !!-----------------------------------------------------------------------
+      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_3D_A = ABS(pa)
+      ELSEWHERE              ;   SIGN_ARRAY_3D_A =-ABS(pa)
+      END WHERE
+   END FUNCTION SIGN_ARRAY_3D_A
+
+
+   FUNCTION SIGN_ARRAY_1D_B(pa,pb)
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_1D_B  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa(:),pb      ! input
+      REAL(wp) :: SIGN_ARRAY_1D_B(SIZE(pa,1))  ! result
+      !!-----------------------------------------------------------------------
+      IF( pb >= 0.e0 ) THEN   ;   SIGN_ARRAY_1D_B = ABS(pa)
+      ELSE                    ;   SIGN_ARRAY_1D_B =-ABS(pa)
+      ENDIF
+   END FUNCTION SIGN_ARRAY_1D_B
+
+
+   FUNCTION SIGN_ARRAY_2D_B(pa,pb)
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_2D_B  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa(:,:),pb      ! input
+      REAL(wp) :: SIGN_ARRAY_2D_B(SIZE(pa,1),SIZE(pa,2))  ! result
+      !!-----------------------------------------------------------------------
+      IF( pb >= 0.e0 ) THEN   ;   SIGN_ARRAY_2D_B = ABS(pa)
+      ELSE                    ;   SIGN_ARRAY_2D_B =-ABS(pa)
+      ENDIF
+   END FUNCTION SIGN_ARRAY_2D_B
+
+
+   FUNCTION SIGN_ARRAY_3D_B(pa,pb)
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_3D_B  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa(:,:,:),pb      ! input
+      REAL(wp) :: SIGN_ARRAY_3D_B(SIZE(pa,1),SIZE(pa,2),SIZE(pa,3))  ! result
+      !!-----------------------------------------------------------------------
+      IF( pb >= 0.e0 ) THEN   ;   SIGN_ARRAY_3D_B = ABS(pa)
+      ELSE                    ;   SIGN_ARRAY_3D_B =-ABS(pa)
+      ENDIF
+   END FUNCTION SIGN_ARRAY_3D_B
+#endif
+
+   !!======================================================================
+END MODULE lib_fortran
Index: /utils/tools_ticket2413/DOMAINcfg/src/lib_fortran_generic.h90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/lib_fortran_generic.h90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/lib_fortran_generic.h90	(revision 12863)
@@ -0,0 +1,139 @@
+#if defined GLOBSUM_CODE
+!                          ! FUNCTION FUNCTION_GLOBSUM !
+#   if defined DIM_1d
+#      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
+#      define ARRAY_IN(i,j,k)   ptab(i)
+#      define ARRAY2_IN(i,j,k)  ptab2(i)
+#      define J_SIZE(ptab)      1
+#      define K_SIZE(ptab)      1
+#      define MASK_ARRAY(i,j)   1.
+#   endif
+#   if defined DIM_2d
+#      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
+#      define ARRAY_IN(i,j,k)   ptab(i,j)
+#      define ARRAY2_IN(i,j,k)  ptab2(i,j)
+#      define J_SIZE(ptab)      SIZE(ptab,2)
+#      define K_SIZE(ptab)      1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
+#      define ARRAY_IN(i,j,k)   ptab(i,j,k)
+#      define ARRAY2_IN(i,j,k)  ptab2(i,j,k)
+#      define J_SIZE(ptab)      SIZE(ptab,2)
+#      define K_SIZE(ptab)      SIZE(ptab,3)
+#   endif
+#   if defined OPERATION_GLOBSUM
+#      define MASK_ARRAY(i,j)   tmask_i(i,j)
+#   endif
+#   if defined OPERATION_FULL_GLOBSUM
+#      define MASK_ARRAY(i,j)   tmask_h(i,j)
+#   endif
+
+   FUNCTION FUNCTION_GLOBSUM( cdname, ptab )
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*),  INTENT(in   ) ::   cdname  ! name of the calling subroutine
+      ARRAY_TYPE(:,:,:)                             ! array on which operation is applied
+      REAL(wp)   ::  FUNCTION_GLOBSUM
+      !
+      !!-----------------------------------------------------------------------
+      !
+      REAL(wp)                              ::   FUNCTION_GLOB_OP   ! global sum
+      !!
+      COMPLEX(wp)::   ctmp
+      REAL(wp)   ::   ztmp
+      INTEGER    ::   ji, jj, jk   ! dummy loop indices
+      INTEGER    ::   ipi, ipj, ipk    ! dimensions
+      !!-----------------------------------------------------------------------
+      !
+      ipi = SIZE(ptab,1)   ! 1st dimension
+      ipj = J_SIZE(ptab)   ! 2nd dimension
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      !
+      ctmp = CMPLX( 0.e0, 0.e0, wp )   ! warning ctmp is cumulated
+   
+      DO jk = 1, ipk
+        DO jj = 1, ipj
+          DO ji = 1, ipi
+             ztmp =  ARRAY_IN(ji,jj,jk) * MASK_ARRAY(ji,jj)
+             CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+          END DO
+        END DO
+      END DO
+      CALL mpp_sum( cdname, ctmp )   ! sum over the global domain
+      FUNCTION_GLOBSUM = REAL(ctmp,wp)
+
+   END FUNCTION FUNCTION_GLOBSUM
+
+#undef ARRAY_TYPE
+#undef ARRAY2_TYPE
+#undef ARRAY_IN
+#undef ARRAY2_IN
+#undef J_SIZE
+#undef K_SIZE
+#undef MASK_ARRAY
+!
+# endif
+#if defined GLOBMINMAX_CODE
+!                          ! FUNCTION FUNCTION_GLOBMINMAX !
+#   if defined DIM_2d
+#      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
+#      define ARRAY_IN(i,j,k)   ptab(i,j)
+#      define ARRAY2_IN(i,j,k)  ptab2(i,j)
+#      define K_SIZE(ptab)      1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_TYPE(i,j,k)    REAL(wp)                 , INTENT(in   ) ::   ARRAY_IN(i,j,k)
+#      define ARRAY_IN(i,j,k)   ptab(i,j,k)
+#      define ARRAY2_IN(i,j,k)  ptab2(i,j,k)
+#      define K_SIZE(ptab)      SIZE(ptab,3)
+#   endif
+#   if defined OPERATION_GLOBMIN
+#      define SCALAR_OPERATION min
+#      define ARRAY_OPERATION minval
+#      define MPP_OPERATION mpp_min
+#   endif
+#   if defined OPERATION_GLOBMAX
+#      define SCALAR_OPERATION max
+#      define ARRAY_OPERATION maxval
+#      define MPP_OPERATION mpp_max
+#   endif
+
+   FUNCTION FUNCTION_GLOBMINMAX( cdname, ptab )
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*),  INTENT(in   ) ::   cdname  ! name of the calling subroutine
+      ARRAY_TYPE(:,:,:)                             ! array on which operation is applied
+      REAL(wp)   ::  FUNCTION_GLOBMINMAX
+      !
+      !!-----------------------------------------------------------------------
+      !
+      REAL(wp)                              ::   FUNCTION_GLOB_OP   ! global sum
+      !!
+      COMPLEX(wp)::   ctmp
+      REAL(wp)   ::   ztmp
+      INTEGER    ::   jk       ! dummy loop indices
+      INTEGER    ::   ipk      ! dimensions
+      !!-----------------------------------------------------------------------
+      !
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      !
+      ztmp = ARRAY_OPERATION( ARRAY_IN(:,:,1)*tmask_i(:,:) )
+      DO jk = 2, ipk
+         ztmp = SCALAR_OPERATION(ztmp, ARRAY_OPERATION( ARRAY_IN(:,:,jk)*tmask_i(:,:) ))
+      ENDDO
+
+      CALL MPP_OPERATION( cdname, ztmp)
+
+      FUNCTION_GLOBMINMAX = ztmp
+
+
+   END FUNCTION FUNCTION_GLOBMINMAX
+
+#undef ARRAY_TYPE
+#undef ARRAY2_TYPE
+#undef ARRAY_IN
+#undef ARRAY2_IN
+#undef K_SIZE
+#undef SCALAR_OPERATION
+#undef ARRAY_OPERATION
+#undef MPP_OPERATION
+# endif
Index: /utils/tools_ticket2413/DOMAINcfg/src/lib_mpp.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/lib_mpp.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/lib_mpp.F90	(revision 12863)
@@ -0,0 +1,2083 @@
+MODULE lib_mpp
+   !!======================================================================
+   !!                       ***  MODULE  lib_mpp  ***
+   !! Ocean numerics:  massively parallel processing library
+   !!=====================================================================
+   !! History :  OPA  !  1994  (M. Guyon, J. Escobar, M. Imbard)  Original code
+   !!            7.0  !  1997  (A.M. Treguier)  SHMEM additions
+   !!            8.0  !  1998  (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI
+   !!                 !  1998  (J.M. Molines) Open boundary conditions
+   !!   NEMO     1.0  !  2003  (J.M. Molines, G. Madec)  F90, free form
+   !!                 !  2003  (J.M. Molines) add mpp_ini_north(_3d,_2d)
+   !!             -   !  2004  (R. Bourdalle Badie)  isend option in mpi
+   !!                 !  2004  (J.M. Molines) minloc, maxloc
+   !!             -   !  2005  (G. Madec, S. Masson)  npolj=5,6 F-point & ice cases
+   !!             -   !  2005  (R. Redler) Replacement of MPI_COMM_WORLD except for MPI_Abort
+   !!             -   !  2005  (R. Benshila, G. Madec)  add extra halo case
+   !!             -   !  2008  (R. Benshila) add mpp_ini_ice
+   !!            3.2  !  2009  (R. Benshila) SHMEM suppression, north fold in lbc_nfd
+   !!            3.2  !  2009  (O. Marti)    add mpp_ini_znl
+   !!            4.0  !  2011  (G. Madec)  move ctl_ routines from in_out_manager
+   !!            3.5  !  2012  (S.Mocavero, I. Epicoco) Add mpp_lnk_bdy_3d/2d routines to optimize the BDY comm.
+   !!            3.5  !  2013  (C. Ethe, G. Madec)  message passing arrays as local variables 
+   !!            3.5  !  2013  (S.Mocavero, I.Epicoco - CMCC) north fold optimizations
+   !!            3.6  !  2015  (O. Tintó and M. Castrillo - BSC) Added '_multiple' case for 2D lbc and max
+   !!            4.0  !  2017  (G. Madec) automatique allocation of array argument (use any 3rd dimension)
+   !!             -   !  2017  (G. Madec) create generic.h90 files to generate all lbc and north fold routines
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   ctl_stop      : update momentum and tracer Kz from a tke scheme
+   !!   ctl_warn      : initialization, namelist read, and parameters control
+   !!   ctl_opn       : Open file and check if required file is available.
+   !!   ctl_nam       : Prints informations when an error occurs while reading a namelist
+   !!   get_unit      : give the index of an unused logical unit
+   !!----------------------------------------------------------------------
+#if   defined key_mpp_mpi
+   !!----------------------------------------------------------------------
+   !!   'key_mpp_mpi'             MPI massively parallel processing library
+   !!----------------------------------------------------------------------
+   !!   lib_mpp_alloc : allocate mpp arrays
+   !!   mynode        : indentify the processor unit
+   !!   mpp_lnk       : interface (defined in lbclnk) for message passing of 2d or 3d arrays (mpp_lnk_2d, mpp_lnk_3d)
+   !!   mpp_lnk_icb   : interface for message passing of 2d arrays with extra halo for icebergs (mpp_lnk_2d_icb)
+   !!   mpprecv       :
+   !!   mppsend       :
+   !!   mppscatter    :
+   !!   mppgather     :
+   !!   mpp_min       : generic interface for mppmin_int , mppmin_a_int , mppmin_real, mppmin_a_real
+   !!   mpp_max       : generic interface for mppmax_int , mppmax_a_int , mppmax_real, mppmax_a_real
+   !!   mpp_sum       : generic interface for mppsum_int , mppsum_a_int , mppsum_real, mppsum_a_real
+   !!   mpp_minloc    :
+   !!   mpp_maxloc    :
+   !!   mppsync       :
+   !!   mppstop       :
+   !!   mpp_ini_north : initialisation of north fold
+   !!   mpp_lbc_north_icb : alternative to mpp_nfd for extra outer halo with icebergs
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE lbcnfd         ! north fold treatment
+   USE in_out_manager ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTERFACE mpp_nfd
+      MODULE PROCEDURE   mpp_nfd_2d    , mpp_nfd_3d    , mpp_nfd_4d
+      MODULE PROCEDURE   mpp_nfd_2d_ptr, mpp_nfd_3d_ptr, mpp_nfd_4d_ptr
+   END INTERFACE
+
+   ! Interface associated to the mpp_lnk_... routines is defined in lbclnk
+   PUBLIC   mpp_lnk_2d    , mpp_lnk_3d    , mpp_lnk_4d
+   PUBLIC   mpp_lnk_2d_ptr, mpp_lnk_3d_ptr, mpp_lnk_4d_ptr
+   !
+!!gm  this should be useless
+   PUBLIC   mpp_nfd_2d    , mpp_nfd_3d    , mpp_nfd_4d
+   PUBLIC   mpp_nfd_2d_ptr, mpp_nfd_3d_ptr, mpp_nfd_4d_ptr
+!!gm end
+   !
+   PUBLIC   ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam
+   PUBLIC   mynode, mppstop, mppsync, mpp_comm_free
+   PUBLIC   mpp_ini_north
+   PUBLIC   mpp_lnk_2d_icb
+   PUBLIC   mpp_lbc_north_icb
+   PUBLIC   mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc
+   PUBLIC   mpp_delay_max, mpp_delay_sum, mpp_delay_rcv
+   PUBLIC   mppscatter, mppgather
+   PUBLIC   mpp_ini_znl
+   PUBLIC   mppsend, mpprecv                          ! needed by TAM and ICB routines
+   PUBLIC   mpp_lnk_bdy_2d, mpp_lnk_bdy_3d, mpp_lnk_bdy_4d
+   
+   !! * Interfaces
+   !! define generic interface for these routine as they are called sometimes
+   !! with scalar arguments instead of array arguments, which causes problems
+   !! for the compilation on AIX system as well as NEC and SGI. Ok on COMPACQ
+   INTERFACE mpp_min
+      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real
+   END INTERFACE
+   INTERFACE mpp_max
+      MODULE PROCEDURE mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real
+   END INTERFACE
+   INTERFACE mpp_sum
+      MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real,   &
+         &             mppsum_realdd, mppsum_a_realdd
+   END INTERFACE
+   INTERFACE mpp_minloc
+      MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d
+   END INTERFACE
+   INTERFACE mpp_maxloc
+      MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
+   END INTERFACE
+
+   !! ========================= !!
+   !!  MPI  variable definition !!
+   !! ========================= !!
+!$AGRIF_DO_NOT_TREAT
+   INCLUDE 'mpif.h'
+!$AGRIF_END_DO_NOT_TREAT
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .TRUE.    !: mpp flag
+
+   INTEGER, PARAMETER         ::   nprocmax = 2**10   ! maximun dimension (required to be a power of 2)
+
+   INTEGER, PUBLIC ::   mppsize        ! number of process
+   INTEGER, PUBLIC ::   mpprank        ! process number  [ 0 - size-1 ]
+!$AGRIF_DO_NOT_TREAT
+   INTEGER, PUBLIC ::   mpi_comm_oce   ! opa local communicator
+!$AGRIF_END_DO_NOT_TREAT
+
+   INTEGER :: MPI_SUMDD
+
+   ! variables used for zonal integration
+   INTEGER, PUBLIC ::   ncomm_znl       !: communicator made by the processors on the same zonal average
+   LOGICAL, PUBLIC ::   l_znl_root      !: True on the 'left'most processor on the same row
+   INTEGER         ::   ngrp_znl        !  group ID for the znl processors
+   INTEGER         ::   ndim_rank_znl   !  number of processors on the same zonal average
+   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_znl  ! dimension ndim_rank_znl, number of the procs into the same znl domain
+
+   ! North fold condition in mpp_mpi with jpni > 1 (PUBLIC for TAM)
+   INTEGER, PUBLIC ::   ngrp_world        !: group ID for the world processors
+   INTEGER, PUBLIC ::   ngrp_opa          !: group ID for the opa processors
+   INTEGER, PUBLIC ::   ngrp_north        !: group ID for the northern processors (to be fold)
+   INTEGER, PUBLIC ::   ncomm_north       !: communicator made by the processors belonging to ngrp_north
+   INTEGER, PUBLIC ::   ndim_rank_north   !: number of 'sea' processor in the northern line (can be /= jpni !)
+   INTEGER, PUBLIC ::   njmppmax          !: value of njmpp for the processors of the northern line
+   INTEGER, PUBLIC ::   north_root        !: number (in the comm_opa) of proc 0 in the northern comm
+   INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_north   !: dimension ndim_rank_north
+
+   ! Type of send : standard, buffered, immediate
+   CHARACTER(len=1), PUBLIC ::   cn_mpi_send        !: type od mpi send/recieve (S=standard, B=bsend, I=isend)
+   LOGICAL         , PUBLIC ::   l_isend = .FALSE.  !: isend use indicator (T if cn_mpi_send='I')
+   INTEGER         , PUBLIC ::   nn_buffer          !: size of the buffer in case of mpi_bsend
+
+   ! Communications summary report
+   CHARACTER(len=400), DIMENSION(:), ALLOCATABLE ::   crname_lbc                   !: names of lbc_lnk calling routines
+   CHARACTER(len=400), DIMENSION(:), ALLOCATABLE ::   crname_glb                   !: names of global comm calling routines
+   CHARACTER(len=400), DIMENSION(:), ALLOCATABLE ::   crname_dlg                   !: names of delayed global comm calling routines
+   INTEGER, PUBLIC                               ::   ncom_stp = 0                 !: copy of time step # istp
+   INTEGER, PUBLIC                               ::   ncom_fsbc = 1                !: copy of sbc time step # nn_fsbc
+   INTEGER, PUBLIC                               ::   ncom_dttrc = 1               !: copy of top time step # nn_dttrc
+   INTEGER, PUBLIC                               ::   ncom_freq                    !: frequency of comm diagnostic
+   INTEGER, PUBLIC , DIMENSION(:,:), ALLOCATABLE ::   ncomm_sequence               !: size of communicated arrays (halos)
+   INTEGER, PARAMETER, PUBLIC                    ::   ncom_rec_max = 3000          !: max number of communication record
+   INTEGER, PUBLIC                               ::   n_sequence_lbc = 0           !: # of communicated arraysvia lbc
+   INTEGER, PUBLIC                               ::   n_sequence_glb = 0           !: # of global communications
+   INTEGER, PUBLIC                               ::   n_sequence_dlg = 0           !: # of delayed global communications
+   INTEGER, PUBLIC                               ::   numcom = -1                  !: logical unit for communicaton report
+   LOGICAL, PUBLIC                               ::   l_full_nf_update = .TRUE.    !: logical for a full (2lines) update of bc at North fold report
+   INTEGER,                    PARAMETER, PUBLIC ::   nbdelay = 2       !: number of delayed operations
+   !: name (used as id) of allreduce-delayed operations
+   ! Warning: we must use the same character length in an array constructor (at least for gcc compiler)
+   CHARACTER(len=32), DIMENSION(nbdelay), PUBLIC ::   c_delaylist = (/ 'cflice', 'fwb   ' /)
+   !: component name where the allreduce-delayed operation is performed
+   CHARACTER(len=3),  DIMENSION(nbdelay), PUBLIC ::   c_delaycpnt = (/ 'ICE'   , 'OCE' /)
+   TYPE, PUBLIC ::   DELAYARR
+      REAL(   wp), POINTER, DIMENSION(:) ::  z1d => NULL()
+      COMPLEX(wp), POINTER, DIMENSION(:) ::  y1d => NULL()
+   END TYPE DELAYARR
+   TYPE( DELAYARR ), DIMENSION(nbdelay), PUBLIC  ::   todelay              
+   INTEGER,          DIMENSION(nbdelay), PUBLIC  ::   ndelayid = -1     !: mpi request id of the delayed operations
+
+   ! timing summary report
+   REAL(wp), DIMENSION(2), PUBLIC ::  waiting_time = 0._wp
+   REAL(wp)              , PUBLIC ::  compute_time = 0._wp, elapsed_time = 0._wp
+   
+   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   tampon   ! buffer in case of bsend
+
+   LOGICAL, PUBLIC ::   ln_nnogather                !: namelist control of northfold comms
+   LOGICAL, PUBLIC ::   l_north_nogather = .FALSE.  !: internal control of northfold comms
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: lib_mpp.F90 10538 2019-01-17 10:41:10Z clem $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   FUNCTION mynode( ldtxt, ldname, kumnam_ref, kumnam_cfg, kumond, kstop, localComm )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mynode  ***
+      !!
+      !! ** Purpose :   Find processor unit
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt        !
+      CHARACTER(len=*)             , INTENT(in   ) ::   ldname       !
+      INTEGER                      , INTENT(in   ) ::   kumnam_ref   ! logical unit for reference namelist
+      INTEGER                      , INTENT(in   ) ::   kumnam_cfg   ! logical unit for configuration namelist
+      INTEGER                      , INTENT(inout) ::   kumond       ! logical unit for namelist output
+      INTEGER                      , INTENT(inout) ::   kstop        ! stop indicator
+      INTEGER         , OPTIONAL   , INTENT(in   ) ::   localComm    !
+      !
+      INTEGER ::   mynode, ierr, code, ji, ii, ios
+      LOGICAL ::   mpi_was_called
+      !
+      NAMELIST/nammpp/ cn_mpi_send, nn_buffer, jpni, jpnj, ln_nnogather
+      !!----------------------------------------------------------------------
+      !
+      ii = 1
+      WRITE(ldtxt(ii),*)                                                                  ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) 'mynode : mpi initialisation'                                    ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '~~~~~~ '                                                        ;   ii = ii + 1
+      !
+      REWIND( kumnam_ref )              ! Namelist nammpp in reference namelist: mpi variables
+      READ  ( kumnam_ref, nammpp, IOSTAT = ios, ERR = 901)
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nammpp in reference namelist', lwp )
+      !
+      REWIND( kumnam_cfg )              ! Namelist nammpp in configuration namelist: mpi variables
+      READ  ( kumnam_cfg, nammpp, IOSTAT = ios, ERR = 902 )
+902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nammpp in configuration namelist', lwp )
+      !
+      !                              ! control print
+      WRITE(ldtxt(ii),*) '   Namelist nammpp'                                             ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      mpi send type          cn_mpi_send = ', cn_mpi_send       ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      size exported buffer   nn_buffer   = ', nn_buffer,' bytes';   ii = ii + 1
+      !
+      IF( jpni < 1 .OR. jpnj < 1  ) THEN
+         WRITE(ldtxt(ii),*) '      jpni and jpnj will be calculated automatically' ;   ii = ii + 1
+      ELSE
+         WRITE(ldtxt(ii),*) '      processor grid extent in i         jpni = ',jpni       ;   ii = ii + 1
+         WRITE(ldtxt(ii),*) '      processor grid extent in j         jpnj = ',jpnj       ;   ii = ii + 1
+      ENDIF
+
+      WRITE(ldtxt(ii),*) '      avoid use of mpi_allgather at the north fold  ln_nnogather = ', ln_nnogather  ; ii = ii + 1
+
+      CALL mpi_initialized ( mpi_was_called, code )
+      IF( code /= MPI_SUCCESS ) THEN
+         DO ji = 1, SIZE(ldtxt)
+            IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+         END DO
+         WRITE(*, cform_err)
+         WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized'
+         CALL mpi_abort( mpi_comm_world, code, ierr )
+      ENDIF
+
+      IF( mpi_was_called ) THEN
+         !
+         SELECT CASE ( cn_mpi_send )
+         CASE ( 'S' )                ! Standard mpi send (blocking)
+            WRITE(ldtxt(ii),*) '           Standard blocking mpi send (send)'             ;   ii = ii + 1
+         CASE ( 'B' )                ! Buffer mpi send (blocking)
+            WRITE(ldtxt(ii),*) '           Buffer blocking mpi send (bsend)'              ;   ii = ii + 1
+            IF( Agrif_Root() )   CALL mpi_init_oce( ldtxt, ii, ierr )
+         CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
+            WRITE(ldtxt(ii),*) '           Immediate non-blocking send (isend)'           ;   ii = ii + 1
+            l_isend = .TRUE.
+         CASE DEFAULT
+            WRITE(ldtxt(ii),cform_err)                                                    ;   ii = ii + 1
+            WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send     ;   ii = ii + 1
+            kstop = kstop + 1
+         END SELECT
+         !
+      ELSEIF ( PRESENT(localComm) .AND. .NOT. mpi_was_called ) THEN
+         WRITE(ldtxt(ii),cform_err)                                                    ;   ii = ii + 1
+         WRITE(ldtxt(ii),*) ' lib_mpp: You cannot provide a local communicator '          ;   ii = ii + 1
+         WRITE(ldtxt(ii),*) '          without calling MPI_Init before ! '                ;   ii = ii + 1
+         kstop = kstop + 1
+      ELSE
+         SELECT CASE ( cn_mpi_send )
+         CASE ( 'S' )                ! Standard mpi send (blocking)
+            WRITE(ldtxt(ii),*) '           Standard blocking mpi send (send)'             ;   ii = ii + 1
+            CALL mpi_init( ierr )
+         CASE ( 'B' )                ! Buffer mpi send (blocking)
+            WRITE(ldtxt(ii),*) '           Buffer blocking mpi send (bsend)'              ;   ii = ii + 1
+            IF( Agrif_Root() )   CALL mpi_init_oce( ldtxt, ii, ierr )
+         CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
+            WRITE(ldtxt(ii),*) '           Immediate non-blocking send (isend)'           ;   ii = ii + 1
+            l_isend = .TRUE.
+            CALL mpi_init( ierr )
+         CASE DEFAULT
+            WRITE(ldtxt(ii),cform_err)                                                    ;   ii = ii + 1
+            WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send     ;   ii = ii + 1
+            kstop = kstop + 1
+         END SELECT
+         !
+      ENDIF
+
+      IF( PRESENT(localComm) ) THEN
+         IF( Agrif_Root() ) THEN
+            mpi_comm_oce = localComm
+         ENDIF
+      ELSE
+         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_oce, code)
+         IF( code /= MPI_SUCCESS ) THEN
+            DO ji = 1, SIZE(ldtxt)
+               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+            END DO
+            WRITE(*, cform_err)
+            WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup'
+            CALL mpi_abort( mpi_comm_world, code, ierr )
+         ENDIF
+      ENDIF
+
+#if defined key_agrif
+      IF( Agrif_Root() ) THEN
+         CALL Agrif_MPI_Init(mpi_comm_oce)
+      ELSE
+         CALL Agrif_MPI_set_grid_comm(mpi_comm_oce)
+      ENDIF
+#endif
+
+      CALL mpi_comm_rank( mpi_comm_oce, mpprank, ierr )
+      CALL mpi_comm_size( mpi_comm_oce, mppsize, ierr )
+      mynode = mpprank
+
+      IF( mynode == 0 ) THEN
+         CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 )
+         WRITE(kumond, nammpp)      
+      ENDIF
+      !
+      CALL MPI_OP_CREATE(DDPDD_MPI, .TRUE., MPI_SUMDD, ierr)
+      !
+   END FUNCTION mynode
+
+   !!----------------------------------------------------------------------
+   !!                   ***  routine mpp_lnk_(2,3,4)d  ***
+   !!
+   !!   * Argument : dummy argument use in mpp_lnk_... routines
+   !!                ptab   :   array or pointer of arrays on which the boundary condition is applied
+   !!                cd_nat :   nature of array grid-points
+   !!                psgn   :   sign used across the north fold boundary
+   !!                kfld   :   optional, number of pt3d arrays
+   !!                cd_mpp :   optional, fill the overlap area only
+   !!                pval   :   optional, background value (used at closed boundaries)
+   !!----------------------------------------------------------------------
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+#  define DIM_2d
+#     define ROUTINE_LNK           mpp_lnk_2d
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           mpp_lnk_2d_ptr
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     undef MULTI
+#  undef DIM_2d
+   !
+   !                       !==  3D array and array of 3D pointer  ==!
+   !
+#  define DIM_3d
+#     define ROUTINE_LNK           mpp_lnk_3d
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           mpp_lnk_3d_ptr
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     undef MULTI
+#  undef DIM_3d
+   !
+   !                       !==  4D array and array of 4D pointer  ==!
+   !
+#  define DIM_4d
+#     define ROUTINE_LNK           mpp_lnk_4d
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           mpp_lnk_4d_ptr
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     undef MULTI
+#  undef DIM_4d
+
+   !!----------------------------------------------------------------------
+   !!                   ***  routine mpp_nfd_(2,3,4)d  ***
+   !!
+   !!   * Argument : dummy argument use in mpp_nfd_... routines
+   !!                ptab   :   array or pointer of arrays on which the boundary condition is applied
+   !!                cd_nat :   nature of array grid-points
+   !!                psgn   :   sign used across the north fold boundary
+   !!                kfld   :   optional, number of pt3d arrays
+   !!                cd_mpp :   optional, fill the overlap area only
+   !!                pval   :   optional, background value (used at closed boundaries)
+   !!----------------------------------------------------------------------
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+#  define DIM_2d
+#     define ROUTINE_NFD           mpp_nfd_2d
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           mpp_nfd_2d_ptr
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_2d
+   !
+   !                       !==  3D array and array of 3D pointer  ==!
+   !
+#  define DIM_3d
+#     define ROUTINE_NFD           mpp_nfd_3d
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           mpp_nfd_3d_ptr
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_3d
+   !
+   !                       !==  4D array and array of 4D pointer  ==!
+   !
+#  define DIM_4d
+#     define ROUTINE_NFD           mpp_nfd_4d
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           mpp_nfd_4d_ptr
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_4d
+
+
+   !!----------------------------------------------------------------------
+   !!                   ***  routine mpp_lnk_bdy_(2,3,4)d  ***
+   !!
+   !!   * Argument : dummy argument use in mpp_lnk_... routines
+   !!                ptab   :   array or pointer of arrays on which the boundary condition is applied
+   !!                cd_nat :   nature of array grid-points
+   !!                psgn   :   sign used across the north fold boundary
+   !!                kb_bdy :   BDY boundary set
+   !!                kfld   :   optional, number of pt3d arrays
+   !!----------------------------------------------------------------------
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+#  define DIM_2d
+#     define ROUTINE_BDY           mpp_lnk_bdy_2d
+#     include "mpp_bdy_generic.h90"
+#     undef ROUTINE_BDY
+#  undef DIM_2d
+   !
+   !                       !==  3D array and array of 3D pointer  ==!
+   !
+#  define DIM_3d
+#     define ROUTINE_BDY           mpp_lnk_bdy_3d
+#     include "mpp_bdy_generic.h90"
+#     undef ROUTINE_BDY
+#  undef DIM_3d
+   !
+   !                       !==  4D array and array of 4D pointer  ==!
+   !
+#  define DIM_4d
+#     define ROUTINE_BDY           mpp_lnk_bdy_4d
+#     include "mpp_bdy_generic.h90"
+#     undef ROUTINE_BDY
+#  undef DIM_4d
+
+   !!----------------------------------------------------------------------
+   !!
+   !!   load_array  &   mpp_lnk_2d_9    à generaliser a 3D et 4D
+   
+   
+   !!    mpp_lnk_sum_2d et 3D   ====>>>>>>   à virer du code !!!!
+   
+   
+   !!----------------------------------------------------------------------
+
+
+
+   SUBROUTINE mppsend( ktyp, pmess, kbytes, kdest, md_req )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsend  ***
+      !!
+      !! ** Purpose :   Send messag passing array
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(inout) ::   pmess(*)   ! array of real
+      INTEGER , INTENT(in   ) ::   kbytes     ! size of the array pmess
+      INTEGER , INTENT(in   ) ::   kdest      ! receive process number
+      INTEGER , INTENT(in   ) ::   ktyp       ! tag of the message
+      INTEGER , INTENT(in   ) ::   md_req     ! argument for isend
+      !!
+      INTEGER ::   iflag
+      !!----------------------------------------------------------------------
+      !
+      SELECT CASE ( cn_mpi_send )
+      CASE ( 'S' )                ! Standard mpi send (blocking)
+         CALL mpi_send ( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_oce        , iflag )
+      CASE ( 'B' )                ! Buffer mpi send (blocking)
+         CALL mpi_bsend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_oce        , iflag )
+      CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
+         ! be carefull, one more argument here : the mpi request identifier..
+         CALL mpi_isend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_oce, md_req, iflag )
+      END SELECT
+      !
+   END SUBROUTINE mppsend
+
+
+   SUBROUTINE mpprecv( ktyp, pmess, kbytes, ksource )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpprecv  ***
+      !!
+      !! ** Purpose :   Receive messag passing array
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(inout) ::   pmess(*)   ! array of real
+      INTEGER , INTENT(in   ) ::   kbytes     ! suze of the array pmess
+      INTEGER , INTENT(in   ) ::   ktyp       ! Tag of the recevied message
+      INTEGER, OPTIONAL, INTENT(in) :: ksource    ! source process number
+      !!
+      INTEGER :: istatus(mpi_status_size)
+      INTEGER :: iflag
+      INTEGER :: use_source
+      !!----------------------------------------------------------------------
+      !
+      ! If a specific process number has been passed to the receive call,
+      ! use that one. Default is to use mpi_any_source
+      use_source = mpi_any_source
+      IF( PRESENT(ksource) )   use_source = ksource
+      !
+      CALL mpi_recv( pmess, kbytes, mpi_double_precision, use_source, ktyp, mpi_comm_oce, istatus, iflag )
+      !
+   END SUBROUTINE mpprecv
+
+
+   SUBROUTINE mppgather( ptab, kp, pio )
+      !!----------------------------------------------------------------------
+      !!                   ***  routine mppgather  ***
+      !!
+      !! ** Purpose :   Transfert between a local subdomain array and a work
+      !!     array which is distributed following the vertical level.
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj)      , INTENT(in   ) ::   ptab   ! subdomain input array
+      INTEGER                           , INTENT(in   ) ::   kp     ! record length
+      REAL(wp), DIMENSION(jpi,jpj,jpnij), INTENT(  out) ::   pio    ! subdomain input array
+      !!
+      INTEGER :: itaille, ierror   ! temporary integer
+      !!---------------------------------------------------------------------
+      !
+      itaille = jpi * jpj
+      CALL mpi_gather( ptab, itaille, mpi_double_precision, pio, itaille     ,   &
+         &                            mpi_double_precision, kp , mpi_comm_oce, ierror )
+      !
+   END SUBROUTINE mppgather
+
+
+   SUBROUTINE mppscatter( pio, kp, ptab )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppscatter  ***
+      !!
+      !! ** Purpose :   Transfert between awork array which is distributed
+      !!      following the vertical level and the local subdomain array.
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpnij)  ::   pio    ! output array
+      INTEGER                             ::   kp     ! Tag (not used with MPI
+      REAL(wp), DIMENSION(jpi,jpj)        ::   ptab   ! subdomain array input
+      !!
+      INTEGER :: itaille, ierror   ! temporary integer
+      !!---------------------------------------------------------------------
+      !
+      itaille = jpi * jpj
+      !
+      CALL mpi_scatter( pio, itaille, mpi_double_precision, ptab, itaille     ,   &
+         &                            mpi_double_precision, kp  , mpi_comm_oce, ierror )
+      !
+   END SUBROUTINE mppscatter
+
+   
+   SUBROUTINE mpp_delay_sum( cdname, cdelay, y_in, pout, ldlast, kcom )
+     !!----------------------------------------------------------------------
+      !!                   ***  routine mpp_delay_sum  ***
+      !!
+      !! ** Purpose :   performed delayed mpp_sum, the result is received on next call
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in   )               ::   cdname  ! name of the calling subroutine
+      CHARACTER(len=*), INTENT(in   )               ::   cdelay  ! name (used as id) of the delayed operation
+      COMPLEX(wp),      INTENT(in   ), DIMENSION(:) ::   y_in
+      REAL(wp),         INTENT(  out), DIMENSION(:) ::   pout
+      LOGICAL,          INTENT(in   )               ::   ldlast  ! true if this is the last time we call this routine
+      INTEGER,          INTENT(in   ), OPTIONAL     ::   kcom
+      !!
+      INTEGER ::   ji, isz
+      INTEGER ::   idvar
+      INTEGER ::   ierr, ilocalcomm
+      COMPLEX(wp), ALLOCATABLE, DIMENSION(:) ::   ytmp
+      !!----------------------------------------------------------------------
+      ilocalcomm = mpi_comm_oce
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+
+      isz = SIZE(y_in)
+      
+      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_dlg = .TRUE. )
+
+      idvar = -1
+      DO ji = 1, nbdelay
+         IF( TRIM(cdelay) == TRIM(c_delaylist(ji)) ) idvar = ji
+      END DO
+      IF ( idvar == -1 )   CALL ctl_stop( 'STOP',' mpp_delay_sum : please add a new delayed exchange for '//TRIM(cdname) )
+
+      IF ( ndelayid(idvar) == 0 ) THEN         ! first call    with restart: %z1d defined in iom_delay_rst
+         !                                       --------------------------
+         IF ( SIZE(todelay(idvar)%z1d) /= isz ) THEN                  ! Check dimension coherence
+            IF(lwp) WRITE(numout,*) ' WARNING: the nb of delayed variables in restart file is not the model one'
+            DEALLOCATE(todelay(idvar)%z1d)
+            ndelayid(idvar) = -1                                      ! do as if we had no restart
+         ELSE
+            ALLOCATE(todelay(idvar)%y1d(isz))
+            todelay(idvar)%y1d(:) = CMPLX(todelay(idvar)%z1d(:), 0., wp)   ! create %y1d, complex variable needed by mpi_sumdd
+         END IF
+      ENDIF
+      
+      IF( ndelayid(idvar) == -1 ) THEN         ! first call without restart: define %y1d and %z1d from y_in with blocking allreduce
+         !                                       --------------------------
+         ALLOCATE(todelay(idvar)%z1d(isz), todelay(idvar)%y1d(isz))   ! allocate also %z1d as used for the restart
+         CALL mpi_allreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ierr )   ! get %y1d
+         todelay(idvar)%z1d(:) = REAL(todelay(idvar)%y1d(:), wp)      ! define %z1d from %y1d
+      ENDIF
+
+      IF( ndelayid(idvar) > 0 )   CALL mpp_delay_rcv( idvar )         ! make sure %z1d is received
+
+      ! send back pout from todelay(idvar)%z1d defined at previous call
+      pout(:) = todelay(idvar)%z1d(:)
+
+      ! send y_in into todelay(idvar)%y1d with a non-blocking communication
+#if defined key_mpi2
+      IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.)
+      CALL  mpi_allreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ndelayid(idvar), ierr )
+      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.)
+#else
+      CALL mpi_iallreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ndelayid(idvar), ierr )
+#endif
+
+   END SUBROUTINE mpp_delay_sum
+
+   
+   SUBROUTINE mpp_delay_max( cdname, cdelay, p_in, pout, ldlast, kcom )
+      !!----------------------------------------------------------------------
+      !!                   ***  routine mpp_delay_max  ***
+      !!
+      !! ** Purpose :   performed delayed mpp_max, the result is received on next call
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in   )                 ::   cdname  ! name of the calling subroutine
+      CHARACTER(len=*), INTENT(in   )                 ::   cdelay  ! name (used as id) of the delayed operation
+      REAL(wp),         INTENT(in   ), DIMENSION(:)   ::   p_in    ! 
+      REAL(wp),         INTENT(  out), DIMENSION(:)   ::   pout    ! 
+      LOGICAL,          INTENT(in   )                 ::   ldlast  ! true if this is the last time we call this routine
+      INTEGER,          INTENT(in   ), OPTIONAL       ::   kcom
+      !!
+      INTEGER ::   ji, isz
+      INTEGER ::   idvar
+      INTEGER ::   ierr, ilocalcomm
+      !!----------------------------------------------------------------------
+      ilocalcomm = mpi_comm_oce
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+
+      isz = SIZE(p_in)
+
+      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_dlg = .TRUE. )
+
+      idvar = -1
+      DO ji = 1, nbdelay
+         IF( TRIM(cdelay) == TRIM(c_delaylist(ji)) ) idvar = ji
+      END DO
+      IF ( idvar == -1 )   CALL ctl_stop( 'STOP',' mpp_delay_max : please add a new delayed exchange for '//TRIM(cdname) )
+
+      IF ( ndelayid(idvar) == 0 ) THEN         ! first call    with restart: %z1d defined in iom_delay_rst
+         !                                       --------------------------
+         IF ( SIZE(todelay(idvar)%z1d) /= isz ) THEN                  ! Check dimension coherence
+            IF(lwp) WRITE(numout,*) ' WARNING: the nb of delayed variables in restart file is not the model one'
+            DEALLOCATE(todelay(idvar)%z1d)
+            ndelayid(idvar) = -1                                      ! do as if we had no restart
+         END IF
+      ENDIF
+
+      IF( ndelayid(idvar) == -1 ) THEN         ! first call without restart: define %z1d from p_in with a blocking allreduce
+         !                                       --------------------------
+         ALLOCATE(todelay(idvar)%z1d(isz))
+         CALL mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ierr )   ! get %z1d
+      ENDIF
+
+      IF( ndelayid(idvar) > 0 )   CALL mpp_delay_rcv( idvar )         ! make sure %z1d is received
+
+      ! send back pout from todelay(idvar)%z1d defined at previous call
+      pout(:) = todelay(idvar)%z1d(:)
+
+      ! send p_in into todelay(idvar)%z1d with a non-blocking communication
+#if defined key_mpi2
+      IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.)
+      CALL  mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ndelayid(idvar), ierr )
+      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.)
+#else
+      CALL mpi_iallreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ndelayid(idvar), ierr )
+#endif
+
+   END SUBROUTINE mpp_delay_max
+
+   
+   SUBROUTINE mpp_delay_rcv( kid )
+      !!----------------------------------------------------------------------
+      !!                   ***  routine mpp_delay_rcv  ***
+      !!
+      !! ** Purpose :  force barrier for delayed mpp (needed for restart) 
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER,INTENT(in   )      ::  kid 
+      INTEGER ::   ierr
+      !!----------------------------------------------------------------------
+      IF( ndelayid(kid) /= -2 ) THEN  
+#if ! defined key_mpi2
+         IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.)
+         CALL mpi_wait( ndelayid(kid), MPI_STATUS_IGNORE, ierr )                        ! make sure todelay(kid) is received
+         IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.)
+#endif
+         IF( ASSOCIATED(todelay(kid)%y1d) )   todelay(kid)%z1d(:) = REAL(todelay(kid)%y1d(:), wp)  ! define %z1d from %y1d
+         ndelayid(kid) = -2   ! add flag to know that mpi_wait was already called on kid
+      ENDIF
+   END SUBROUTINE mpp_delay_rcv
+
+   
+   !!----------------------------------------------------------------------
+   !!    ***  mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real  ***
+   !!   
+   !!----------------------------------------------------------------------
+   !!
+#  define OPERATION_MAX
+#  define INTEGER_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppmax_int
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppmax_a_int
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef INTEGER_TYPE
+!
+#  define REAL_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppmax_real
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppmax_a_real
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef REAL_TYPE
+#  undef OPERATION_MAX
+   !!----------------------------------------------------------------------
+   !!    ***  mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real  ***
+   !!   
+   !!----------------------------------------------------------------------
+   !!
+#  define OPERATION_MIN
+#  define INTEGER_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppmin_int
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppmin_a_int
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef INTEGER_TYPE
+!
+#  define REAL_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppmin_real
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppmin_a_real
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef REAL_TYPE
+#  undef OPERATION_MIN
+
+   !!----------------------------------------------------------------------
+   !!    ***  mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real  ***
+   !!   
+   !!   Global sum of 1D array or a variable (integer, real or complex)
+   !!----------------------------------------------------------------------
+   !!
+#  define OPERATION_SUM
+#  define INTEGER_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppsum_int
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppsum_a_int
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef INTEGER_TYPE
+!
+#  define REAL_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppsum_real
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppsum_a_real
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef REAL_TYPE
+#  undef OPERATION_SUM
+
+#  define OPERATION_SUM_DD
+#  define COMPLEX_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppsum_realdd
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppsum_a_realdd
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef COMPLEX_TYPE
+#  undef OPERATION_SUM_DD
+
+   !!----------------------------------------------------------------------
+   !!    ***  mpp_minloc2d, mpp_minloc3d, mpp_maxloc2d, mpp_maxloc3d
+   !!   
+   !!----------------------------------------------------------------------
+   !!
+#  define OPERATION_MINLOC
+#  define DIM_2d
+#     define ROUTINE_LOC           mpp_minloc2d
+#     include "mpp_loc_generic.h90"
+#     undef ROUTINE_LOC
+#  undef DIM_2d
+#  define DIM_3d
+#     define ROUTINE_LOC           mpp_minloc3d
+#     include "mpp_loc_generic.h90"
+#     undef ROUTINE_LOC
+#  undef DIM_3d
+#  undef OPERATION_MINLOC
+
+#  define OPERATION_MAXLOC
+#  define DIM_2d
+#     define ROUTINE_LOC           mpp_maxloc2d
+#     include "mpp_loc_generic.h90"
+#     undef ROUTINE_LOC
+#  undef DIM_2d
+#  define DIM_3d
+#     define ROUTINE_LOC           mpp_maxloc3d
+#     include "mpp_loc_generic.h90"
+#     undef ROUTINE_LOC
+#  undef DIM_3d
+#  undef OPERATION_MAXLOC
+
+   SUBROUTINE mppsync()
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsync  ***
+      !!
+      !! ** Purpose :   Massively parallel processors, synchroneous
+      !!
+      !!-----------------------------------------------------------------------
+      INTEGER :: ierror
+      !!-----------------------------------------------------------------------
+      !
+      CALL mpi_barrier( mpi_comm_oce, ierror )
+      !
+   END SUBROUTINE mppsync
+
+
+   SUBROUTINE mppstop( ldfinal, ld_force_abort ) 
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppstop  ***
+      !!
+      !! ** purpose :   Stop massively parallel processors method
+      !!
+      !!----------------------------------------------------------------------
+      LOGICAL, OPTIONAL, INTENT(in) :: ldfinal    ! source process number
+      LOGICAL, OPTIONAL, INTENT(in) :: ld_force_abort    ! source process number
+      LOGICAL ::   llfinal, ll_force_abort
+      INTEGER ::   info
+      !!----------------------------------------------------------------------
+      llfinal = .FALSE.
+      IF( PRESENT(ldfinal) ) llfinal = ldfinal
+      ll_force_abort = .FALSE.
+      IF( PRESENT(ld_force_abort) ) ll_force_abort = ld_force_abort
+      !
+      IF(ll_force_abort) THEN
+         CALL mpi_abort( MPI_COMM_WORLD )
+      ELSE
+         CALL mppsync
+         CALL mpi_finalize( info )
+      ENDIF
+      IF( .NOT. llfinal ) STOP 123456
+      !
+   END SUBROUTINE mppstop
+
+
+   SUBROUTINE mpp_comm_free( kcom )
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kcom
+      !!
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      CALL MPI_COMM_FREE(kcom, ierr)
+      !
+   END SUBROUTINE mpp_comm_free
+
+
+   SUBROUTINE mpp_ini_znl( kumout )
+      !!----------------------------------------------------------------------
+      !!               ***  routine mpp_ini_znl  ***
+      !!
+      !! ** Purpose :   Initialize special communicator for computing zonal sum
+      !!
+      !! ** Method  : - Look for processors in the same row
+      !!              - Put their number in nrank_znl
+      !!              - Create group for the znl processors
+      !!              - Create a communicator for znl processors
+      !!              - Determine if processor should write znl files
+      !!
+      !! ** output
+      !!      ndim_rank_znl = number of processors on the same row
+      !!      ngrp_znl = group ID for the znl processors
+      !!      ncomm_znl = communicator for the ice procs.
+      !!      n_znl_root = number (in the world) of proc 0 in the ice comm.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kumout   ! ocean.output logical units
+      !
+      INTEGER :: jproc      ! dummy loop integer
+      INTEGER :: ierr, ii   ! local integer
+      INTEGER, ALLOCATABLE, DIMENSION(:) ::   kwork
+      !!----------------------------------------------------------------------
+      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_world     : ', ngrp_world
+      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_world : ', mpi_comm_world
+      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_oce   : ', mpi_comm_oce
+      !
+      ALLOCATE( kwork(jpnij), STAT=ierr )
+      IF( ierr /= 0 ) THEN
+         WRITE(kumout, cform_err)
+         WRITE(kumout,*) 'mpp_ini_znl : failed to allocate 1D array of length jpnij'
+         CALL mppstop
+      ENDIF
+
+      IF( jpnj == 1 ) THEN
+         ngrp_znl  = ngrp_world
+         ncomm_znl = mpi_comm_oce
+      ELSE
+         !
+         CALL MPI_ALLGATHER ( njmpp, 1, mpi_integer, kwork, 1, mpi_integer, mpi_comm_oce, ierr )
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - kwork pour njmpp : ', kwork
+         !-$$        CALL flush(numout)
+         !
+         ! Count number of processors on the same row
+         ndim_rank_znl = 0
+         DO jproc=1,jpnij
+            IF ( kwork(jproc) == njmpp ) THEN
+               ndim_rank_znl = ndim_rank_znl + 1
+            ENDIF
+         END DO
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ndim_rank_znl : ', ndim_rank_znl
+         !-$$        CALL flush(numout)
+         ! Allocate the right size to nrank_znl
+         IF (ALLOCATED (nrank_znl)) DEALLOCATE(nrank_znl)
+         ALLOCATE(nrank_znl(ndim_rank_znl))
+         ii = 0
+         nrank_znl (:) = 0
+         DO jproc=1,jpnij
+            IF ( kwork(jproc) == njmpp) THEN
+               ii = ii + 1
+               nrank_znl(ii) = jproc -1
+            ENDIF
+         END DO
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - nrank_znl : ', nrank_znl
+         !-$$        CALL flush(numout)
+
+         ! Create the opa group
+         CALL MPI_COMM_GROUP(mpi_comm_oce,ngrp_opa,ierr)
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_opa : ', ngrp_opa
+         !-$$        CALL flush(numout)
+
+         ! Create the znl group from the opa group
+         CALL MPI_GROUP_INCL  ( ngrp_opa, ndim_rank_znl, nrank_znl, ngrp_znl, ierr )
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_znl ', ngrp_znl
+         !-$$        CALL flush(numout)
+
+         ! Create the znl communicator from the opa communicator, ie the pool of procs in the same row
+         CALL MPI_COMM_CREATE ( mpi_comm_oce, ngrp_znl, ncomm_znl, ierr )
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ncomm_znl ', ncomm_znl
+         !-$$        CALL flush(numout)
+         !
+      END IF
+
+      ! Determines if processor if the first (starting from i=1) on the row
+      IF ( jpni == 1 ) THEN
+         l_znl_root = .TRUE.
+      ELSE
+         l_znl_root = .FALSE.
+         kwork (1) = nimpp
+         CALL mpp_min ( 'lib_mpp', kwork(1), kcom = ncomm_znl)
+         IF ( nimpp == kwork(1)) l_znl_root = .TRUE.
+      END IF
+
+      DEALLOCATE(kwork)
+
+   END SUBROUTINE mpp_ini_znl
+
+
+   SUBROUTINE mpp_ini_north
+      !!----------------------------------------------------------------------
+      !!               ***  routine mpp_ini_north  ***
+      !!
+      !! ** Purpose :   Initialize special communicator for north folding
+      !!      condition together with global variables needed in the mpp folding
+      !!
+      !! ** Method  : - Look for northern processors
+      !!              - Put their number in nrank_north
+      !!              - Create groups for the world processors and the north processors
+      !!              - Create a communicator for northern processors
+      !!
+      !! ** output
+      !!      njmppmax = njmpp for northern procs
+      !!      ndim_rank_north = number of processors in the northern line
+      !!      nrank_north (ndim_rank_north) = number  of the northern procs.
+      !!      ngrp_world = group ID for the world processors
+      !!      ngrp_north = group ID for the northern processors
+      !!      ncomm_north = communicator for the northern procs.
+      !!      north_root = number (in the world) of proc 0 in the northern comm.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER ::   ierr
+      INTEGER ::   jjproc
+      INTEGER ::   ii, ji
+      !!----------------------------------------------------------------------
+      !
+      njmppmax = MAXVAL( njmppt )
+      !
+      ! Look for how many procs on the northern boundary
+      ndim_rank_north = 0
+      DO jjproc = 1, jpnij
+         IF( njmppt(jjproc) == njmppmax )   ndim_rank_north = ndim_rank_north + 1
+      END DO
+      !
+      ! Allocate the right size to nrank_north
+      IF (ALLOCATED (nrank_north)) DEALLOCATE(nrank_north)
+      ALLOCATE( nrank_north(ndim_rank_north) )
+
+      ! Fill the nrank_north array with proc. number of northern procs.
+      ! Note : the rank start at 0 in MPI
+      ii = 0
+      DO ji = 1, jpnij
+         IF ( njmppt(ji) == njmppmax   ) THEN
+            ii=ii+1
+            nrank_north(ii)=ji-1
+         END IF
+      END DO
+      !
+      ! create the world group
+      CALL MPI_COMM_GROUP( mpi_comm_oce, ngrp_world, ierr )
+      !
+      ! Create the North group from the world group
+      CALL MPI_GROUP_INCL( ngrp_world, ndim_rank_north, nrank_north, ngrp_north, ierr )
+      !
+      ! Create the North communicator , ie the pool of procs in the north group
+      CALL MPI_COMM_CREATE( mpi_comm_oce, ngrp_north, ncomm_north, ierr )
+      !
+   END SUBROUTINE mpp_ini_north
+
+
+   SUBROUTINE mpi_init_oce( ldtxt, ksft, code )
+      !!---------------------------------------------------------------------
+      !!                   ***  routine mpp_init.opa  ***
+      !!
+      !! ** Purpose :: export and attach a MPI buffer for bsend
+      !!
+      !! ** Method  :: define buffer size in namelist, if 0 no buffer attachment
+      !!            but classical mpi_init
+      !!
+      !! History :: 01/11 :: IDRIS initial version for IBM only
+      !!            08/04 :: R. Benshila, generalisation
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt
+      INTEGER                      , INTENT(inout) ::   ksft
+      INTEGER                      , INTENT(  out) ::   code
+      INTEGER                                      ::   ierr, ji
+      LOGICAL                                      ::   mpi_was_called
+      !!---------------------------------------------------------------------
+      !
+      CALL mpi_initialized( mpi_was_called, code )      ! MPI initialization
+      IF ( code /= MPI_SUCCESS ) THEN
+         DO ji = 1, SIZE(ldtxt)
+            IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+         END DO
+         WRITE(*, cform_err)
+         WRITE(*, *) ' lib_mpp: Error in routine mpi_initialized'
+         CALL mpi_abort( mpi_comm_world, code, ierr )
+      ENDIF
+      !
+      IF( .NOT. mpi_was_called ) THEN
+         CALL mpi_init( code )
+         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_oce, code )
+         IF ( code /= MPI_SUCCESS ) THEN
+            DO ji = 1, SIZE(ldtxt)
+               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+            END DO
+            WRITE(*, cform_err)
+            WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup'
+            CALL mpi_abort( mpi_comm_world, code, ierr )
+         ENDIF
+      ENDIF
+      !
+      IF( nn_buffer > 0 ) THEN
+         WRITE(ldtxt(ksft),*) 'mpi_bsend, buffer allocation of  : ', nn_buffer   ;   ksft = ksft + 1
+         ! Buffer allocation and attachment
+         ALLOCATE( tampon(nn_buffer), stat = ierr )
+         IF( ierr /= 0 ) THEN
+            DO ji = 1, SIZE(ldtxt)
+               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+            END DO
+            WRITE(*, cform_err)
+            WRITE(*, *) ' lib_mpp: Error in ALLOCATE', ierr
+            CALL mpi_abort( mpi_comm_world, code, ierr )
+         END IF
+         CALL mpi_buffer_attach( tampon, nn_buffer, code )
+      ENDIF
+      !
+   END SUBROUTINE mpi_init_oce
+
+
+   SUBROUTINE DDPDD_MPI( ydda, yddb, ilen, itype )
+      !!---------------------------------------------------------------------
+      !!   Routine DDPDD_MPI: used by reduction operator MPI_SUMDD
+      !!
+      !!   Modification of original codes written by David H. Bailey
+      !!   This subroutine computes yddb(i) = ydda(i)+yddb(i)
+      !!---------------------------------------------------------------------
+      INTEGER                     , INTENT(in)    ::   ilen, itype
+      COMPLEX(wp), DIMENSION(ilen), INTENT(in)    ::   ydda
+      COMPLEX(wp), DIMENSION(ilen), INTENT(inout) ::   yddb
+      !
+      REAL(wp) :: zerr, zt1, zt2    ! local work variables
+      INTEGER  :: ji, ztmp           ! local scalar
+      !!---------------------------------------------------------------------
+      !
+      ztmp = itype   ! avoid compilation warning
+      !
+      DO ji=1,ilen
+      ! Compute ydda + yddb using Knuth's trick.
+         zt1  = real(ydda(ji)) + real(yddb(ji))
+         zerr = zt1 - real(ydda(ji))
+         zt2  = ((real(yddb(ji)) - zerr) + (real(ydda(ji)) - (zt1 - zerr))) &
+                + aimag(ydda(ji)) + aimag(yddb(ji))
+
+         ! The result is zt1 + zt2, after normalization.
+         yddb(ji) = cmplx ( zt1 + zt2, zt2 - ((zt1 + zt2) - zt1),wp )
+      END DO
+      !
+   END SUBROUTINE DDPDD_MPI
+
+
+   SUBROUTINE mpp_lbc_north_icb( pt2d, cd_type, psgn, kextj)
+      !!---------------------------------------------------------------------
+      !!                   ***  routine mpp_lbc_north_icb  ***
+      !!
+      !! ** Purpose :   Ensure proper north fold horizontal bondary condition
+      !!              in mpp configuration in case of jpn1 > 1 and for 2d
+      !!              array with outer extra halo
+      !!
+      !! ** Method  :   North fold condition and mpp with more than one proc
+      !!              in i-direction require a specific treatment. We gather
+      !!              the 4+kextj northern lines of the global domain on 1
+      !!              processor and apply lbc north-fold on this sub array.
+      !!              Then we scatter the north fold array back to the processors.
+      !!              This routine accounts for an extra halo with icebergs
+      !!              and assumes ghost rows and columns have been suppressed.
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d     ! 2D array with extra halo
+      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type  ! nature of pt3d grid-points
+      !                                                     !   = T ,  U , V , F or W -points
+      REAL(wp)                , INTENT(in   ) ::   psgn     ! = -1. the sign change across the
+      !!                                                    ! north fold, =  1. otherwise
+      INTEGER                 , INTENT(in   ) ::   kextj    ! Extra halo width at north fold
+      !
+      INTEGER ::   ji, jj, jr
+      INTEGER ::   ierr, itaille, ildi, ilei, iilb
+      INTEGER ::   ipj, ij, iproc
+      !
+      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE  ::  ztab_e, znorthloc_e
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE  ::  znorthgloio_e
+      !!----------------------------------------------------------------------
+      !
+      ipj=4
+      ALLOCATE(        ztab_e(jpiglo, 1-kextj:ipj+kextj)       ,       &
+     &            znorthloc_e(jpimax, 1-kextj:ipj+kextj)       ,       &
+     &          znorthgloio_e(jpimax, 1-kextj:ipj+kextj,jpni)    )
+      !
+      ztab_e(:,:)      = 0._wp
+      znorthloc_e(:,:) = 0._wp
+      !
+      ij = 1 - kextj
+      ! put the last ipj+2*kextj lines of pt2d into znorthloc_e 
+      DO jj = jpj - ipj + 1 - kextj , jpj + kextj
+         znorthloc_e(1:jpi,ij)=pt2d(1:jpi,jj)
+         ij = ij + 1
+      END DO
+      !
+      itaille = jpimax * ( ipj + 2*kextj )
+      !
+      IF( ln_timing ) CALL tic_tac(.TRUE.)
+      CALL MPI_ALLGATHER( znorthloc_e(1,1-kextj)    , itaille, MPI_DOUBLE_PRECISION,    &
+         &                znorthgloio_e(1,1-kextj,1), itaille, MPI_DOUBLE_PRECISION,    &
+         &                ncomm_north, ierr )
+      !
+      IF( ln_timing ) CALL tic_tac(.FALSE.)
+      !
+      DO jr = 1, ndim_rank_north            ! recover the global north array
+         iproc = nrank_north(jr) + 1
+         ildi = nldit (iproc)
+         ilei = nleit (iproc)
+         iilb = nimppt(iproc)
+         DO jj = 1-kextj, ipj+kextj
+            DO ji = ildi, ilei
+               ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr)
+            END DO
+         END DO
+      END DO
+
+      ! 2. North-Fold boundary conditions
+      ! ----------------------------------
+      CALL lbc_nfd( ztab_e(:,1-kextj:ipj+kextj), cd_type, psgn, kextj )
+
+      ij = 1 - kextj
+      !! Scatter back to pt2d
+      DO jj = jpj - ipj + 1 - kextj , jpj + kextj
+         DO ji= 1, jpi
+            pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij)
+         END DO
+         ij  = ij +1
+      END DO
+      !
+      DEALLOCATE( ztab_e, znorthloc_e, znorthgloio_e )
+      !
+   END SUBROUTINE mpp_lbc_north_icb
+
+
+   SUBROUTINE mpp_lnk_2d_icb( cdname, pt2d, cd_type, psgn, kexti, kextj )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_2d_icb  ***
+      !!
+      !! ** Purpose :   Message passing management for 2d array (with extra halo for icebergs)
+      !!                This routine receives a (1-kexti:jpi+kexti,1-kexti:jpj+kextj)
+      !!                array (usually (0:jpi+1, 0:jpj+1)) from lbc_lnk_icb calls.
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing mask
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    jpi    : first dimension of the local subdomain
+      !!                    jpj    : second dimension of the local subdomain
+      !!                    kexti  : number of columns for extra outer halo
+      !!                    kextj  : number of rows for extra outer halo
+      !!                    nbondi : mark for "east-west local boundary"
+      !!                    nbondj : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*)                                        , INTENT(in   ) ::   cdname      ! name of the calling subroutine
+      REAL(wp), DIMENSION(1-kexti:jpi+kexti,1-kextj:jpj+kextj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
+      CHARACTER(len=1)                                        , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points
+      REAL(wp)                                                , INTENT(in   ) ::   psgn     ! sign used across the north fold
+      INTEGER                                                 , INTENT(in   ) ::   kexti    ! extra i-halo width
+      INTEGER                                                 , INTENT(in   ) ::   kextj    ! extra j-halo width
+      !
+      INTEGER  ::   jl   ! dummy loop indices
+      INTEGER  ::   imigr, iihom, ijhom        ! local integers
+      INTEGER  ::   ipreci, iprecj             !   -       -
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !!
+      REAL(wp), DIMENSION(1-kexti:jpi+kexti,nn_hls+kextj,2) ::   r2dns, r2dsn
+      REAL(wp), DIMENSION(1-kextj:jpj+kextj,nn_hls+kexti,2) ::   r2dwe, r2dew
+      !!----------------------------------------------------------------------
+
+      ipreci = nn_hls + kexti      ! take into account outer extra 2D overlap area
+      iprecj = nn_hls + kextj
+
+      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, 1, 1, 1, ld_lbc = .TRUE. )
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      ! Order matters Here !!!!
+      !
+      !                                      ! East-West boundaries
+      !                                           !* Cyclic east-west
+      IF( l_Iperio ) THEN
+         pt2d(1-kexti:     1   ,:) = pt2d(jpim1-kexti: jpim1 ,:)       ! east
+         pt2d(  jpi  :jpi+kexti,:) = pt2d(     2     :2+kexti,:)       ! west
+         !
+      ELSE                                        !* closed
+         IF( .NOT. cd_type == 'F' )   pt2d(  1-kexti   :nn_hls   ,:) = 0._wp    ! east except at F-point
+                                      pt2d(jpi-nn_hls+1:jpi+kexti,:) = 0._wp    ! west
+      ENDIF
+      !                                      ! North-South boundaries
+      IF( l_Jperio ) THEN                         !* cyclic (only with no mpp j-split)
+         pt2d(:,1-kextj:     1   ) = pt2d(:,jpjm1-kextj:  jpjm1)       ! north
+         pt2d(:,  jpj  :jpj+kextj) = pt2d(:,     2     :2+kextj)       ! south
+      ELSE                                        !* closed
+         IF( .NOT. cd_type == 'F' )   pt2d(:,  1-kextj   :nn_hls   ) = 0._wp    ! north except at F-point
+                                      pt2d(:,jpj-nn_hls+1:jpj+kextj) = 0._wp    ! south
+      ENDIF
+      !
+
+      ! north fold treatment
+      ! -----------------------
+      IF( npolj /= 0 ) THEN
+         !
+         SELECT CASE ( jpni )
+                   CASE ( 1 )     ;   CALL lbc_nfd          ( pt2d(1:jpi,1:jpj+kextj), cd_type, psgn, kextj )
+                   CASE DEFAULT   ;   CALL mpp_lbc_north_icb( pt2d(1:jpi,1:jpj+kextj), cd_type, psgn, kextj )
+         END SELECT
+         !
+      ENDIF
+
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity
+      !
+      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+         iihom = jpi-nreci-kexti
+         DO jl = 1, ipreci
+            r2dew(:,jl,1) = pt2d(nn_hls+jl,:)
+            r2dwe(:,jl,1) = pt2d(iihom +jl,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = ipreci * ( jpj + 2*kextj )
+      !
+      IF( ln_timing ) CALL tic_tac(.TRUE.)
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, r2dwe(1-kextj,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, r2dew(1-kextj,1,2), imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, r2dew(1-kextj,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, r2dwe(1-kextj,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, r2dew(1-kextj,1,2), imigr, noea )
+         CALL mpprecv( 2, r2dwe(1-kextj,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, r2dew(1-kextj,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, r2dwe(1-kextj,1,2), imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      IF( ln_timing ) CALL tic_tac(.FALSE.)
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = jpi - nn_hls
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jl = 1, ipreci
+            pt2d(iihom+jl,:) = r2dew(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, ipreci
+            pt2d(jl-kexti,:) = r2dwe(:,jl,2)
+            pt2d(iihom+jl,:) = r2dew(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, ipreci
+            pt2d(jl-kexti,:) = r2dwe(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = jpj-nrecj-kextj
+         DO jl = 1, iprecj
+            r2dsn(:,jl,1) = pt2d(:,ijhom +jl)
+            r2dns(:,jl,1) = pt2d(:,nn_hls+jl)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = iprecj * ( jpi + 2*kexti )
+      !
+      IF( ln_timing ) CALL tic_tac(.TRUE.)
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, r2dsn(1-kexti,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, r2dns(1-kexti,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, r2dns(1-kexti,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, r2dsn(1-kexti,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, r2dns(1-kexti,1,2), imigr, nono )
+         CALL mpprecv( 4, r2dsn(1-kexti,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 3, r2dns(1-kexti,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, r2dsn(1-kexti,1,2), imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      IF( ln_timing ) CALL tic_tac(.FALSE.)
+      !
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = jpj - nn_hls
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jl = 1, iprecj
+            pt2d(:,ijhom+jl) = r2dns(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, iprecj
+            pt2d(:,jl-kextj) = r2dsn(:,jl,2)
+            pt2d(:,ijhom+jl) = r2dns(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, iprecj
+            pt2d(:,jl-kextj) = r2dsn(:,jl,2)
+         END DO
+      END SELECT
+      !
+   END SUBROUTINE mpp_lnk_2d_icb
+
+
+   SUBROUTINE mpp_report( cdname, kpk, kpl, kpf, ld_lbc, ld_glb, ld_dlg )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_report  ***
+      !!
+      !! ** Purpose :   report use of mpp routines per time-setp
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*),           INTENT(in   ) ::   cdname      ! name of the calling subroutine
+      INTEGER         , OPTIONAL, INTENT(in   ) ::   kpk, kpl, kpf
+      LOGICAL         , OPTIONAL, INTENT(in   ) ::   ld_lbc, ld_glb, ld_dlg
+      !!
+      LOGICAL ::   ll_lbc, ll_glb, ll_dlg
+      INTEGER ::    ji,  jj,  jk,  jh, jf   ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      ll_lbc = .FALSE.
+      IF( PRESENT(ld_lbc) ) ll_lbc = ld_lbc
+      ll_glb = .FALSE.
+      IF( PRESENT(ld_glb) ) ll_glb = ld_glb
+      ll_dlg = .FALSE.
+      IF( PRESENT(ld_dlg) ) ll_dlg = ld_dlg
+      !
+      ! find the smallest common frequency: default = frequency product, if multiple, choose the larger of the 2 frequency
+      IF( ncom_dttrc /= 1 )   CALL ctl_stop( 'STOP', 'mpp_report, ncom_dttrc /= 1 not coded...' ) 
+      ncom_freq = ncom_fsbc
+      !
+      IF ( ncom_stp == nit000+ncom_freq ) THEN   ! avoid to count extra communications in potential initializations at nit000
+         IF( ll_lbc ) THEN
+            IF( .NOT. ALLOCATED(ncomm_sequence) ) ALLOCATE( ncomm_sequence(ncom_rec_max,2) )
+            IF( .NOT. ALLOCATED(    crname_lbc) ) ALLOCATE(     crname_lbc(ncom_rec_max  ) )
+            n_sequence_lbc = n_sequence_lbc + 1
+            IF( n_sequence_lbc > ncom_rec_max ) CALL ctl_stop( 'STOP', 'lib_mpp, increase ncom_rec_max' )   ! deadlock
+            crname_lbc(n_sequence_lbc) = cdname     ! keep the name of the calling routine
+            ncomm_sequence(n_sequence_lbc,1) = kpk*kpl   ! size of 3rd and 4th dimensions
+            ncomm_sequence(n_sequence_lbc,2) = kpf       ! number of arrays to be treated (multi)
+         ENDIF
+         IF( ll_glb ) THEN
+            IF( .NOT. ALLOCATED(crname_glb) ) ALLOCATE( crname_glb(ncom_rec_max) )
+            n_sequence_glb = n_sequence_glb + 1
+            IF( n_sequence_glb > ncom_rec_max ) CALL ctl_stop( 'STOP', 'lib_mpp, increase ncom_rec_max' )   ! deadlock
+            crname_glb(n_sequence_glb) = cdname     ! keep the name of the calling routine
+         ENDIF
+         IF( ll_dlg ) THEN
+            IF( .NOT. ALLOCATED(crname_dlg) ) ALLOCATE( crname_dlg(ncom_rec_max) )
+            n_sequence_dlg = n_sequence_dlg + 1
+            IF( n_sequence_dlg > ncom_rec_max ) CALL ctl_stop( 'STOP', 'lib_mpp, increase ncom_rec_max' )   ! deadlock
+            crname_dlg(n_sequence_dlg) = cdname     ! keep the name of the calling routine
+         ENDIF
+      ELSE IF ( ncom_stp == nit000+2*ncom_freq ) THEN
+         CALL ctl_opn( numcom, 'communication_report.txt', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
+         WRITE(numcom,*) ' '
+         WRITE(numcom,*) ' ------------------------------------------------------------'
+         WRITE(numcom,*) ' Communication pattern report (second oce+sbc+top time step):'
+         WRITE(numcom,*) ' ------------------------------------------------------------'
+         WRITE(numcom,*) ' '
+         WRITE(numcom,'(A,I4)') ' Exchanged halos : ', n_sequence_lbc
+         jj = 0; jk = 0; jf = 0; jh = 0
+         DO ji = 1, n_sequence_lbc
+            IF ( ncomm_sequence(ji,1) .GT. 1 ) jk = jk + 1
+            IF ( ncomm_sequence(ji,2) .GT. 1 ) jf = jf + 1
+            IF ( ncomm_sequence(ji,1) .GT. 1 .AND. ncomm_sequence(ji,2) .GT. 1 ) jj = jj + 1
+            jh = MAX (jh, ncomm_sequence(ji,1)*ncomm_sequence(ji,2))
+         END DO
+         WRITE(numcom,'(A,I3)') ' 3D Exchanged halos : ', jk
+         WRITE(numcom,'(A,I3)') ' Multi arrays exchanged halos : ', jf
+         WRITE(numcom,'(A,I3)') '   from which 3D : ', jj
+         WRITE(numcom,'(A,I10)') ' Array max size : ', jh*jpi*jpj
+         WRITE(numcom,*) ' '
+         WRITE(numcom,*) ' lbc_lnk called'
+         jj = 1
+         DO ji = 2, n_sequence_lbc
+            IF( crname_lbc(ji-1) /= crname_lbc(ji) ) THEN
+               WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_lbc(ji-1))
+               jj = 0
+            END IF
+            jj = jj + 1 
+         END DO
+         WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_lbc(n_sequence_lbc))
+         WRITE(numcom,*) ' '
+         IF ( n_sequence_glb > 0 ) THEN
+            WRITE(numcom,'(A,I4)') ' Global communications : ', n_sequence_glb
+            jj = 1
+            DO ji = 2, n_sequence_glb
+               IF( crname_glb(ji-1) /= crname_glb(ji) ) THEN
+                  WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_glb(ji-1))
+                  jj = 0
+               END IF
+               jj = jj + 1 
+            END DO
+            WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_glb(n_sequence_glb))
+            DEALLOCATE(crname_glb)
+         ELSE
+            WRITE(numcom,*) ' No MPI global communication '
+         ENDIF
+         WRITE(numcom,*) ' '
+         IF ( n_sequence_dlg > 0 ) THEN
+            WRITE(numcom,'(A,I4)') ' Delayed global communications : ', n_sequence_dlg
+            jj = 1
+            DO ji = 2, n_sequence_dlg
+               IF( crname_dlg(ji-1) /= crname_dlg(ji) ) THEN
+                  WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_dlg(ji-1))
+                  jj = 0
+               END IF
+               jj = jj + 1 
+            END DO
+            WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_dlg(n_sequence_dlg))
+            DEALLOCATE(crname_dlg)
+         ELSE
+            WRITE(numcom,*) ' No MPI delayed global communication '
+         ENDIF
+         WRITE(numcom,*) ' '
+         WRITE(numcom,*) ' -----------------------------------------------'
+         WRITE(numcom,*) ' '
+         DEALLOCATE(ncomm_sequence)
+         DEALLOCATE(crname_lbc)
+      ENDIF
+   END SUBROUTINE mpp_report
+
+   
+   SUBROUTINE tic_tac (ld_tic, ld_global)
+
+    LOGICAL,           INTENT(IN) :: ld_tic
+    LOGICAL, OPTIONAL, INTENT(IN) :: ld_global
+    REAL(wp), DIMENSION(2), SAVE :: tic_wt
+    REAL(wp),               SAVE :: tic_ct = 0._wp
+    INTEGER :: ii
+
+    IF( ncom_stp <= nit000 ) RETURN
+    IF( ncom_stp == nitend ) RETURN
+    ii = 1
+    IF( PRESENT( ld_global ) ) THEN
+       IF( ld_global ) ii = 2
+    END IF
+    
+    IF ( ld_tic ) THEN
+       tic_wt(ii) = MPI_Wtime()                                                    ! start count tic->tac (waiting time)
+       IF ( tic_ct > 0.0_wp ) compute_time = compute_time + MPI_Wtime() - tic_ct   ! cumulate count tac->tic
+    ELSE
+       waiting_time(ii) = waiting_time(ii) + MPI_Wtime() - tic_wt(ii)              ! cumulate count tic->tac
+       tic_ct = MPI_Wtime()                                                        ! start count tac->tic (waiting time)
+    ENDIF
+    
+   END SUBROUTINE tic_tac
+
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Default case:            Dummy module        share memory computing
+   !!----------------------------------------------------------------------
+   USE in_out_manager
+
+   INTERFACE mpp_sum
+      MODULE PROCEDURE mppsum_int, mppsum_a_int, mppsum_real, mppsum_a_real, mppsum_realdd, mppsum_a_realdd
+   END INTERFACE
+   INTERFACE mpp_max
+      MODULE PROCEDURE mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real
+   END INTERFACE
+   INTERFACE mpp_min
+      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real
+   END INTERFACE
+   INTERFACE mpp_minloc
+      MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d
+   END INTERFACE
+   INTERFACE mpp_maxloc
+      MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
+   END INTERFACE
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .FALSE.      !: mpp flag
+   LOGICAL, PUBLIC            ::   ln_nnogather          !: namelist control of northfold comms (needed here in case "key_mpp_mpi" is not used)
+   INTEGER, PUBLIC            ::   mpi_comm_oce          ! opa local communicator
+
+   INTEGER, PARAMETER, PUBLIC               ::   nbdelay = 0   ! make sure we don't enter loops: DO ji = 1, nbdelay
+   CHARACTER(len=32), DIMENSION(1), PUBLIC  ::   c_delaylist = 'empty'
+   CHARACTER(len=32), DIMENSION(1), PUBLIC  ::   c_delaycpnt = 'empty'
+   LOGICAL, PUBLIC                          ::   l_full_nf_update = .TRUE.
+   TYPE ::   DELAYARR
+      REAL(   wp), POINTER, DIMENSION(:) ::  z1d => NULL()
+      COMPLEX(wp), POINTER, DIMENSION(:) ::  y1d => NULL()
+   END TYPE DELAYARR
+   TYPE( DELAYARR ), DIMENSION(1), PUBLIC  ::   todelay              
+   INTEGER,  PUBLIC, DIMENSION(1)           ::   ndelayid = -1
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION lib_mpp_alloc(kumout)          ! Dummy function
+      INTEGER, INTENT(in) ::   kumout
+      lib_mpp_alloc = 0
+   END FUNCTION lib_mpp_alloc
+
+   FUNCTION mynode( ldtxt, ldname, kumnam_ref, knumnam_cfg,  kumond , kstop, localComm ) RESULT (function_value)
+      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm
+      CHARACTER(len=*),DIMENSION(:) ::   ldtxt
+      CHARACTER(len=*) ::   ldname
+      INTEGER ::   function_value
+      INTEGER ::   kumnam_ref, knumnam_cfg , kumond , kstop
+      IF( PRESENT( localComm ) ) mpi_comm_oce = localComm
+      function_value = 0
+      IF( .FALSE. )   ldtxt(:) = 'never done'
+      CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 )
+   END FUNCTION mynode
+
+   SUBROUTINE mppsync                       ! Dummy routine
+   END SUBROUTINE mppsync
+
+   !!----------------------------------------------------------------------
+   !!    ***  mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real  ***
+   !!   
+   !!----------------------------------------------------------------------
+   !!
+#  define OPERATION_MAX
+#  define INTEGER_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppmax_int
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppmax_a_int
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef INTEGER_TYPE
+!
+#  define REAL_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppmax_real
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppmax_a_real
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef REAL_TYPE
+#  undef OPERATION_MAX
+   !!----------------------------------------------------------------------
+   !!    ***  mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real  ***
+   !!   
+   !!----------------------------------------------------------------------
+   !!
+#  define OPERATION_MIN
+#  define INTEGER_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppmin_int
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppmin_a_int
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef INTEGER_TYPE
+!
+#  define REAL_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppmin_real
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppmin_a_real
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef REAL_TYPE
+#  undef OPERATION_MIN
+
+   !!----------------------------------------------------------------------
+   !!    ***  mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real  ***
+   !!   
+   !!   Global sum of 1D array or a variable (integer, real or complex)
+   !!----------------------------------------------------------------------
+   !!
+#  define OPERATION_SUM
+#  define INTEGER_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppsum_int
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppsum_a_int
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef INTEGER_TYPE
+!
+#  define REAL_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppsum_real
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppsum_a_real
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef REAL_TYPE
+#  undef OPERATION_SUM
+
+#  define OPERATION_SUM_DD
+#  define COMPLEX_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppsum_realdd
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppsum_a_realdd
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef COMPLEX_TYPE
+#  undef OPERATION_SUM_DD
+
+   !!----------------------------------------------------------------------
+   !!    ***  mpp_minloc2d, mpp_minloc3d, mpp_maxloc2d, mpp_maxloc3d
+   !!   
+   !!----------------------------------------------------------------------
+   !!
+#  define OPERATION_MINLOC
+#  define DIM_2d
+#     define ROUTINE_LOC           mpp_minloc2d
+#     include "mpp_loc_generic.h90"
+#     undef ROUTINE_LOC
+#  undef DIM_2d
+#  define DIM_3d
+#     define ROUTINE_LOC           mpp_minloc3d
+#     include "mpp_loc_generic.h90"
+#     undef ROUTINE_LOC
+#  undef DIM_3d
+#  undef OPERATION_MINLOC
+
+#  define OPERATION_MAXLOC
+#  define DIM_2d
+#     define ROUTINE_LOC           mpp_maxloc2d
+#     include "mpp_loc_generic.h90"
+#     undef ROUTINE_LOC
+#  undef DIM_2d
+#  define DIM_3d
+#     define ROUTINE_LOC           mpp_maxloc3d
+#     include "mpp_loc_generic.h90"
+#     undef ROUTINE_LOC
+#  undef DIM_3d
+#  undef OPERATION_MAXLOC
+
+   SUBROUTINE mpp_delay_sum( cdname, cdelay, y_in, pout, ldlast, kcom )
+      CHARACTER(len=*), INTENT(in   )               ::   cdname  ! name of the calling subroutine
+      CHARACTER(len=*), INTENT(in   )               ::   cdelay  ! name (used as id) of the delayed operation
+      COMPLEX(wp),      INTENT(in   ), DIMENSION(:) ::   y_in
+      REAL(wp),         INTENT(  out), DIMENSION(:) ::   pout
+      LOGICAL,          INTENT(in   )               ::   ldlast  ! true if this is the last time we call this routine
+      INTEGER,          INTENT(in   ), OPTIONAL     ::   kcom
+      !
+      pout(:) = REAL(y_in(:), wp)
+   END SUBROUTINE mpp_delay_sum
+
+   SUBROUTINE mpp_delay_max( cdname, cdelay, p_in, pout, ldlast, kcom )
+      CHARACTER(len=*), INTENT(in   )               ::   cdname  ! name of the calling subroutine
+      CHARACTER(len=*), INTENT(in   )               ::   cdelay  ! name (used as id) of the delayed operation
+      REAL(wp),         INTENT(in   ), DIMENSION(:) ::   p_in
+      REAL(wp),         INTENT(  out), DIMENSION(:) ::   pout
+      LOGICAL,          INTENT(in   )               ::   ldlast  ! true if this is the last time we call this routine
+      INTEGER,          INTENT(in   ), OPTIONAL     ::   kcom
+      !
+      pout(:) = p_in(:)
+   END SUBROUTINE mpp_delay_max
+
+   SUBROUTINE mpp_delay_rcv( kid )
+      INTEGER,INTENT(in   )      ::  kid 
+      WRITE(*,*) 'mpp_delay_rcv: You should not have seen this print! error?', kid
+   END SUBROUTINE mpp_delay_rcv
+   
+   SUBROUTINE mppstop( ldfinal, ld_force_abort )
+      LOGICAL, OPTIONAL, INTENT(in) :: ldfinal    ! source process number
+      LOGICAL, OPTIONAL, INTENT(in) :: ld_force_abort    ! source process number
+      STOP      ! non MPP case, just stop the run
+   END SUBROUTINE mppstop
+
+   SUBROUTINE mpp_ini_znl( knum )
+      INTEGER :: knum
+      WRITE(*,*) 'mpp_ini_znl: You should not have seen this print! error?', knum
+   END SUBROUTINE mpp_ini_znl
+
+   SUBROUTINE mpp_comm_free( kcom )
+      INTEGER :: kcom
+      WRITE(*,*) 'mpp_comm_free: You should not have seen this print! error?', kcom
+   END SUBROUTINE mpp_comm_free
+   
+#endif
+
+   !!----------------------------------------------------------------------
+   !!   All cases:         ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam   routines
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ctl_stop( cd1, cd2, cd3, cd4, cd5 ,   &
+      &                 cd6, cd7, cd8, cd9, cd10 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE  stop_opa  ***
+      !!
+      !! ** Purpose :   print in ocean.outpput file a error message and
+      !!                increment the error number (nstop) by one.
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd1, cd2, cd3, cd4, cd5
+      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd6, cd7, cd8, cd9, cd10
+      !!----------------------------------------------------------------------
+      !
+      nstop = nstop + 1
+
+      ! force to open ocean.output file
+      IF( numout == 6 ) CALL ctl_opn( numout, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+       
+      WRITE(numout,cform_err)
+      IF( PRESENT(cd1 ) )   WRITE(numout,*) TRIM(cd1)
+      IF( PRESENT(cd2 ) )   WRITE(numout,*) TRIM(cd2)
+      IF( PRESENT(cd3 ) )   WRITE(numout,*) TRIM(cd3)
+      IF( PRESENT(cd4 ) )   WRITE(numout,*) TRIM(cd4)
+      IF( PRESENT(cd5 ) )   WRITE(numout,*) TRIM(cd5)
+      IF( PRESENT(cd6 ) )   WRITE(numout,*) TRIM(cd6)
+      IF( PRESENT(cd7 ) )   WRITE(numout,*) TRIM(cd7)
+      IF( PRESENT(cd8 ) )   WRITE(numout,*) TRIM(cd8)
+      IF( PRESENT(cd9 ) )   WRITE(numout,*) TRIM(cd9)
+      IF( PRESENT(cd10) )   WRITE(numout,*) TRIM(cd10)
+
+                               CALL FLUSH(numout    )
+      IF( numstp     /= -1 )   CALL FLUSH(numstp    )
+      IF( numrun     /= -1 )   CALL FLUSH(numrun    )
+      IF( numevo_ice /= -1 )   CALL FLUSH(numevo_ice)
+      !
+      IF( cd1 == 'STOP' ) THEN
+         WRITE(numout,*)  'huge E-R-R-O-R : immediate stop'
+         CALL mppstop(ld_force_abort = .true.)
+      ENDIF
+      !
+   END SUBROUTINE ctl_stop
+
+
+   SUBROUTINE ctl_warn( cd1, cd2, cd3, cd4, cd5,   &
+      &                 cd6, cd7, cd8, cd9, cd10 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE  stop_warn  ***
+      !!
+      !! ** Purpose :   print in ocean.outpput file a error message and
+      !!                increment the warning number (nwarn) by one.
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd1, cd2, cd3, cd4, cd5
+      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd6, cd7, cd8, cd9, cd10
+      !!----------------------------------------------------------------------
+      !
+      nwarn = nwarn + 1
+      IF(lwp) THEN
+         WRITE(numout,cform_war)
+         IF( PRESENT(cd1 ) ) WRITE(numout,*) TRIM(cd1)
+         IF( PRESENT(cd2 ) ) WRITE(numout,*) TRIM(cd2)
+         IF( PRESENT(cd3 ) ) WRITE(numout,*) TRIM(cd3)
+         IF( PRESENT(cd4 ) ) WRITE(numout,*) TRIM(cd4)
+         IF( PRESENT(cd5 ) ) WRITE(numout,*) TRIM(cd5)
+         IF( PRESENT(cd6 ) ) WRITE(numout,*) TRIM(cd6)
+         IF( PRESENT(cd7 ) ) WRITE(numout,*) TRIM(cd7)
+         IF( PRESENT(cd8 ) ) WRITE(numout,*) TRIM(cd8)
+         IF( PRESENT(cd9 ) ) WRITE(numout,*) TRIM(cd9)
+         IF( PRESENT(cd10) ) WRITE(numout,*) TRIM(cd10)
+      ENDIF
+      CALL FLUSH(numout)
+      !
+   END SUBROUTINE ctl_warn
+
+
+   SUBROUTINE ctl_opn( knum, cdfile, cdstat, cdform, cdacce, klengh, kout, ldwp, karea )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ctl_opn  ***
+      !!
+      !! ** Purpose :   Open file and check if required file is available.
+      !!
+      !! ** Method  :   Fortan open
+      !!----------------------------------------------------------------------
+      INTEGER          , INTENT(  out) ::   knum      ! logical unit to open
+      CHARACTER(len=*) , INTENT(in   ) ::   cdfile    ! file name to open
+      CHARACTER(len=*) , INTENT(in   ) ::   cdstat    ! disposition specifier
+      CHARACTER(len=*) , INTENT(in   ) ::   cdform    ! formatting specifier
+      CHARACTER(len=*) , INTENT(in   ) ::   cdacce    ! access specifier
+      INTEGER          , INTENT(in   ) ::   klengh    ! record length
+      INTEGER          , INTENT(in   ) ::   kout      ! number of logical units for write
+      LOGICAL          , INTENT(in   ) ::   ldwp      ! boolean term for print
+      INTEGER, OPTIONAL, INTENT(in   ) ::   karea     ! proc number
+      !
+      CHARACTER(len=80) ::   clfile
+      INTEGER           ::   iost
+      !!----------------------------------------------------------------------
+      !
+      ! adapt filename
+      ! ----------------
+      clfile = TRIM(cdfile)
+      IF( PRESENT( karea ) ) THEN
+         IF( karea > 1 )   WRITE(clfile, "(a,'_',i4.4)") TRIM(clfile), karea-1
+      ENDIF
+#if defined key_agrif
+      IF( .NOT. Agrif_Root() )   clfile = TRIM(Agrif_CFixed())//'_'//TRIM(clfile)
+      knum=Agrif_Get_Unit()
+#else
+      knum=get_unit()
+#endif
+      IF( TRIM(cdfile) == '/dev/null' )   clfile = TRIM(cdfile)   ! force the use of /dev/null
+      !
+      iost=0
+      IF( cdacce(1:6) == 'DIRECT' )  THEN         ! cdacce has always more than 6 characters
+         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat, RECL=klengh         , ERR=100, IOSTAT=iost )
+      ELSE IF( TRIM(cdstat) == 'APPEND' )  THEN   ! cdstat can have less than 6 characters
+         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS='UNKNOWN', POSITION='APPEND', ERR=100, IOSTAT=iost )
+      ELSE
+         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat                      , ERR=100, IOSTAT=iost )
+      ENDIF
+      IF( iost /= 0 .AND. TRIM(clfile) == '/dev/null' ) &   ! for windows
+         &  OPEN(UNIT=knum,FILE='NUL', FORM=cdform, ACCESS=cdacce, STATUS=cdstat                      , ERR=100, IOSTAT=iost )   
+      IF( iost == 0 ) THEN
+         IF(ldwp) THEN
+            WRITE(kout,*) '     file   : ', TRIM(clfile),' open ok'
+            WRITE(kout,*) '     unit   = ', knum
+            WRITE(kout,*) '     status = ', cdstat
+            WRITE(kout,*) '     form   = ', cdform
+            WRITE(kout,*) '     access = ', cdacce
+            WRITE(kout,*)
+         ENDIF
+      ENDIF
+100   CONTINUE
+      IF( iost /= 0 ) THEN
+         IF(ldwp) THEN
+            WRITE(kout,*)
+            WRITE(kout,*) ' ===>>>> : bad opening file: ', TRIM(clfile)
+            WRITE(kout,*) ' =======   ===  '
+            WRITE(kout,*) '           unit   = ', knum
+            WRITE(kout,*) '           status = ', cdstat
+            WRITE(kout,*) '           form   = ', cdform
+            WRITE(kout,*) '           access = ', cdacce
+            WRITE(kout,*) '           iostat = ', iost
+            WRITE(kout,*) '           we stop. verify the file '
+            WRITE(kout,*)
+         ELSE  !!! Force writing to make sure we get the information - at least once - in this violent STOP!!
+            WRITE(*,*)
+            WRITE(*,*) ' ===>>>> : bad opening file: ', TRIM(clfile)
+            WRITE(*,*) ' =======   ===  '
+            WRITE(*,*) '           unit   = ', knum
+            WRITE(*,*) '           status = ', cdstat
+            WRITE(*,*) '           form   = ', cdform
+            WRITE(*,*) '           access = ', cdacce
+            WRITE(*,*) '           iostat = ', iost
+            WRITE(*,*) '           we stop. verify the file '
+            WRITE(*,*)
+         ENDIF
+         CALL FLUSH( kout ) 
+         STOP 'ctl_opn bad opening'
+      ENDIF
+      !
+   END SUBROUTINE ctl_opn
+
+
+   SUBROUTINE ctl_nam ( kios, cdnam, ldwp )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ctl_nam  ***
+      !!
+      !! ** Purpose :   Informations when error while reading a namelist
+      !!
+      !! ** Method  :   Fortan open
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(inout) ::   kios    ! IO status after reading the namelist
+      CHARACTER(len=*), INTENT(in   ) ::   cdnam   ! group name of namelist for which error occurs
+      CHARACTER(len=5)                ::   clios   ! string to convert iostat in character for print
+      LOGICAL         , INTENT(in   ) ::   ldwp    ! boolean term for print
+      !!----------------------------------------------------------------------
+      !
+      WRITE (clios, '(I5.0)')   kios
+      IF( kios < 0 ) THEN         
+         CALL ctl_warn( 'end of record or file while reading namelist '   &
+            &           // TRIM(cdnam) // ' iostat = ' // TRIM(clios) )
+      ENDIF
+      !
+      IF( kios > 0 ) THEN
+         CALL ctl_stop( 'misspelled variable in namelist '   &
+            &           // TRIM(cdnam) // ' iostat = ' // TRIM(clios) )
+      ENDIF
+      kios = 0
+      RETURN
+      !
+   END SUBROUTINE ctl_nam
+
+
+   INTEGER FUNCTION get_unit()
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  get_unit  ***
+      !!
+      !! ** Purpose :   return the index of an unused logical unit
+      !!----------------------------------------------------------------------
+      LOGICAL :: llopn
+      !!----------------------------------------------------------------------
+      !
+      get_unit = 15   ! choose a unit that is big enough then it is not already used in NEMO
+      llopn = .TRUE.
+      DO WHILE( (get_unit < 998) .AND. llopn )
+         get_unit = get_unit + 1
+         INQUIRE( unit = get_unit, opened = llopn )
+      END DO
+      IF( (get_unit == 999) .AND. llopn ) THEN
+         CALL ctl_stop( 'get_unit: All logical units until 999 are used...' )
+         get_unit = -1
+      ENDIF
+      !
+   END FUNCTION get_unit
+
+   !!----------------------------------------------------------------------
+END MODULE lib_mpp
Index: /utils/tools_ticket2413/DOMAINcfg/src/make_domain_cfg.f90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/make_domain_cfg.f90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/make_domain_cfg.f90	(revision 12863)
@@ -0,0 +1,20 @@
+PROGRAM make_domain_cfg
+   !!======================================================================
+   !!                     ***  PROGRAM  make_domain_cfg  ***
+   !!
+   !! ** Purpose :  tool to create domain_cfg.nc file via nemogcm
+   !!======================================================================
+   !! History :   OPA  ! 2001-02  (M. Imbard, A. Weaver)  Original code
+   !!   NEMO      1.0  ! 2003-10  (G. Madec) F90
+   !!----------------------------------------------------------------------
+   USE nemogcm   ! NEMO system   (nemo_gcm routine)
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: nemo.f90 2528 2010-12-27 17:33:53Z rblod $ 
+   !! Software governed by the CeCILL licence     (./LICENSE)
+   !!----------------------------------------------------------------------
+   !
+   CALL nemo_gcm           ! NEMO direct code
+   ! 
+   !!======================================================================
+END PROGRAM make_domain_cfg 
Index: /utils/tools_ticket2413/DOMAINcfg/src/mpp_allreduce_generic.h90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/mpp_allreduce_generic.h90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/mpp_allreduce_generic.h90	(revision 12863)
@@ -0,0 +1,82 @@
+!                          !==  IN: ptab is an array  ==!
+#   if defined REAL_TYPE
+#      define ARRAY_TYPE(i)    REAL(wp)         , INTENT(inout) ::   ARRAY_IN(i)
+#      define TMP_TYPE(i)      REAL(wp)         , ALLOCATABLE   ::   work(i)
+#      define MPI_TYPE mpi_double_precision
+#   endif
+#   if defined INTEGER_TYPE
+#      define ARRAY_TYPE(i)    INTEGER          , INTENT(inout) ::   ARRAY_IN(i)
+#      define TMP_TYPE(i)      INTEGER          , ALLOCATABLE   ::   work(i)
+#      define MPI_TYPE mpi_integer
+#   endif
+#   if defined COMPLEX_TYPE
+#      define ARRAY_TYPE(i)    COMPLEX          , INTENT(inout) ::   ARRAY_IN(i)
+#      define TMP_TYPE(i)      COMPLEX          , ALLOCATABLE   ::   work(i)
+#      define MPI_TYPE mpi_double_complex
+#   endif
+#   if defined DIM_0d
+#      define ARRAY_IN(i)   ptab
+#      define I_SIZE(ptab)          1
+#   endif
+#   if defined DIM_1d
+#      define ARRAY_IN(i)   ptab(i)
+#      define I_SIZE(ptab)          SIZE(ptab,1)
+#   endif
+#   if defined OPERATION_MAX
+#      define MPI_OPERATION mpi_max
+#   endif
+#   if defined OPERATION_MIN
+#      define MPI_OPERATION mpi_min
+#   endif
+#   if defined OPERATION_SUM
+#      define MPI_OPERATION mpi_sum
+#   endif
+#   if defined OPERATION_SUM_DD
+#      define MPI_OPERATION mpi_sumdd
+#   endif
+
+   SUBROUTINE ROUTINE_ALLREDUCE( cdname, ptab, kdim, kcom )
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*),                   INTENT(in   ) ::   cdname  ! name of the calling subroutine
+      ARRAY_TYPE(:)   ! array or pointer of arrays on which the boundary condition is applied
+      INTEGER, OPTIONAL, INTENT(in   ) ::   kdim        ! optional pointer dimension
+      INTEGER, OPTIONAL, INTENT(in   ) ::   kcom        ! optional communicator
+#if defined key_mpp_mpi
+      !
+      INTEGER :: ipi, ii, ierr
+      INTEGER :: ierror, ilocalcomm
+      TMP_TYPE(:)
+      !!-----------------------------------------------------------------------
+      !
+      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_glb = .TRUE. )
+      !
+      ilocalcomm = mpi_comm_oce
+      IF( PRESENT(kcom) )   ilocalcomm = kcom
+      !
+      IF( PRESENT(kdim) ) then
+         ipi = kdim
+      ELSE
+         ipi = I_SIZE(ptab)   ! 1st dimension
+      ENDIF
+      !
+      ALLOCATE(work(ipi))
+      IF( ln_timing ) CALL tic_tac(.TRUE., ld_global = .TRUE.)
+      CALL mpi_allreduce( ARRAY_IN(:), work, ipi, MPI_TYPE, MPI_OPERATION, ilocalcomm, ierror )
+      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.)
+      DO ii = 1, ipi
+         ARRAY_IN(ii) = work(ii)
+      ENDDO
+      DEALLOCATE(work)
+#else
+      ! nothing to do if non-mpp case
+      RETURN
+#endif
+
+   END SUBROUTINE ROUTINE_ALLREDUCE
+
+#undef ARRAY_TYPE
+#undef ARRAY_IN
+#undef I_SIZE
+#undef MPI_OPERATION
+#undef TMP_TYPE
+#undef MPI_TYPE
Index: /utils/tools_ticket2413/DOMAINcfg/src/mpp_bdy_generic.h90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/mpp_bdy_generic.h90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/mpp_bdy_generic.h90	(revision 12863)
@@ -0,0 +1,293 @@
+#   define ARRAY_TYPE(i,j,k,l,f)    REAL(wp)                    , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f)
+#   define NAT_IN(k)                cd_nat
+#   define SGN_IN(k)                psgn
+#   define IBD_IN(k)                kb_bdy
+#   define F_SIZE(ptab)             1
+#   define OPT_K(k)                 
+#   if defined DIM_2d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
+#      define K_SIZE(ptab)          1
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          SIZE(ptab,4)
+#   endif
+
+   SUBROUTINE ROUTINE_BDY( cdname, ptab, cd_nat, psgn      , kb_bdy )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_bdy_3d  ***
+      !!
+      !! ** Purpose :   Message passing management
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing BDY boundaries 
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi_bdy : mark for "east-west local boundary"
+      !!                    nbondj_bdy : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors 
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!
+      !! ** Action  :   ptab with update value at its periphery
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*)            , INTENT(in   ) ::   cdname      ! name of the calling subroutine
+      ARRAY_TYPE(:,:,:,:,:)   ! array or pointer of arrays on which the boundary condition is applied
+      CHARACTER(len=1)            , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
+      REAL(wp)                    , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
+      INTEGER                     , INTENT(in   ) ::   IBD_IN(:)   ! BDY boundary set
+      !
+      INTEGER  ::   ji, jj, jk, jl, jh, jf     ! dummy loop indices
+      INTEGER  ::   ipk, ipl, ipf              ! 3dimension of the input array
+      INTEGER  ::   imigr, iihom, ijhom        ! local integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      REAL(wp) ::   zland                      ! local scalar
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !
+      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
+      !!----------------------------------------------------------------------
+      !
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      ipl = L_SIZE(ptab)   ! 4th    -
+      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
+      !
+      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ipk, ipl, ipf, ld_lbc = .TRUE. )
+      !      
+      ALLOCATE( zt3ns(jpi,nn_hls,ipk,ipl,ipf,2), zt3sn(jpi,nn_hls,ipk,ipl,ipf,2),   &
+         &      zt3ew(jpj,nn_hls,ipk,ipl,ipf,2), zt3we(jpj,nn_hls,ipk,ipl,ipf,2)  )
+
+      zland = 0._wp
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      !
+      DO jf = 1, ipf                   ! number of arrays to be treated
+         !
+         !                                ! East-West boundaries
+         !                    
+         IF( nbondi == 2) THEN                  ! neither subdomain to the east nor to the west
+            !                                      !* Cyclic
+            IF( l_Iperio ) THEN
+               ARRAY_IN( 1 ,:,:,:,jf) = ARRAY_IN(jpim1,:,:,:,jf)
+               ARRAY_IN(jpi,:,:,:,jf) = ARRAY_IN(  2  ,:,:,:,jf)
+            ELSE                                   !* Closed
+               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(     1       :nn_hls,:,:,:,jf) = zland  ! east except F-point
+                                               ARRAY_IN(nlci-nn_hls+1:jpi   ,:,:,:,jf) = zland  ! west
+            ENDIF
+         ELSEIF(nbondi == -1) THEN              ! subdomain to the east only
+            IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(1:nn_hls,:,:,:,jf) = zland     ! south except F-point
+            !
+         ELSEIF(nbondi ==  1) THEN              ! subdomain to the west only
+            ARRAY_IN(nlci-nn_hls+1:jpi,:,:,:,jf) = zland    ! north
+         ENDIF
+         !                                ! North-South boundaries
+         !
+         IF( nbondj == 2) THEN                  ! neither subdomain to the north nor to the south
+            !                                      !* Cyclic
+            IF( l_Jperio ) THEN
+               ARRAY_IN(:, 1 ,:,:,jf) = ARRAY_IN(:,jpjm1,:,:,jf)
+               ARRAY_IN(:,jpj,:,:,jf) = ARRAY_IN(:,  2  ,:,:,jf)
+            ELSE                                   !* Closed
+               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(:,     1       :nn_hls,:,:,jf) = zland  ! east except F-point
+                                               ARRAY_IN(:,nlcj-nn_hls+1:jpj   ,:,:,jf) = zland  ! west
+            ENDIF
+         ELSEIF(nbondj == -1) THEN              ! subdomain to the east only
+            IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(:,1:nn_hls,:,:,jf) = zland     ! south except F-point
+            !
+         ELSEIF(nbondj ==  1) THEN              ! subdomain to the west only
+            ARRAY_IN(:,nlcj-nn_hls+1:jpj,:,:,jf) = zland    ! north
+         ENDIF
+         !
+      END DO
+
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity 
+      !
+      !
+      DO jf = 1, ipf
+         SELECT CASE ( nbondi_bdy(IBD_IN(jf)) )      ! Read Dirichlet lateral conditions
+         CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+            iihom = nlci-nreci
+               DO jl = 1, ipl
+                  DO jk = 1, ipk
+                     DO jh = 1, nn_hls
+                        zt3ew(:,jh,jk,jl,jf,1) = ARRAY_IN(nn_hls+jh,:,jk,jl,jf)
+                        zt3we(:,jh,jk,jl,jf,1) = ARRAY_IN(iihom +jh,:,jk,jl,jf)
+                     END DO
+                  END DO
+               END DO
+         END SELECT
+         !
+         !                           ! Migrations
+!!gm      imigr = nn_hls * jpj * ipk * ipl * ipf
+         imigr = nn_hls * jpj * ipk * ipl
+         !
+         IF( ln_timing ) CALL tic_tac(.TRUE.)
+         !
+         SELECT CASE ( nbondi_bdy(IBD_IN(jf)) )
+         CASE ( -1 )
+            CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req1 )
+            CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea )
+            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         CASE ( 0 )
+            CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 )
+            CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req2 )
+            CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea )
+            CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe )
+            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+            IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
+         CASE ( 1 )
+            CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 )
+            CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe )
+            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         END SELECT
+         !
+         IF( ln_timing ) CALL tic_tac(.FALSE.)
+         !
+         !                           ! Write Dirichlet lateral conditions
+         iihom = nlci-nn_hls
+         !
+         !
+         SELECT CASE ( nbondi_bdy_b(IBD_IN(jf)) )
+         CASE ( -1 )
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         CASE ( 0 )
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     ARRAY_IN(jh      ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2)
+                     ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         CASE ( 1 )
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     ARRAY_IN(jh      ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         END SELECT
+         !
+      END DO
+
+      ! 3. north fold treatment
+      ! -----------------------
+      !
+      ! do it before south directions so concerned processes can do it without waiting for the comm with the sourthern neighbor
+      IF( npolj /= 0) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:) OPT_K(:) )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_nfd( ptab, NAT_IN(:), SGN_IN(:) OPT_K(:) )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+
+      ! 4. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      DO jf = 1, ipf
+         IF( nbondj_bdy(IBD_IN(jf)) /= 2 ) THEN      ! Read Dirichlet lateral conditions
+            ijhom = nlcj-nrecj
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     zt3sn(:,jh,jk,jl,jf,1) = ARRAY_IN(:,ijhom +jh,jk,jl,jf)
+                     zt3ns(:,jh,jk,jl,jf,1) = ARRAY_IN(:,nn_hls+jh,jk,jl,jf)
+                  END DO
+               END DO
+            END DO
+         ENDIF
+         !
+         !                           ! Migrations
+!!gm      imigr = nn_hls * jpi * ipk * ipl * ipf
+         imigr = nn_hls * jpi * ipk * ipl
+         !
+         IF( ln_timing ) CALL tic_tac(.TRUE.)
+         ! 
+         SELECT CASE ( nbondj_bdy(IBD_IN(jf)) )
+         CASE ( -1 )
+            CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req1 )
+            CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono )
+            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         CASE ( 0 )
+            CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 )
+            CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req2 )
+            CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono )
+            CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso )
+            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+            IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
+         CASE ( 1 )
+            CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 )
+            CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso )
+            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         END SELECT
+         !
+         IF( ln_timing ) CALL tic_tac(.FALSE.)
+         !
+         !                           ! Write Dirichlet lateral conditions
+         ijhom = nlcj-nn_hls
+         !
+         SELECT CASE ( nbondj_bdy_b(IBD_IN(jf)) )
+         CASE ( -1 )
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         CASE ( 0 )
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     ARRAY_IN(:,      jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2)
+                     ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         CASE ( 1 )
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     ARRAY_IN(:,jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         END SELECT
+      END DO
+      !
+      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we  )
+      !
+   END SUBROUTINE ROUTINE_BDY
+
+#undef ARRAY_TYPE
+#undef NAT_IN
+#undef SGN_IN
+#undef IBD_IN
+#undef ARRAY_IN
+#undef K_SIZE
+#undef L_SIZE
+#undef F_SIZE
+#undef OPT_K
Index: /utils/tools_ticket2413/DOMAINcfg/src/mpp_lnk_generic.h90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/mpp_lnk_generic.h90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/mpp_lnk_generic.h90	(revision 12863)
@@ -0,0 +1,347 @@
+#if defined MULTI
+#   define NAT_IN(k)                cd_nat(k)   
+#   define SGN_IN(k)                psgn(k)
+#   define F_SIZE(ptab)             kfld
+#   define OPT_K(k)                 ,ipf
+#   if defined DIM_2d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D)                , INTENT(inout) ::   ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
+#      define K_SIZE(ptab)             1
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D)                , INTENT(inout) ::   ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3)
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D)                , INTENT(inout) ::   ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
+#      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4)
+#   endif
+#else
+#   define ARRAY_TYPE(i,j,k,l,f)    REAL(wp)                    , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f)
+#   define NAT_IN(k)                cd_nat
+#   define SGN_IN(k)                psgn
+#   define F_SIZE(ptab)             1
+#   define OPT_K(k)                 
+#   if defined DIM_2d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
+#      define K_SIZE(ptab)          1
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          SIZE(ptab,4)
+#   endif
+#endif
+
+#if defined MULTI
+   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn, kfld, cd_mpp, pval )
+      INTEGER                     , INTENT(in   ) ::   kfld        ! number of pt3d arrays
+#else
+   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn      , cd_mpp, pval )
+#endif
+      ARRAY_TYPE(:,:,:,:,:)                                        ! array or pointer of arrays on which the boundary condition is applied
+      CHARACTER(len=*)            , INTENT(in   ) ::   cdname      ! name of the calling subroutine
+      CHARACTER(len=1)            , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
+      REAL(wp)                    , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
+      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp      ! fill the overlap area only
+      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval        ! background value (used at closed boundaries)
+      !
+      INTEGER  ::    ji,  jj,  jk,  jl, jh, jf   ! dummy loop indices
+      INTEGER  ::   ipi, ipj, ipk, ipl, ipf      ! dimension of the input array
+      INTEGER  ::   imigr, iihom, ijhom          ! local integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err     ! for key_mpi_isend
+      INTEGER  ::   ierr
+      REAL(wp) ::   zland
+      INTEGER , DIMENSION(MPI_STATUS_SIZE)      ::   ml_stat        ! for key_mpi_isend
+      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! north-south & south-north  halos
+      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! east -west  & west - east  halos
+      !!----------------------------------------------------------------------
+      !
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      ipl = L_SIZE(ptab)   ! 4th    -
+      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
+      !
+      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ipk, ipl, ipf, ld_lbc = .TRUE. )
+      !
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0._wp     ! zero by default
+      ENDIF
+
+      ! ------------------------------- !
+      !   standard boundary treatment   !    ! CAUTION: semi-column notation is often impossible
+      ! ------------------------------- !
+      !
+      IF( .NOT. PRESENT( cd_mpp ) ) THEN     !==  standard close or cyclic treatment  ==!
+         !
+         DO jf = 1, ipf                      ! number of arrays to be treated
+            !
+            !                                ! East-West boundaries
+            IF( l_Iperio ) THEN                    !* cyclic
+               ARRAY_IN( 1 ,:,:,:,jf) = ARRAY_IN(jpim1,:,:,:,jf)
+               ARRAY_IN(jpi,:,:,:,jf) = ARRAY_IN(  2  ,:,:,:,jf)
+            ELSE                                   !* closed
+               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(     1       :nn_hls,:,:,:,jf) = zland    ! east except F-point
+                                               ARRAY_IN(nlci-nn_hls+1:jpi   ,:,:,:,jf) = zland    ! west
+            ENDIF
+            !                                ! North-South boundaries
+            IF( l_Jperio ) THEN                    !* cyclic (only with no mpp j-split)
+               ARRAY_IN(:, 1 ,:,:,jf) = ARRAY_IN(:, jpjm1,:,:,jf)
+               ARRAY_IN(:,jpj,:,:,jf) = ARRAY_IN(:,   2  ,:,:,jf)
+            ELSE                                   !* closed
+               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(:,     1       :nn_hls,:,:,jf) = zland    ! south except F-point
+                                               ARRAY_IN(:,nlcj-nn_hls+1:jpj   ,:,:,jf) = zland    ! north
+            ENDIF
+         END DO
+         !
+      ENDIF
+
+      ! ------------------------------- !
+      !      East and west exchange     !
+      ! ------------------------------- !
+      ! we play with the neigbours AND the row number because of the periodicity
+      !
+      IF( ABS(nbondi) == 1 ) ALLOCATE( zt3ew(jpj,nn_hls,ipk,ipl,ipf,1), zt3we(jpj,nn_hls,ipk,ipl,ipf,1) )
+      IF(     nbondi  == 0 ) ALLOCATE( zt3ew(jpj,nn_hls,ipk,ipl,ipf,2), zt3we(jpj,nn_hls,ipk,ipl,ipf,2) )
+      !
+      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
+      CASE ( -1 )
+         iihom = nlci-nreci
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     zt3we(:,jh,jk,jl,jf,1) = ARRAY_IN(iihom +jh,:,jk,jl,jf)
+                  END DO
+               END DO
+            END DO
+         END DO
+      CASE ( 0 )
+         iihom = nlci-nreci
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     zt3ew(:,jh,jk,jl,jf,1) = ARRAY_IN(nn_hls+jh,:,jk,jl,jf)
+                     zt3we(:,jh,jk,jl,jf,1) = ARRAY_IN(iihom +jh,:,jk,jl,jf)
+                  END DO
+               END DO
+            END DO
+         END DO
+      CASE ( 1 )
+         iihom = nlci-nreci
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     zt3ew(:,jh,jk,jl,jf,1) = ARRAY_IN(nn_hls+jh,:,jk,jl,jf)
+                  END DO
+               END DO
+            END DO
+         END DO
+      END SELECT
+      !                           ! Migrations
+      imigr = nn_hls * jpj * ipk * ipl * ipf      
+      !
+      IF( ln_timing ) CALL tic_tac(.TRUE.)
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt3ew(1,1,1,1,1,1), imigr, noea )
+         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe )
+         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         IF(l_isend)   CALL mpi_wait(ml_req2, ml_stat, ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt3we(1,1,1,1,1,1), imigr, nowe )
+         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err )
+      END SELECT
+      !
+      IF( ln_timing ) CALL tic_tac(.FALSE.)
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = nlci-nn_hls
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,1)
+                  END DO
+               END DO
+            END DO
+         END DO
+      CASE ( 0 )
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     ARRAY_IN(jh      ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2)
+                     ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         END DO
+      CASE ( 1 )
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     ARRAY_IN(jh      ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,1)
+                  END DO
+               END DO
+            END DO
+         END DO
+      END SELECT
+      !
+      IF( nbondi /= 2 ) DEALLOCATE( zt3ew, zt3we )
+      !
+      ! ------------------------------- !
+      !     3. north fold treatment     !
+      ! ------------------------------- !
+      ! do it before south directions so concerned processes can do it without waiting for the comm with the sourthern neighbor
+      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:) OPT_K(:) )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_nfd( ptab, NAT_IN(:), SGN_IN(:) OPT_K(:) )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+      !
+      ! ------------------------------- !
+      !  4. North and south directions  !
+      ! ------------------------------- !
+      ! always closed : we play only with the neigbours
+      !
+      IF( ABS(nbondj) == 1 ) ALLOCATE( zt3ns(jpi,nn_hls,ipk,ipl,ipf,1), zt3sn(jpi,nn_hls,ipk,ipl,ipf,1) )
+      IF(     nbondj  == 0 ) ALLOCATE( zt3ns(jpi,nn_hls,ipk,ipl,ipf,2), zt3sn(jpi,nn_hls,ipk,ipl,ipf,2) )
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         ijhom = nlcj-nrecj
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     zt3sn(:,jh,jk,jl,jf,1) = ARRAY_IN(:,ijhom +jh,jk,jl,jf)
+                  END DO
+               END DO
+            END DO
+         END DO
+      CASE ( 0 )
+         ijhom = nlcj-nrecj
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     zt3sn(:,jh,jk,jl,jf,1) = ARRAY_IN(:,ijhom +jh,jk,jl,jf)
+                     zt3ns(:,jh,jk,jl,jf,1) = ARRAY_IN(:,nn_hls+jh,jk,jl,jf)
+                  END DO
+               END DO
+            END DO
+         END DO
+      CASE ( 1 )
+         ijhom = nlcj-nrecj
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     zt3ns(:,jh,jk,jl,jf,1) = ARRAY_IN(:,nn_hls+jh,jk,jl,jf)
+                  END DO
+               END DO
+            END DO
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = nn_hls * jpi * ipk * ipl * ipf
+      !
+      IF( ln_timing ) CALL tic_tac(.TRUE.)
+      ! 
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt3ns(1,1,1,1,1,1), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err )
+      CASE ( 0 )
+         CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso )
+         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err )
+         IF(l_isend)   CALL mpi_wait(ml_req2, ml_stat, ml_err )
+      CASE ( 1 )
+         CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt3sn(1,1,1,1,1,1), imigr, noso )
+         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err )
+      END SELECT
+      !
+      IF( ln_timing ) CALL tic_tac(.FALSE.)
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = nlcj-nn_hls
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,1)
+                  END DO
+               END DO
+            END DO
+         END DO
+      CASE ( 0 )
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     ARRAY_IN(:,      jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2)
+                     ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2)
+                  END DO
+               END DO
+            END DO
+         END DO
+      CASE ( 1 )
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jh = 1, nn_hls
+                     ARRAY_IN(:,jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,1)
+                  END DO
+               END DO
+            END DO
+         END DO
+      END SELECT
+      !
+      IF( nbondj /= 2 ) DEALLOCATE( zt3ns, zt3sn )
+      !
+   END SUBROUTINE ROUTINE_LNK
+
+#undef ARRAY_TYPE
+#undef NAT_IN
+#undef SGN_IN
+#undef ARRAY_IN
+#undef K_SIZE
+#undef L_SIZE
+#undef F_SIZE
+#undef OPT_K
Index: /utils/tools_ticket2413/DOMAINcfg/src/mpp_loc_generic.h90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/mpp_loc_generic.h90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/mpp_loc_generic.h90	(revision 12863)
@@ -0,0 +1,109 @@
+                          !==  IN: ptab is an array  ==!
+#      define ARRAY_TYPE(i,j,k)    REAL(wp)        , INTENT(in   ) ::   ARRAY_IN(i,j,k)
+#      define MASK_TYPE(i,j,k)     REAL(wp)        , INTENT(in   ) ::   MASK_IN(i,j,k)
+#   if defined DIM_2d
+#      define ARRAY_IN(i,j,k)   ptab(i,j)
+#      define MASK_IN(i,j,k)    pmask(i,j)
+#      define INDEX_TYPE(k)        INTEGER         , INTENT(  out) ::   kindex(2)
+#      define K_SIZE(ptab)      1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_IN(i,j,k)   ptab(i,j,k)
+#      define MASK_IN(i,j,k)    pmask(i,j,k)
+#      define INDEX_TYPE(k)        INTEGER         , INTENT(  out) ::   kindex(3)
+#      define K_SIZE(ptab)      SIZE(ptab,3)
+#   endif
+#   if defined OPERATION_MAXLOC
+#      define MPI_OPERATION mpi_maxloc
+#      define LOC_OPERATION MAXLOC
+#      define ERRVAL -HUGE
+#   endif
+#   if defined OPERATION_MINLOC
+#      define MPI_OPERATION mpi_minloc
+#      define LOC_OPERATION MINLOC
+#      define ERRVAL HUGE
+#   endif
+
+   SUBROUTINE ROUTINE_LOC( cdname, ptab, pmask, pmin, kindex )
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in   ) ::   cdname  ! name of the calling subroutine
+      ARRAY_TYPE(:,:,:)                            ! array on which loctrans operation is applied
+      MASK_TYPE(:,:,:)                             ! local mask
+      REAL(wp)        , INTENT(  out) ::   pmin    ! Global minimum of ptab
+      INDEX_TYPE(:)                                ! index of minimum in global frame
+# if defined key_mpp_mpi
+      !
+      INTEGER  ::   ierror, ii, idim
+      INTEGER  ::   index0
+      REAL(wp) ::   zmin     ! local minimum
+      INTEGER , DIMENSION(:), ALLOCATABLE  ::   ilocs
+      REAL(wp), DIMENSION(2,1) ::   zain, zaout
+      !!-----------------------------------------------------------------------
+      !
+      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_glb = .TRUE. )
+      !
+      idim = SIZE(kindex)
+      !
+      IF ( ALL(MASK_IN(:,:,:) /= 1._wp) ) THEN
+         ! special case for land processors
+         zmin = ERRVAL(zmin)
+         index0 = 0
+      ELSE
+         ALLOCATE ( ilocs(idim) )
+         !
+         ilocs = LOC_OPERATION( ARRAY_IN(:,:,:) , mask= MASK_IN(:,:,:) == 1._wp )
+         zmin  = ARRAY_IN(ilocs(1),ilocs(2),ilocs(3))
+         !
+         kindex(1) = mig( ilocs(1) )
+#  if defined DIM_2d || defined DIM_3d    /* avoid warning when kindex has 1 element */
+         kindex(2) = mjg( ilocs(2) )
+#  endif
+#  if defined DIM_3d                      /* avoid warning when kindex has 2 elements */
+         kindex(3) = ilocs(3)
+#  endif
+         ! 
+         DEALLOCATE (ilocs)
+         !
+         index0 = kindex(1)-1   ! 1d index starting at 0
+#  if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */
+         index0 = index0 + jpiglo * (kindex(2)-1)
+#  endif
+#  if defined DIM_3d                     /* avoid warning when kindex has 2 elements */
+         index0 = index0 + jpiglo * jpjglo * (kindex(3)-1)
+#  endif
+      END IF
+      zain(1,:) = zmin
+      zain(2,:) = REAL(index0, wp)
+      !
+      IF( ln_timing ) CALL tic_tac(.TRUE., ld_global = .TRUE.)
+      CALL MPI_ALLREDUCE( zain, zaout, 1, MPI_2DOUBLE_PRECISION, MPI_OPERATION ,MPI_COMM_OCE, ierror)
+      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.)
+      !
+      pmin      = zaout(1,1)
+      index0    = NINT( zaout(2,1) )
+#  if defined DIM_3d                     /* avoid warning when kindex has 2 elements */
+      kindex(3) = index0 / (jpiglo*jpjglo)
+      index0    = index0 - kindex(3) * (jpiglo*jpjglo)
+#  endif
+#  if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */
+      kindex(2) = index0 / jpiglo
+      index0 = index0 - kindex(2) * jpiglo
+#  endif
+      kindex(1) = index0
+      kindex(:) = kindex(:) + 1   ! start indices at 1
+#else
+      kindex = 0 ; pmin = 0.
+      WRITE(*,*) 'ROUTINE_LOC: You should not have seen this print! error?'
+#endif
+
+   END SUBROUTINE ROUTINE_LOC
+
+#undef ARRAY_TYPE
+#undef MAX_TYPE
+#undef ARRAY_IN
+#undef MASK_IN
+#undef K_SIZE
+#undef MPI_OPERATION
+#undef LOC_OPERATION
+#undef INDEX_TYPE
+#undef ERRVAL
Index: /utils/tools_ticket2413/DOMAINcfg/src/mpp_nfd_generic.h90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/mpp_nfd_generic.h90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/mpp_nfd_generic.h90	(revision 12863)
@@ -0,0 +1,311 @@
+#if defined MULTI
+#   define NAT_IN(k)                cd_nat(k)   
+#   define SGN_IN(k)                psgn(k)
+#   define F_SIZE(ptab)             kfld
+#   define LBC_ARG                  (jf)
+#   if defined DIM_2d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D)     , INTENT(inout) ::   ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
+#      define K_SIZE(ptab)             1
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D)     , INTENT(inout) ::   ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3)
+#      define L_SIZE(ptab)             1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D)     , INTENT(inout) ::   ptab(f)
+#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
+#      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
+#      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4)
+#   endif
+#else
+!                          !==  IN: ptab is an array  ==!
+#   define ARRAY_TYPE(i,j,k,l,f)    REAL(wp)         , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f)
+#   define NAT_IN(k)                cd_nat
+#   define SGN_IN(k)                psgn
+#   define F_SIZE(ptab)             1
+#   define LBC_ARG
+#   if defined DIM_2d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
+#      define K_SIZE(ptab)          1
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          1
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l)
+#      define K_SIZE(ptab)          SIZE(ptab,3)
+#      define L_SIZE(ptab)          SIZE(ptab,4)
+#   endif
+#endif
+
+   SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kfld )
+      !!----------------------------------------------------------------------
+      ARRAY_TYPE(:,:,:,:,:)   ! array or pointer of arrays on which the boundary condition is applied
+      CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
+      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
+      INTEGER, OPTIONAL, INTENT(in   ) ::   kfld        ! number of pt3d arrays
+      !
+      INTEGER  ::   ji,  jj,  jk,  jl, jh, jf, jr   ! dummy loop indices
+      INTEGER  ::   ipi, ipj, ipk, ipl, ipf         ! dimension of the input array
+      INTEGER  ::   imigr, iihom, ijhom             ! local integers
+      INTEGER  ::   ierr, ibuffsize, ilci, ildi, ilei, iilb
+      INTEGER  ::   ij, iproc
+      INTEGER, DIMENSION (jpmaxngh)       ::   ml_req_nf   ! for mpi_isend when avoiding mpi_allgather
+      INTEGER                             ::   ml_err      ! for mpi_isend when avoiding mpi_allgather
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat     ! for mpi_isend when avoiding mpi_allgather
+      !                                                    ! Workspace for message transfers avoiding mpi_allgather
+      INTEGER                             ::   ipf_j       ! sum of lines for all multi fields
+      INTEGER                             ::   js          ! counter
+      INTEGER, DIMENSION(:,:),          ALLOCATABLE ::   jj_s  ! position of sent lines
+      INTEGER, DIMENSION(:),            ALLOCATABLE ::   ipj_s ! number of sent lines
+      REAL(wp), DIMENSION(:,:,:)      , ALLOCATABLE ::   ztabl
+      REAL(wp), DIMENSION(:,:,:,:,:)  , ALLOCATABLE ::   ztab, ztabr
+      REAL(wp), DIMENSION(:,:,:,:,:)  , ALLOCATABLE ::   znorthloc, zfoldwk      
+      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   znorthgloio
+      !!----------------------------------------------------------------------
+      !
+      ipk = K_SIZE(ptab)   ! 3rd dimension
+      ipl = L_SIZE(ptab)   ! 4th    -
+      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
+      !
+      IF( l_north_nogather ) THEN      !==  ????  ==!
+
+         ALLOCATE(ipj_s(ipf))
+
+         ipj      = 2            ! Max 2nd dimension of message transfers (last two j-line only)
+         ipj_s(:) = 1            ! Real 2nd dimension of message transfers (depending on perf requirement)
+                                 ! by default, only one line is exchanged
+
+         ALLOCATE( jj_s(ipf,2) )
+
+         ! re-define number of exchanged lines :
+         !  must be two during the first two time steps
+         !  to correct possible incoherent values on North fold lines from restart 
+
+         !!!!!!!!!           temporary switch off this optimisation ==> force TRUE           !!!!!!!!
+         !!!!!!!!!  needed to get the same results without agrif and with agrif and no zoom  !!!!!!!!
+         !!!!!!!!!                    I don't know why we must do that...                    !!!!!!!!
+         l_full_nf_update = .TRUE.
+
+         ! Two lines update (slower but necessary to avoid different values ion identical grid points
+         IF ( l_full_nf_update .OR.                          &    ! if coupling fields
+              ( ncom_stp == nit000 .AND. .NOT. ln_rstart ) ) &    ! at first time step, if not restart
+            ipj_s(:) = 2
+
+         ! Index of modifying lines in input
+         DO jf = 1, ipf                      ! Loop over the number of arrays to be processed
+            !
+            SELECT CASE ( npolj )
+            !
+            CASE ( 3, 4 )                       ! *  North fold  T-point pivot
+               !
+               SELECT CASE ( NAT_IN(jf) )
+               !
+               CASE ( 'T' , 'W' ,'U' )                            ! T-, U-, W-point
+                  jj_s(jf,1) = nlcj - 2 ;  jj_s(jf,2) = nlcj - 1
+               CASE ( 'V' , 'F' )                                 ! V-, F-point
+                  jj_s(jf,1) = nlcj - 3 ;  jj_s(jf,2) = nlcj - 2
+               END SELECT
+            !
+            CASE ( 5, 6 )                        ! *  North fold  F-point pivot
+               SELECT CASE ( NAT_IN(jf) )
+               !
+               CASE ( 'T' , 'W' ,'U' )                            ! T-, U-, W-point
+                  jj_s(jf,1) = nlcj - 1      
+                  ipj_s(jf) = 1                  ! need only one line anyway
+               CASE ( 'V' , 'F' )                                 ! V-, F-point
+                  jj_s(jf,1) = nlcj - 2 ;  jj_s(jf,2) = nlcj - 1
+               END SELECT
+            !
+            END SELECT
+            !
+         ENDDO
+         ! 
+         ipf_j = sum (ipj_s(:))      ! Total number of lines to be exchanged
+         !
+         ALLOCATE( znorthloc(jpimax,ipf_j,ipk,ipl,1) )
+         !
+         js = 0
+         DO jf = 1, ipf                      ! Loop over the number of arrays to be processed
+            DO jj = 1, ipj_s(jf)
+               js = js + 1
+               DO jl = 1, ipl
+                  DO jk = 1, ipk
+                     znorthloc(1:jpi,js,jk,jl,1) = ARRAY_IN(1:jpi,jj_s(jf,jj),jk,jl,jf)
+                  END DO
+               END DO
+            END DO
+         END DO
+         !
+         ibuffsize = jpimax * ipf_j * ipk * ipl
+         !
+         ALLOCATE( zfoldwk(jpimax,ipf_j,ipk,ipl,1) )
+         ALLOCATE( ztabr(jpimax*jpmaxngh,ipj,ipk,ipl,ipf) ) 
+         ! when some processors of the north fold are suppressed, 
+         ! values of ztab* arrays corresponding to these suppressed domain won't be defined 
+         ! and we need a default definition to 0.
+         ! a better test should be: a testing if "suppressed land-processors" belongs to the north-pole folding
+         IF ( jpni*jpnj /= jpnij ) ztabr(:,:,:,:,:) = 0._wp
+         !
+         ! start waiting time measurement
+         IF( ln_timing ) CALL tic_tac(.TRUE.)
+         !
+         DO jr = 1, nsndto
+            IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN
+               CALL mppsend( 5, znorthloc, ibuffsize, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) )
+            ENDIF
+         END DO
+         !
+         DO jr = 1,nsndto
+            iproc = nfipproc(isendto(jr),jpnj)
+            IF(iproc /= -1) THEN
+               iilb = nimppt(iproc+1)
+               ilci = nlcit (iproc+1)
+               ildi = nldit (iproc+1)
+               ilei = nleit (iproc+1)
+               IF( iilb            ==      1 )   ildi = 1      ! e-w boundary already done -> force to take 1st column
+               IF( iilb + ilci - 1 == jpiglo )   ilei = ilci   ! e-w boundary already done -> force to take last column
+               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)
+            ENDIF
+            IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN
+               CALL mpprecv(5, zfoldwk, ibuffsize, iproc)
+               js = 0
+               DO jf = 1, ipf ; DO jj = 1, ipj_s(jf)
+                  js = js + 1
+                  DO jl = 1, ipl
+                     DO jk = 1, ipk
+                        DO ji = ildi, ilei
+                           ztabr(iilb+ji,jj,jk,jl,jf) = zfoldwk(ji,js,jk,jl,1)
+                        END DO
+                     END DO
+                  END DO
+               END DO; END DO
+            ELSE IF( iproc == narea-1 ) THEN
+               DO jf = 1, ipf ; DO jj = 1, ipj_s(jf)
+                  DO jl = 1, ipl
+                     DO jk = 1, ipk
+                        DO ji = ildi, ilei
+                           ztabr(iilb+ji,jj,jk,jl,jf) = ARRAY_IN(ji,jj_s(jf,jj),jk,jl,jf)
+                        END DO
+                     END DO
+                  END DO
+               END DO; END DO
+            ENDIF
+         END DO
+         IF( l_isend ) THEN
+            DO jr = 1,nsndto
+               IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN
+                  CALL mpi_wait( ml_req_nf(jr), ml_stat, ml_err )
+               ENDIF
+            END DO
+         ENDIF
+         !
+         IF( ln_timing ) CALL tic_tac(.FALSE.)
+         !
+         ! North fold boundary condition
+         !
+         DO jf = 1, ipf
+            CALL lbc_nfd_nogather(ARRAY_IN(:,:,:,:,jf), ztabr(:,1:ipj_s(jf),:,:,jf), cd_nat LBC_ARG, psgn LBC_ARG )
+         END DO
+         !
+         DEALLOCATE( zfoldwk )
+         DEALLOCATE( ztabr ) 
+         DEALLOCATE( jj_s ) 
+         DEALLOCATE( ipj_s ) 
+      ELSE                             !==  ????  ==!
+         !
+         ipj   = 4            ! 2nd dimension of message transfers (last j-lines)
+         !
+         ALLOCATE( znorthloc(jpimax,ipj,ipk,ipl,ipf) )
+         !
+         DO jf = 1, ipf                ! put in znorthloc the last ipj j-lines of ptab
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jj = nlcj - ipj +1, nlcj
+                     ij = jj - nlcj + ipj
+                     znorthloc(1:jpi,ij,jk,jl,jf) = ARRAY_IN(1:jpi,jj,jk,jl,jf)
+                  END DO
+               END DO
+            END DO
+         END DO
+         !
+         ibuffsize = jpimax * ipj * ipk * ipl * ipf
+         !
+         ALLOCATE( ztab       (jpiglo,ipj,ipk,ipl,ipf     ) )
+         ALLOCATE( znorthgloio(jpimax,ipj,ipk,ipl,ipf,jpni) )
+         !
+         ! when some processors of the north fold are suppressed,
+         ! values of ztab* arrays corresponding to these suppressed domain won't be defined
+         ! and we need a default definition to 0.
+         ! a better test should be: a testing if "suppressed land-processors" belongs to the north-pole folding
+         IF ( jpni*jpnj /= jpnij ) ztab(:,:,:,:,:) = 0._wp
+         !
+         ! start waiting time measurement
+         IF( ln_timing ) CALL tic_tac(.TRUE.)
+         CALL MPI_ALLGATHER( znorthloc  , ibuffsize, MPI_DOUBLE_PRECISION,                &
+            &                znorthgloio, ibuffsize, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+         !
+         ! stop waiting time measurement
+         IF( ln_timing ) CALL tic_tac(.FALSE.)
+         !
+         DO jr = 1, ndim_rank_north         ! recover the global north array
+            iproc = nrank_north(jr) + 1
+            iilb  = nimppt(iproc)
+            ilci  = nlcit (iproc)
+            ildi  = nldit (iproc)
+            ilei  = nleit (iproc)
+            IF( iilb            ==      1 )   ildi = 1      ! e-w boundary already done -> force to take 1st column
+            IF( iilb + ilci - 1 == jpiglo )   ilei = ilci   ! e-w boundary already done -> force to take last column
+            DO jf = 1, ipf
+               DO jl = 1, ipl
+                  DO jk = 1, ipk
+                     DO jj = 1, ipj
+                        DO ji = ildi, ilei
+                           ztab(ji+iilb-1,jj,jk,jl,jf) = znorthgloio(ji,jj,jk,jl,jf,jr)
+                        END DO
+                     END DO
+                  END DO
+               END DO
+            END DO
+         END DO
+         DO jf = 1, ipf
+            CALL lbc_nfd( ztab(:,:,:,:,jf), cd_nat LBC_ARG, psgn LBC_ARG )   ! North fold boundary condition
+         END DO
+         !
+         DO jf = 1, ipf
+            DO jl = 1, ipl
+               DO jk = 1, ipk
+                  DO jj = nlcj-ipj+1, nlcj             ! Scatter back to ARRAY_IN
+                     ij = jj - nlcj + ipj
+                     DO ji= 1, nlci
+                        ARRAY_IN(ji,jj,jk,jl,jf) = ztab(ji+nimpp-1,ij,jk,jl,jf)
+                     END DO
+                  END DO
+               END DO
+            END DO
+         END DO
+         !
+      !
+         DEALLOCATE( ztab )
+         DEALLOCATE( znorthgloio )
+      ENDIF
+      !
+      DEALLOCATE( znorthloc )
+      !
+   END SUBROUTINE ROUTINE_NFD
+
+#undef ARRAY_TYPE
+#undef NAT_IN
+#undef SGN_IN
+#undef ARRAY_IN
+#undef K_SIZE
+#undef L_SIZE
+#undef F_SIZE
+#undef LBC_ARG
Index: /utils/tools_ticket2413/DOMAINcfg/src/mppini.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/mppini.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/mppini.F90	(revision 12863)
@@ -0,0 +1,1217 @@
+MODULE mppini
+   !!======================================================================
+   !!                       ***  MODULE mppini   ***
+   !! Ocean initialization : distributed memory computing initialization
+   !!======================================================================
+   !! History :  6.0  !  1994-11  (M. Guyon)  Original code
+   !!  OPA       7.0  !  1995-04  (J. Escobar, M. Imbard)
+   !!            8.0  !  1998-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
+   !!  NEMO      1.0  !  2004-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1
+   !!            3.4  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) add mpp_init_nfdcom
+   !!            3.   ! 2013-06  (I. Epicoco, S. Mocavero, CMCC) mpp_init_nfdcom: setup avoiding MPI communication 
+   !!            4.0  !  2016-06  (G. Madec)  use domain configuration file instead of bathymetry file
+   !!            4.0  !  2017-06  (J.M. Molines, T. Lovato) merge of mppini and mppini_2
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!  mpp_init          : Lay out the global domain over processors with/without land processor elimination
+   !!  mpp_init_mask     : Read global bathymetric information to facilitate land suppression
+   !!  mpp_init_ioipsl   : IOIPSL initialization in mpp 
+   !!  mpp_init_partition: Calculate MPP domain decomposition
+   !!  factorise         : Calculate the factors of the no. of MPI processes
+   !!  mpp_init_nfdcom   : Setup for north fold exchanges with explicit point-to-point messaging
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE bdy_oce        ! open BounDarY  
+   !
+   USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges 
+   USE lib_mpp        ! distribued memory computing library
+   USE iom            ! nemo I/O library 
+   USE ioipsl         ! I/O IPSL library
+   USE in_out_manager ! I/O Manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC mpp_init       ! called by opa.F90
+
+   INTEGER :: numbot = -1  ! 'bottom_level' local logical unit
+   INTEGER :: numbdy = -1  ! 'bdy_msk'      local logical unit
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: mppini.F90 10570 2019-01-24 15:14:49Z acc $ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+#if ! defined key_mpp_mpi
+   !!----------------------------------------------------------------------
+   !!   Default option :                            shared memory computing
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE mpp_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init  ***
+      !!
+      !! ** Purpose :   Lay out the global domain over processors.
+      !!
+      !! ** Method  :   Shared memory computing, set the local processor
+      !!              variables to the value of the global domain
+      !!----------------------------------------------------------------------
+      !
+      jpimax = jpiglo
+      jpjmax = jpjglo
+      jpi    = jpiglo
+      jpj    = jpjglo
+      jpk    = jpkglo
+      jpim1  = jpi-1                                            ! inner domain indices
+      jpjm1  = jpj-1                                            !   "           "
+      jpkm1  = MAX( 1, jpk-1 )                                  !   "           "
+      jpij   = jpi*jpj
+      jpni   = 1
+      jpnj   = 1
+      jpnij  = jpni*jpnj
+      nimpp  = 1           ! 
+      njmpp  = 1
+      nlci   = jpi
+      nlcj   = jpj
+      nldi   = 1
+      nldj   = 1
+      nlei   = jpi
+      nlej   = jpj
+      nbondi = 2
+      nbondj = 2
+      nidom  = FLIO_DOM_NONE
+      npolj = jperio
+      l_Iperio = jpni == 1 .AND. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7)
+      l_Jperio = jpnj == 1 .AND. (jperio == 2 .OR. jperio == 7)
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'mpp_init : NO massively parallel processing'
+         WRITE(numout,*) '~~~~~~~~ '
+         WRITE(numout,*) '   l_Iperio = ', l_Iperio, '    l_Jperio = ', l_Jperio 
+         WRITE(numout,*) '     npolj  = ',   npolj , '      njmpp  = ', njmpp
+      ENDIF
+      !
+      IF(  jpni /= 1 .OR. jpnj /= 1 .OR. jpnij /= 1 )                                     &
+         CALL ctl_stop( 'mpp_init: equality  jpni = jpnj = jpnij = 1 is not satisfied',   &
+            &           'the domain is lay out for distributed memory computing!' )
+         !
+   END SUBROUTINE mpp_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   'key_mpp_mpi'                     MPI massively parallel processing
+   !!----------------------------------------------------------------------
+
+
+   SUBROUTINE mpp_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init  ***
+      !!                    
+      !! ** Purpose :   Lay out the global domain over processors.
+      !!      If land processors are to be eliminated, this program requires the
+      !!      presence of the domain configuration file. Land processors elimination
+      !!      is performed if jpni x jpnj /= jpnij. In this case, using the MPP_PREP
+      !!      preprocessing tool, help for defining the best cutting out.
+      !!
+      !! ** Method  :   Global domain is distributed in smaller local domains.
+      !!      Periodic condition is a function of the local domain position
+      !!      (global boundary or neighbouring domain) and of the global
+      !!      periodic
+      !!      Type :         jperio global periodic condition
+      !!
+      !! ** Action : - set domain parameters
+      !!                    nimpp     : longitudinal index 
+      !!                    njmpp     : latitudinal  index
+      !!                    narea     : number for local area
+      !!                    nlci      : first dimension
+      !!                    nlcj      : second dimension
+      !!                    nbondi    : mark for "east-west local boundary"
+      !!                    nbondj    : mark for "north-south local boundary"
+      !!                    nproc     : number for local processor
+      !!                    noea      : number for local neighboring processor
+      !!                    nowe      : number for local neighboring processor
+      !!                    noso      : number for local neighboring processor
+      !!                    nono      : number for local neighboring processor
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jn, jproc, jarea   ! dummy loop indices
+      INTEGER ::   inijmin
+      INTEGER ::   i2add
+      INTEGER ::   inum                       ! local logical unit
+      INTEGER ::   idir, ifreq, icont         ! local integers
+      INTEGER ::   ii, il1, ili, imil         !   -       -
+      INTEGER ::   ij, il2, ilj, ijm1         !   -       -
+      INTEGER ::   iino, ijno, iiso, ijso     !   -       -
+      INTEGER ::   iiea, ijea, iiwe, ijwe     !   -       -
+      INTEGER ::   iarea0                     !   -       -
+      INTEGER ::   ierr, ios                  ! 
+      INTEGER ::   inbi, inbj, iimax,  ijmax, icnt1, icnt2
+      LOGICAL ::   llbest
+      LOGICAL ::   llwrtlay
+      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   iin, ii_nono, ii_noea          ! 1D workspace
+      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   ijn, ii_noso, ii_nowe          !  -     -
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iimppt, ilci, ibondi, ipproc   ! 2D workspace
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ijmppt, ilcj, ibondj, ipolj    !  -     -
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ilei, ildi, iono, ioea         !  -     -
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ilej, ildj, ioso, iowe         !  -     -
+      LOGICAL, ALLOCATABLE, DIMENSION(:,:) ::   llisoce                        !  -     -
+      NAMELIST/nambdy/ ln_bdy, nb_bdy, ln_coords_file, cn_coords_file,           &
+           &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,     &
+           &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             &  
+           &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, &
+           &             cn_ice, nn_ice_dta,                                     &
+           &             rn_ice_tem, rn_ice_sal, rn_ice_age,                     &
+           &             ln_vol, nn_volctl, nn_rimwidth, nb_jpk_bdy
+      !!----------------------------------------------------------------------
+
+      llwrtlay = lwp .OR. ln_ctl .OR. sn_cfctl%l_layout
+      ! do we need to take into account bdy_msk?
+      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist : BDY
+      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903)
+903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist (mppini)', lwp )
+      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist : BDY
+      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 )
+904   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist (mppini)', lwp )
+      !
+      IF(               ln_read_cfg ) CALL iom_open( cn_domcfg,    numbot )
+      IF( ln_bdy .AND. ln_mask_file ) CALL iom_open( cn_mask_file, numbdy )
+      !
+      !  1. Dimension arrays for subdomains
+      ! -----------------------------------
+      !
+      ! If dimensions of processor grid weren't specified in the namelist file
+      ! then we calculate them here now that we have our communicator size
+      IF( jpni < 1 .OR. jpnj < 1 ) THEN
+         CALL mpp_init_bestpartition( mppsize, jpni, jpnj )
+         llbest = .TRUE.
+      ELSE
+         CALL mpp_init_bestpartition( mppsize, inbi, inbj, icnt2 )
+         CALL mpp_basic_decomposition( jpni, jpnj, jpimax, jpjmax )
+         CALL mpp_basic_decomposition( inbi, inbj,  iimax,  ijmax )
+         IF( iimax*ijmax < jpimax*jpjmax ) THEN
+            llbest = .FALSE.
+            icnt1 = jpni*jpnj - mppsize
+            WRITE(ctmp1,9000) '   The chosen domain decomposition ', jpni, ' x ', jpnj, ' with ', icnt1, ' land sub-domains'
+            WRITE(ctmp2,9000) '   has larger MPI subdomains (jpi = ', jpimax, ', jpj = ', jpjmax, ', jpi*jpj = ', jpimax*jpjmax, ')'
+            WRITE(ctmp3,9000) '   than the following domain decompostion ', inbi, ' x ', inbj, ' with ', icnt2, ' land sub-domains'
+            WRITE(ctmp4,9000) '   which MPI subdomains size is jpi = ', iimax, ', jpj = ', ijmax, ', jpi*jpj = ', iimax*ijmax, ' '
+            CALL ctl_warn( 'mpp_init:', '~~~~~~~~ ', ctmp1, ctmp2, ctmp3, ctmp4, ' ', '    --- YOU ARE WASTING CPU... ---', ' ' )
+         ELSE
+            llbest = .TRUE.
+         ENDIF
+      ENDIF
+      
+      ! look for land mpi subdomains...
+      ALLOCATE( llisoce(jpni,jpnj) )
+      CALL mpp_init_isoce( jpni, jpnj, llisoce )
+      inijmin = COUNT( llisoce )   ! number of oce subdomains
+
+      IF( mppsize < inijmin ) THEN
+         WRITE(ctmp1,9001) '   With this specified domain decomposition: jpni = ', jpni, ' jpnj = ', jpnj
+         WRITE(ctmp2,9002) '   we can eliminate only ', jpni*jpnj - inijmin, ' land mpi subdomains therefore '
+         WRITE(ctmp3,9001) '   the number of ocean mpi subdomains (', inijmin,') exceed the number of MPI processes:', mppsize
+         WRITE(ctmp4,*) '   ==>>> There is the list of best domain decompositions you should use: '
+         CALL ctl_stop( 'mpp_init:', '~~~~~~~~ ', ctmp1, ctmp2, ctmp3, ctmp4 )
+         CALL mpp_init_bestpartition( mppsize, ldlist = .TRUE. )   ! must be done by all core
+         CALL ctl_stop( 'STOP' )
+      ENDIF
+
+      IF( mppsize > jpni*jpnj ) THEN
+         WRITE(ctmp1,9003) '   The number of mpi processes: ', mppsize
+         WRITE(ctmp2,9003) '   exceeds the maximum number of subdomains (ocean+land) = ', jpni*jpnj
+         WRITE(ctmp3,9001) '   defined by the following domain decomposition: jpni = ', jpni, ' jpnj = ', jpnj
+         WRITE(ctmp4,*) '   ==>>> There is the list of best domain decompositions you should use: '
+         CALL ctl_stop( 'mpp_init:', '~~~~~~~~ ', ctmp1, ctmp2, ctmp3, ctmp4 )
+         CALL mpp_init_bestpartition( mppsize, ldlist = .TRUE. )   ! must be done by all core
+         CALL ctl_stop( 'STOP' )
+      ENDIF
+
+      jpnij = mppsize   ! force jpnij definition <-- remove as much land subdomains as needed to reach this condition
+      IF( mppsize > inijmin ) THEN
+         WRITE(ctmp1,9003) '   The number of mpi processes: ', mppsize
+         WRITE(ctmp2,9003) '   exceeds the maximum number of ocean subdomains = ', inijmin
+         WRITE(ctmp3,9002) '   we suppressed ', jpni*jpnj - mppsize, ' land subdomains '
+         WRITE(ctmp4,9002) '   BUT we had to keep ', mppsize - inijmin, ' land subdomains that are useless...'
+         CALL ctl_warn( 'mpp_init:', '~~~~~~~~ ', ctmp1, ctmp2, ctmp3, ctmp4, ' ', '    --- YOU ARE WASTING CPU... ---', ' ' )
+      ELSE   ! mppsize = inijmin
+         IF(lwp) THEN
+            IF(llbest) WRITE(numout,*) 'mpp_init: You use an optimal domain decomposition'
+            WRITE(numout,*) '~~~~~~~~ '
+            WRITE(numout,9003) '   Number of mpi processes: ', mppsize
+            WRITE(numout,9003) '   Number of ocean subdomains = ', inijmin
+            WRITE(numout,9003) '   Number of suppressed land subdomains = ', jpni*jpnj - inijmin
+            WRITE(numout,*)
+         ENDIF
+      ENDIF
+9000  FORMAT (a, i4, a, i4, a, i7, a)
+9001  FORMAT (a, i4, a, i4)
+9002  FORMAT (a, i4, a)
+9003  FORMAT (a, i5)
+
+      IF( numbot /= -1 )   CALL iom_close( numbot )
+      IF( numbdy /= -1 )   CALL iom_close( numbdy )
+    
+      ALLOCATE(  nfiimpp(jpni,jpnj), nfipproc(jpni,jpnj), nfilcit(jpni,jpnj) ,    &
+         &       nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) ,    &
+         &       njmppt(jpnij) , ibonjt(jpnij) , nldit(jpnij) , nldjt(jpnij) ,    &
+         &                                       nleit(jpnij) , nlejt(jpnij) ,    &
+         &       iin(jpnij), ii_nono(jpnij), ii_noea(jpnij),   &
+         &       ijn(jpnij), ii_noso(jpnij), ii_nowe(jpnij),   &
+         &       iimppt(jpni,jpnj), ilci(jpni,jpnj), ibondi(jpni,jpnj), ipproc(jpni,jpnj),   &
+         &       ijmppt(jpni,jpnj), ilcj(jpni,jpnj), ibondj(jpni,jpnj), ipolj(jpni,jpnj),   &
+         &       ilei(jpni,jpnj), ildi(jpni,jpnj), iono(jpni,jpnj), ioea(jpni,jpnj),   &
+         &       ilej(jpni,jpnj), ildj(jpni,jpnj), ioso(jpni,jpnj), iowe(jpni,jpnj),   &
+         &       STAT=ierr )
+      CALL mpp_sum( 'mppini', ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'mpp_init: unable to allocate standard ocean arrays' )
+      
+#if defined key_agrif
+      IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90)
+         IF( jpiglo /= nbcellsx + 2 + 2*nbghostcells ) THEN
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) 'jpiglo shoud be: ', nbcellsx + 2 + 2*nbghostcells
+            ENDIF        
+            CALL ctl_stop( 'STOP', 'mpp_init: Agrif children requires jpiglo == nbcellsx + 2 + 2*nbghostcells' )
+         ENDIF   
+         IF( jpjglo /= nbcellsy + 2 + 2*nbghostcells ) THEN
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) 'jpjglo shoud be: ', nbcellsy + 2 + 2*nbghostcells
+            ENDIF        
+            CALL ctl_stop( 'STOP', 'mpp_init: Agrif children requires jpjglo == nbcellsy + 2 + 2*nbghostcells' )
+         ENDIF   
+         IF( ln_use_jattr )   CALL ctl_stop( 'STOP', 'mpp_init:Agrif children requires ln_use_jattr = .false. ' )
+      ENDIF
+#endif
+      !
+      !  2. Index arrays for subdomains
+      ! -----------------------------------
+      !
+      nreci = 2 * nn_hls
+      nrecj = 2 * nn_hls
+      CALL mpp_basic_decomposition( jpni, jpnj, jpimax, jpjmax, iimppt, ijmppt, ilci, ilcj )
+      nfiimpp(:,:) = iimppt(:,:)
+      nfilcit(:,:) = ilci(:,:)
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'MPI Message Passing MPI - domain lay out over processors'
+         WRITE(numout,*)
+         WRITE(numout,*) '   defines mpp subdomains'
+         WRITE(numout,*) '      jpni = ', jpni  
+         WRITE(numout,*) '      jpnj = ', jpnj
+         WRITE(numout,*)
+         WRITE(numout,*) '      sum ilci(i,1) = ', sum(ilci(:,1)), ' jpiglo = ', jpiglo
+         WRITE(numout,*) '      sum ilcj(1,j) = ', sum(ilcj(1,:)), ' jpjglo = ', jpjglo
+      ENDIF
+     
+      ! 3. Subdomain description in the Regular Case
+      ! --------------------------------------------
+      ! specific cases where there is no communication -> must do the periodicity by itself
+      ! Warning: because of potential land-area suppression, do not use nbond[ij] == 2  
+      l_Iperio = jpni == 1 .AND. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7)
+      l_Jperio = jpnj == 1 .AND. (jperio == 2 .OR. jperio == 7)
+      
+      DO jarea = 1, jpni*jpnj
+         !
+         iarea0 = jarea - 1
+         ii = 1 + MOD(iarea0,jpni)
+         ij = 1 +     iarea0/jpni
+         ili = ilci(ii,ij)
+         ilj = ilcj(ii,ij)
+         ibondi(ii,ij) = 0                         ! default: has e-w neighbours
+         IF( ii   ==    1 )   ibondi(ii,ij) = -1   ! first column, has only e neighbour
+         IF( ii   == jpni )   ibondi(ii,ij) =  1   ! last column,  has only w neighbour
+         IF( jpni ==    1 )   ibondi(ii,ij) =  2   ! has no e-w neighbour
+         ibondj(ii,ij) = 0                         ! default: has n-s neighbours
+         IF( ij   ==    1 )   ibondj(ii,ij) = -1   ! first row, has only n neighbour
+         IF( ij   == jpnj )   ibondj(ii,ij) =  1   ! last row,  has only s neighbour
+         IF( jpnj ==    1 )   ibondj(ii,ij) =  2   ! has no n-s neighbour
+
+         ! Subdomain neighbors (get their zone number): default definition
+         ioso(ii,ij) = iarea0 - jpni
+         iowe(ii,ij) = iarea0 - 1
+         ioea(ii,ij) = iarea0 + 1
+         iono(ii,ij) = iarea0 + jpni
+         ildi(ii,ij) =  1  + nn_hls
+         ilei(ii,ij) = ili - nn_hls
+         ildj(ii,ij) =  1  + nn_hls
+         ilej(ii,ij) = ilj - nn_hls
+
+         ! East-West periodicity: change ibondi, ioea, iowe
+         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 ) THEN
+            IF( jpni  /= 1 )   ibondi(ii,ij) = 0                        ! redefine: all have e-w neighbours
+            IF( ii ==    1 )   iowe(ii,ij) = iarea0 +        (jpni-1)   ! redefine: first column, address of w neighbour
+            IF( ii == jpni )   ioea(ii,ij) = iarea0 -        (jpni-1)   ! redefine: last column,  address of e neighbour
+         ENDIF
+
+         ! Simple North-South periodicity: change ibondj, ioso, iono
+         IF( jperio == 2 .OR. jperio == 7 ) THEN
+            IF( jpnj  /= 1 )   ibondj(ii,ij) = 0                        ! redefine: all have n-s neighbours
+            IF( ij ==    1 )   ioso(ii,ij) = iarea0 + jpni * (jpnj-1)   ! redefine: first row, address of s neighbour
+            IF( ij == jpnj )   iono(ii,ij) = iarea0 - jpni * (jpnj-1)   ! redefine: last row,  address of n neighbour
+         ENDIF
+
+         ! North fold: define ipolj, change iono. Warning: we do not change ibondj...
+         ipolj(ii,ij) = 0
+         IF( jperio == 3 .OR. jperio == 4 ) THEN
+            ijm1 = jpni*(jpnj-1)
+            imil = ijm1+(jpni+1)/2
+            IF( jarea > ijm1 ) ipolj(ii,ij) = 3
+            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
+            IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1   ! MPI rank of northern neighbour
+         ENDIF
+         IF( jperio == 5 .OR. jperio == 6 ) THEN
+            ijm1 = jpni*(jpnj-1)
+            imil = ijm1+(jpni+1)/2
+            IF( jarea > ijm1) ipolj(ii,ij) = 5
+            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
+            IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1    ! MPI rank of northern neighbour
+         ENDIF
+         !
+      END DO
+
+      ! 4. deal with land subdomains
+      ! ----------------------------
+      !
+      ! specify which subdomains are oce subdomains; other are land subdomains
+      ipproc(:,:) = -1
+      icont = -1
+      DO jarea = 1, jpni*jpnj
+         iarea0 = jarea - 1
+         ii = 1 + MOD(iarea0,jpni)
+         ij = 1 +     iarea0/jpni
+         IF( llisoce(ii,ij) ) THEN
+            icont = icont + 1
+            ipproc(ii,ij) = icont
+            iin(icont+1) = ii
+            ijn(icont+1) = ij
+         ENDIF
+      END DO
+      ! if needed add some land subdomains to reach jpnij active subdomains
+      i2add = jpnij - inijmin
+      DO jarea = 1, jpni*jpnj
+         iarea0 = jarea - 1
+         ii = 1 + MOD(iarea0,jpni)
+         ij = 1 +     iarea0/jpni
+         IF( .NOT. llisoce(ii,ij) .AND. i2add > 0 ) THEN
+            icont = icont + 1
+            ipproc(ii,ij) = icont
+            iin(icont+1) = ii
+            ijn(icont+1) = ij
+            i2add = i2add - 1
+         ENDIF
+      END DO
+      nfipproc(:,:) = ipproc(:,:)
+
+      ! neighbour treatment: change ibondi, ibondj if next to a land zone
+      DO jarea = 1, jpni*jpnj
+         ii = 1 + MOD( jarea-1  , jpni )
+         ij = 1 +     (jarea-1) / jpni
+         ! land-only area with an active n neigbour
+         IF ( ipproc(ii,ij) == -1 .AND. 0 <= iono(ii,ij) .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
+            iino = 1 + MOD( iono(ii,ij) , jpni )                    ! ii index of this n neigbour
+            ijno = 1 +      iono(ii,ij) / jpni                      ! ij index of this n neigbour
+            ! In case of north fold exchange: I am the n neigbour of my n neigbour!! (#1057)
+            ! --> for northern neighbours of northern row processors (in case of north-fold)
+            !     need to reverse the LOGICAL direction of communication 
+            idir = 1                                           ! we are indeed the s neigbour of this n neigbour
+            IF( ij == jpnj .AND. ijno == jpnj )   idir = -1    ! both are on the last row, we are in fact the n neigbour
+            IF( ibondj(iino,ijno) == idir     )   ibondj(iino,ijno) =   2     ! this n neigbour had only a s/n neigbour -> no more
+            IF( ibondj(iino,ijno) == 0        )   ibondj(iino,ijno) = -idir   ! this n neigbour had both, n-s neighbours -> keep 1
+         ENDIF
+         ! land-only area with an active s neigbour
+         IF( ipproc(ii,ij) == -1 .AND. 0 <= ioso(ii,ij) .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
+            iiso = 1 + MOD( ioso(ii,ij) , jpni )                    ! ii index of this s neigbour
+            ijso = 1 +      ioso(ii,ij) / jpni                      ! ij index of this s neigbour
+            IF( ibondj(iiso,ijso) == -1 )   ibondj(iiso,ijso) = 2   ! this s neigbour had only a n neigbour    -> no more neigbour
+            IF( ibondj(iiso,ijso) ==  0 )   ibondj(iiso,ijso) = 1   ! this s neigbour had both, n-s neighbours -> keep s neigbour
+         ENDIF
+         ! land-only area with an active e neigbour
+         IF( ipproc(ii,ij) == -1 .AND. 0 <= ioea(ii,ij) .AND. ioea(ii,ij) <= jpni*jpnj-1 ) THEN
+            iiea = 1 + MOD( ioea(ii,ij) , jpni )                    ! ii index of this e neigbour
+            ijea = 1 +      ioea(ii,ij) / jpni                      ! ij index of this e neigbour
+            IF( ibondi(iiea,ijea) == 1 )   ibondi(iiea,ijea) =  2   ! this e neigbour had only a w neigbour    -> no more neigbour
+            IF( ibondi(iiea,ijea) == 0 )   ibondi(iiea,ijea) = -1   ! this e neigbour had both, e-w neighbours -> keep e neigbour
+         ENDIF
+         ! land-only area with an active w neigbour
+         IF( ipproc(ii,ij) == -1 .AND. 0 <= iowe(ii,ij) .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
+            iiwe = 1 + MOD( iowe(ii,ij) , jpni )                    ! ii index of this w neigbour
+            ijwe = 1 +      iowe(ii,ij) / jpni                      ! ij index of this w neigbour
+            IF( ibondi(iiwe,ijwe) == -1 )   ibondi(iiwe,ijwe) = 2   ! this w neigbour had only a e neigbour    -> no more neigbour
+            IF( ibondi(iiwe,ijwe) ==  0 )   ibondi(iiwe,ijwe) = 1   ! this w neigbour had both, e-w neighbours -> keep w neigbour
+         ENDIF
+      END DO
+
+      ! Update il[de][ij] according to modified ibond[ij]
+      ! ----------------------
+      DO jproc = 1, jpnij
+         ii = iin(jproc)
+         ij = ijn(jproc)
+         IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) =  1
+         IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ilci(ii,ij)
+         IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) =  1
+         IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilcj(ii,ij)
+      END DO
+      
+      ! 5. Subdomain print
+      ! ------------------
+      IF(lwp) THEN
+         ifreq = 4
+         il1 = 1
+         DO jn = 1, (jpni-1)/ifreq+1
+            il2 = MIN(jpni,il1+ifreq-1)
+            WRITE(numout,*)
+            WRITE(numout,9400) ('***',ji=il1,il2-1)
+            DO jj = jpnj, 1, -1
+               WRITE(numout,9403) ('   ',ji=il1,il2-1)
+               WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
+               WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
+               WRITE(numout,9403) ('   ',ji=il1,il2-1)
+               WRITE(numout,9400) ('***',ji=il1,il2-1)
+            END DO
+            WRITE(numout,9401) (ji,ji=il1,il2)
+            il1 = il1+ifreq
+         END DO
+ 9400    FORMAT('           ***'   ,20('*************',a3)    )
+ 9403    FORMAT('           *     ',20('         *   ',a3)    )
+ 9401    FORMAT('              '   ,20('   ',i3,'          ') )
+ 9402    FORMAT('       ',i3,' *  ',20(i3,'  x',i3,'   *   ') )
+ 9404    FORMAT('           *  '   ,20('      ',i3,'   *   ') )
+      ENDIF
+         
+      ! just to save nono etc for all proc
+      ! warning ii*ij (zone) /= nproc (processors)!
+      ! ioso = zone number, ii_noso = proc number
+      ii_noso(:) = -1
+      ii_nono(:) = -1
+      ii_noea(:) = -1
+      ii_nowe(:) = -1 
+      DO jproc = 1, jpnij
+         ii = iin(jproc)
+         ij = ijn(jproc)
+         IF( 0 <= ioso(ii,ij) .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN
+            iiso = 1 + MOD( ioso(ii,ij) , jpni )
+            ijso = 1 +      ioso(ii,ij) / jpni
+            ii_noso(jproc) = ipproc(iiso,ijso)
+         ENDIF
+         IF( 0 <= iowe(ii,ij) .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN
+          iiwe = 1 + MOD( iowe(ii,ij) , jpni )
+          ijwe = 1 +      iowe(ii,ij) / jpni
+          ii_nowe(jproc) = ipproc(iiwe,ijwe)
+         ENDIF
+         IF( 0 <= ioea(ii,ij) .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN
+            iiea = 1 + MOD( ioea(ii,ij) , jpni )
+            ijea = 1 +      ioea(ii,ij) / jpni
+            ii_noea(jproc)= ipproc(iiea,ijea)
+         ENDIF
+         IF( 0 <= iono(ii,ij) .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN
+            iino = 1 + MOD( iono(ii,ij) , jpni )
+            ijno = 1 +      iono(ii,ij) / jpni
+            ii_nono(jproc)= ipproc(iino,ijno)
+         ENDIF
+      END DO
+    
+      ! 6. Change processor name
+      ! ------------------------
+      ii = iin(narea)
+      ij = ijn(narea)
+      !
+      ! set default neighbours
+      noso = ii_noso(narea)
+      nowe = ii_nowe(narea)
+      noea = ii_noea(narea)
+      nono = ii_nono(narea)
+      nlci = ilci(ii,ij)  
+      nldi = ildi(ii,ij)
+      nlei = ilei(ii,ij)
+      nlcj = ilcj(ii,ij)  
+      nldj = ildj(ii,ij)
+      nlej = ilej(ii,ij)
+      nbondi = ibondi(ii,ij)
+      nbondj = ibondj(ii,ij)
+      nimpp = iimppt(ii,ij)  
+      njmpp = ijmppt(ii,ij)
+      jpi = nlci
+      jpj = nlcj
+      jpk = jpkglo                                             ! third dim
+#if defined key_agrif
+      ! simple trick to use same vertical grid as parent but different number of levels: 
+      ! Save maximum number of levels in jpkglo, then define all vertical grids with this number.
+      ! Suppress once vertical online interpolation is ok
+!!$      IF(.NOT.Agrif_Root())   jpkglo = Agrif_Parent( jpkglo )
+#endif
+      jpim1 = jpi-1                                            ! inner domain indices
+      jpjm1 = jpj-1                                            !   "           "
+      jpkm1 = MAX( 1, jpk-1 )                                  !   "           "
+      jpij  = jpi*jpj                                          !  jpi x j
+      DO jproc = 1, jpnij
+         ii = iin(jproc)
+         ij = ijn(jproc)
+         nlcit(jproc) = ilci(ii,ij)
+         nldit(jproc) = ildi(ii,ij)
+         nleit(jproc) = ilei(ii,ij)
+         nlcjt(jproc) = ilcj(ii,ij)
+         nldjt(jproc) = ildj(ii,ij)
+         nlejt(jproc) = ilej(ii,ij)
+         ibonit(jproc) = ibondi(ii,ij)
+         ibonjt(jproc) = ibondj(ii,ij)
+         nimppt(jproc) = iimppt(ii,ij)  
+         njmppt(jproc) = ijmppt(ii,ij) 
+      END DO
+
+      ! Save processor layout in ascii file
+      IF (llwrtlay) THEN
+         CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
+         WRITE(inum,'(a)') '   jpnij   jpimax  jpjmax    jpk  jpiglo  jpjglo'//&
+   &           ' ( local:    narea     jpi     jpj )'
+         WRITE(inum,'(6i8,a,3i8,a)') jpnij,jpimax,jpjmax,jpk,jpiglo,jpjglo,&
+   &           ' ( local: ',narea,jpi,jpj,' )'
+         WRITE(inum,'(a)') 'nproc nlci nlcj nldi nldj nlei nlej nimp njmp nono noso nowe noea nbondi nbondj '
+
+         DO jproc = 1, jpnij
+            WRITE(inum,'(13i5,2i7)')   jproc-1, nlcit  (jproc), nlcjt  (jproc),   &
+               &                                nldit  (jproc), nldjt  (jproc),   &
+               &                                nleit  (jproc), nlejt  (jproc),   &
+               &                                nimppt (jproc), njmppt (jproc),   & 
+               &                                ii_nono(jproc), ii_noso(jproc),   &
+               &                                ii_nowe(jproc), ii_noea(jproc),   &
+               &                                ibonit (jproc), ibonjt (jproc) 
+         END DO
+      END IF
+
+      !                          ! north fold parameter
+      ! Defined npolj, either 0, 3 , 4 , 5 , 6
+      ! In this case the important thing is that npolj /= 0
+      ! Because if we go through these line it is because jpni >1 and thus
+      ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
+      npolj = 0
+      ij = ijn(narea)
+      IF( jperio == 3 .OR. jperio == 4 ) THEN
+         IF( ij == jpnj )   npolj = 3
+      ENDIF
+      IF( jperio == 5 .OR. jperio == 6 ) THEN
+         IF( ij == jpnj )   npolj = 5
+      ENDIF
+      !
+      nproc = narea-1
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '   resulting internal parameters : '
+         WRITE(numout,*) '      nproc  = ', nproc
+         WRITE(numout,*) '      nowe   = ', nowe  , '   noea  =  ', noea
+         WRITE(numout,*) '      nono   = ', nono  , '   noso  =  ', noso
+         WRITE(numout,*) '      nbondi = ', nbondi
+         WRITE(numout,*) '      nbondj = ', nbondj
+         WRITE(numout,*) '      npolj  = ', npolj
+         WRITE(numout,*) '    l_Iperio = ', l_Iperio
+         WRITE(numout,*) '    l_Jperio = ', l_Jperio
+         WRITE(numout,*) '      nlci   = ', nlci
+         WRITE(numout,*) '      nlcj   = ', nlcj
+         WRITE(numout,*) '      nimpp  = ', nimpp
+         WRITE(numout,*) '      njmpp  = ', njmpp
+         WRITE(numout,*) '      nreci  = ', nreci  
+         WRITE(numout,*) '      nrecj  = ', nrecj  
+         WRITE(numout,*) '      nn_hls = ', nn_hls 
+      ENDIF
+
+      !                          ! Prepare mpp north fold
+      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
+         CALL mpp_ini_north
+         IF (lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) '   ==>>>   North fold boundary prepared for jpni >1'
+            ! additional prints in layout.dat
+         ENDIF
+         IF (llwrtlay) THEN
+            WRITE(inum,*)
+            WRITE(inum,*)
+            WRITE(inum,*) 'number of subdomains located along the north fold : ', ndim_rank_north
+            WRITE(inum,*) 'Rank of the subdomains located along the north fold : ', ndim_rank_north
+            DO jproc = 1, ndim_rank_north, 5
+               WRITE(inum,*) nrank_north( jproc:MINVAL( (/jproc+4,ndim_rank_north/) ) )
+            END DO
+         ENDIF
+      ENDIF
+      !
+      CALL mpp_init_ioipsl       ! Prepare NetCDF output file (if necessary)
+      !
+      IF( ln_nnogather ) THEN
+         CALL mpp_init_nfdcom     ! northfold neighbour lists
+         IF (llwrtlay) THEN
+            WRITE(inum,*)
+            WRITE(inum,*)
+            WRITE(inum,*) 'north fold exchanges with explicit point-to-point messaging :'
+            WRITE(inum,*) 'nfsloop : ', nfsloop
+            WRITE(inum,*) 'nfeloop : ', nfeloop
+            WRITE(inum,*) 'nsndto : ', nsndto
+            WRITE(inum,*) 'isendto : ', isendto
+         ENDIF
+      ENDIF
+      !
+      IF (llwrtlay) CLOSE(inum)   
+      !
+      DEALLOCATE(iin, ijn, ii_nono, ii_noea, ii_noso, ii_nowe,    &
+         &       iimppt, ijmppt, ibondi, ibondj, ipproc, ipolj,   &
+         &       ilci, ilcj, ilei, ilej, ildi, ildj,              &
+         &       iono, ioea, ioso, iowe, llisoce)
+      !
+    END SUBROUTINE mpp_init
+
+
+    SUBROUTINE mpp_basic_decomposition( knbi, knbj, kimax, kjmax, kimppt, kjmppt, klci, klcj)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_basic_decomposition  ***
+      !!                    
+      !! ** Purpose :   Lay out the global domain over processors.
+      !!
+      !! ** Method  :   Global domain is distributed in smaller local domains.
+      !!
+      !! ** Action : - set for all knbi*knbj domains:
+      !!                    kimppt     : longitudinal index
+      !!                    kjmppt     : latitudinal  index
+      !!                    klci       : first dimension
+      !!                    klcj       : second dimension
+      !!----------------------------------------------------------------------
+      INTEGER,                                 INTENT(in   ) ::   knbi, knbj
+      INTEGER,                                 INTENT(  out) ::   kimax, kjmax
+      INTEGER, DIMENSION(knbi,knbj), OPTIONAL, INTENT(  out) ::   kimppt, kjmppt
+      INTEGER, DIMENSION(knbi,knbj), OPTIONAL, INTENT(  out) ::   klci, klcj
+      !
+      INTEGER ::   ji, jj
+      INTEGER ::   iresti, irestj, irm, ijpjmin
+      INTEGER ::   ireci, irecj
+      !!----------------------------------------------------------------------
+      !
+#if defined key_nemocice_decomp
+      kimax = ( nx_global+2-2*nn_hls + (knbi-1) ) / knbi + 2*nn_hls    ! first  dim.
+      kjmax = ( ny_global+2-2*nn_hls + (knbj-1) ) / knbj + 2*nn_hls    ! second dim. 
+#else
+      kimax = ( jpiglo - 2*nn_hls + (knbi-1) ) / knbi + 2*nn_hls    ! first  dim.
+      kjmax = ( jpjglo - 2*nn_hls + (knbj-1) ) / knbj + 2*nn_hls    ! second dim.
+#endif
+      IF( .NOT. PRESENT(kimppt) ) RETURN
+      !
+      !  1. Dimension arrays for subdomains
+      ! -----------------------------------
+      !  Computation of local domain sizes klci() klcj()
+      !  These dimensions depend on global sizes knbi,knbj and jpiglo,jpjglo
+      !  The subdomains are squares lesser than or equal to the global
+      !  dimensions divided by the number of processors minus the overlap array.
+      !
+      ireci = 2 * nn_hls
+      irecj = 2 * nn_hls
+      iresti = 1 + MOD( jpiglo - ireci -1 , knbi )
+      irestj = 1 + MOD( jpjglo - irecj -1 , knbj )
+      !
+      !  Need to use kimax and kjmax here since jpi and jpj not yet defined
+#if defined key_nemocice_decomp
+      ! Change padding to be consistent with CICE
+      klci(1:knbi-1      ,:) = kimax
+      klci(knbi          ,:) = jpiglo - (knbi - 1) * (kimax - nreci)
+      klcj(:,      1:knbj-1) = kjmax
+      klcj(:,          knbj) = jpjglo - (knbj - 1) * (kjmax - nrecj)
+#else
+      klci(1:iresti      ,:) = kimax
+      klci(iresti+1:knbi ,:) = kimax-1
+      IF( MINVAL(klci) < 3 ) THEN
+         WRITE(ctmp1,*) '   mpp_basic_decomposition: minimum value of jpi must be >= 3'
+         WRITE(ctmp2,*) '   We have ', MINVAL(klci)
+        CALL ctl_stop( 'STOP', ctmp1, ctmp2 )
+      ENDIF
+      IF( jperio == 3 .OR. jperio == 4 .OR. jperio == 5 .OR. jperio == 6 ) THEN
+         ! minimize the size of the last row to compensate for the north pole folding coast
+         IF( jperio == 3 .OR. jperio == 4 )   ijpjmin = 5   ! V and F folding involves line jpj-3 that must not be south boundary
+         IF( jperio == 5 .OR. jperio == 6 )   ijpjmin = 4   ! V and F folding involves line jpj-2 that must not be south boundary
+         irm = knbj - irestj                                    ! total number of lines to be removed
+         klcj(:,            knbj) = MAX( ijpjmin, kjmax-irm )   ! we must have jpj >= ijpjmin in the last row
+         irm = irm - ( kjmax - klcj(1,knbj) )                   ! remaining number of lines to remove 
+         irestj = knbj - 1 - irm                        
+         klcj(:,        1:irestj) = kjmax
+         klcj(:, irestj+1:knbj-1) = kjmax-1
+      ELSE
+         ijpjmin = 3
+         klcj(:,      1:irestj) = kjmax
+         klcj(:, irestj+1:knbj) = kjmax-1
+      ENDIF
+      IF( MINVAL(klcj) < ijpjmin ) THEN
+         WRITE(ctmp1,*) '   mpp_basic_decomposition: minimum value of jpj must be >= ', ijpjmin
+         WRITE(ctmp2,*) '   We have ', MINVAL(klcj)
+         CALL ctl_stop( 'STOP', ctmp1, ctmp2 )
+      ENDIF
+#endif
+
+      !  2. Index arrays for subdomains
+      ! -------------------------------
+      kimppt(:,:) = 1
+      kjmppt(:,:) = 1
+      !
+      IF( knbi > 1 ) THEN
+         DO jj = 1, knbj
+            DO ji = 2, knbi
+               kimppt(ji,jj) = kimppt(ji-1,jj) + klci(ji-1,jj) - ireci
+            END DO
+         END DO
+      ENDIF
+      !
+      IF( knbj > 1 )THEN
+         DO jj = 2, knbj
+            DO ji = 1, knbi
+               kjmppt(ji,jj) = kjmppt(ji,jj-1) + klcj(ji,jj-1) - irecj
+            END DO
+         END DO
+      ENDIF
+      
+   END SUBROUTINE mpp_basic_decomposition
+
+
+   SUBROUTINE mpp_init_bestpartition( knbij, knbi, knbj, knbcnt, ldlist )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE mpp_init_bestpartition  ***
+      !!
+      !! ** Purpose :
+      !!
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      INTEGER,           INTENT(in   ) ::   knbij         ! total number if subdomains               (knbi*knbj)
+      INTEGER, OPTIONAL, INTENT(  out) ::   knbi, knbj    ! number if subdomains along i and j (knbi and knbj)
+      INTEGER, OPTIONAL, INTENT(  out) ::   knbcnt        ! number of land subdomains
+      LOGICAL, OPTIONAL, INTENT(in   ) ::   ldlist        ! .true.: print the list the best domain decompositions (with land)
+      !
+      INTEGER :: ji, jj, ii, iitarget
+      INTEGER :: iszitst, iszjtst
+      INTEGER :: isziref, iszjref
+      INTEGER :: inbij, iszij
+      INTEGER :: inbimax, inbjmax, inbijmax
+      INTEGER :: isz0, isz1
+      INTEGER, DIMENSION(  :), ALLOCATABLE :: indexok
+      INTEGER, DIMENSION(  :), ALLOCATABLE :: inbi0, inbj0, inbij0   ! number of subdomains along i,j
+      INTEGER, DIMENSION(  :), ALLOCATABLE :: iszi0, iszj0, iszij0   ! max size of the subdomains along i,j
+      INTEGER, DIMENSION(  :), ALLOCATABLE :: inbi1, inbj1, inbij1   ! number of subdomains along i,j
+      INTEGER, DIMENSION(  :), ALLOCATABLE :: iszi1, iszj1, iszij1   ! max size of the subdomains along i,j
+      LOGICAL :: llist
+      LOGICAL, DIMENSION(:,:), ALLOCATABLE :: llmsk2d                 ! max size of the subdomains along i,j
+      LOGICAL, DIMENSION(:,:), ALLOCATABLE :: llisoce              !  -     -
+      REAL(wp)::   zpropland
+      !!----------------------------------------------------------------------
+      !
+      llist = .FALSE.
+      IF( PRESENT(ldlist) ) llist = ldlist
+
+      CALL mpp_init_landprop( zpropland )                      ! get the proportion of land point over the gloal domain
+      inbij = NINT( REAL(knbij, wp) / ( 1.0 - zpropland ) )    ! define the largest possible value for jpni*jpnj
+      !
+      IF( llist ) THEN   ;   inbijmax = inbij*2
+      ELSE               ;   inbijmax = inbij
+      ENDIF
+      !
+      ALLOCATE(inbi0(inbijmax),inbj0(inbijmax),iszi0(inbijmax),iszj0(inbijmax))
+      !
+      inbimax = 0
+      inbjmax = 0
+      isziref = jpiglo*jpjglo+1
+      iszjref = jpiglo*jpjglo+1
+      !
+      ! get the list of knbi that gives a smaller jpimax than knbi-1
+      ! get the list of knbj that gives a smaller jpjmax than knbj-1
+      DO ji = 1, inbijmax      
+#if defined key_nemocice_decomp
+         iszitst = ( nx_global+2-2*nn_hls + (ji-1) ) / ji + 2*nn_hls    ! first  dim.
+#else
+         iszitst = ( jpiglo - 2*nn_hls + (ji-1) ) / ji + 2*nn_hls
+#endif
+         IF( iszitst < isziref ) THEN
+            isziref = iszitst
+            inbimax = inbimax + 1
+            inbi0(inbimax) = ji
+            iszi0(inbimax) = isziref
+         ENDIF
+#if defined key_nemocice_decomp
+         iszjtst = ( ny_global+2-2*nn_hls + (ji-1) ) / ji + 2*nn_hls    ! first  dim.
+#else
+         iszjtst = ( jpjglo - 2*nn_hls + (ji-1) ) / ji + 2*nn_hls
+#endif
+         IF( iszjtst < iszjref ) THEN
+            iszjref = iszjtst
+            inbjmax = inbjmax + 1
+            inbj0(inbjmax) = ji
+            iszj0(inbjmax) = iszjref
+         ENDIF
+      END DO
+
+      ! combine these 2 lists to get all possible knbi*knbj <  inbijmax
+      ALLOCATE( llmsk2d(inbimax,inbjmax) )
+      DO jj = 1, inbjmax
+         DO ji = 1, inbimax
+            IF ( inbi0(ji) * inbj0(jj) <= inbijmax ) THEN   ;   llmsk2d(ji,jj) = .TRUE.
+            ELSE                                            ;   llmsk2d(ji,jj) = .FALSE.
+            ENDIF
+         END DO
+      END DO
+      isz1 = COUNT(llmsk2d)
+      ALLOCATE( inbi1(isz1), inbj1(isz1), iszi1(isz1), iszj1(isz1) )
+      ii = 0
+      DO jj = 1, inbjmax
+         DO ji = 1, inbimax
+            IF( llmsk2d(ji,jj) .EQV. .TRUE. ) THEN
+               ii = ii + 1
+               inbi1(ii) = inbi0(ji)
+               inbj1(ii) = inbj0(jj)
+               iszi1(ii) = iszi0(ji)
+               iszj1(ii) = iszj0(jj)
+            END IF
+         END DO
+      END DO
+      DEALLOCATE( inbi0, inbj0, iszi0, iszj0 )
+      DEALLOCATE( llmsk2d )
+
+      ALLOCATE( inbij1(isz1), iszij1(isz1) )
+      inbij1(:) = inbi1(:) * inbj1(:)
+      iszij1(:) = iszi1(:) * iszj1(:)
+
+      ! if therr is no land and no print
+      IF( .NOT. llist .AND. numbot == -1 .AND. numbdy == -1 ) THEN
+         ! get the smaller partition which gives the smallest subdomain size
+         ii = MINLOC(inbij1, mask = iszij1 == MINVAL(iszij1), dim = 1)
+         knbi = inbi1(ii)
+         knbj = inbj1(ii)
+         IF(PRESENT(knbcnt))   knbcnt = 0
+         DEALLOCATE( inbi1, inbj1, inbij1, iszi1, iszj1, iszij1 )
+         RETURN
+      ENDIF
+
+      ! extract only the partitions which reduce the subdomain size in comparison with smaller partitions
+      ALLOCATE( indexok(isz1) )                                 ! to store indices of the best partitions
+      isz0 = 0                                                  ! number of best partitions     
+      inbij = 1                                                 ! start with the min value of inbij1 => 1
+      iszij = jpiglo*jpjglo+1                                   ! default: larger than global domain
+      DO WHILE( inbij <= inbijmax )                             ! if we did not reach the max of inbij1
+         ii = MINLOC(iszij1, mask = inbij1 == inbij, dim = 1)   ! warning: send back the first occurence if multiple results
+         IF ( iszij1(ii) < iszij ) THEN
+            isz0 = isz0 + 1
+            indexok(isz0) = ii
+            iszij = iszij1(ii)
+         ENDIF
+         inbij = MINVAL(inbij1, mask = inbij1 > inbij)   ! warning: return largest integer value if mask = .false. everywhere
+      END DO
+      DEALLOCATE( inbij1, iszij1 )
+
+      ! keep only the best partitions (sorted by increasing order of subdomains number and decreassing subdomain size)
+      ALLOCATE( inbi0(isz0), inbj0(isz0), iszi0(isz0), iszj0(isz0) )
+      DO ji = 1, isz0
+         ii = indexok(ji)
+         inbi0(ji) = inbi1(ii)
+         inbj0(ji) = inbj1(ii)
+         iszi0(ji) = iszi1(ii)
+         iszj0(ji) = iszj1(ii)
+      END DO
+      DEALLOCATE( indexok, inbi1, inbj1, iszi1, iszj1 )
+
+      IF( llist ) THEN  ! we print about 21 best partitions
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,         *) '                  For your information:'
+            WRITE(numout,'(a,i5,a)') '  list of the best partitions around ',   knbij, ' mpi processes'
+            WRITE(numout,         *) '  --------------------------------------', '-----', '--------------'
+            WRITE(numout,*)
+         END IF
+         iitarget = MINLOC( inbi0(:)*inbj0(:), mask = inbi0(:)*inbj0(:) >= knbij, dim = 1 )
+         DO ji = MAX(1,iitarget-10), MIN(isz0,iitarget+10)
+            ALLOCATE( llisoce(inbi0(ji), inbj0(ji)) )
+            CALL mpp_init_isoce( inbi0(ji), inbj0(ji), llisoce ) ! Warning: must be call by all cores (call mpp_sum)
+            inbij = COUNT(llisoce)
+            DEALLOCATE( llisoce )
+            IF(lwp) WRITE(numout,'(a, i5, a, i5, a, i4, a, i4, a, i9, a, i5, a, i5, a)')    &
+               &     'nb_cores ' , inbij,' oce + ', inbi0(ji)*inbj0(ji) - inbij             &
+               &                                , ' land ( ', inbi0(ji),' x ', inbj0(ji),   &
+               & ' ), nb_points ', iszi0(ji)*iszj0(ji),' ( ', iszi0(ji),' x ', iszj0(ji),' )'
+         END DO
+         DEALLOCATE( inbi0, inbj0, iszi0, iszj0 )
+         RETURN
+      ENDIF
+      
+      DEALLOCATE( iszi0, iszj0 )
+      inbij = inbijmax + 1        ! default: larger than possible
+      ii = isz0+1                 ! start from the end of the list (smaller subdomains)
+      DO WHILE( inbij > knbij )   ! while the number of ocean subdomains exceed the number of procs
+         ii = ii -1 
+         ALLOCATE( llisoce(inbi0(ii), inbj0(ii)) )
+         CALL mpp_init_isoce( inbi0(ii), inbj0(ii), llisoce )            ! must be done by all core
+         inbij = COUNT(llisoce)
+         DEALLOCATE( llisoce )
+      END DO
+      knbi = inbi0(ii)
+      knbj = inbj0(ii)
+      IF(PRESENT(knbcnt))   knbcnt = knbi * knbj - inbij
+      DEALLOCATE( inbi0, inbj0 )
+      !
+   END SUBROUTINE mpp_init_bestpartition
+   
+   
+   SUBROUTINE mpp_init_landprop( propland )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init_landprop  ***
+      !!
+      !! ** Purpose : the the proportion of land points in the surface land-sea mask
+      !!
+      !! ** Method  : read iproc strips (of length jpiglo) of the land-sea mask
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(  out) :: propland    ! proportion of land points in the global domain (between 0 and 1)
+      !
+      INTEGER, DIMENSION(jpni*jpnj) ::   kusedom_1d
+      INTEGER :: inboce, iarea
+      INTEGER :: iproc, idiv, ijsz
+      INTEGER :: ijstr
+      LOGICAL, ALLOCATABLE, DIMENSION(:,:) ::   lloce
+      !!----------------------------------------------------------------------
+      ! do nothing if there is no land-sea mask
+      IF( numbot == -1 .and. numbdy == -1 ) THEN
+         propland = 0.
+         RETURN
+      ENDIF
+
+      ! number of processes reading the bathymetry file 
+      iproc = MINVAL( (/mppsize, jpjglo/2, 100/) )  ! read a least 2 lines, no more that 100 processes reading at the same time
+      
+      ! we want to read iproc strips of the land-sea mask. -> pick up iproc processes every idiv processes starting at 1
+      IF( iproc == 1 ) THEN   ;   idiv = mppsize
+      ELSE                    ;   idiv = ( mppsize - 1 ) / ( iproc - 1 )
+      ENDIF
+
+      iarea = (narea-1)/idiv   ! involed process number (starting counting at 0)
+      IF( MOD( narea-1, idiv ) == 0 .AND. iarea < iproc ) THEN   ! beware idiv can be = to 1
+         !
+         ijsz = jpjglo / iproc                                               ! width of the stripe to read
+         IF( iarea < MOD(jpjglo,iproc) ) ijsz = ijsz + 1
+         ijstr = iarea*(jpjglo/iproc) + MIN(iarea, MOD(jpjglo,iproc)) + 1    ! starting j position of the reading
+         !
+         ALLOCATE( lloce(jpiglo, ijsz) )                                     ! allocate the strip
+         CALL mpp_init_readbot_strip( ijstr, ijsz, lloce )
+         inboce = COUNT(lloce)                                               ! number of ocean point in the stripe
+         DEALLOCATE(lloce)
+         !
+      ELSE
+         inboce = 0
+      ENDIF
+      CALL mpp_sum( 'mppini', inboce )   ! total number of ocean points over the global domain
+      !
+      propland = REAL( jpiglo*jpjglo - inboce, wp ) / REAL( jpiglo*jpjglo, wp ) 
+      !
+   END SUBROUTINE mpp_init_landprop
+   
+   
+   SUBROUTINE mpp_init_isoce( knbi, knbj, ldisoce )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init_nboce  ***
+      !!
+      !! ** Purpose : check for a mpi domain decomposition knbi x knbj which
+      !!              subdomains contain at least 1 ocean point
+      !!
+      !! ** Method  : read knbj strips (of length jpiglo) of the land-sea mask
+      !!----------------------------------------------------------------------
+      INTEGER,                       INTENT(in   ) ::   knbi, knbj     ! domain decomposition
+      LOGICAL, DIMENSION(knbi,knbj), INTENT(  out) ::   ldisoce        ! .true. if a sub domain constains 1 ocean point 
+      !
+      INTEGER, DIMENSION(knbi,knbj) ::   inboce                        ! number oce oce pint in each mpi subdomain
+      INTEGER, DIMENSION(knbi*knbj) ::   inboce_1d
+      INTEGER :: idiv, iimax, ijmax, iarea
+      INTEGER :: ji, jn
+      LOGICAL, ALLOCATABLE, DIMENSION(:,:) ::   lloce                  ! lloce(i,j) = .true. if the point (i,j) is ocean 
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iimppt, ilci
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ijmppt, ilcj
+      !!----------------------------------------------------------------------
+      ! do nothing if there is no land-sea mask
+      IF( numbot == -1 .AND. numbdy == -1 ) THEN
+         ldisoce(:,:) = .TRUE.
+         RETURN
+      ENDIF
+
+      ! we want to read knbj strips of the land-sea mask. -> pick up knbj processes every idiv processes starting at 1
+      IF           ( knbj == 1 ) THEN   ;   idiv = mppsize
+      ELSE IF ( mppsize < knbj ) THEN   ;   idiv = 1
+      ELSE                              ;   idiv = ( mppsize - 1 ) / ( knbj - 1 )
+      ENDIF
+      inboce(:,:) = 0          ! default no ocean point found
+
+      DO jn = 0, (knbj-1)/mppsize   ! if mppsize < knbj : more strips than mpi processes (because of potential land domains)
+         !
+         iarea = (narea-1)/idiv + jn * mppsize   ! involed process number (starting counting at 0)
+         IF( MOD( narea-1, idiv ) == 0 .AND. iarea < knbj ) THEN   ! beware idiv can be = to 1
+            !
+            ALLOCATE( iimppt(knbi,knbj), ijmppt(knbi,knbj), ilci(knbi,knbj), ilcj(knbi,knbj) )
+            CALL mpp_basic_decomposition( knbi, knbj, iimax, ijmax, iimppt, ijmppt, ilci, ilcj )
+            !
+            ALLOCATE( lloce(jpiglo, ilcj(1,iarea+1)) )                                         ! allocate the strip
+            CALL mpp_init_readbot_strip( ijmppt(1,iarea+1), ilcj(1,iarea+1), lloce )           ! read the strip
+            DO  ji = 1, knbi
+               inboce(ji,iarea+1) = COUNT( lloce(iimppt(ji,1):iimppt(ji,1)+ilci(ji,1)-1,:) )   ! number of ocean point in subdomain
+            END DO
+            !
+            DEALLOCATE(lloce)
+            DEALLOCATE(iimppt, ijmppt, ilci, ilcj)
+            !
+         ENDIF
+      END DO
+   
+      inboce_1d = RESHAPE(inboce, (/ knbi*knbj /))
+      CALL mpp_sum( 'mppini', inboce_1d )
+      inboce = RESHAPE(inboce_1d, (/knbi, knbj/))
+      ldisoce(:,:) = inboce(:,:) /= 0
+      !
+   END SUBROUTINE mpp_init_isoce
+   
+   
+   SUBROUTINE mpp_init_readbot_strip( kjstr, kjcnt, ldoce )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init_readbot_strip  ***
+      !!
+      !! ** Purpose : Read relevant bathymetric information in order to
+      !!              provide a land/sea mask used for the elimination
+      !!              of land domains, in an mpp computation.
+      !!
+      !! ** Method  : read stipe of size (jpiglo,...)
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) :: kjstr       ! starting j position of the reading
+      INTEGER                         , INTENT(in   ) :: kjcnt       ! number of lines to read
+      LOGICAL, DIMENSION(jpiglo,kjcnt), INTENT(  out) :: ldoce       ! ldoce(i,j) = .true. if the point (i,j) is ocean 
+      !
+      INTEGER                           ::   inumsave                ! local logical unit
+      REAL(wp), DIMENSION(jpiglo,kjcnt) ::   zbot, zbdy 
+      !!----------------------------------------------------------------------
+      !
+      inumsave = numout   ;   numout = numnul   !   redirect all print to /dev/null
+      !
+      IF( numbot /= -1 ) THEN
+         CALL iom_get( numbot, jpdom_unknown, 'bottom_level', zbot, kstart = (/1,kjstr/), kcount = (/jpiglo, kjcnt/) )
+      ELSE
+         zbot(:,:) = 1.                         ! put a non-null value
+      ENDIF
+
+       IF( numbdy /= -1 ) THEN                  ! Adjust with bdy_msk if it exists    
+         CALL iom_get ( numbdy, jpdom_unknown, 'bdy_msk', zbdy, kstart = (/1,kjstr/), kcount = (/jpiglo, kjcnt/) )
+         zbot(:,:) = zbot(:,:) * zbdy(:,:)
+      ENDIF
+      !
+      ldoce(:,:) = zbot(:,:) > 0.
+      numout = inumsave
+      !
+   END SUBROUTINE mpp_init_readbot_strip
+
+
+   SUBROUTINE mpp_init_ioipsl
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init_ioipsl  ***
+      !!
+      !! ** Purpose :   
+      !!
+      !! ** Method  :   
+      !!
+      !! History :
+      !!   9.0  !  04-03  (G. Madec )  MPP-IOIPSL 
+      !!   " "  !  08-12  (A. Coward)  addition in case of jpni*jpnj < jpnij
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(2) ::   iglo, iloc, iabsf, iabsl, ihals, ihale, idid
+      !!----------------------------------------------------------------------
+
+      ! The domain is split only horizontally along i- or/and j- direction
+      ! So we need at the most only 1D arrays with 2 elements.
+      ! Set idompar values equivalent to the jpdom_local_noextra definition
+      ! used in IOM. This works even if jpnij .ne. jpni*jpnj.
+      iglo(1) = jpiglo
+      iglo(2) = jpjglo
+      iloc(1) = nlci
+      iloc(2) = nlcj
+      iabsf(1) = nimppt(narea)
+      iabsf(2) = njmppt(narea)
+      iabsl(:) = iabsf(:) + iloc(:) - 1
+      ihals(1) = nldi - 1
+      ihals(2) = nldj - 1
+      ihale(1) = nlci - nlei
+      ihale(2) = nlcj - nlej
+      idid(1) = 1
+      idid(2) = 2
+
+      IF(lwp) THEN
+          WRITE(numout,*)
+          WRITE(numout,*) 'mpp_init_ioipsl :   iloc  = ', iloc (1), iloc (2)
+          WRITE(numout,*) '~~~~~~~~~~~~~~~     iabsf = ', iabsf(1), iabsf(2)
+          WRITE(numout,*) '                    ihals = ', ihals(1), ihals(2)
+          WRITE(numout,*) '                    ihale = ', ihale(1), ihale(2)
+      ENDIF
+      !
+      CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom)
+      !
+   END SUBROUTINE mpp_init_ioipsl  
+
+
+   SUBROUTINE mpp_init_nfdcom
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE  mpp_init_nfdcom  ***
+      !! ** Purpose :   Setup for north fold exchanges with explicit 
+      !!                point-to-point messaging
+      !!
+      !! ** Method :   Initialization of the northern neighbours lists.
+      !!----------------------------------------------------------------------
+      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)
+      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 
+      !!----------------------------------------------------------------------
+      INTEGER  ::   sxM, dxM, sxT, dxT, jn
+      INTEGER  ::   njmppmax
+      !!----------------------------------------------------------------------
+      !
+      njmppmax = MAXVAL( njmppt )
+      !
+      !initializes the north-fold communication variables
+      isendto(:) = 0
+      nsndto     = 0
+      !
+      IF ( njmpp == njmppmax ) THEN      ! if I am a process in the north
+         !
+         !sxM is the first point (in the global domain) needed to compute the north-fold for the current process
+         sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1
+         !dxM is the last point (in the global domain) needed to compute the north-fold for the current process
+         dxM = jpiglo - nimppt(narea) + 2
+         !
+         ! loop over the other north-fold processes to find the processes
+         ! managing the points belonging to the sxT-dxT range
+         !
+         DO jn = 1, jpni
+            !
+            sxT = nfiimpp(jn, jpnj)                            ! sxT = 1st  point (in the global domain) of the jn process
+            dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1    ! dxT = last point (in the global domain) of the jn process
+            !
+            IF    ( sxT < sxM  .AND.  sxM < dxT ) THEN
+               nsndto          = nsndto + 1
+               isendto(nsndto) = jn
+            ELSEIF( sxM <= sxT  .AND.  dxM >= dxT ) THEN
+               nsndto          = nsndto + 1
+               isendto(nsndto) = jn
+            ELSEIF( dxM <  dxT  .AND.  sxT <  dxM ) THEN
+               nsndto          = nsndto + 1
+               isendto(nsndto) = jn
+            ENDIF
+            !
+         END DO
+         nfsloop = 1
+         nfeloop = nlci
+         DO jn = 2,jpni-1
+            IF( nfipproc(jn,jpnj) == (narea - 1) ) THEN
+               IF( nfipproc(jn-1,jpnj) == -1 )   nfsloop = nldi
+               IF( nfipproc(jn+1,jpnj) == -1 )   nfeloop = nlei
+            ENDIF
+         END DO
+         !
+      ENDIF
+      l_north_nogather = .TRUE.
+      !
+   END SUBROUTINE mpp_init_nfdcom
+
+
+#endif
+
+   !!======================================================================
+END MODULE mppini
Index: /utils/tools_ticket2413/DOMAINcfg/src/nc4interface.f90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/nc4interface.f90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/nc4interface.f90	(revision 12863)
@@ -0,0 +1,55 @@
+MODULE nc4interface
+!-
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+
+      !!--------------------------------------------------------------------
+      !! 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
+
+!------------------
+END MODULE nc4interface
Index: /utils/tools_ticket2413/DOMAINcfg/src/nemogcm.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/nemogcm.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/nemogcm.F90	(revision 12863)
@@ -0,0 +1,421 @@
+MODULE nemogcm
+   !!======================================================================
+   !!                       ***  MODULE nemogcm   ***
+   !! Ocean system   : NEMO GCM (ocean dynamics, on-line tracers, biochemistry and sea-ice)
+   !!======================================================================
+   !! History :  OPA  ! 1990-10  (C. Levy, G. Madec)  Original code
+   !!            7.0  ! 1991-11  (M. Imbard, C. Levy, G. Madec)
+   !!            7.1  ! 1993-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar,
+   !!                             P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes) release 7.1
+   !!             -   ! 1992-06  (L.Terray)  coupling implementation
+   !!             -   ! 1993-11  (M.A. Filiberti) IGLOO sea-ice
+   !!            8.0  ! 1996-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar,
+   !!                             P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy) release 8.0
+   !!            8.1  ! 1997-06  (M. Imbard, G. Madec)
+   !!            8.2  ! 1999-11  (M. Imbard, H. Goosse)  LIM sea-ice model
+   !!                 ! 1999-12  (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols)  OPEN-MP
+   !!                 ! 2000-07  (J-M Molines, M. Imbard)  Open Boundary Conditions  (CLIPPER)
+   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and modules
+   !!             -   ! 2004-06  (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces
+   !!             -   ! 2004-08  (C. Talandier) New trends organization
+   !!             -   ! 2005-06  (C. Ethe) Add the 1D configuration possibility
+   !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
+   !!             -   ! 2006-03  (L. Debreu, C. Mazauric)  Agrif implementation
+   !!             -   ! 2006-04  (G. Madec, R. Benshila)  Step reorganization
+   !!             -   ! 2007-07  (J. Chanut, A. Sellar) Unstructured open boundaries (BDY)
+   !!            3.2  ! 2009-08  (S. Masson)  open/write in the listing file in mpp
+   !!            3.3  ! 2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface
+   !!             -   ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
+   !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!            3.4  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) add nemo_northcomms
+   !!             -   ! 2011-11  (C. Harris) decomposition changes for running with CICE
+   !!            3.6  ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 
+   !!             -   ! 2013-06  (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication 
+   !!             -   ! 2014-12  (G. Madec) remove KPP scheme and cross-land advection (cla)
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   nemo_gcm      : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice
+   !!   nemo_init     : initialization of the NEMO system
+   !!   nemo_ctl      : initialisation of the contol print
+   !!   nemo_closefile: close remaining open files
+   !!   nemo_alloc    : dynamical allocation
+   !!   nemo_partition: calculate MPP domain decomposition
+   !!   factorise     : calculate the factors of the no. of MPI processes
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain variables
+   USE in_out_manager ! I/O manager
+   USE iom            !
+   USE domcfg         ! domain configuration               (dom_cfg routine)
+   USE mppini         ! shared/distributed memory setting (mpp_init routine)
+   USE domain         ! domain initialization             (dom_init routine)
+   USE phycst         ! physical constant                  (par_cst routine)
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE lib_mpp        ! distributed memory computing
+
+   USE lbcnfd , ONLY  : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   nemo_gcm    ! called by model.F90
+   PUBLIC   nemo_init   ! needed by AGRIF
+   PUBLIC   nemo_alloc  ! needed by TAM
+
+   CHARACTER(lc) ::   cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing
+   
+#if defined key_agrif 
+   external agrif_boundary_connections, agrif_update_all, agrif_recompute_scalefactors
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
+   !! $Id: nemogcm.F90 6152 2015-12-21 22:33:57Z acc $
+   !! Software governed by the CeCILL licence     (./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE nemo_gcm
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_gcm  ***
+      !!
+      !! ** Purpose :   NEMO solves the primitive equations on an orthogonal
+      !!              curvilinear mesh on the sphere.
+      !!
+      !! ** Method  : - model general initialization
+      !!              - launch the time-stepping (stp routine)
+      !!              - finalize the run by closing files and communications
+      !!
+      !! References : Madec, Delecluse, Imbard, and Levy, 1997:  internal report, IPSL.
+      !!              Madec, 2008, internal report, IPSL.
+      !!----------------------------------------------------------------------
+      INTEGER ::   istp       ! time step index
+      !!----------------------------------------------------------------------
+      !
+#if defined key_agrif
+      CALL Agrif_Init_Grids()      ! AGRIF: set the meshes
+#endif
+      !                            !-----------------------!
+      CALL nemo_init               !==  Initialisations  ==!
+      !                            !-----------------------!
+
+#if defined key_agrif    
+      CALL Agrif_Regrid()
+      
+      CALL Agrif_Step_Child(agrif_boundary_connections)
+      
+      CALL Agrif_Step_Child_adj(agrif_update_all)
+      
+      CALL Agrif_Step_Child(agrif_recompute_scalefactors)
+      
+      CALL Agrif_Step_Child(cfg_write)
+#endif
+
+      ! check that all process are still there... If some process have an error,
+      ! they will never enter in step and other processes will wait until the end of the cpu time!
+      IF( lk_mpp )   CALL mpp_max( 'nemogcm',nstop )
+
+      IF(lwp) WRITE(numout,cform_aaa)   ! Flag AAAAAAA
+
+      !                            !-----------------------!
+      !                            !==  finalize the run  ==!
+      !                            !------------------------!
+      !
+      IF( nstop /= 0 .AND. lwp ) THEN   ! error print
+         WRITE(numout,cform_err)
+         WRITE(numout,*) nstop, ' error have been found'
+      ENDIF
+      !
+      !
+      CALL nemo_closefile
+      !
+      !
+   END SUBROUTINE nemo_gcm
+
+
+   SUBROUTINE nemo_init
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_init  ***
+      !!
+      !! ** Purpose :   initialization of the NEMO GCM
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji                 ! dummy loop indices
+      INTEGER  ::   ios, ilocal_comm   ! local integers
+      CHARACTER(len=120), DIMENSION(60) ::   cltxt, cltxt2, clnam
+      !!
+      NAMELIST/namctl/ ln_ctl   , sn_cfctl, nn_print, nn_ictls, nn_ictle,   &
+         &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             &
+         &             ln_timing, ln_diacfl
+      NAMELIST/namcfg/ ln_e3_dep,                                &
+         &             cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, &
+         &             jperio, ln_use_jattr, ln_domclo
+      !!----------------------------------------------------------------------
+      !
+      cltxt = ''
+      !
+      !                             ! Open reference namelist and configuration namelist files
+      CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+      CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+      !
+      REWIND( numnam_ref )              ! Namelist namctl in reference namelist
+      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. )
+      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist
+      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
+902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. )
+      !
+      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist
+      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
+903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. )
+      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist
+      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
+904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )   
+
+! Force values for AGRIF zoom (cf. agrif_user.F90)
+      !
+      !                             !--------------------------------------------!
+      !                             !  set communicator & select the local node  !
+      !                             !  NB: mynode also opens output.namelist.dyn !
+      !                             !      on unit number numond on first proc   !
+      !                             !--------------------------------------------!
+      ! Nodes selection (control print return in cltxt)
+      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop )
+      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 )
+
+      lwm = (narea == 1)                                    ! control of output namelists
+      lwp = (narea == 1) .OR. ln_ctl                        ! control of all listing output print
+
+      IF(lwm) THEN
+         ! write merged namelists from earlier to output namelist now that the
+         ! file has been opened in call to mynode. nammpp has already been
+         ! written in mynode (if lk_mpp_mpi)
+         WRITE( numond, namctl )
+         WRITE( numond, namcfg )
+      ENDIF
+
+        IF(lwp) THEN                            ! open listing units
+         !
+         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+         !
+         WRITE(numout,*)
+         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC'
+         WRITE(numout,*) '                       NEMO team'
+         WRITE(numout,*) '            Ocean General Circulation Model'
+         WRITE(numout,*) '                NEMO version 4.0  (2019) '
+         WRITE(numout,*)
+         WRITE(numout,*) "           ._      ._      ._      ._      ._    "
+         WRITE(numout,*) "       _.-._)`\_.-._)`\_.-._)`\_.-._)`\_.-._)`\_ "
+         WRITE(numout,*)
+         WRITE(numout,*) "           o         _,           _,             "
+         WRITE(numout,*) "            o      .' (        .-' /             "
+         WRITE(numout,*) "           o     _/..._'.    .'   /              "
+         WRITE(numout,*) "      (    o .-'`      ` '-./  _.'               "
+         WRITE(numout,*) "       )    ( o)           ;= <_         (       "
+         WRITE(numout,*) "      (      '-.,\\__ __.-;`\   '.        )      "
+         WRITE(numout,*) "       )  )       \) |`\ \)  '.   \      (   (   "
+         WRITE(numout,*) "      (  (           \_/       '-._\      )   )  "
+         WRITE(numout,*) "       )  )                        `     (   (   "
+         WRITE(numout,*) "     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ "
+         WRITE(numout,*)
+         
+         DO ji = 1, SIZE(cltxt)
+            IF( TRIM(cltxt (ji)) /= '' )   WRITE(numout,*) TRIM(cltxt(ji))    ! control print of mynode
+         END DO
+         WRITE(numout,*)
+         WRITE(numout,*)
+   !      DO ji = 1, SIZE(cltxt2)
+   !         IF( TRIM(cltxt2(ji)) /= '' )   WRITE(numout,*) TRIM(cltxt2(ji))   ! control print of domain size
+   !      END DO
+         !
+         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA
+         !
+      ENDIF
+      ! open /dev/null file to be able to supress output write easily
+   !   CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+      !
+      !                                      ! Domain decomposition
+      CALL mpp_init                          ! MPP
+
+ !    IF( Agrif_Root() ) THEN
+ !        jpi = ( jpiglo     -2*jpreci + (jpni-1) ) / jpni + 2*jpreci    ! first  dim.
+ !        jpj = ( jpjglo     -2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj    ! second dim.
+ !     ENDIF
+         jpk = jpkdta                                             ! third dim
+         jpim1 = jpi-1                                            ! inner domain indices
+         jpjm1 = jpj-1                                            !   "           "
+         jpkm1 = jpk-1                                            !   "           "
+         jpij  = jpi*jpj                                          !  jpi x j
+
+#if defined key_agrif
+      CALL Agrif_Declare_Var
+#endif
+
+      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
+      CALL nemo_alloc()
+
+      !                             !-------------------------------!
+      !                             !  NEMO general initialization  !
+      !                             !-------------------------------!
+
+      CALL nemo_ctl                          ! Control prints & Benchmark
+
+      !                                      ! Domain decomposition
+        !
+      !                                      ! General initialization
+                            CALL     phy_cst    ! Physical constants
+                            CALL     dom_cfg    ! Domain configuration
+                            CALL     dom_init   ! Domain
+      !
+   END SUBROUTINE nemo_init
+
+
+   SUBROUTINE nemo_ctl
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_ctl  ***
+      !!
+      !! ** Purpose :   control print setting
+      !!
+      !! ** Method  : - print namctl information and check some consistencies
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'nemo_ctl: Control prints'
+         WRITE(numout,*) '~~~~~~~~'
+         WRITE(numout,*) '   Namelist namctl'
+         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
+         WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config
+         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat
+         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat
+         WRITE(numout,*) '                              sn_cfctl%l_oceout  = ', sn_cfctl%l_oceout
+         WRITE(numout,*) '                              sn_cfctl%l_layout  = ', sn_cfctl%l_layout
+         WRITE(numout,*) '                              sn_cfctl%l_mppout  = ', sn_cfctl%l_mppout
+         WRITE(numout,*) '                              sn_cfctl%l_mpptop  = ', sn_cfctl%l_mpptop
+         WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin  
+         WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax  
+         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr 
+         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr 
+         WRITE(numout,*) '      level of print                  nn_print   = ', nn_print
+         WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls
+         WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle
+         WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls
+         WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle
+         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt
+         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt
+         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing
+         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl
+      ENDIF
+      !
+      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names
+      nictls    = nn_ictls
+      nictle    = nn_ictle
+      njctls    = nn_jctls
+      njctle    = nn_jctle
+      isplt     = nn_isplt
+      jsplt     = nn_jsplt
+
+      !
+      !                             ! Parameter control
+      !
+      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
+         IF( lk_mpp .AND. jpnij > 1 ) THEN
+            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain
+         ELSE
+            IF( isplt == 1 .AND. jsplt == 1  ) THEN
+               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   &
+                  &           ' - the print control will be done over the whole domain' )
+            ENDIF
+            ijsplt = isplt * jsplt            ! total number of processors ijsplt
+         ENDIF
+         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
+         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
+         !
+         !                              ! indices used for the SUM control
+         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area
+            lsp_area = .FALSE.
+         ELSE                                             ! print control done over a specific  area
+            lsp_area = .TRUE.
+            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
+               CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
+               nictls = 1
+            ENDIF
+            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
+               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
+               nictle = jpiglo
+            ENDIF
+            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
+               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
+               njctls = 1
+            ENDIF
+            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
+               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
+               njctle = jpjglo
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+!      IF( 1._wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.',  &
+!         &                                                'Compile with key_nosignedzero enabled:',   &
+!         &                                                '--> add -Dkey_nosignedzero to the definition of %CPP in your arch file' )
+      !
+#if defined key_agrif
+      IF( ln_timing )   CALL ctl_stop( 'AGRIF not implemented with ln_timing = true')
+#endif
+      !
+   END SUBROUTINE nemo_ctl
+
+
+   SUBROUTINE nemo_closefile
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_closefile  ***
+      !!
+      !! ** Purpose :   Close the files
+      !!----------------------------------------------------------------------
+      !
+      IF( lk_mpp )   CALL mppsync
+      !
+      CALL iom_close                                 ! close all input/output files managed by iom_*
+      !
+      IF( numstp          /= -1 )   CLOSE( numstp          )   ! time-step file
+      IF( numnam_ref      /= -1 )   CLOSE( numnam_ref      )   ! oce reference namelist
+      IF( numnam_cfg      /= -1 )   CLOSE( numnam_cfg      )   ! oce configuration namelist
+      IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist
+      IF( numnam_ice_ref  /= -1 )   CLOSE( numnam_ice_ref  )   ! ice reference namelist
+      IF( numnam_ice_cfg  /= -1 )   CLOSE( numnam_ice_cfg  )   ! ice configuration namelist
+      IF( lwm.AND.numoni  /= -1 )   CLOSE( numoni          )   ! ice output namelist
+      IF( numevo_ice      /= -1 )   CLOSE( numevo_ice      )   ! ice variables (temp. evolution)
+      IF( numout          /=  6 )   CLOSE( numout          )   ! standard model output file
+      IF( numdct_vol      /= -1 )   CLOSE( numdct_vol      )   ! volume transports
+      IF( numdct_heat     /= -1 )   CLOSE( numdct_heat     )   ! heat transports
+      IF( numdct_salt     /= -1 )   CLOSE( numdct_salt     )   ! salt transports
+      !
+      numout = 6                                     ! redefine numout in case it is used after this point...
+      !
+   END SUBROUTINE nemo_closefile
+
+
+   SUBROUTINE nemo_alloc
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_alloc  ***
+      !!
+      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
+      !!
+      !! ** Method  :
+      !!----------------------------------------------------------------------
+      USE dom_oce   , ONLY: dom_oce_alloc
+      !
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      ierr = dom_oce_alloc   ()          ! ocean domain
+      !
+      CALL mpp_sum( 'nemogcm', ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' )
+      !
+   END SUBROUTINE nemo_alloc
+
+
+
+   !!======================================================================
+END MODULE nemogcm
+
Index: /utils/tools_ticket2413/DOMAINcfg/src/par_kind.f90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/par_kind.f90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/par_kind.f90	(revision 12863)
@@ -0,0 +1,40 @@
+MODULE par_kind
+   !!======================================================================
+   !!                   ***  MODULE par_kind  ***
+   !! Ocean :  define the kind of real for the whole model
+   !!======================================================================
+   !! History :  1.0  ! 2002-06  (G. Madec)  Original code
+   !!            3.3  ! 2010-12  (G. Madec)  add a standard length of character strings
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTEGER, PUBLIC, PARAMETER ::   jpbyt   = 8    !: real size for mpp communications
+   INTEGER, PUBLIC, PARAMETER ::   jpbytda = 4    !: real size in input data files 4 or 8
+
+   ! Number model from which the SELECTED_*_KIND are requested:
+   !             4 byte REAL       8 byte REAL
+   ! CRAY:           -            precision = 13
+   !                              exponent = 2465
+   ! IEEE:      precision = 6     precision = 15
+   !            exponent = 37     exponent = 307
+
+   !                                                                !!** Floating point **
+   INTEGER, PUBLIC, PARAMETER ::   sp = SELECTED_REAL_KIND( 6, 37)   !: single precision (real 4)
+   INTEGER, PUBLIC, PARAMETER ::   dp = SELECTED_REAL_KIND(12,307)   !: double precision (real 8)
+   INTEGER, PUBLIC, PARAMETER ::   wp = dp                              !: working precision
+
+   !                                                                !!** Integer **
+   INTEGER, PUBLIC, PARAMETER ::   i4 = SELECTED_INT_KIND( 9)        !: single precision (integer 4)
+   INTEGER, PUBLIC, PARAMETER ::   i8 = SELECTED_INT_KIND(14)        !: double precision (integer 8)
+   
+   !                                                                !!** Integer **
+   INTEGER, PUBLIC, PARAMETER ::   lc = 256                          !: Lenght of Character strings
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: par_kind.F90 2528 2010-12-27 17:33:53Z rblod $ 
+   !! Software governed by the CeCILL licence     (./LICENSE)
+   !!----------------------------------------------------------------------
+END MODULE par_kind
Index: /utils/tools_ticket2413/DOMAINcfg/src/par_oce.f90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/par_oce.f90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/par_oce.f90	(revision 12863)
@@ -0,0 +1,94 @@
+MODULE par_oce
+   !!======================================================================
+   !!                        ***  par_oce  ***
+   !! Ocean :   set the ocean parameters
+   !!======================================================================
+   !! History :  OPA  !  1991     (Imbard, Levy, Madec)  Original code
+   !!   NEMO     1.0  !  2004-01  (G. Madec, J.-M. Molines)  Free form and module
+   !!            3.3  !  2010-09  (C. Ethe) TRA-TRC merge: add jpts, jp_tem & jp_sal
+   !!----------------------------------------------------------------------
+   USE par_kind          ! kind parameters
+
+   IMPLICIT NONE
+   PUBLIC
+
+   CHARACTER(lc) ::   cp_cfg           !: name of the configuration
+   CHARACTER(lc) ::   cp_cfz           !: name of the zoom of configuration
+   INTEGER       ::   jp_cfg           !: resolution of the configuration
+
+   ! data size                                       !!! * size of all input files *
+   INTEGER       ::   jpidta           !: 1st lateral dimension ( >= jpi )
+   INTEGER       ::   jpjdta           !: 2nd    "         "    ( >= jpj )
+   INTEGER       ::   jpkdta           !: number of levels      ( >= jpk )
+   LOGICAL       ::   ln_e3_dep        ! e3. definition flag
+   REAL(wp)      ::   pp_not_used       = 999999._wp   !: vertical grid parameter
+   REAL(wp)      ::   pp_to_be_computed = 999999._wp   !:    -      -       -
+   !!----------------------------------------------------------------------
+   !!                   namcfg namelist parameters
+   !!----------------------------------------------------------------------
+   LOGICAL       ::   ln_read_cfg      !: (=T) read the domain configuration file or (=F) not
+   CHARACTER(lc) ::      cn_domcfg        !: filename the configuration file to be read
+   LOGICAL       ::   ln_write_cfg     !: (=T) create the domain configuration file
+   CHARACTER(lc) ::      cn_domcfg_out    !: filename the configuration file to be read
+   !
+   LOGICAL       ::   ln_use_jattr     !: input file read offset
+   !                                   !  Use file global attribute: open_ocean_jstart to determine start j-row 
+   !                                   !  when reading input from those netcdf files that have the 
+   !                                   !  attribute defined. This is designed to enable input files associated 
+   !                                   !  with the extended grids used in the under ice shelf configurations to 
+   !                                   !  be used without redundant rows when the ice shelves are not in use.
+   ! 
+
+   !!---------------------------------------------------------------------
+   !! Domain Matrix size 
+   !!---------------------------------------------------------------------
+   ! configuration name & resolution   (required only in ORCA family case)
+   CHARACTER(lc) ::   cn_cfg           !: name of the configuration
+   INTEGER       ::   nn_cfg           !: resolution of the configuration 
+
+   ! global domain size               !!! * total computational domain *
+   INTEGER       ::   jpiglo           !: 1st dimension of global domain --> i-direction
+   INTEGER       ::   jpjglo           !: 2nd    -                  -    --> j-direction
+   INTEGER       ::   jpkglo           !: 3nd    -                  -    --> k levels
+
+   ! global domain size for AGRIF     !!! * total AGRIF computational domain *
+   INTEGER, PUBLIC            ::   nbug_in_agrif_conv_do_not_remove_or_modify = 1 - 1
+   INTEGER, PUBLIC, PARAMETER ::   nbghostcells = 3                             !: number of ghost cells
+   INTEGER, PUBLIC            ::   nbcellsx   ! = jpiglo - 2 - 2*nbghostcells   !: number of cells in i-direction
+   INTEGER, PUBLIC            ::   nbcellsy   ! = jpjglo - 2 - 2*nbghostcells   !: number of cells in j-direction
+
+   ! local domain size                !!! * local computational domain *
+   INTEGER, PUBLIC ::   jpi   !                                                    !: first  dimension
+   INTEGER, PUBLIC ::   jpj   !                                                    !: second dimension
+   INTEGER, PUBLIC ::   jpk   ! = jpkglo                                           !: third  dimension
+   INTEGER, PUBLIC ::   jpim1 ! = jpi-1                                            !: inner domain indices
+   INTEGER, PUBLIC ::   jpjm1 ! = jpj-1                                            !:   -     -      -
+   INTEGER, PUBLIC ::   jpkm1 ! = jpk-1                                            !:   -     -      -
+   INTEGER, PUBLIC ::   jpij  ! = jpi*jpj                                          !:  jpi x jpj
+   INTEGER, PUBLIC ::   jpimax! = ( jpiglo-2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls !: maximum jpi
+   INTEGER, PUBLIC ::   jpjmax! = ( jpjglo-2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls !: maximum jpj
+
+   !!---------------------------------------------------------------------
+   !! Active tracer parameters
+   !!---------------------------------------------------------------------
+   INTEGER, PUBLIC, PARAMETER ::   jpts   = 2    !: Number of active tracers (=2, i.e. T & S )
+   INTEGER, PUBLIC, PARAMETER ::   jp_tem = 1    !: indice for temperature
+   INTEGER, PUBLIC, PARAMETER ::   jp_sal = 2    !: indice for salinity
+
+   !!----------------------------------------------------------------------
+   !!   Domain decomposition
+   !!----------------------------------------------------------------------
+   !! if we dont use massively parallel computer (parameters jpni=jpnj=1) so jpiglo=jpi and jpjglo=jpj
+   INTEGER, PUBLIC            ::   jpni         !: number of processors following i 
+   INTEGER, PUBLIC            ::   jpnj         !: number of processors following j
+   INTEGER, PUBLIC            ::   jpnij        !: nb of local domain = nb of processors ( <= jpni x jpnj )
+   INTEGER, PUBLIC, PARAMETER ::   jpr2di = 0   !: number of columns for extra outer halo 
+   INTEGER, PUBLIC, PARAMETER ::   jpr2dj = 0   !: number of rows    for extra outer halo 
+   INTEGER, PUBLIC, PARAMETER ::   nn_hls = 1   !: halo width (applies to both rows and columns)
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: par_oce.F90 10068 2018-08-28 14:09:04Z nicolasmartin $ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!======================================================================
+END MODULE par_oce
Index: /utils/tools_ticket2413/DOMAINcfg/src/phycst.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/phycst.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/phycst.F90	(revision 12863)
@@ -0,0 +1,139 @@
+MODULE phycst
+   !!======================================================================
+   !!                    ***  MODULE  phycst  ***
+   !!     Definition of of both ocean and ice parameters used in the code
+   !!=====================================================================
+   !! History :   OPA  !  1990-10  (C. Levy - G. Madec)  Original code
+   !!             8.1  !  1991-11  (G. Madec, M. Imbard)  cosmetic changes
+   !!   NEMO      1.0  !  2002-08  (G. Madec, C. Ethe)  F90, add ice constants
+   !!              -   !  2006-08  (G. Madec)  style 
+   !!             3.2  !  2006-08  (S. Masson, G. Madec)  suppress useless variables + style 
+   !!             3.4  !  2011-11  (C. Harris)  minor changes for CICE constants 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   phy_cst  : define and print physical constant and domain parameters
+   !!----------------------------------------------------------------------
+   USE par_oce          ! ocean parameters
+   USE in_out_manager   ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   phy_cst     ! routine called by inipar.F90
+
+   REAL(wp), PUBLIC ::   rpi      = 3.141592653589793_wp             !: pi
+   REAL(wp), PUBLIC ::   rad      = 3.141592653589793_wp / 180._wp   !: conversion from degre into radian
+   REAL(wp), PUBLIC ::   rsmall   = 0.5 * EPSILON( 1.e0 )            !: smallest real computer value
+   
+   REAL(wp), PUBLIC ::   rday     = 24.*60.*60.      !: day                                [s]
+   REAL(wp), PUBLIC ::   rsiyea                      !: sideral year                       [s]
+   REAL(wp), PUBLIC ::   rsiday                      !: sideral day                        [s]
+   REAL(wp), PUBLIC ::   raamo    =  12._wp          !: number of months in one year
+   REAL(wp), PUBLIC ::   rjjhh    =  24._wp          !: number of hours in one day
+   REAL(wp), PUBLIC ::   rhhmm    =  60._wp          !: number of minutes in one hour
+   REAL(wp), PUBLIC ::   rmmss    =  60._wp          !: number of seconds in one minute
+   REAL(wp), PUBLIC ::   omega                       !: earth rotation parameter           [s-1]
+   REAL(wp), PUBLIC ::   ra       = 6371229._wp      !: earth radius                       [m]
+   REAL(wp), PUBLIC ::   grav     = 9.80665_wp       !: gravity                            [m/s2]   
+   REAL(wp), PUBLIC ::   rt0      = 273.15_wp        !: freezing point of fresh water [Kelvin]
+
+   REAL(wp), PUBLIC ::   rau0                        !: volumic mass of reference     [kg/m3]
+   REAL(wp), PUBLIC ::   r1_rau0                     !: = 1. / rau0                   [m3/kg]
+   REAL(wp), PUBLIC ::   rcp                         !: ocean specific heat           [J/Kelvin]
+   REAL(wp), PUBLIC ::   r1_rcp                      !: = 1. / rcp                    [Kelvin/J]
+   REAL(wp), PUBLIC ::   rau0_rcp                    !: = rau0 * rcp 
+   REAL(wp), PUBLIC ::   r1_rau0_rcp                 !: = 1. / ( rau0 * rcp )
+
+   REAL(wp), PUBLIC ::   emic     =    0.97_wp       !: emissivity of snow or ice (not used?)
+
+   REAL(wp), PUBLIC ::   sice     =    6.0_wp        !: salinity of ice (for pisces)          [psu]
+   REAL(wp), PUBLIC ::   soce     =   34.7_wp        !: salinity of sea (for pisces and isf)  [psu]
+   REAL(wp), PUBLIC ::   rLevap   =    2.5e+6_wp     !: latent heat of evaporation (water)
+   REAL(wp), PUBLIC ::   vkarmn   =    0.4_wp        !: von Karman constant
+   REAL(wp), PUBLIC ::   stefan   =    5.67e-8_wp    !: Stefan-Boltzmann constant 
+
+   REAL(wp), PUBLIC ::   rhos     =  330._wp         !: volumic mass of snow                                  [kg/m3]
+   REAL(wp), PUBLIC ::   rhoi     =  917._wp         !: volumic mass of sea ice                               [kg/m3]
+   REAL(wp), PUBLIC ::   rhow     = 1000._wp         !: volumic mass of freshwater in melt ponds              [kg/m3]
+   REAL(wp), PUBLIC ::   rcnd_i   =    2.034396_wp   !: thermal conductivity of fresh ice                     [W/m/K]
+   REAL(wp), PUBLIC ::   rcpi     = 2067.0_wp        !: specific heat of fresh ice                            [J/kg/K]
+   REAL(wp), PUBLIC ::   rLsub    =    2.834e+6_wp   !: pure ice latent heat of sublimation                   [J/kg]
+   REAL(wp), PUBLIC ::   rLfus    =    0.334e+6_wp   !: latent heat of fusion of fresh ice                    [J/kg]
+   REAL(wp), PUBLIC ::   rTmlt    =    0.054_wp      !: decrease of seawater meltpoint with salinity
+
+   REAL(wp), PUBLIC ::   r1_rhoi                     !: 1 / rhoi
+   REAL(wp), PUBLIC ::   r1_rhos                     !: 1 / rhos
+   REAL(wp), PUBLIC ::   r1_rcpi                     !: 1 / rcpi
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: phycst.F90 10068 2018-08-28 14:09:04Z nicolasmartin $ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+   
+CONTAINS
+   
+   SUBROUTINE phy_cst
+      !!----------------------------------------------------------------------
+      !!                       ***  ROUTINE phy_cst  ***
+      !!
+      !! ** Purpose :   set and print the constants
+      !!----------------------------------------------------------------------
+
+      rsiyea = 365.25_wp * rday * 2._wp * rpi / 6.283076_wp
+      rsiday = rday / ( 1._wp + rday / rsiyea )
+#if defined key_cice
+      omega  = 7.292116e-05
+#else
+      omega  = 2._wp * rpi / rsiday 
+#endif
+
+      r1_rhoi = 1._wp / rhoi
+      r1_rhos = 1._wp / rhos
+      r1_rcpi = 1._wp / rcpi
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'phy_cst : initialization of ocean parameters and constants'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '      mathematical constant                 rpi = ', rpi
+         WRITE(numout,*) '      day                                rday   = ', rday,   ' s'
+         WRITE(numout,*) '      sideral year                       rsiyea = ', rsiyea, ' s'
+         WRITE(numout,*) '      sideral day                        rsiday = ', rsiday, ' s'
+         WRITE(numout,*) '      omega                              omega  = ', omega,  ' s^-1'
+         WRITE(numout,*)
+         WRITE(numout,*) '      nb of months per year               raamo = ', raamo, ' months'
+         WRITE(numout,*) '      nb of hours per day                 rjjhh = ', rjjhh, ' hours'
+         WRITE(numout,*) '      nb of minutes per hour              rhhmm = ', rhhmm, ' mn'
+         WRITE(numout,*) '      nb of seconds per minute            rmmss = ', rmmss, ' s'
+         WRITE(numout,*)
+         WRITE(numout,*) '      earth radius                         ra   = ', ra   , ' m'
+         WRITE(numout,*) '      gravity                              grav = ', grav , ' m/s^2'
+         WRITE(numout,*)
+         WRITE(numout,*) '      freezing point of water              rt0  = ', rt0  , ' K'
+         WRITE(numout,*)
+         WRITE(numout,*) '   reference density and heat capacity now defined in eosbn2.f90'
+         WRITE(numout,*)
+         WRITE(numout,*) '      thermal conductivity of pure ice          = ', rcnd_i  , ' J/s/m/K'
+         WRITE(numout,*) '      thermal conductivity of snow is defined in a namelist '
+         WRITE(numout,*) '      fresh ice specific heat                   = ', rcpi    , ' J/kg/K'
+         WRITE(numout,*) '      latent heat of fusion of fresh ice / snow = ', rLfus   , ' J/kg'
+         WRITE(numout,*) '      latent heat of subl.  of fresh ice / snow = ', rLsub   , ' J/kg'
+         WRITE(numout,*) '      density of sea ice                        = ', rhoi    , ' kg/m^3'
+         WRITE(numout,*) '      density of snow                           = ', rhos    , ' kg/m^3'
+         WRITE(numout,*) '      density of freshwater (in melt ponds)     = ', rhow    , ' kg/m^3'
+         WRITE(numout,*) '      salinity of ice (for pisces)              = ', sice    , ' psu'
+         WRITE(numout,*) '      salinity of sea (for pisces and isf)      = ', soce    , ' psu'
+         WRITE(numout,*) '      latent heat of evaporation (water)        = ', rLevap  , ' J/m^3' 
+         WRITE(numout,*) '      von Karman constant                       = ', vkarmn 
+         WRITE(numout,*) '      Stefan-Boltzmann constant                 = ', stefan  , ' J/s/m^2/K^4'
+         WRITE(numout,*)
+         WRITE(numout,*) '      conversion: degre ==> radian          rad = ', rad
+         WRITE(numout,*)
+         WRITE(numout,*) '      smallest real computer value       rsmall = ', rsmall
+      ENDIF
+
+   END SUBROUTINE phy_cst
+
+   !!======================================================================
+END MODULE phycst
Index: /utils/tools_ticket2413/DOMAINcfg/src/stringop.f90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/stringop.f90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/stringop.f90	(revision 12863)
@@ -0,0 +1,185 @@
+MODULE stringop
+!-
+!$Id: stringop.f90 2281 2010-10-15 14:21:13Z smasson $
+!-
+! 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: /utils/tools_ticket2413/DOMAINcfg/src/timing.F90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/timing.F90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/timing.F90	(revision 12863)
@@ -0,0 +1,866 @@
+MODULE timing
+   !!========================================================================
+   !!                     ***  MODULE  timing  ***
+   !!========================================================================
+   !! History : 4.0  ! 2001-05  (R. Benshila)   
+   !!------------------------------------------------------------------------
+
+   !!------------------------------------------------------------------------
+   !!   timming_init    : initialize timing process 
+   !!   timing_start    : start Timer
+   !!   timing_stop     : stop  Timer
+   !!   timing_reset    : end timing variable creation
+   !!   timing_finalize : compute stats and write output in calling w*_info 
+   !!   timing_ini_var  : create timing variables 
+   !!   timing_listing  : print instumented subroutines in ocean.output
+   !!   wcurrent_info   : compute and print detailed stats on the current CPU
+   !!   wave_info       : compute and print averaged statson all processors
+   !!   wmpi_info       : compute and write global stats  
+   !!   supress         : suppress an element of the timing linked list  
+   !!   insert          : insert an element of the timing linked list  
+   !!------------------------------------------------------------------------
+   USE in_out_manager  ! I/O manager 
+   USE dom_oce         ! ocean domain
+   USE lib_mpp          
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   timing_init, timing_finalize   ! called in nemogcm module 
+   PUBLIC   timing_reset                   ! called in step module 
+   PUBLIC   timing_start, timing_stop      ! called in each routine to time 
+   
+#if defined key_mpp_mpi
+   INCLUDE 'mpif.h'
+#endif
+
+   ! Variables for fine grain timing
+   TYPE timer
+      CHARACTER(LEN=20)  :: cname
+      CHARACTER(LEN=20)  :: surname
+      INTEGER :: rank
+      REAL(wp)  :: t_cpu, t_clock, tsum_cpu, tsum_clock, tmax_cpu, tmax_clock, tmin_cpu, tmin_clock, tsub_cpu, tsub_clock
+      INTEGER :: ncount, ncount_max, ncount_rate  
+      INTEGER :: niter
+      LOGICAL :: l_tdone
+      TYPE(timer), POINTER :: next => NULL()
+      TYPE(timer), POINTER :: prev => NULL()
+      TYPE(timer), POINTER :: parent_section => NULL()
+   END TYPE timer
+    
+   TYPE alltimer
+      CHARACTER(LEN=20), DIMENSION(:), POINTER :: cname => NULL()
+      REAL(wp), DIMENSION(:), POINTER :: tsum_cpu   => NULL()
+      REAL(wp), DIMENSION(:), POINTER :: tsum_clock => NULL()
+      INTEGER, DIMENSION(:), POINTER :: niter => NULL()
+      TYPE(alltimer), POINTER :: next => NULL()
+      TYPE(alltimer), POINTER :: prev => NULL()
+   END TYPE alltimer 
+ 
+   TYPE(timer), POINTER :: s_timer_root => NULL()
+   TYPE(timer), POINTER :: s_timer      => NULL()
+   TYPE(timer), POINTER :: s_timer_old      => NULL()
+
+   TYPE(timer), POINTER :: s_wrk        => NULL()
+   REAL(wp) :: t_overclock, t_overcpu
+   LOGICAL :: l_initdone = .FALSE.
+   INTEGER :: nsize
+   
+   ! Variables for coarse grain timing
+   REAL(wp) :: tot_etime, tot_ctime
+   REAL(kind=wp), DIMENSION(2)     :: t_elaps, t_cpu
+   REAL(wp), ALLOCATABLE, DIMENSION(:) :: all_etime, all_ctime
+   INTEGER :: nfinal_count, ncount, ncount_rate, ncount_max
+   INTEGER, DIMENSION(8)           :: nvalues
+   CHARACTER(LEN=8), DIMENSION(2)  :: cdate
+   CHARACTER(LEN=10), DIMENSION(2) :: ctime
+   CHARACTER(LEN=5)                :: czone
+    
+   ! From of ouput file (1/proc or one global)   !RB to put in nammpp or namctl
+   LOGICAL :: ln_onefile = .TRUE. 
+   LOGICAL :: lwriter
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: timing.F90 10510 2019-01-14 16:13:17Z clem $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE timing_start(cdinfo)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_start  ***
+      !! ** Purpose :   collect execution time
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in) :: cdinfo
+      !
+       IF(ASSOCIATED(s_timer) ) s_timer_old => s_timer
+       !
+      ! Create timing structure at first call of the routine 
+       CALL timing_ini_var(cdinfo)
+   !   write(*,*) 'after inivar ', s_timer%cname
+
+      ! ici timing_ini_var a soit retrouve s_timer et fait return soit ajoute un maillon
+      ! maintenant on regarde si le call d'avant corrsspond a un parent ou si il est ferme
+      IF( .NOT. s_timer_old%l_tdone ) THEN      
+         s_timer%parent_section => s_timer_old
+      ELSE
+         s_timer%parent_section => NULL()
+      ENDIF    
+
+      s_timer%l_tdone = .FALSE.
+      s_timer%niter = s_timer%niter + 1
+      s_timer%t_cpu = 0.
+      s_timer%t_clock = 0.
+                  
+      ! CPU time collection
+      CALL CPU_TIME( s_timer%t_cpu  )
+      ! clock time collection
+#if defined key_mpp_mpi
+      s_timer%t_clock= MPI_Wtime()
+#else
+      CALL SYSTEM_CLOCK(COUNT_RATE=s_timer%ncount_rate, COUNT_MAX=s_timer%ncount_max)
+      CALL SYSTEM_CLOCK(COUNT = s_timer%ncount)
+#endif
+!      write(*,*) 'end of start ', s_timer%cname
+
+      !
+   END SUBROUTINE timing_start
+
+
+   SUBROUTINE timing_stop(cdinfo, csection)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_stop  ***
+      !! ** Purpose :   finalize timing and output
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in) :: cdinfo
+      CHARACTER(len=*), INTENT(in), OPTIONAL :: csection
+      !
+      INTEGER  :: ifinal_count, iperiods    
+      REAL(wp) :: zcpu_end, zmpitime,zcpu_raw,zclock_raw
+      !
+      s_wrk => NULL()
+
+      ! clock time collection
+#if defined key_mpp_mpi
+      zmpitime = MPI_Wtime()
+#else
+      CALL SYSTEM_CLOCK(COUNT = ifinal_count)
+#endif
+      ! CPU time collection
+      CALL CPU_TIME( zcpu_end )
+
+!!$      IF(associated(s_timer%parent_section))then
+!!$        write(*,*) s_timer%cname,' <-- ', s_timer%parent_section%cname
+!!$      ENDIF  
+
+ !     No need to search ... : s_timer has the last value defined in start
+ !     s_timer => s_timer_root
+ !     DO WHILE( TRIM(s_timer%cname) /= TRIM(cdinfo) ) 
+ !        IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next
+ !     END DO
+ 
+      ! CPU time correction
+      zcpu_raw = zcpu_end - s_timer%t_cpu - t_overcpu ! total time including child
+      s_timer%t_cpu  = zcpu_raw - s_timer%tsub_cpu
+  !    IF(s_timer%cname==trim('lbc_lnk_2d'))  write(*,*) s_timer%tsub_cpu,zcpu_end
+
+      ! clock time correction
+#if defined key_mpp_mpi
+      zclock_raw = zmpitime - s_timer%t_clock - t_overclock ! total time including child
+      s_timer%t_clock = zclock_raw - t_overclock - s_timer%tsub_clock
+#else
+      iperiods = ifinal_count - s_timer%ncount
+      IF( ifinal_count < s_timer%ncount )  &
+         iperiods = iperiods + s_timer%ncount_max 
+         zclock_raw = REAL(iperiods) / s_timer%ncount_rate !- t_overclock   
+         s_timer%t_clock  = zclock_raw - s_timer%tsub_clock
+#endif
+ !     IF(s_timer%cname==trim('lbc_lnk_2d')) write(*,*) zclock_raw , s_timer%tsub_clock
+      
+      ! Correction of parent section
+      IF( .NOT. PRESENT(csection) ) THEN
+         IF ( ASSOCIATED(s_timer%parent_section ) ) THEN
+            s_timer%parent_section%tsub_cpu   = zcpu_raw   + s_timer%parent_section%tsub_cpu 
+            s_timer%parent_section%tsub_clock = zclock_raw + s_timer%parent_section%tsub_clock             
+         ENDIF
+      ENDIF
+            
+      ! time diagnostics 
+      s_timer%tsum_clock = s_timer%tsum_clock + s_timer%t_clock 
+      s_timer%tsum_cpu   = s_timer%tsum_cpu   + s_timer%t_cpu
+!RB to use to get min/max during a time integration
+!      IF( .NOT. l_initdone ) THEN
+!         s_timer%tmin_clock = s_timer%t_clock 
+!         s_timer%tmin_cpu   = s_timer%t_cpu 
+!      ELSE
+!         s_timer%tmin_clock = MIN( s_timer%tmin_clock, s_timer%t_clock ) 
+!         s_timer%tmin_cpu   = MIN( s_timer%tmin_cpu  , s_timer%t_cpu   ) 
+!      ENDIF   
+!      s_timer%tmax_clock = MAX( s_timer%tmax_clock, s_timer%t_clock ) 
+!      s_timer%tmax_cpu   = MAX( s_timer%tmax_cpu  , s_timer%t_cpu   )  
+      !
+      s_timer%tsub_clock = 0.
+      s_timer%tsub_cpu = 0.
+      s_timer%l_tdone = .TRUE.
+      !
+      !
+      ! we come back
+      IF ( ASSOCIATED(s_timer%parent_section ) ) s_timer => s_timer%parent_section
+     
+!      write(*,*) 'end of stop ', s_timer%cname
+
+   END SUBROUTINE timing_stop
+ 
+ 
+   SUBROUTINE timing_init
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_init  ***
+      !! ** Purpose :   open timing output file
+      !!----------------------------------------------------------------------
+      INTEGER :: iperiods, istart_count, ifinal_count
+      REAL(wp) :: zdum
+      LOGICAL :: ll_f
+             
+      IF( ln_onefile ) THEN
+         IF( lwp) CALL ctl_opn( numtime, 'timing.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout,.TRUE., narea )
+         lwriter = lwp
+      ELSE
+         CALL ctl_opn( numtime, 'timing.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout,.FALSE., narea )
+         lwriter = .TRUE.
+      ENDIF
+      
+      IF( lwriter) THEN      
+         WRITE(numtime,*)
+         WRITE(numtime,*) '      CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC - INGV'
+         WRITE(numtime,*) '                             NEMO team'
+         WRITE(numtime,*) '                  Ocean General Circulation Model'
+         WRITE(numtime,*) '                        version 4.0  (2019) '
+         WRITE(numtime,*)
+         WRITE(numtime,*) '                        Timing Informations '
+         WRITE(numtime,*)
+         WRITE(numtime,*)
+      ENDIF   
+      
+      ! Compute clock function overhead
+#if defined key_mpp_mpi        
+      t_overclock = MPI_WTIME()
+      t_overclock = MPI_WTIME() - t_overclock
+#else        
+      CALL SYSTEM_CLOCK(COUNT_RATE=ncount_rate, COUNT_MAX=ncount_max)
+      CALL SYSTEM_CLOCK(COUNT = istart_count)
+      CALL SYSTEM_CLOCK(COUNT = ifinal_count)
+      iperiods = ifinal_count - istart_count
+      IF( ifinal_count < istart_count )  &
+          iperiods = iperiods + ncount_max 
+      t_overclock = REAL(iperiods) / ncount_rate
+#endif
+
+      ! Compute cpu_time function overhead
+      CALL CPU_TIME(zdum)
+      CALL CPU_TIME(t_overcpu)
+      
+      ! End overhead omputation  
+      t_overcpu = t_overcpu - zdum        
+      t_overclock = t_overcpu + t_overclock        
+
+      ! Timing on date and time
+      CALL DATE_AND_TIME(cdate(1),ctime(1),czone,nvalues)
+    
+      CALL CPU_TIME(t_cpu(1))      
+#if defined key_mpp_mpi        
+      ! Start elapsed and CPU time counters
+      t_elaps(1) = MPI_WTIME()
+#else
+      CALL SYSTEM_CLOCK(COUNT_RATE=ncount_rate, COUNT_MAX=ncount_max)
+      CALL SYSTEM_CLOCK(COUNT = ncount)
+#endif                 
+      !
+   END SUBROUTINE timing_init
+
+
+   SUBROUTINE timing_finalize
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_finalize ***
+      !! ** Purpose :  compute average time 
+      !!               write timing output file
+      !!----------------------------------------------------------------------
+      TYPE(timer), POINTER :: s_temp
+      INTEGER :: idum, iperiods, icode
+      INTEGER :: ji
+      LOGICAL :: ll_ord, ll_averep
+      CHARACTER(len=120) :: clfmt            
+      REAL(wp), DIMENSION(:), ALLOCATABLE ::   timing_glob
+      REAL(wp) ::   zsypd   ! simulated years per day (Balaji 2017)
+      REAL(wp) ::   zperc, ztot
+
+      ll_averep = .TRUE.
+    
+      ! total CPU and elapse
+      CALL CPU_TIME(t_cpu(2))
+      t_cpu(2)   = t_cpu(2)    - t_cpu(1)   - t_overcpu
+#if defined key_mpp_mpi
+      t_elaps(2) = MPI_WTIME() - t_elaps(1) - t_overclock
+#else
+      CALL SYSTEM_CLOCK(COUNT = nfinal_count)
+      iperiods = nfinal_count - ncount
+      IF( nfinal_count < ncount )  &
+          iperiods = iperiods + ncount_max 
+      t_elaps(2) = REAL(iperiods) / ncount_rate - t_overclock
+#endif      
+
+      ! End of timings on date & time
+      CALL DATE_AND_TIME(cdate(2),ctime(2),czone,nvalues)
+       
+      ! Compute the numer of routines
+      nsize = 0 
+      s_timer => s_timer_root
+      DO WHILE( ASSOCIATED(s_timer) )
+         nsize = nsize + 1
+         s_timer => s_timer%next
+      END DO
+      idum = nsize
+      CALL mpp_sum('timing', idum)
+      IF( idum/jpnij /= nsize ) THEN
+         IF( lwriter ) WRITE(numtime,*) '        ===> W A R N I N G: '
+         IF( lwriter ) WRITE(numtime,*) ' Some CPU have different number of routines instrumented for timing'
+         IF( lwriter ) WRITE(numtime,*) ' No detailed report on averaged timing can be provided'
+         IF( lwriter ) WRITE(numtime,*) ' The following detailed report only deals with the current processor'
+         IF( lwriter ) WRITE(numtime,*)
+         ll_averep = .FALSE.
+      ENDIF   
+
+#if defined key_mpp_mpi      
+      ! in MPI gather some info
+      ALLOCATE( all_etime(jpnij), all_ctime(jpnij) )
+      CALL MPI_ALLGATHER(t_elaps(2), 1, MPI_DOUBLE_PRECISION,   &
+                         all_etime , 1, MPI_DOUBLE_PRECISION,   &
+                         MPI_COMM_OCE, icode)
+      CALL MPI_ALLGATHER(t_cpu(2) , 1, MPI_DOUBLE_PRECISION,   &
+                         all_ctime, 1, MPI_DOUBLE_PRECISION,   &
+                         MPI_COMM_OCE, icode)
+      tot_etime = SUM(all_etime(:))
+      tot_ctime = SUM(all_ctime(:))
+#else
+      tot_etime = t_elaps(2)
+      tot_ctime = t_cpu  (2)           
+#endif
+
+      ! write output file
+      IF( lwriter ) WRITE(numtime,*) 'Total timing (sum) :'
+      IF( lwriter ) WRITE(numtime,*) '--------------------'
+      IF( lwriter ) WRITE(numtime,"('Elapsed Time (s)  CPU Time (s)')")
+      IF( lwriter ) WRITE(numtime,'(5x,f12.3,1x,f12.3)')  tot_etime, tot_ctime
+      IF( lwriter ) WRITE(numtime,*) 
+#if defined key_mpp_mpi
+      IF( ll_averep ) CALL waver_info
+      CALL wmpi_info
+#endif      
+      IF( lwriter ) CALL wcurrent_info
+      
+      clfmt='(1X,"Timing started on ",2(A2,"/"),A4," at ",2(A2,":"),A2," MET ",A3,":",A2," from GMT")'
+      IF( lwriter ) WRITE(numtime, TRIM(clfmt)) &           
+      &       cdate(1)(7:8), cdate(1)(5:6), cdate(1)(1:4),   &
+      &       ctime(1)(1:2), ctime(1)(3:4), ctime(1)(5:6),   &
+      &       czone(1:3),    czone(4:5)                     
+      clfmt='(1X,  "Timing   ended on ",2(A2,"/"),A4," at ",2(A2,":"),A2," MET ",A3,":",A2," from GMT")'
+      IF( lwriter ) WRITE(numtime, TRIM(clfmt)) &           
+      &       cdate(2)(7:8), cdate(2)(5:6), cdate(2)(1:4),   &
+      &       ctime(2)(1:2), ctime(2)(3:4), ctime(2)(5:6),   &
+      &       czone(1:3),    czone(4:5)
+
+#if defined key_mpp_mpi
+      ALLOCATE(timing_glob(4*jpnij), stat=icode)
+      CALL MPI_GATHER( (/compute_time, waiting_time(1), waiting_time(2), elapsed_time/),   &
+         &             4, MPI_DOUBLE_PRECISION, timing_glob, 4, MPI_DOUBLE_PRECISION, 0, MPI_COMM_OCE, icode)
+      IF( narea == 1 ) THEN
+         WRITE(numtime,*) ' '
+         WRITE(numtime,*) ' Report on time spent on waiting MPI messages '
+         WRITE(numtime,*) '    total timing measured between nit000+1 and nitend-1 '
+         WRITE(numtime,*) '    warning: includes restarts writing time if output before nitend... '
+         WRITE(numtime,*) ' '
+         DO ji = 1, jpnij
+            ztot = SUM( timing_glob(4*ji-3:4*ji-1) )
+            WRITE(numtime,'(A28,F11.6,            A34,I8)') 'Computing       time : ',timing_glob(4*ji-3), ' on MPI rank : ', ji
+            IF ( ztot /= 0. ) zperc = timing_glob(4*ji-2) / ztot * 100.
+            WRITE(numtime,'(A28,F11.6,A2, F4.1,A3,A25,I8)') 'Waiting lbc_lnk time : ',timing_glob(4*ji-2)   &
+               &                                                         , ' (',      zperc,' %)',   ' on MPI rank : ', ji
+            IF ( ztot /= 0. ) zperc = timing_glob(4*ji-1) / ztot * 100.
+            WRITE(numtime,'(A28,F11.6,A2, F4.1,A3,A25,I8)') 'Waiting  global time : ',timing_glob(4*ji-1)   &
+               &                                                         , ' (',      zperc,' %)',   ' on MPI rank : ', ji
+            zsypd = rn_rdt * REAL(nitend-nit000-1, wp) / (timing_glob(4*ji) * 365.)
+            WRITE(numtime,'(A28,F11.6,A7,F10.3,A2,A15,I8)') 'Total           time : ',timing_glob(4*ji  )   &
+               &                                                         , ' (SYPD: ', zsypd, ')',   ' on MPI rank : ', ji
+         END DO
+      ENDIF
+      DEALLOCATE(timing_glob)
+#endif      
+
+      IF( lwriter ) CLOSE(numtime) 
+      !
+   END SUBROUTINE timing_finalize
+   
+
+   SUBROUTINE wcurrent_info
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE wcurrent_info ***
+      !! ** Purpose :  compute and write timing output file
+      !!----------------------------------------------------------------------
+      LOGICAL :: ll_ord
+      CHARACTER(len=2048) :: clfmt            
+   
+      ! reorder the current list by elapse time      
+      s_wrk => NULL()
+      s_timer => s_timer_root
+      DO
+         ll_ord = .TRUE.
+         s_timer => s_timer_root
+         DO WHILE ( ASSOCIATED( s_timer%next ) )
+         IF (.NOT. ASSOCIATED(s_timer%next)) EXIT
+            IF ( s_timer%tsum_clock < s_timer%next%tsum_clock ) THEN 
+               ALLOCATE(s_wrk)
+               s_wrk = s_timer%next
+               CALL insert  (s_timer, s_timer_root, s_wrk)
+               CALL suppress(s_timer%next)            
+               ll_ord = .FALSE.
+               CYCLE            
+            ENDIF           
+         IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next
+         END DO         
+         IF( ll_ord ) EXIT
+      END DO
+            
+      ! write current info
+      WRITE(numtime,*) 'Detailed timing for proc :', narea-1
+      WRITE(numtime,*) '--------------------------'
+      WRITE(numtime,*) 'Section             ',            &
+      &   'Elapsed Time (s)  ','Elapsed Time (%)  ',   &
+      &   'CPU Time(s)  ','CPU Time (%)  ','CPU/Elapsed  ','Frequency' 
+      s_timer => s_timer_root  
+      clfmt = '(1x,a,4x,f12.3,6x,f12.3,x,f12.3,2x,f12.3,6x,f7.3,2x,i9)'
+      DO WHILE ( ASSOCIATED(s_timer) )
+         WRITE(numtime,TRIM(clfmt))   s_timer%cname,   &
+         &   s_timer%tsum_clock,s_timer%tsum_clock*100./t_elaps(2),            &
+         &   s_timer%tsum_cpu  ,s_timer%tsum_cpu*100./t_cpu(2)    ,            &
+         &   s_timer%tsum_cpu/s_timer%tsum_clock, s_timer%niter
+         s_timer => s_timer%next
+      END DO
+      WRITE(numtime,*)
+      !                  
+   END SUBROUTINE wcurrent_info
+
+#if defined key_mpp_mpi     
+   SUBROUTINE waver_info
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE wcurrent_info ***
+      !! ** Purpose :  compute and write averaged timing informations
+      !!----------------------------------------------------------------------
+      TYPE(alltimer), POINTER :: sl_timer_glob_root => NULL()
+      TYPE(alltimer), POINTER :: sl_timer_glob      => NULL()
+      TYPE(timer), POINTER :: sl_timer_ave_root => NULL()
+      TYPE(timer), POINTER :: sl_timer_ave      => NULL()
+      INTEGER :: icode
+      INTEGER :: ierr
+      LOGICAL :: ll_ord           
+      CHARACTER(len=200) :: clfmt              
+                 
+      ! Initialised the global strucutre   
+      ALLOCATE(sl_timer_glob_root, Stat=ierr)
+      IF(ierr /= 0)THEN
+         WRITE(numtime,*) 'Failed to allocate global timing structure in waver_info'
+         RETURN
+      END IF
+
+      ALLOCATE(sl_timer_glob_root%cname     (jpnij), &
+               sl_timer_glob_root%tsum_cpu  (jpnij), &
+               sl_timer_glob_root%tsum_clock(jpnij), &
+               sl_timer_glob_root%niter     (jpnij), Stat=ierr)
+      IF(ierr /= 0)THEN
+         WRITE(numtime,*) 'Failed to allocate global timing structure in waver_info'
+         RETURN
+      END IF
+      sl_timer_glob_root%cname(:)       = ''
+      sl_timer_glob_root%tsum_cpu(:)   = 0._wp
+      sl_timer_glob_root%tsum_clock(:) = 0._wp
+      sl_timer_glob_root%niter(:)      = 0
+      sl_timer_glob_root%next => NULL()
+      sl_timer_glob_root%prev => NULL()
+      !ARPDBG - don't need to allocate a pointer that's immediately then
+      !         set to point to some other object.
+      !ALLOCATE(sl_timer_glob)
+      !ALLOCATE(sl_timer_glob%cname     (jpnij))
+      !ALLOCATE(sl_timer_glob%tsum_cpu  (jpnij))
+      !ALLOCATE(sl_timer_glob%tsum_clock(jpnij))
+      !ALLOCATE(sl_timer_glob%niter     (jpnij))
+      sl_timer_glob => sl_timer_glob_root
+      !
+      IF( narea .EQ. 1 ) THEN
+         ALLOCATE(sl_timer_ave_root)
+         sl_timer_ave_root%cname       = ''
+         sl_timer_ave_root%t_cpu      = 0._wp
+         sl_timer_ave_root%t_clock    = 0._wp
+         sl_timer_ave_root%tsum_cpu   = 0._wp
+         sl_timer_ave_root%tsum_clock = 0._wp
+         sl_timer_ave_root%tmax_cpu   = 0._wp
+         sl_timer_ave_root%tmax_clock = 0._wp
+         sl_timer_ave_root%tmin_cpu   = 0._wp
+         sl_timer_ave_root%tmin_clock = 0._wp
+         sl_timer_ave_root%tsub_cpu   = 0._wp
+         sl_timer_ave_root%tsub_clock = 0._wp
+         sl_timer_ave_root%ncount      = 0
+         sl_timer_ave_root%ncount_rate = 0
+         sl_timer_ave_root%ncount_max  = 0
+         sl_timer_ave_root%niter       = 0
+         sl_timer_ave_root%l_tdone  = .FALSE.
+         sl_timer_ave_root%next => NULL()
+         sl_timer_ave_root%prev => NULL()
+         ALLOCATE(sl_timer_ave)
+         sl_timer_ave => sl_timer_ave_root            
+      ENDIF 
+
+      ! Gather info from all processors
+      s_timer => s_timer_root
+      DO WHILE ( ASSOCIATED(s_timer) )
+         CALL MPI_GATHER(s_timer%cname     , 20, MPI_CHARACTER,   &
+                         sl_timer_glob%cname, 20, MPI_CHARACTER,   &
+                         0, MPI_COMM_OCE, icode)
+         CALL MPI_GATHER(s_timer%tsum_clock     , 1, MPI_DOUBLE_PRECISION,   &
+                         sl_timer_glob%tsum_clock, 1, MPI_DOUBLE_PRECISION,   &
+                         0, MPI_COMM_OCE, icode)
+         CALL MPI_GATHER(s_timer%tsum_cpu     , 1, MPI_DOUBLE_PRECISION,   &
+                         sl_timer_glob%tsum_cpu, 1, MPI_DOUBLE_PRECISION,   &
+                         0, MPI_COMM_OCE, icode)
+         CALL MPI_GATHER(s_timer%niter     , 1, MPI_INTEGER,   &
+                         sl_timer_glob%niter, 1, MPI_INTEGER,   &
+                         0, MPI_COMM_OCE, icode)
+
+         IF( narea == 1 .AND. ASSOCIATED(s_timer%next) ) THEN
+            ALLOCATE(sl_timer_glob%next)
+            ALLOCATE(sl_timer_glob%next%cname     (jpnij))
+            ALLOCATE(sl_timer_glob%next%tsum_cpu  (jpnij))
+            ALLOCATE(sl_timer_glob%next%tsum_clock(jpnij))
+            ALLOCATE(sl_timer_glob%next%niter     (jpnij))
+            sl_timer_glob%next%prev => sl_timer_glob
+            sl_timer_glob%next%next => NULL()
+            sl_timer_glob           => sl_timer_glob%next
+         ENDIF              
+         s_timer => s_timer%next
+      END DO      
+      
+      IF( narea == 1 ) THEN    
+         ! Compute some stats
+         sl_timer_glob => sl_timer_glob_root
+         DO WHILE( ASSOCIATED(sl_timer_glob) )
+            sl_timer_ave%cname  = sl_timer_glob%cname(1)
+            sl_timer_ave%tsum_cpu   = SUM   (sl_timer_glob%tsum_cpu  (:)) / jpnij
+            sl_timer_ave%tsum_clock = SUM   (sl_timer_glob%tsum_clock(:)) / jpnij
+            sl_timer_ave%tmax_cpu   = MAXVAL(sl_timer_glob%tsum_cpu  (:))
+            sl_timer_ave%tmax_clock = MAXVAL(sl_timer_glob%tsum_clock(:))
+            sl_timer_ave%tmin_cpu   = MINVAL(sl_timer_glob%tsum_cpu  (:))
+            sl_timer_ave%tmin_clock = MINVAL(sl_timer_glob%tsum_clock(:))
+            sl_timer_ave%niter      = SUM   (sl_timer_glob%niter     (:))
+            !
+            IF( ASSOCIATED(sl_timer_glob%next) ) THEN
+               ALLOCATE(sl_timer_ave%next)          
+               sl_timer_ave%next%prev => sl_timer_ave
+               sl_timer_ave%next%next => NULL()           
+               sl_timer_ave           => sl_timer_ave%next
+            ENDIF
+            sl_timer_glob => sl_timer_glob%next                                
+         END DO
+      
+         ! reorder the averaged list by CPU time      
+         s_wrk => NULL()
+         sl_timer_ave => sl_timer_ave_root
+         DO
+            ll_ord = .TRUE.
+            sl_timer_ave => sl_timer_ave_root
+            DO WHILE( ASSOCIATED( sl_timer_ave%next ) )
+
+               IF( .NOT. ASSOCIATED(sl_timer_ave%next) ) EXIT
+
+               IF ( sl_timer_ave%tsum_clock < sl_timer_ave%next%tsum_clock ) THEN 
+                  ALLOCATE(s_wrk)
+                  ! Copy data into the new object pointed to by s_wrk
+                  s_wrk = sl_timer_ave%next
+                  ! Insert this new timer object before our current position
+                  CALL insert  (sl_timer_ave, sl_timer_ave_root, s_wrk)
+                  ! Remove the old object from the list
+                  CALL suppress(sl_timer_ave%next)            
+                  ll_ord = .FALSE.
+                  CYCLE            
+               ENDIF           
+               IF( ASSOCIATED(sl_timer_ave%next) ) sl_timer_ave => sl_timer_ave%next
+            END DO         
+            IF( ll_ord ) EXIT
+         END DO
+
+         ! write averaged info
+         WRITE(numtime,"('Averaged timing on all processors :')")
+         WRITE(numtime,"('-----------------------------------')")
+         WRITE(numtime,"('Section',13x,'Elap. Time(s)',2x,'Elap. Time(%)',2x, &
+         &   'CPU Time(s)',2x,'CPU Time(%)',2x,'CPU/Elap',1x,   &
+         &   'Max elap(%)',2x,'Min elap(%)',2x,            &           
+         &   'Freq')")
+         sl_timer_ave => sl_timer_ave_root  
+         clfmt = '((A),E15.7,2x,f6.2,5x,f12.2,5x,f6.2,5x,f7.2,2x,f12.2,4x,f6.2,2x,f9.2)'
+         DO WHILE ( ASSOCIATED(sl_timer_ave) )
+            WRITE(numtime,TRIM(clfmt))   sl_timer_ave%cname(1:18),                            &
+            &   sl_timer_ave%tsum_clock,sl_timer_ave%tsum_clock*100.*jpnij/tot_etime,   &
+            &   sl_timer_ave%tsum_cpu  ,sl_timer_ave%tsum_cpu*100.*jpnij/tot_ctime  ,   &
+            &   sl_timer_ave%tsum_cpu/sl_timer_ave%tsum_clock,                          &
+            &   sl_timer_ave%tmax_clock*100.*jpnij/tot_etime,                           &
+            &   sl_timer_ave%tmin_clock*100.*jpnij/tot_etime,                           &                                               
+            &   sl_timer_ave%niter/REAL(jpnij)
+            sl_timer_ave => sl_timer_ave%next
+         END DO
+         WRITE(numtime,*)
+         !
+         DEALLOCATE(sl_timer_ave_root)
+      ENDIF
+      !
+      DEALLOCATE(sl_timer_glob_root)
+      !                  
+   END SUBROUTINE waver_info
+  
+  
+   SUBROUTINE wmpi_info
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE wmpi_time  ***
+      !! ** Purpose :   compute and write a summary of MPI infos 
+      !!----------------------------------------------------------------------   
+      !   
+      INTEGER                            :: idum, icode
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: iall_rank
+      REAL(wp) :: ztot_ratio
+      REAL(wp) :: zmax_etime, zmax_ctime, zmax_ratio, zmin_etime, zmin_ctime, zmin_ratio
+      REAL(wp) :: zavg_etime, zavg_ctime, zavg_ratio
+      REAL(wp), ALLOCATABLE, DIMENSION(:) :: zall_ratio
+      CHARACTER(LEN=128), dimension(8) :: cllignes
+      CHARACTER(LEN=128)               :: clhline, clstart_date, clfinal_date
+      CHARACTER(LEN=2048)              :: clfmt    
+   
+      ! Gather all times
+      ALLOCATE( zall_ratio(jpnij), iall_rank(jpnij) )
+      IF( narea == 1 ) THEN
+         iall_rank(:) = (/ (idum,idum=0,jpnij-1) /)
+   
+         ! Compute elapse user time
+         zavg_etime = tot_etime/REAL(jpnij,wp)
+         zmax_etime = MAXVAL(all_etime(:))
+         zmin_etime = MINVAL(all_etime(:))
+
+         ! Compute CPU user time
+         zavg_ctime = tot_ctime/REAL(jpnij,wp)
+         zmax_ctime = MAXVAL(all_ctime(:))
+         zmin_ctime = MINVAL(all_ctime(:))
+   
+         ! Compute cpu/elapsed ratio
+         zall_ratio(:) = all_ctime(:) / all_etime(:)
+         ztot_ratio    = SUM(zall_ratio(:))
+         zavg_ratio    = ztot_ratio/REAL(jpnij,wp)
+         zmax_ratio    = MAXVAL(zall_ratio(:))
+         zmin_ratio    = MINVAL(zall_ratio(:))   
+   
+         ! Output Format
+         clhline    ='1x,13("-"),"|",18("-"),"|",14("-"),"|",18("-"),/,'
+         cllignes(1)='(1x,"MPI summary report :",/,'
+         cllignes(2)='1x,"--------------------",//,'
+         cllignes(3)='1x,"Process Rank |"," Elapsed Time (s) |"," CPU Time (s) |"," Ratio CPU/Elapsed",/,'
+         cllignes(4)='    (1x,i4,9x,"|",f12.3,6x,"|",f12.3,2x,"|",4x,f7.3,/),'
+         WRITE(cllignes(4)(1:4),'(I4)') jpnij
+         cllignes(5)='1x,"Total        |",f12.3,6x,"|",F12.3,2x,"|",4x,f7.3,/,'
+         cllignes(6)='1x,"Minimum      |",f12.3,6x,"|",F12.3,2x,"|",4x,f7.3,/,'
+         cllignes(7)='1x,"Maximum      |",f12.3,6x,"|",F12.3,2x,"|",4x,f7.3,/,'
+         cllignes(8)='1x,"Average      |",f12.3,6x,"|",F12.3,2x,"|",4x,f7.3)'
+         clfmt=TRIM(cllignes(1))// TRIM(cllignes(2))//TRIM(cllignes(3))//          &
+           & TRIM(clhline)//TRIM(cllignes(4))//TRIM(clhline)//TRIM(cllignes(5))//  &
+           & TRIM(clhline)//TRIM(cllignes(6))//TRIM(clhline)//TRIM(cllignes(7))//  &
+           & TRIM(clhline)//TRIM(cllignes(8))
+         WRITE(numtime, TRIM(clfmt)) &
+             (iall_rank(idum),all_etime(idum),all_ctime(idum),zall_ratio(idum),idum=1, jpnij), &
+             tot_etime,     tot_ctime,     ztot_ratio,   &
+             zmin_etime,    zmin_ctime,    zmin_ratio,   &
+             zmax_etime,    zmax_ctime,    zmax_ratio,   &
+             zavg_etime,    zavg_ctime,    zavg_ratio
+         WRITE(numtime,*)    
+      END IF
+      !
+      DEALLOCATE(zall_ratio, iall_rank)
+      !
+   END SUBROUTINE wmpi_info
+#endif   
+
+
+   SUBROUTINE timing_ini_var(cdinfo)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_ini_var  ***
+      !! ** Purpose :   create timing structure 
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in) :: cdinfo
+      LOGICAL :: ll_section
+       
+      !
+      IF( .NOT. ASSOCIATED(s_timer_root) ) THEN
+         ALLOCATE(s_timer_root)
+         s_timer_root%cname       = cdinfo
+         s_timer_root%t_cpu      = 0._wp
+         s_timer_root%t_clock    = 0._wp
+         s_timer_root%tsum_cpu   = 0._wp
+         s_timer_root%tsum_clock = 0._wp
+         s_timer_root%tmax_cpu   = 0._wp
+         s_timer_root%tmax_clock = 0._wp
+         s_timer_root%tmin_cpu   = 0._wp
+         s_timer_root%tmin_clock = 0._wp
+         s_timer_root%tsub_cpu   = 0._wp
+         s_timer_root%tsub_clock = 0._wp
+         s_timer_root%ncount      = 0
+         s_timer_root%ncount_rate = 0
+         s_timer_root%ncount_max  = 0
+         s_timer_root%niter       = 0
+         s_timer_root%l_tdone  = .FALSE.
+         s_timer_root%next => NULL()
+         s_timer_root%prev => NULL()
+         s_timer => s_timer_root
+         !
+         ALLOCATE(s_wrk)
+         s_wrk => NULL()
+         !
+         ALLOCATE(s_timer_old)
+         s_timer_old%cname       = cdinfo
+         s_timer_old%t_cpu      = 0._wp
+         s_timer_old%t_clock    = 0._wp
+         s_timer_old%tsum_cpu   = 0._wp
+         s_timer_old%tsum_clock = 0._wp
+         s_timer_old%tmax_cpu   = 0._wp
+         s_timer_old%tmax_clock = 0._wp
+         s_timer_old%tmin_cpu   = 0._wp
+         s_timer_old%tmin_clock = 0._wp
+         s_timer_old%tsub_cpu   = 0._wp
+         s_timer_old%tsub_clock = 0._wp
+         s_timer_old%ncount      = 0
+         s_timer_old%ncount_rate = 0
+         s_timer_old%ncount_max  = 0
+         s_timer_old%niter       = 0
+         s_timer_old%l_tdone  = .TRUE.
+         s_timer_old%next => NULL()
+         s_timer_old%prev => NULL()
+
+      ELSE
+         s_timer => s_timer_root
+         ! case of already existing area (typically inside a loop)
+   !         write(*,*) 'in ini_var for routine : ', cdinfo
+         DO WHILE( ASSOCIATED(s_timer) ) 
+            IF( TRIM(s_timer%cname) .EQ. TRIM(cdinfo) ) THEN
+ !             write(*,*) 'in ini_var for routine : ', cdinfo,' we return'           
+               RETURN ! cdinfo is already in the chain
+            ENDIF
+            s_timer => s_timer%next
+         END DO
+
+         ! end of the chain
+         s_timer => s_timer_root
+         DO WHILE( ASSOCIATED(s_timer%next) )
+            s_timer => s_timer%next
+         END DO
+
+    !     write(*,*) 'after search', s_timer%cname
+         ! cdinfo is not part of the chain so we add it with initialisation          
+          ALLOCATE(s_timer%next)
+    !     write(*,*) 'after allocation of next'
+  
+         s_timer%next%cname       = cdinfo
+         s_timer%next%t_cpu      = 0._wp
+         s_timer%next%t_clock    = 0._wp
+         s_timer%next%tsum_cpu   = 0._wp
+         s_timer%next%tsum_clock = 0._wp  
+         s_timer%next%tmax_cpu   = 0._wp
+         s_timer%next%tmax_clock = 0._wp
+         s_timer%next%tmin_cpu   = 0._wp
+         s_timer%next%tmin_clock = 0._wp
+         s_timer%next%tsub_cpu   = 0._wp
+         s_timer%next%tsub_clock = 0._wp
+         s_timer%next%ncount      = 0
+         s_timer%next%ncount_rate = 0
+         s_timer%next%ncount_max  = 0
+         s_timer%next%niter       = 0
+         s_timer%next%l_tdone  = .FALSE.
+         s_timer%next%parent_section => NULL()
+         s_timer%next%prev => s_timer
+         s_timer%next%next => NULL()
+         s_timer => s_timer%next
+      ENDIF 
+      !    write(*,*) 'after allocation'
+     !
+   END SUBROUTINE timing_ini_var
+
+
+   SUBROUTINE timing_reset
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE timing_reset  ***
+      !! ** Purpose :   go to root of timing tree 
+      !!----------------------------------------------------------------------
+      l_initdone = .TRUE. 
+!      IF(lwp) WRITE(numout,*)
+!      IF(lwp) WRITE(numout,*) 'timing_reset : instrumented routines for timing'
+!      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+      CALL timing_list(s_timer_root)
+!      WRITE(numout,*)
+      !
+   END SUBROUTINE timing_reset
+
+
+   RECURSIVE SUBROUTINE timing_list(ptr)
+   
+      TYPE(timer), POINTER, INTENT(inout) :: ptr
+      !
+      IF( ASSOCIATED(ptr%next) ) CALL timing_list(ptr%next)
+      IF(lwp) WRITE(numout,*)'   ', ptr%cname   
+      !
+   END SUBROUTINE timing_list
+
+
+   SUBROUTINE insert(sd_current, sd_root ,sd_ptr)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE insert  ***
+      !! ** Purpose :   insert an element in timer structure
+      !!----------------------------------------------------------------------
+      TYPE(timer), POINTER, INTENT(inout) :: sd_current, sd_root, sd_ptr
+      !
+     
+      IF( ASSOCIATED( sd_current, sd_root ) ) THEN
+         ! If our current element is the root element then
+         ! replace it with the one being inserted
+         sd_root => sd_ptr
+      ELSE
+         sd_current%prev%next => sd_ptr
+      END IF
+      sd_ptr%next     => sd_current
+      sd_ptr%prev     => sd_current%prev
+      sd_current%prev => sd_ptr
+      ! Nullify the pointer to the new element now that it is held
+      ! within the list. If we don't do this then a subsequent call
+      ! to ALLOCATE memory to this pointer will fail.
+      sd_ptr => NULL()
+      !    
+   END SUBROUTINE insert
+  
+  
+   SUBROUTINE suppress(sd_ptr)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE suppress  ***
+      !! ** Purpose :   supress an element in timer structure
+      !!----------------------------------------------------------------------
+      TYPE(timer), POINTER, INTENT(inout) :: sd_ptr
+      !
+      TYPE(timer), POINTER :: sl_temp
+    
+      sl_temp => sd_ptr
+      sd_ptr => sd_ptr%next    
+      IF ( ASSOCIATED(sl_temp%next) ) sl_temp%next%prev => sl_temp%prev
+      DEALLOCATE(sl_temp)
+      sl_temp => NULL()
+      !
+    END SUBROUTINE suppress
+
+   !!=====================================================================
+END MODULE timing
Index: /utils/tools_ticket2413/DOMAINcfg/src/vectopt_loop_substitute.h90
===================================================================
--- /utils/tools_ticket2413/DOMAINcfg/src/vectopt_loop_substitute.h90	(revision 12863)
+++ /utils/tools_ticket2413/DOMAINcfg/src/vectopt_loop_substitute.h90	(revision 12863)
@@ -0,0 +1,18 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  vectopt_loop_substitute  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute the inner loop start/end indices with CPP macro
+   !!                allow unrolling of do-loop (useful with vector processors)
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: vectopt_loop_substitute.h90 10068 2018-08-28 14:09:04Z nicolasmartin $ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+#if defined key_vectopt_loop
+#  define   fs_2       1
+#  define   fs_jpim1   jpi
+#else
+#  define   fs_2       2
+#  define   fs_jpim1   jpim1
+#endif
Index: /utils/tools_ticket2413/GRIDGEN/namelist_R05
===================================================================
--- /utils/tools_ticket2413/GRIDGEN/namelist_R05	(revision 12863)
+++ /utils/tools_ticket2413/GRIDGEN/namelist_R05	(revision 12863)
@@ -0,0 +1,19 @@
+&input_output
+    ln_iom_activated = true 
+/
+
+&coarse_grid_files    
+    cn_parent_coordinate_file = 'coordinates_ORCA_R05.nc'
+    cn_position_pivot = 'F-grid'
+/    
+
+&nesting    
+    nn_imin = 0
+    nn_imax = 1
+    nn_jmin = 1
+    nn_jmax = 1
+    nn_rhox  = 2
+    nn_rhoy = 2
+/
+
+
Index: /utils/tools_ticket2413/GRIDGEN/namelist_R2
===================================================================
--- /utils/tools_ticket2413/GRIDGEN/namelist_R2	(revision 12863)
+++ /utils/tools_ticket2413/GRIDGEN/namelist_R2	(revision 12863)
@@ -0,0 +1,19 @@
+&input_output
+    ln_iom_activated = true 
+/
+
+&coarse_grid_files    
+    cn_parent_coordinate_file = 'coordinates_ORCA_R2.nc'
+    cn_position_pivot = 'T-grid'
+/    
+
+&nesting    
+    nn_imin = 49
+    nn_imax = 52
+    nn_jmin = 147
+    nn_jmax = 147
+    nn_rhox  = 3
+    nn_rhoy = 3
+/
+
+
Index: /utils/tools_ticket2413/GRIDGEN/src/cfg_tools.f90
===================================================================
--- /utils/tools_ticket2413/GRIDGEN/src/cfg_tools.f90	(revision 12863)
+++ /utils/tools_ticket2413/GRIDGEN/src/cfg_tools.f90	(revision 12863)
@@ -0,0 +1,633 @@
+MODULE cfg_tools
+!!-----------------------------------------------------------
+!!
+!!  to make that we use a 4th order polynomial interpolation
+!!
+!!	         Created by Brice Lemaire on 12/2009.
+!!
+!!-----------------------------------------------------------
+  USE readwrite
+  USE projection
+  !
+  IMPLICIT NONE
+  PUBLIC
+  !
+  !
+  !
+  CONTAINS
+  !********************************************************
+  !               SUBROUTINE interp_grid   				*
+  !									        			*
+  !	 calculate polynomial interpolation at 4th order	*
+  !												        *
+  !		   CALLED from create_coordinates.f90	        *
+  !********************************************************   
+  SUBROUTINE interp_grid
+    !
+	REAL*8, DIMENSION(:,:),ALLOCATABLE :: dlcoef      !Array to store the coefficients of Lagrange 	 
+	INTEGER :: ji, jj, jk, jproj
+	INTEGER :: istat, ip
+	LOGICAL :: llnorth_pole = .FALSE.
+	!
+	WRITE(*,*) ''
+	WRITE(*,*) '### SUBROUTINE interp_grid ###'
+	WRITE(*,*) ''
+	!
+	jproj = 0
+	!
+	! Calculate coefficients for interpolation along longitude
+	!
+	ALLOCATE(dlcoef(nn_rhox-1,4))
+	istat = pol_coef(dlcoef,nn_rhox)
+	IF (istat/=1) THEN    
+      WRITE(*,*) "ERROR WITH LAGRANGIAN COEFFICIENTS"
+      STOP
+    ENDIF
+	!
+	WRITE(*,*) 'Interpolation along longitude'
+    !
+	DO jj = nn_rhoy,nygmix,nn_rhoy     
+	  DO ji = nn_rhox,nxgmix,nn_rhox
+        !
+		DO jk = 1,nn_rhox-1
+		  !
+		  ! First, we check the +-180 discontinuity.
+		  ! In this case, we increase the negative values of 360.
+		  IF(ABS(smixgrd%glam(ji,jj)-smixgrd%glam(ji+1*nn_rhox,jj)).GT.180.0.AND.smixgrd%glam(ji,jj).LT.0.) THEN
+	        smixgrd%glam(ji,jj) = smixgrd%glam(ji,jj) + 360.
+		  ENDIF
+		  !
+		  IF(ABS(smixgrd%glam(ji,jj)-smixgrd%glam(ji+1*nn_rhox,jj)).GT.180.0.AND.smixgrd%glam(ji+1*nn_rhox,jj).LT.0.) THEN
+	        smixgrd%glam(ji+1*nn_rhox,jj) = smixgrd%glam(ji+1*nn_rhox,jj) + 360.
+		  ENDIF
+		  !
+		  IF(ABS(smixgrd%glam(ji+1*nn_rhox,jj)-smixgrd%glam(ji+2*nn_rhox,jj)).GT.180.0.AND.smixgrd%glam(ji+1*nn_rhox,jj).LT.0.) THEN
+            smixgrd%glam(ji+1*nn_rhox,jj) = smixgrd%glam(ji+1*nn_rhox,jj) + 360.
+		  ENDIF
+		  !
+		  IF(ABS(smixgrd%glam(ji+1*nn_rhox,jj)-smixgrd%glam(ji+2*nn_rhox,jj)).GT.180.0.AND.smixgrd%glam(ji+2*nn_rhox,jj).LT.0.) THEN
+            smixgrd%glam(ji+2*nn_rhox,jj) = smixgrd%glam(ji+2*nn_rhox,jj) + 360.
+		  ENDIF
+		  !
+		  IF(ABS(smixgrd%glam(ji+2*nn_rhox,jj)-smixgrd%glam(ji+3*nn_rhox,jj)).GT.180.0.AND.smixgrd%glam(ji+2*nn_rhox,jj).LT.0.) THEN
+            smixgrd%glam(ji+2*nn_rhox,jj) = smixgrd%glam(ji+2*nn_rhox,jj) + 360.
+		  ENDIF
+		  !
+		  IF(ABS(smixgrd%glam(ji+2*nn_rhox,jj)-smixgrd%glam(ji+3*nn_rhox,jj)).GT.180.0.AND.smixgrd%glam(ji+3*nn_rhox,jj).LT.0.) THEN
+            smixgrd%glam(ji+3*nn_rhox,jj) = smixgrd%glam(ji+3*nn_rhox,jj) + 360.
+		  ENDIF		  
+		  !
+		  ! If we are along north boundary,	
+		  ! the variation of longitude looks like a heaviside fonction at the geographical north pole.
+		  ! Thus, we can't make an interpolation.	  
+		  IF(ABS(smixgrd%glam(ji,jj) - smixgrd%glam(ji+3*nn_rhox,jj)).EQ.180.0)THEN
+			 llnorth_pole = .TRUE.
+		  ENDIF
+		  !  
+		  ! Nearby the geographical north pole,
+		  ! the variation of the longitudes is too important.
+		  ! We need to make a polar stereographic projection before interpolation.
+		  !IF(.NOT.llnorth_pole.AND.ABS(smixgrd%glam(ji,jj)-smixgrd%glam(ji+3*nn_rhox,jj)).GE.80.0) THEN
+		  IF(.NOT.llnorth_pole.AND.smixgrd%gphi(ji,jj).GE.88.) THEN
+			CALL stereo_projection(ji,jj,jk,llnorth_pole,1)
+			jproj = 1
+		  ENDIF
+		  !															
+		  smixgrd%glam(ji+nn_rhox+jk,jj) =   dlcoef(jk,1) * smixgrd%glam(ji,jj)            &
+										   + dlcoef(jk,2) * smixgrd%glam(ji+1*nn_rhox,jj)   &
+										   + dlcoef(jk,3) * smixgrd%glam(ji+2*nn_rhox,jj)   &
+										   + dlcoef(jk,4) * smixgrd%glam(ji+3*nn_rhox,jj)
+		  !
+		  smixgrd%gphi(ji+nn_rhox+jk,jj) =   dlcoef(jk,1) * smixgrd%gphi(ji,jj)            &
+										   + dlcoef(jk,2) * smixgrd%gphi(ji+1*nn_rhox,jj)   &
+										   + dlcoef(jk,3) * smixgrd%gphi(ji+2*nn_rhox,jj)   &
+										   + dlcoef(jk,4) * smixgrd%gphi(ji+3*nn_rhox,jj)
+		  !
+		  smixgrd%e1(ji+nn_rhox+jk,jj) =     dlcoef(jk,1) * smixgrd%e1(ji,jj)            &
+										   + dlcoef(jk,2) * smixgrd%e1(ji+1*nn_rhox,jj)   &
+										   + dlcoef(jk,3) * smixgrd%e1(ji+2*nn_rhox,jj)   &
+										   + dlcoef(jk,4) * smixgrd%e1(ji+3*nn_rhox,jj)
+		  !
+		  smixgrd%e2(ji+nn_rhox+jk,jj) =     dlcoef(jk,1) * smixgrd%e2(ji,jj)            &
+										   + dlcoef(jk,2) * smixgrd%e2(ji+1*nn_rhox,jj)   &
+										   + dlcoef(jk,3) * smixgrd%e2(ji+2*nn_rhox,jj)   &
+										   + dlcoef(jk,4) * smixgrd%e2(ji+3*nn_rhox,jj)
+		  !
+		  smixgrd%nav_lon(ji+nn_rhox+jk,jj) = smixgrd%glam(ji+nn_rhox+jk,jj)
+		  smixgrd%nav_lat(ji+nn_rhox+jk,jj) = smixgrd%gphi(ji+nn_rhox+jk,jj)
+		  !		
+		  ! We make the polar stereographic projection reverse if needs.  
+		  IF(jproj.EQ.1)THEN
+			CALL stereo_projection_inv(ji,jj,jk,llnorth_pole,1)
+		  ENDIF
+          !
+		  ! We replace the strong values along the north boundary.
+  		  IF(llnorth_pole)THEN
+			IF(smixgrd%glam(ji+1*nn_rhox,jj).EQ.smixgrd%glam(ji+2*nn_rhox,jj))THEN
+			  smixgrd%glam(ji+nn_rhox+jk,jj) = smixgrd%glam(ji+1*nn_rhox,jj)		  
+	    	ELSEIF(ABS(smixgrd%glam(ji+1*nn_rhox,jj) - smixgrd%glam(ji+2*nn_rhox,jj)).EQ.180.0)THEN
+			  IF(smixgrd%gphi(ji+1*nn_rhox,jj).LT.smixgrd%gphi(ji+2*nn_rhox,jj))THEN
+				smixgrd%glam(ji+nn_rhox+jk,jj) = smixgrd%glam(ji+1*nn_rhox,jj)
+			  ELSEIF(smixgrd%gphi(ji+1*nn_rhox,jj).GT.smixgrd%gphi(ji+2*nn_rhox,jj))THEN
+				smixgrd%glam(ji+nn_rhox+jk,jj) = smixgrd%glam(ji+2*nn_rhox,jj)
+			  ENDIF
+			ENDIF
+		  ENDIF
+		  !
+		  ip = 0
+		  jproj = 0
+		  llnorth_pole = .FALSE.
+		  !
+		END DO
+	  END DO
+	END DO
+	!
+  	WHERE(smixgrd%glam.GT.180)
+	  smixgrd%glam = smixgrd%glam - 360.0
+	ENDWHERE
+	!
+	DEALLOCATE(dlcoef)
+	!
+	! Calculate coefficients for interpolation along latitude
+	!
+	ALLOCATE(dlcoef(nn_rhoy-1,4))
+	istat = pol_coef(dlcoef,nn_rhoy)
+	IF (istat/=1) THEN    
+      WRITE(*,*) "ERROR WITH LAGRANGIAN COEFFICIENTS"
+      STOP
+    ENDIF
+	!
+	WRITE(*,*) 'Interpolation along latitude'
+	!
+print*, nequator
+	DO ji = 1,nxgmix,1    
+      !
+	  DO jj = nn_rhoy,nygmix,nn_rhoy
+	  	!
+		DO jk = 1,nn_rhoy-1
+		  !
+		  IF(ABS(smixgrd%glam(ji,jj)-smixgrd%glam(ji,jj+1*nn_rhoy)).GT.180.0.AND.smixgrd%glam(ji,jj).LT.0.) THEN
+	        smixgrd%glam(ji,jj) = smixgrd%glam(ji,jj) + 360.
+		  ENDIF
+		  !
+		  IF(ABS(smixgrd%glam(ji,jj)-smixgrd%glam(ji,jj+1*nn_rhoy)).GT.180.0.AND.smixgrd%glam(ji,jj+1*nn_rhoy).LT.0.) THEN
+	        smixgrd%glam(ji,jj+1*nn_rhoy) = smixgrd%glam(ji,jj+1*nn_rhoy) + 360.
+		  ENDIF
+		  !
+		  IF(ABS(smixgrd%glam(ji,jj+1*nn_rhoy)-smixgrd%glam(ji,jj+2*nn_rhoy)).GT.180.0.AND.smixgrd%glam(ji,jj+1*nn_rhoy).LT.0.) THEN
+            smixgrd%glam(ji,jj+1*nn_rhoy) = smixgrd%glam(ji,jj+1*nn_rhoy) + 360.
+		  ENDIF
+		  !
+		  IF(ABS(smixgrd%glam(ji,jj+1*nn_rhoy)-smixgrd%glam(ji,jj+2*nn_rhoy)).GT.180.0.AND.smixgrd%glam(ji,jj+2*nn_rhoy).LT.0.) THEN
+            smixgrd%glam(ji,jj+2*nn_rhoy) = smixgrd%glam(ji,jj+2*nn_rhoy) + 360.
+		  ENDIF
+		  !
+		  IF(ABS(smixgrd%glam(ji,jj+2*nn_rhoy)-smixgrd%glam(ji,jj+3*nn_rhoy)).GT.180.0.AND.smixgrd%glam(ji,jj+2*nn_rhoy).LT.0.) THEN
+            smixgrd%glam(ji,jj+2*nn_rhoy) = smixgrd%glam(ji,jj+2*nn_rhoy) + 360.
+		  ENDIF
+		  !
+		  IF(ABS(smixgrd%glam(ji,jj+2*nn_rhoy)-smixgrd%glam(ji,jj+3*nn_rhoy)).GT.180.0.AND.smixgrd%glam(ji,jj+3*nn_rhoy).LT.0.) THEN
+            smixgrd%glam(ji,jj+3*nn_rhoy) = smixgrd%glam(ji,jj+3*nn_rhoy) + 360.
+		  ENDIF	
+		  !
+		  !IF(.NOT.llnorth_pole.AND.ABS(smixgrd%glam(ji,jj)-smixgrd%glam(ji,jj+3*nn_rhoy)).GE.60.0) THEN
+		  IF(.NOT.llnorth_pole.AND.smixgrd%gphi(ji,jj).GE.88.) THEN
+			CALL stereo_projection(ji,jj,jk,llnorth_pole,2)
+			jproj = 1
+		  ENDIF	
+		  !	
+		  smixgrd%glam(ji,jj+nn_rhoy+jk) =  dlcoef(jk,1) * smixgrd%glam(ji,jj)           &
+								          + dlcoef(jk,2) * smixgrd%glam(ji,jj+nn_rhoy)   &
+								          + dlcoef(jk,3) * smixgrd%glam(ji,jj+2*nn_rhoy) &
+								          + dlcoef(jk,4) * smixgrd%glam(ji,jj+3*nn_rhoy)
+		  !
+		  smixgrd%gphi(ji,jj+nn_rhoy+jk) =  dlcoef(jk,1) * smixgrd%gphi(ji,jj)           &
+								          + dlcoef(jk,2) * smixgrd%gphi(ji,jj+nn_rhoy)   &
+									      + dlcoef(jk,3) * smixgrd%gphi(ji,jj+2*nn_rhoy) &
+								          + dlcoef(jk,4) * smixgrd%gphi(ji,jj+3*nn_rhoy)
+		  !
+		  smixgrd%e1(ji,jj+nn_rhoy+jk) =    dlcoef(jk,1) * smixgrd%e1(ji,jj)           &
+								          + dlcoef(jk,2) * smixgrd%e1(ji,jj+nn_rhoy)   &
+								          + dlcoef(jk,3) * smixgrd%e1(ji,jj+2*nn_rhoy) &
+								          + dlcoef(jk,4) * smixgrd%e1(ji,jj+3*nn_rhoy)
+		  !
+		  smixgrd%e2(ji,jj+nn_rhoy+jk) =    dlcoef(jk,1) * smixgrd%e2(ji,jj)           &
+								          + dlcoef(jk,2) * smixgrd%e2(ji,jj+nn_rhoy)   &
+								          + dlcoef(jk,3) * smixgrd%e2(ji,jj+2*nn_rhoy) &
+								          + dlcoef(jk,4) * smixgrd%e2(ji,jj+3*nn_rhoy)
+		  !
+		  smixgrd%nav_lon(ji,jj+nn_rhoy+jk) = smixgrd%glam(ji,jj+nn_rhoy+jk)
+		  smixgrd%nav_lat(ji,jj+nn_rhoy+jk) = smixgrd%gphi(ji,jj+nn_rhoy+jk)
+		  !
+		  IF(jproj.EQ.1)THEN
+			CALL stereo_projection_inv(ji,jj,jk,llnorth_pole,2)
+		  ENDIF	
+		  !	 
+		  jproj = 0
+		  llnorth_pole = .FALSE.		  
+		  !
+	    END DO
+		!							   
+		IF(jj+3*nn_rhoy.EQ.nygmix) EXIT
+		!
+	  END DO
+      !
+	END DO	
+	!
+	WHERE(smixgrd%glam.GT.180.)
+	  smixgrd%glam = smixgrd%glam - 360.0
+	ENDWHERE
+	!	
+	WRITE(*,*) ''
+	WRITE(*,*) '### END SUBROUTINE interp_grid ###'
+	WRITE(*,*) ''
+	!
+  END SUBROUTINE
+  !
+  !
+  !
+  !********************************************************
+  !                  FUNCTION pol_coef   			    *
+  !									        			*
+  !	      calculate the coefficients of Lagrange   		*
+  !			 for the polynomial interpolation	        *
+  !												        *
+  !            CALLED from SUBROUTINE interp            *
+  !********************************************************
+  REAL FUNCTION pol_coef(kvect,kxy)
+    !
+	REAL*8, DIMENSION(:,:),ALLOCATABLE :: kvect
+	REAL*8, DIMENSION(3) :: dlv		
+	INTEGER :: ji, jm, jk
+	REAL*8 :: dlx0              !position relative du point  calculer 
+	INTEGER :: jx_k, jx_i       !position relative des points utiliss pour l'interpolation
+	REAL*8 :: dleps 
+	INTEGER :: kxy, irho
+	!
+	!on parle de position relative puisque nous utilisons les positions
+	!indiciaires, lesquelles sont rptes dans toute la grille.
+	!Il n'est donc ncessaire de calculer qu'une fois les 4 coefficients 
+	!qui seront utiliss dans toute la grille en fonction de nn_rho
+	!
+	WRITE(*,*) ''
+	WRITE(*,*) '*** FUNCTION pol_coef ***'
+	WRITE(*,*) ''
+	!
+	jm=1
+	dleps = 1.-1e-8
+	!
+	irho = kxy 
+	!
+	DO jk = 1,irho-1 
+	  dlx0 = irho+1+jk
+	  ji=1
+	  DO jx_i = 1,4+3*(irho-1),irho
+		jm=1
+		DO jx_k=1,4+3*(irho-1),irho
+		  IF(jx_k == jx_i) THEN
+			CYCLE
+		  ELSE	
+			dlv(jm) = (dlx0-jx_k) / (jx_i-jx_k)
+			jm = jm + 1
+		  END IF
+		END DO
+		kvect(jk,ji) = product(dlv)
+		ji = ji + 1
+	  END DO
+	END DO
+	!
+	IF(SUM(kvect).LT.dleps .OR. SUM(kvect).GT.dleps) THEN
+	  WRITE(*,*) ''
+	  WRITE(*,*) '*** CHECK LAGRANGE COEFFICIENTS: ***'
+	  WRITE(*,*) ''
+	  !	  
+	  DO ji=1,irho-1
+		WRITE(*,*)'point #',ji
+		WRITE(*,*) 'dlcoef(:)= ', kvect(ji,:)
+		WRITE(*,*) 'SUM(dlcoef(:)) =', SUM(kvect(ji,:))
+		WRITE(*,*)''
+	  END DO
+	  pol_coef = 1
+	ELSE
+	  !
+	  pol_coef = 0
+    ENDIF
+	!
+  END FUNCTION pol_coef
+  !
+  !
+  !
+  !********************************************************
+  !                SUBROUTINE child_grid     		    *
+  !									        			*
+  !	      create the child grids from mixed grid	    *
+  !												        *
+  !		   CALLED from create_coordinates.f90	        *
+  !********************************************************
+  SUBROUTINE child_grid	 
+    !
+	INTEGER :: ji, jj
+	INTEGER :: ip, iq
+	REAL*8, DIMENSION(2) :: dlgrdt, dlgrdu, dlgrdv, dlgrdf
+	REAL*8 :: dleps
+	!
+	WRITE(*,*) ''
+	WRITE(*,*) '### SUBROUTINE child_grid ###'
+	WRITE(*,*) ''
+	!	
+	IF(.NOT.nglobal.AND.(nn_rhox.GT.1.OR.nn_rhoy.GT.1)) THEN
+	  iq=1
+	  DO jj = (2*nn_rhoy)+1-nequator,(nygmix-(2*nn_rhoy-1)-nequator),2
+	    ip=1
+	    DO ji = (2*nn_rhox)+1,(nxgmix-(2*nn_rhox-1)),2
+		  !
+		  sfingrd%nav_lon(ip,iq) = smixgrd%nav_lon(ji,jj)
+		  sfingrd%nav_lat(ip,iq) = smixgrd%nav_lat(ji,jj)
+		  !
+		  sfingrd%glamt(ip,iq) = smixgrd%glam(ji,jj)
+		  sfingrd%glamu(ip,iq) = smixgrd%glam(ji+1,jj)
+		  sfingrd%glamv(ip,iq) = smixgrd%glam(ji,jj+1)
+		  sfingrd%glamf(ip,iq) = smixgrd%glam(ji+1,jj+1)
+		  !
+		  sfingrd%gphit(ip,iq) = smixgrd%gphi(ji,jj)
+		  sfingrd%gphiu(ip,iq) = smixgrd%gphi(ji+1,jj)
+		  sfingrd%gphiv(ip,iq) = smixgrd%gphi(ji,jj+1)
+		  sfingrd%gphif(ip,iq) = smixgrd%gphi(ji+1,jj+1)
+		  !
+		  sfingrd%e1t(ip,iq) = smixgrd%e1(ji,jj)
+		  sfingrd%e1u(ip,iq) = smixgrd%e1(ji+1,jj)
+		  sfingrd%e1v(ip,iq) = smixgrd%e1(ji,jj+1)
+		  sfingrd%e1f(ip,iq) = smixgrd%e1(ji+1,jj+1)
+		  !
+		  sfingrd%e2t(ip,iq) = smixgrd%e2(ji,jj)
+		  sfingrd%e2u(ip,iq) = smixgrd%e2(ji+1,jj)
+		  sfingrd%e2v(ip,iq) = smixgrd%e2(ji,jj+1)
+		  sfingrd%e2f(ip,iq) = smixgrd%e2(ji+1,jj+1)
+		  !		
+		  ip=ip+1
+		ENDDO
+		iq=iq+1
+	  ENDDO
+      !
+	ELSEIF(nglobal.AND.(nn_rhox.GT.1.OR.nn_rhoy.GT.1))THEN
+	  iq=1
+      DO jj = (2*nn_rhoy)+1-nequator,nygmix,2  
+	    ip=1
+		DO ji = (2*nn_rhox)-1,nxgmix,2
+		  !
+		  sfingrd%nav_lon(ip,iq) = smixgrd%nav_lon(ji,jj)
+		  sfingrd%nav_lat(ip,iq) = smixgrd%nav_lat(ji,jj)
+		  !
+		  sfingrd%glamt(ip,iq) = smixgrd%glam(ji,jj)
+		  sfingrd%glamu(ip,iq) = smixgrd%glam(ji+1,jj)
+		  sfingrd%glamv(ip,iq) = smixgrd%glam(ji,jj+1)
+		  sfingrd%glamf(ip,iq) = smixgrd%glam(ji+1,jj+1)
+		  !
+		  sfingrd%gphit(ip,iq) = smixgrd%gphi(ji,jj)
+		  sfingrd%gphiu(ip,iq) = smixgrd%gphi(ji+1,jj)
+		  sfingrd%gphiv(ip,iq) = smixgrd%gphi(ji,jj+1)
+		  sfingrd%gphif(ip,iq) = smixgrd%gphi(ji+1,jj+1)
+		  !
+		  sfingrd%e1t(ip,iq) = smixgrd%e1(ji,jj)
+		  sfingrd%e1u(ip,iq) = smixgrd%e1(ji+1,jj)
+		  sfingrd%e1v(ip,iq) = smixgrd%e1(ji,jj+1)
+		  sfingrd%e1f(ip,iq) = smixgrd%e1(ji+1,jj+1)
+		  !
+		  sfingrd%e2t(ip,iq) = smixgrd%e2(ji,jj)
+		  sfingrd%e2u(ip,iq) = smixgrd%e2(ji+1,jj)
+		  sfingrd%e2v(ip,iq) = smixgrd%e2(ji,jj+1)
+		  sfingrd%e2f(ip,iq) = smixgrd%e2(ji+1,jj+1)
+		  !	
+		  IF(ip.EQ.nxfine) EXIT
+		  !
+		  ip=ip+1
+		  !
+		ENDDO
+		!
+		IF(iq.EQ.nyfine) EXIT
+		!
+		iq=iq+1		
+		!
+	  ENDDO
+	  !
+	ELSE                                                 !No interpolation
+	  iq=1
+	  DO jj = 1,nygmix-1,2    
+	    ip=1
+	    DO ji = 1,nxgmix-1,2
+		  !
+		  sfingrd%nav_lon(ip,iq) = smixgrd%nav_lon(ji,jj)
+		  sfingrd%nav_lat(ip,iq) = smixgrd%nav_lat(ji,jj)
+		  !
+		  sfingrd%glamt(ip,iq) = smixgrd%glam(ji,jj)
+		  sfingrd%glamu(ip,iq) = smixgrd%glam(ji+1,jj)
+		  sfingrd%glamv(ip,iq) = smixgrd%glam(ji,jj+1)
+		  sfingrd%glamf(ip,iq) = smixgrd%glam(ji+1,jj+1)
+		  !
+		  sfingrd%gphit(ip,iq) = smixgrd%gphi(ji,jj)
+		  sfingrd%gphiu(ip,iq) = smixgrd%gphi(ji+1,jj)
+		  sfingrd%gphiv(ip,iq) = smixgrd%gphi(ji,jj+1)
+		  sfingrd%gphif(ip,iq) = smixgrd%gphi(ji+1,jj+1)
+		  !
+		  sfingrd%e1t(ip,iq) = smixgrd%e1(ji,jj)
+		  sfingrd%e1u(ip,iq) = smixgrd%e1(ji+1,jj)
+		  sfingrd%e1v(ip,iq) = smixgrd%e1(ji,jj+1)
+		  sfingrd%e1f(ip,iq) = smixgrd%e1(ji+1,jj+1)
+		  !
+		  sfingrd%e2t(ip,iq) = smixgrd%e2(ji,jj)
+		  sfingrd%e2u(ip,iq) = smixgrd%e2(ji+1,jj)
+		  sfingrd%e2v(ip,iq) = smixgrd%e2(ji,jj+1)
+		  sfingrd%e2f(ip,iq) = smixgrd%e2(ji+1,jj+1)
+		  !		
+		  ip=ip+1
+		END DO
+		iq=iq+1
+	  END DO
+    !
+	ENDIF
+	!
+	! With a global domain, we check the overlap bands for have
+	! * Grid(1,:) = Grid(n-1,:)
+	! * Grid(2,:) = Grid(n,:)
+	! because after interpolation the first column have no values  
+	IF(nglobal.AND.nn_rhox.GT.1)THEN
+	  !
+	  sfingrd%nav_lon(1,:) = sfingrd%nav_lon(nxfine-1,:)
+	  sfingrd%nav_lat(1,:) = sfingrd%nav_lat(nxfine-1,:)
+	  !
+	  sfingrd%glamt(1,:) = sfingrd%glamt(nxfine-1,:)
+	  sfingrd%glamu(1,:) = sfingrd%glamu(nxfine-1,:)
+	  sfingrd%glamv(1,:) = sfingrd%glamv(nxfine-1,:)
+	  sfingrd%glamf(1,:) = sfingrd%glamf(nxfine-1,:)
+	  !
+	  sfingrd%gphit(1,:) = sfingrd%gphit(nxfine-1,:)
+	  sfingrd%gphiu(1,:) = sfingrd%gphiu(nxfine-1,:)
+	  sfingrd%gphiv(1,:) = sfingrd%gphiv(nxfine-1,:)
+	  sfingrd%gphif(1,:) = sfingrd%gphif(nxfine-1,:)
+	  !
+	  sfingrd%e1t(1,:) = sfingrd%e1t(nxfine-1,:)
+	  sfingrd%e1u(1,:) = sfingrd%e1u(nxfine-1,:)
+	  sfingrd%e1v(1,:) = sfingrd%e1v(nxfine-1,:)
+	  sfingrd%e1f(1,:) = sfingrd%e1f(nxfine-1,:)
+	  !
+	  sfingrd%e2t(1,:) = sfingrd%e2t(nxfine-1,:)
+	  sfingrd%e2u(1,:) = sfingrd%e2u(nxfine-1,:)
+	  sfingrd%e2v(1,:) = sfingrd%e2v(nxfine-1,:)
+	  sfingrd%e2f(1,:) = sfingrd%e2f(nxfine-1,:)
+	  !
+	  WRITE(*,*) ''
+	  WRITE(*,*) 'WE CHECK THE OVERLAP BANDS FOR EACH FINE GRID (T,U,V & F):'
+	  WRITE(*,*) ' ==> SUM{ grd(1,:) + grd(2,:) } - SUM{ grd(n-1) + grd(n,:) } = 0'
+	  !
+	  dleps = 1e-2
+	  !
+	  WRITE(*,*) '* grid T:'
+	  dlgrdt(1) = SUM(sfingrd%glamt(1,:)) + SUM(sfingrd%glamt(2,:))
+	  dlgrdt(1) = dlgrdt(1) + SUM(sfingrd%gphit(1,:)) + SUM(sfingrd%gphit(2,:))  
+	  dlgrdt(1) = dlgrdt(1) + SUM(sfingrd%e1t(1,:)) + SUM(sfingrd%e1t(2,:))  
+	  dlgrdt(1) = dlgrdt(1) + SUM(sfingrd%e2t(1,:)) + SUM(sfingrd%e2t(2,:)) 
+	  !
+	  dlgrdt(2) = SUM(sfingrd%glamt(nxfine-1,:)) + SUM(sfingrd%glamt(nxfine,:))
+	  dlgrdt(2) = dlgrdt(2) + SUM(sfingrd%gphit(nxfine-1,:)) + SUM(sfingrd%gphit(nxfine,:))  
+	  dlgrdt(2) = dlgrdt(2) + SUM(sfingrd%e1t(nxfine-1,:)) + SUM(sfingrd%e1t(nxfine,:))  
+	  dlgrdt(2) = dlgrdt(2) + SUM(sfingrd%e2t(nxfine-1,:)) + SUM(sfingrd%e2t(nxfine,:))	
+	  !  
+	  IF((dlgrdt(1)-dlgrdt(2)).GT.dleps.OR.(dlgrdt(1)+dlgrdt(2)).LT.dleps) THEN				
+	    WRITE(*,*) '   ERROR'
+		print*,(dlgrdt(1)-dlgrdt(2)), (dlgrdt(1)+dlgrdt(2))
+	  ELSE
+	    WRITE(*,*) 'OVERLAP BANDS OK'
+	  ENDIF
+	  !
+	  WRITE(*,*) '* grid U:'
+	  dlgrdu(1) = SUM(sfingrd%glamu(1,:)) + SUM(sfingrd%glamu(2,:))
+	  dlgrdu(1) = dlgrdu(1) + SUM(sfingrd%gphiu(1,:)) + SUM(sfingrd%gphiu(2,:))  
+	  dlgrdu(1) = dlgrdu(1) + SUM(sfingrd%e1u(1,:)) + SUM(sfingrd%e1u(2,:))  
+	  dlgrdu(1) = dlgrdu(1) + SUM(sfingrd%e2u(1,:)) + SUM(sfingrd%e2u(2,:)) 
+	  !
+	  dlgrdu(2) = SUM(sfingrd%glamu(nxfine-1,:)) + SUM(sfingrd%glamu(nxfine,:))
+	  dlgrdu(2) = dlgrdu(2) + SUM(sfingrd%gphiu(nxfine-1,:)) + SUM(sfingrd%gphiu(nxfine,:))  
+	  dlgrdu(2) = dlgrdu(2) + SUM(sfingrd%e1u(nxfine-1,:)) + SUM(sfingrd%e1u(nxfine,:))  
+	  dlgrdu(2) = dlgrdu(2) + SUM(sfingrd%e2u(nxfine-1,:)) + SUM(sfingrd%e2u(nxfine,:))	
+	  !  
+	  IF((dlgrdu(1)-dlgrdu(2)).GT.dleps.OR.(dlgrdu(1)+dlgrdu(2)).LT.dleps) THEN				
+	    WRITE(*,*) '   ERROR'
+		print*,(dlgrdu(1)-dlgrdu(2)),  (dlgrdu(1)+dlgrdu(2))
+	  ELSE
+	    WRITE(*,*) 'OVERLAP BANDS OK'
+	  ENDIF
+	  !	  
+	  WRITE(*,*) '* grid V:'
+	  dlgrdv(1) = SUM(sfingrd%glamv(1,:)) + SUM(sfingrd%glamv(2,:))
+	  dlgrdv(1) = dlgrdv(1) + SUM(sfingrd%gphiv(1,:)) + SUM(sfingrd%gphiv(2,:))  
+	  dlgrdv(1) = dlgrdv(1) + SUM(sfingrd%e1v(1,:)) + SUM(sfingrd%e1v(2,:))  
+	  dlgrdv(1) = dlgrdv(1) + SUM(sfingrd%e2v(1,:)) + SUM(sfingrd%e2v(2,:)) 
+	  !
+	  dlgrdv(2) = SUM(sfingrd%glamv(nxfine-1,:)) + SUM(sfingrd%glamv(nxfine,:))
+	  dlgrdv(2) = dlgrdv(2) + SUM(sfingrd%gphiv(nxfine-1,:)) + SUM(sfingrd%gphiv(nxfine,:))  
+	  dlgrdv(2) = dlgrdv(2) + SUM(sfingrd%e1v(nxfine-1,:)) + SUM(sfingrd%e1v(nxfine,:))  
+	  dlgrdv(2) = dlgrdv(2) + SUM(sfingrd%e2v(nxfine-1,:)) + SUM(sfingrd%e2v(nxfine,:))	
+	  !  
+	  IF((dlgrdv(1)-dlgrdv(2)).GT.dleps.OR.(dlgrdv(1)+dlgrdv(2)).LT.dleps) THEN				
+	    WRITE(*,*) '   ERROR'
+		print*,(dlgrdv(1)-dlgrdv(2)), (dlgrdv(1)+dlgrdv(2))
+	  ELSE
+	    WRITE(*,*) 'OVERLAP BANDS OK'
+	  ENDIF
+	  !	
+	  WRITE(*,*) '* grid F:'
+	  dlgrdf(1) = SUM(sfingrd%glamf(1,:)) + SUM(sfingrd%glamf(2,:))
+	  dlgrdf(1) = dlgrdf(1) + SUM(sfingrd%gphif(1,:)) + SUM(sfingrd%gphif(2,:))  
+	  dlgrdf(1) = dlgrdf(1) + SUM(sfingrd%e1f(1,:)) + SUM(sfingrd%e1f(2,:))  
+	  dlgrdf(1) = dlgrdf(1) + SUM(sfingrd%e2f(1,:)) + SUM(sfingrd%e2f(2,:)) 
+	  !
+	  dlgrdf(2) = SUM(sfingrd%glamf(nxfine-1,:)) + SUM(sfingrd%glamf(nxfine,:))
+	  dlgrdf(2) = dlgrdf(2) + SUM(sfingrd%gphif(nxfine-1,:)) + SUM(sfingrd%gphif(nxfine,:))  
+	  dlgrdf(2) = dlgrdf(2) + SUM(sfingrd%e1f(nxfine-1,:)) + SUM(sfingrd%e1f(nxfine,:))  
+	  dlgrdf(2) = dlgrdf(2) + SUM(sfingrd%e2f(nxfine-1,:)) + SUM(sfingrd%e2f(nxfine,:))	
+	  !  
+	  IF((dlgrdf(1)-dlgrdf(2)).GT.dleps.OR.(dlgrdf(1)+dlgrdf(2)).LT.dleps) THEN				
+	    WRITE(*,*) '   ERROR'
+		print*, (dlgrdf(1)-dlgrdf(2)),  (dlgrdf(1)+dlgrdf(2))
+	  ELSE
+	    WRITE(*,*) 'OVERLAP BANDS OK'
+	  ENDIF
+	  !
+	  WRITE(*,*) ''
+	  WRITE(*,*) ' grid T'
+	  WRITE(*,*)  'i=    ','      1            ','         2            ','          3   '
+	  WRITE(*,*)  sfingrd%glamt(1:3,1)
+	  WRITE(*,*)  sfingrd%gphit(1:3,1)
+	  WRITE(*,*)  'i=    ','     n-2           ','        n-1           ','          n   '
+	  WRITE(*,*)  sfingrd%glamt(nxfine-2:nxfine,1)
+	  WRITE(*,*)  sfingrd%gphit(nxfine-2:nxfine,1)
+	  WRITE(*,*) ''
+	  WRITE(*,*) ' grid U'
+	  WRITE(*,*)  'i=    ','      1            ','         2            ','          3   '
+	  WRITE(*,*)  sfingrd%glamu(1:3,1)
+	  WRITE(*,*)  sfingrd%gphiu(1:3,1)
+	  WRITE(*,*)  'i=    ','     n-2           ','        n-1           ','          n   '
+	  WRITE(*,*)  sfingrd%glamu(nxfine-2:nxfine,1)
+	  WRITE(*,*)  sfingrd%gphiu(nxfine-2:nxfine,1)
+	  WRITE(*,*) ''
+	  WRITE(*,*) ' grid V'
+	  WRITE(*,*)  'i=    ','      1            ','         2            ','          3   '
+	  WRITE(*,*)  sfingrd%glamv(1:3,1)
+	  WRITE(*,*)  sfingrd%gphiv(1:3,1)
+	  WRITE(*,*)  'i=    ','     n-2           ','        n-1           ','          n   '
+	  WRITE(*,*)  sfingrd%glamv(nxfine-2:nxfine,1)
+	  WRITE(*,*)  sfingrd%gphiv(nxfine-2:nxfine,1)
+	  WRITE(*,*) ''	
+	  WRITE(*,*) ' grid F'
+	  WRITE(*,*)  'i=    ','      1            ','         2            ','          3   '
+	  WRITE(*,*)  sfingrd%glamf(1:3,1)
+	  WRITE(*,*)  sfingrd%gphif(1:3,1)
+	  WRITE(*,*)  'i=    ','     n-2           ','        n-1           ','          n   '
+	  WRITE(*,*)  sfingrd%glamf(nxfine-2:nxfine,1)
+	  WRITE(*,*)  sfingrd%gphif(nxfine-2:nxfine,1)
+	  WRITE(*,*) ''
+	ENDIF
+	!
+	IF(nglobal.AND.nequator.EQ.1) THEN
+      ! *** GRID U
+	  jj = 1
+	  DO ji = nxfine/2 + nn_rhox,nxfine,2
+	    sfingrd%glamu(ji,nyfine-1) = sfingrd%glamu(nxfine/2+1 - jj,nyfine-1)
+	    sfingrd%gphiu(ji,nyfine-1) = sfingrd%gphiu(nxfine/2+1 - jj,nyfine-1)
+	    jj = jj+2
+	  ENDDO
+	  !
+	  jj = 0
+	  DO ji = 2,nxfine
+	    sfingrd%glamu(ji,nyfine) = sfingrd%glamu(nxfine - jj,nyfine-2)
+	    sfingrd%gphiu(ji,nyfine) = sfingrd%gphiu(nxfine - jj,nyfine-2)
+	    jj = jj+1
+	  ENDDO
+	  !	
+	  ! *** GRID T 
+	  jj = 0
+	  DO ji = nxfine/2 + nn_rhox,nxfine
+	    sfingrd%glamt(ji,nyfine-1) = sfingrd%glamt(nxfine/2+1 - jj,nyfine-1)
+	    sfingrd%gphit(ji,nyfine-1) = sfingrd%gphit(nxfine/2+1 - jj,nyfine-1)
+	    jj = jj+1
+	  ENDDO
+	  !
+	  jj = 0
+	  DO ji = 3,nxfine
+	    sfingrd%glamt(ji,nyfine) = sfingrd%glamt(nxfine - jj,nyfine-2)
+	    sfingrd%gphit(ji,nyfine) = sfingrd%gphit(nxfine - jj,nyfine-2)
+	    jj = jj+1
+	  ENDDO
+    ENDIF			  
+	!
+	WRITE(*,*) ''
+	WRITE(*,*) '### END SUBROUTINE child_grid ###'
+	WRITE(*,*) ''
+	!
+  END SUBROUTINE child_grid
+  !
+  !
+  !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!             
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+END MODULE cfg_tools
Index: /utils/tools_ticket2413/GRIDGEN/src/create_coordinates.f90
===================================================================
--- /utils/tools_ticket2413/GRIDGEN/src/create_coordinates.f90	(revision 12863)
+++ /utils/tools_ticket2413/GRIDGEN/src/create_coordinates.f90	(revision 12863)
@@ -0,0 +1,250 @@
+PROGRAM create_coordinates
+!!-----------------------------------------------------------
+!!
+!!	  to create regional coordinates file (e.g. 1_coordinates.nc)
+!!    for fine grid from coarse grid (e.g. coordinates.nc)
+!!
+!!   to make it we use a 4th order polynomial interpolation
+!!
+!!	        Created by Brice Lemaire on 12/2009.
+!!
+!!-----------------------------------------------------------
+  USE netcdf
+  USE cfg_tools
+  USE mixed_grid
+  USE domain
+  !------------
+  IMPLICIT NONE
+  !
+  INTEGER :: narg,iargc
+  INTEGER :: nstat, imodulo
+  INTEGER :: nik, njk, npk
+  INTEGER :: ival
+  CHARACTER(len=80) :: cnmlname, cfingrdname
+  !
+  !
+  !
+  !*************************************  
+  ! Read input file (namelist file)
+  !         using types.f90
+  !*************************************
+  narg = iargc()
+  !
+  IF (narg == 0) THEN
+    cnmlname = 'namelist.input'
+  ELSE
+	CALL getarg(1,cnmlname)
+  ENDIF
+  !
+  CALL read_namelist(cnmlname)  
+  !
+  nstat = read_coordinates(TRIM(cn_parent_coordinate_file),scoagrd)    
+  IF (nstat/=1) THEN    
+   WRITE(*,*) 'unable to open netcdf file : ',cn_parent_coordinate_file
+   STOP
+  ENDIF
+  !
+  nsizex = SIZE(scoagrd%glamt,1)
+  nsizey = SIZE(scoagrd%glamt,2)
+  !
+  WRITE(*,*) ''
+  WRITE(*,*) 'Size of input matrix: '
+  WRITE(*,*) '(',nsizex,';', nsizey,')' 
+  WRITE(*,*) ''
+  !
+  WRITE(*,*) 'Domain: '
+  WRITE(*,*) ''
+  WRITE(*,*) '           ', '    min(1,1:nsizey)       ', '      max(nsizex,1:nsizey)            '
+  WRITE(*,*) 'longitude: ', MINVAL(scoagrd%glamt(1,1:nsizey)), ' --> ', MAXVAL(scoagrd%glamf(nsizex,1:nsizey)) 
+  WRITE(*,*) 'latitude:  ', MINVAL(scoagrd%gphit(1:nsizex,1)), ' --> ', MAXVAL(scoagrd%gphif(1:nsizex,nsizey)) 
+  WRITE(*,*) ''
+  !
+  !*************************************  
+  ! Check the values read in the namelist
+  !*************************************
+  IF(nn_imin.LE.0.OR.nn_imin.GT.nsizex)THEN
+    WRITE(*,*) 'Wrong values in namelist:'
+	WRITE(*,*) 'nn_imin must be greater than 0 and less than', nsizex
+	STOP
+  ENDIF
+  !
+  IF(nn_imax.LE.0.OR.nn_imax.GT.nsizex)THEN
+    WRITE(*,*) 'Wrong values in namelist:'
+	WRITE(*,*) 'nn_imax must be greater than 0 and less than', nsizex
+	STOP
+  ENDIF
+  !
+  IF(nn_jmin.LE.0.OR.nn_jmin.GT.nsizey)THEN
+    WRITE(*,*) 'Wrong values in namelist:'
+	WRITE(*,*) 'nn_jmin must be greater than 0 and less than', nsizey
+	STOP
+  ENDIF
+  !
+  IF(nn_jmax.LE.0.OR.nn_jmax.GT.nsizey)THEN
+    WRITE(*,*) 'Wrong values in namelist:'
+	WRITE(*,*) 'nn_jmax must be greater than 0 and less than', nsizey
+	STOP
+  ENDIF
+  !
+  !*************************************  
+  ! Define the sub-domain chosen by user
+  !*************************************
+  WRITE(*,*) 'Domain defined by user: '
+  WRITE(*,*) ''
+  WRITE(*,*) '           ', '          min           ', '               max            '
+  WRITE(*,*) 'longitude: ', MINVAL(scoagrd%glamt(nn_imin,nn_jmin:nn_jmax)), ' --> ', MAXVAL(scoagrd%glamf(nn_imax,nn_jmin:nn_jmax)) 
+  WRITE(*,*) 'latitude:  ', MINVAL(scoagrd%gphit(nn_imin:nn_imax,nn_jmin)), ' --> ', MAXVAL(scoagrd%gphif(nn_imin:nn_imax,nn_jmax)) 
+  WRITE(*,*) ''
+  !
+  IF(nn_imin.EQ.nn_imax.AND.nn_jmin.EQ.nn_jmax) THEN
+    nglobal = .TRUE.
+	WRITE(*,*) 'Size of domain: GLOBAL'
+  ELSE
+    nglobal = .FALSE.
+	WRITE(*,*) 'Size of domain: REGIONAL'
+  ENDIF
+  !
+  IF(cn_position_pivot.EQ.'F-grid') THEN       !case of ORCA05 & ORCA025 grids
+   npivot = 0
+  ELSEIF(cn_position_pivot.EQ.'T-grid') THEN   !case of ORCA2 grid
+   npivot = 1
+  ENDIF
+  !
+  nmid = nsizex/2 + npivot
+  !
+  !
+  !
+  !*************************************
+  ! Redefine for particular cases
+  !*************************************
+  IF(((nn_imax - nn_imin).EQ.-1).OR.((nn_imax - nn_imin).EQ.-2)) THEN
+    nn_imax = nn_imin
+  ELSEIF(ABS(nn_imin - nn_imax).GE.nsizex-1) THEN
+    nn_imax = nn_imin
+  ELSEIF((nn_imin.EQ.1).AND.(nn_imax.EQ.nsizex)) THEN
+    nn_imax = nn_imin
+  ELSEIF(nn_imin.EQ.1.AND.nn_imax.GT.nn_imin) THEN
+    nn_imin = nsizey-2
+  ELSEIF(nn_imax.EQ.nsizex) THEN
+    nn_imax = 3
+  ELSEIF(nn_imin.EQ.nsizex) THEN
+    nn_imin = nsizex-1
+  ELSEIF(nn_imax.EQ.1.AND.nn_imax.NE.nn_imin) THEN
+    nn_imax = 2
+  ENDIF
+  !
+  !
+  !
+  !*************************************
+  ! We want to fix equator along T and U-points
+  !*************************************
+  imodulo =  MOD(nn_rhoy,2)    
+  !
+  IF(.NOT.nglobal.AND.(scoagrd%gphit(nn_imin,nn_jmin)*scoagrd%gphit(nn_imin,nn_jmax)).LT.0.AND.imodulo.EQ.0) THEN 
+    nequator = 1
+  ELSEIF(nglobal.AND.imodulo.EQ.0) THEN
+    nequator = 1
+  ELSE
+    nequator = 0
+  ENDIF	  
+  !
+  !
+  !
+  !*************************************
+  ! CREATE MIXED GRID
+  !*************************************
+  CALL define_domain
+  !
+  CALL define_mixed_grid 
+  !
+  !
+  !
+  !*************************************
+  !!! CALCULATE FINE GRID DIMENSIONS
+  !************************************* 
+  IF(.NOT.nglobal) THEN
+	IF(nn_rhox.EQ.1) THEN 
+	  nxfine = nxcoag
+	ELSE
+	  nxfine = (nxcoag-2)*nn_rhox + 1
+	ENDIF  
+	!
+	 IF(nn_rhoy.EQ.1) THEN 
+	  nyfine = nycoag
+	ELSE
+	  nyfine = (nycoag-2)*nn_rhoy + 1
+	ENDIF  
+	!
+  ELSEIF(nglobal) THEN
+    IF(nn_rhox.GT.1) THEN
+	  nxfine = (nxgmix - 4*(nn_rhox-1))/2
+	ELSEIF(nn_rhox.EQ.1) THEN
+	  nxfine = nsizex
+	ENDIF
+	!
+	IF(nn_rhoy.GT.1) THEN
+	  nyfine = (nygmix - (2*nn_rhoy))/2 - nn_rhoy + nequator
+	ELSEIF(nn_rhoy.EQ.1) THEN
+	  nyfine = nsizey
+	ENDIF
+	!
+  ENDIF
+  !
+  WRITE(*,*) ''
+  WRITE(*,*) '*** SIZE OF FINE GRID ***'
+  WRITE(*,*) nxfine, ' x ', nyfine
+  WRITE(*,*) ''
+  !
+  !
+  !
+  !*************************************
+  ! Interpolation inside the mixed grid
+  !        from cfg_tools.f90
+  !*************************************
+  IF(nn_rhox.GT.1.OR.nn_rhoy.GT.1) THEN
+	CALL interp_grid    
+  ENDIF
+  !  
+  !
+  ! 
+  !*************************************  
+  ! Define name of child coordinate file  
+  !  coordinates.nc -> 1_coordinates.nc
+  !*************************************
+  CALL set_child_name(cn_parent_coordinate_file,cfingrdname)      
+  !
+  !
+  !
+  !*************************************
+  ! Allocation of child grid elements
+  !          from types.f90
+  !*************************************
+  CALL grid_allocate(sfingrd,nxfine,nyfine)                         
+  !
+  !
+  !
+  !*************************************
+  ! Break the mixed grid smixgrd into 4 grids 
+  !        from cfg_tools.f90
+  !*************************************
+  CALL child_grid                                
+  !     
+  !
+  !
+  !*************************************
+  ! Read parent coordinate file
+  !      from readwrite.f90
+  !*************************************
+  nstat = write_coordinates(cfingrdname,sfingrd,nxfine,nyfine)      
+  IF (nstat/=1) THEN    
+   WRITE(*,*)"unable to write netcdf file : ",cfingrdname
+   STOP
+  ENDIF
+  !	
+  CALL grid_deallocate(scoagrd)
+  CALL grid_deallocate(sfingrd)
+  CALL mixed_grid_deallocate(smixgrd)
+  !
+  !
+  !
+END PROGRAM create_coordinates
Index: /utils/tools_ticket2413/GRIDGEN/src/domain.f90
===================================================================
--- /utils/tools_ticket2413/GRIDGEN/src/domain.f90	(revision 12863)
+++ /utils/tools_ticket2413/GRIDGEN/src/domain.f90	(revision 12863)
@@ -0,0 +1,172 @@
+MODULE domain
+!!-----------------------------------------------------------
+!!
+!!         module to define domain to extract 
+!!                 from initial grid
+!!
+!!	       Created by Brice Lemaire on 01/2010.
+!!
+!!-----------------------------------------------------------
+  USE readwrite
+  USE mixed_grid
+  !
+  IMPLICIT NONE
+  PUBLIC
+  !
+  CONTAINS
+  !********************************************************
+  !              SUBROUTINE  define_domain              *
+  !												        *
+  !      to define the domain of the coarse grid        *
+  !			        which will be used 					*
+  !                                                     *
+  !          CALLED from create_coordinates             *
+  !******************************************************** 
+  SUBROUTINE define_domain
+  !
+  WRITE(*,*) ''
+  WRITE(*,*) ' ### SUBROUTINE define_domain ### '
+  WRITE(*,*) ''
+  !
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  ! *** without northern boundary ***
+  IF((nn_jmax.LT.(nsizey-1)).AND.(nn_jmax.GT.nn_jmin)) THEN             
+    !
+    WRITE(*,*) ' ****************************** ' 
+    WRITE(*,*) ' *** WITHOUT NORTH BOUNDARY *** '
+    WRITE(*,*) ' ****************************** ' 
+    !     
+	! *** with left/right boundary *** 
+	IF(nn_imin.GT.nn_imax) THEN                                        
+	  nxcoag = (nsizex - (nn_imin-1) + 1) + ((nn_imax+1) - 2) 
+	! *** all around the earth ***  
+	ELSEIF(nn_imin.EQ.nn_imax) THEN                       
+	  nxcoag = nsizex
+	ELSE
+	  nxcoag = (nn_imax+1) - (nn_imin-1) + 1                 	
+	ENDIF
+	!  
+	!(+/-1) we need ghost cells to make interpolation
+	nycoag = (nn_jmax+1) - (nn_jmin-1) + 1                
+	!
+  ENDIF
+  !
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !  
+  ! *** along northern boundary ***
+  IF((nn_jmax.LE.nn_jmin).OR.(nn_jmax.GE.nsizey-1)) THEN             
+    !
+    WRITE(*,*) ' **************************** ' 
+    WRITE(*,*) ' *** ALONG NORTH BOUNDARY *** '
+    WRITE(*,*) ' **************************** ' 
+	!
+	! *** with left/right boundary ***
+	IF(nn_imin.GT.nn_imax) THEN                       
+	  !
+	  WRITE(*,*) '' 
+	  WRITE(*,*) ' ** asian bipole ** '
+	  WRITE(*,*) '' 
+	  !	  
+	  nval1 = nsizex - nn_imin + 1
+	  nval2 = nn_imax  
+	  nn_jmin = nn_jmax
+	  !
+	  ! *** to respect symmetry around asian bipole ***
+	  IF((nval1.LT.nval2).AND.(nval2.LT.nmid)) THEN       
+        !
+		nn_imin = nsizex - nval2 + 1	
+		nxcoag = nval2
+		nycoag = (nsizey+1 - (nn_jmin-1))  + (nsizey+1 - (nn_jmax-1)) - 2		  
+	    ! 
+	    ELSEIF((nval1.GE.nval2).AND.(nval1.LT.nmid)) THEN
+	    !
+	    nn_imax = nval1
+		nxcoag = nval1 
+		nycoag = (nsizey+1 - (nn_jmin-1))  + (nsizey+1 - (nn_jmax-1)) - 2		  
+		!
+		! *** all around the earth ***
+	    ELSE                                         
+	    !
+	    nn_imax = nn_imin	
+		!		
+      ENDIF
+	ENDIF
+	!
+	IF(nn_imin.LT.nn_imax) THEN                           
+	  !
+	  ! *** without bipole ***
+	  IF(((nn_imin.LT.nmid).AND.(nn_imax.LT.nmid)).OR.((nn_imin.GT.nmid).AND.(nn_imax.GT.nmid))) THEN  
+	    !
+	    WRITE(*,*) '' 
+	    WRITE(*,*) ' ** without bipole ** '
+	    WRITE(*,*) '' 
+	    !	 	    
+	    nxcoag = (nn_imax+1) - (nn_imin-1) + 1 
+	    nycoag = (nsizey+1 - (nn_jmin-1))  + (nsizey+1 - (nn_jmax-1)) - 2 -0   
+	    !
+		! *** including canada bipole ***
+	    ELSEIF((nn_imin.LE.nmid).AND.(nn_imax.GE.nmid)) THEN    
+		!
+		WRITE(*,*) '' 
+		WRITE(*,*) ' ** canadian bipole ** '
+		WRITE(*,*) '' 
+		!	 		
+		nn_jmin = nn_jmax
+		nval1 = nmid - nn_imin 
+		nval2 = nn_imax - (nmid-1) 
+		!
+		! *** to respect around canada bipole ***
+		IF(nval1.LT.nval2) THEN    
+		  !
+		  nn_imin = nmid - nval2	
+		  nxcoag = (nval2+1)  
+	      nycoag = (nsizey+1 - (nn_jmin-1))  + (nsizey+1 - (nn_jmax-1)) - 2	- (2*npivot)	  
+		  ! 
+		  ELSEIF(nval1.GE.nval2) THEN
+		  !
+		  nn_imax = nmid + nval1
+		  nxcoag = (nval1+1)  
+	      nycoag = (nsizey+1 - (nn_jmin-1))  + (nsizey+1 - (nn_jmax-1)) - 2	- (2*npivot)	  
+		  !
+		ENDIF    
+	  ENDIF	
+    ENDIF
+  ENDIF
+    !
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    !
+	IF(nglobal) THEN                                  !Global
+	  !                                                Don't change the global shape of the matrix
+	  WRITE(*,*) '' 
+	  WRITE(*,*) ' ** global ** '
+	  WRITE(*,*) '' 
+	  !	  
+	  nn_imin = 1
+	  nn_imax = nsizex
+	  nn_jmin = 1
+	  nn_jmax = nsizey
+	  nxcoag = nsizex
+	  nycoag = nsizey
+	  !
+	ELSEIF(nn_imin.EQ.nn_imax) THEN      !Semi-global (e.g northern hemisphere)  
+	  !                                   Change the global shape -> suppression of the northern boundary and bipoles 
+	  WRITE(*,*) '' 
+	  WRITE(*,*) ' ** all around the earth (2 bipoles) ** '
+	  WRITE(*,*) '' 
+	  !	 	
+	  nn_imin = 2 
+	  nn_imax = nmid
+	  nn_jmin = nn_jmax
+	  nxcoag = (nn_imax+1) - (nn_imin-1) + 1 
+	  nycoag = (nsizey+1 - (nn_jmin-1))  + (nsizey+1 - (nn_jmax-1)) - 2	
+	  !
+	ENDIF
+  !  
+  WRITE(*,*) ''
+  WRITE(*,*) ' ### END SUBROUTINE define_domain ### '
+  WRITE(*,*) ''
+  !
+  END SUBROUTINE
+  !
+END MODULE
Index: /utils/tools_ticket2413/GRIDGEN/src/io_netcdf.f90
===================================================================
--- /utils/tools_ticket2413/GRIDGEN/src/io_netcdf.f90	(revision 12863)
+++ /utils/tools_ticket2413/GRIDGEN/src/io_netcdf.f90	(revision 12863)
@@ -0,0 +1,1688 @@
+!************************************************************************
+!                  Fortran 95 OPA Nesting tools			    			*
+!					                                    				*
+!     Copyright (C) 2005 Florian Lemari�(Florian.Lemarie@imag.fr)	    *
+!									                                    *
+!************************************************************************
+!
+!********************************************************************************
+!		                                        								*
+!                              module io_netcdf		    						*
+!						                                        				*
+!                  NetCDF Fortran 90 read/write interface	    				*
+!                  using input/output functions provided						*
+!                                 by unidata									*
+!						                                        				*
+!http://my.unidata.ucar.edu/content/software/netcdf/docs/netcdf-f90/index.html	*
+!									                                        	*
+!********************************************************************************
+!
+!
+!
+MODULE io_netcdf
+  !      
+  USE netcdf
+  USE types
+  !      
+  INTERFACE Read_Ncdf_var
+     MODULE PROCEDURE Read_Ncdf_var1d_Real,       &
+                      Read_Ncdf_var2d_Real,       &
+                      Read_Ncdf_var2d_Real_bis,   &
+                      Read_Ncdf_var3d_Real,       &
+                      Read_Ncdf_var4d_Real,       &
+                      Read_Ncdf_var3d_Real_t,     &
+                      Read_Ncdf_var4d_Real_t,     &
+                      Read_Ncdf_var4d_Real_nt,    &
+                      Read_Ncdf_var1d_Int,        &
+                      Read_Ncdf_var2d_Int,        &
+                      Read_Ncdf_var3d_Int,        &
+                      Read_Ncdf_var4d_Int,        &
+                      Read_Ncdf_var0d_Int,        &
+                      Read_Ncdf_var0d_Real
+  END INTERFACE
+  !
+  INTERFACE Write_Ncdf_var
+     MODULE PROCEDURE Write_Ncdf_var1d_Real,      &
+					  Write_Ncdf_var2d_Real,      &
+					  Write_Ncdf_var3d_Real,      &
+					  Write_Ncdf_var4d_Real,      &
+					  Write_Ncdf_var3d_Real_t,    &
+					  Write_Ncdf_var4d_Real_t,    &
+					  Write_Ncdf_var4d_Real_nt,   &                           
+					  Write_Ncdf_var2d_Real_bis,  &			   
+					  Write_Ncdf_var1d_Int,       &
+					  Write_Ncdf_var2d_Int,       &
+					  Write_Ncdf_var3d_Int,       &
+					  Write_Ncdf_var4d_Int,       &
+					  Write_Ncdf_var0d_Real
+  END INTERFACE
+  ! 
+  INTERFACE Copy_Ncdf_att
+     MODULE PROCEDURE Copy_Ncdf_att_latlon,Copy_Ncdf_att_var
+  END INTERFACE
+  !
+CONTAINS
+  !
+  !****************************************************************
+  !                 subroutine Read_Ncdf_dim					*
+  !				                                				*
+  !     subroutine to retrieve value of a given dimension 		*
+  !	                                							*
+  !     dimname : name of dimension to retrieve		        	*
+  !     file    : netcdf file name				                *
+  !     dimval  : value of the required dimension   			*
+  !								                                *
+  !****************************************************************
+  !
+  SUBROUTINE Read_Ncdf_dim(dimname,file,dimval)   
+    !      
+    IMPLICIT NONE
+    !           
+    CHARACTER(*),INTENT(in) :: dimname,file    
+    INTEGER    :: dimval
+    INTEGER ncid,status,dimid
+    !     
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname,dimid)
+    status = nf90_inquire_dimension(ncid,dimid,len=dimval)						                
+    status = nf90_close(ncid)
+    !      
+  END SUBROUTINE Read_Ncdf_dim
+  !
+  !   
+  !
+  !****************************************************************
+  !                subroutine Write_Ncdf_dim					*
+  !		                                 						*
+  !      subroutine to write a dimension in a given file 		*
+  !		                                						*
+  !     dimname : name of dimension to initialize    			*
+  !     file    : netcdf file name				                *
+  !     dimval  : value of the dimension to write	     		*
+  !								                                *
+  !****************************************************************
+  SUBROUTINE Write_Ncdf_dim(dimname,file,dimval)   
+    !      
+    IMPLICIT NONE
+    !           
+    CHARACTER(*),INTENT(in) :: dimname,file    
+    INTEGER    :: dimval
+    !      
+    ! local variables
+    !
+    INTEGER ncid,status,dimid
+    !     
+    status = nf90_open(file,NF90_WRITE,ncid)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_redef(ncid)
+    IF(dimval.EQ.0) THEN
+       status = nf90_def_dim(ncid,dimname,nf90_unlimited,dimid)       
+    ELSE
+       status = nf90_def_dim(ncid,dimname,dimval,dimid)  
+    END IF
+    !
+    status = nf90_enddef(ncid)
+    !      
+    status = nf90_close(ncid)
+    !      
+  END SUBROUTINE Write_Ncdf_dim
+  !
+  !
+  !
+  !****************************************************************
+  !                 subroutine Read_Ncdf_var					   *
+  !		                                						   *
+  !     subroutine to retrieve values of a given variable 		   *
+  !				                                				   *
+  !     varname : name of variable to retrieve	        		   *
+  !     file    : netcdf file name			                	   *
+  !     tabvar  : array containing values of the required variable *
+  !								                                   *
+  !****************************************************************   
+  SUBROUTINE Read_Ncdf_var1d_Real(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8, DIMENSION(:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(1) :: dimID
+    INTEGER :: dim1
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimID)
+    status=nf90_inquire_dimension(ncid,dimID(1),len=dim1)
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1))  
+    ELSE
+       IF( ANY(SHAPE(tabvar)/=(/dim1/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1))      
+       ENDIF
+    ENDIF
+    !        
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Read_Ncdf_var1d_Real
+  !           
+  !            
+  !           
+  !**************************************************************
+  !         subroutine Read_Ncdf_var2d_real
+  !**************************************************************          
+  SUBROUTINE Read_Ncdf_var2d_Real(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8, DIMENSION(:,:), POINTER :: tabvar
+    !local variables
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2))  
+    ELSE
+       IF( ANY(SHAPE(tabvar)/=(/dim1,dim2/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2))      
+       ENDIF
+    ENDIF
+    !       
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var2d_Real
+  !           
+  !
+  !           
+  !**************************************************************
+  !   subroutine Read_Ncdf_var2d_real_bis
+  !**************************************************************          
+  SUBROUTINE Read_Ncdf_var2d_Real_bis(varname,file,tabvar,strt,cnt)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8, DIMENSION(:,:), POINTER :: tabvar
+    !local variables
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER, DIMENSION(2) :: strt,cnt
+    INTEGER :: dim1,dim2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    dim1 = cnt(1) 
+    dim2 = cnt(2)
+    !      
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2))  
+    ELSE
+       IF( ANY(SHAPE(tabvar)/=(/dim1,dim2/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2))      
+       ENDIF
+    ENDIF
+    !       
+    status=nf90_get_var(ncid,varid,tabvar,start = strt,count = cnt)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var2d_Real_bis
+  !
+  !
+  !           
+  !**************************************************************
+  !   subroutine Read_Ncdf_var3d_real
+  !**************************************************************          
+  SUBROUTINE Read_Ncdf_var3d_Real(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8, DIMENSION(:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2,dim3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)  
+    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,dim3))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,dim3/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2,dim3))      
+       ENDIF
+    ENDIF
+    !      
+    status=nf90_get_var(ncid,varid,tabvar) 
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to retrieve netcdf variable : ",TRIM(varname)
+       STOP
+    ENDIF
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var3d_Real
+  !           
+  !
+  !           
+  !**************************************************************
+  !         subroutine Read_Ncdf_var4d_real
+  !**************************************************************          
+  SUBROUTINE Read_Ncdf_var4d_Real(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2,dim3,dim4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)  
+    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)   
+    status=nf90_inquire_dimension(ncid,dimIDS(4),len=dim4)       
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,dim3,dim4))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,dim3,dim4/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2,dim3,dim4))      
+       ENDIF
+    ENDIF
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var4d_Real
+
+  SUBROUTINE Read_Ncdf_var0d_Real(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8 :: tabvar
+    !
+    !local variables
+    !
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    !
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var0d_Real
+
+  SUBROUTINE Read_Ncdf_var0d_Int(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    !
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var0d_Int
+  !           
+  !             
+  !           
+  !**************************************************************
+  !   subroutine Read_Ncdf_var1d_int
+  !**************************************************************          
+  SUBROUTINE Read_Ncdf_var1d_Int(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER, DIMENSION(:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER,DIMENSION(10) :: dimID
+    INTEGER :: dim1
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimID)
+    status=nf90_inquire_dimension(ncid,dimID(1),len=dim1)          
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1))      
+       ENDIF
+    ENDIF
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !      
+  END SUBROUTINE Read_Ncdf_var1d_Int
+  !           
+  !         
+  !           
+  !**************************************************************
+  !   subroutine Read_Ncdf_var2d_int
+  !**************************************************************          
+  SUBROUTINE Read_Ncdf_var2d_Int(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER, DIMENSION(:,:), POINTER :: tabvar
+    !local variables
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)      
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2))      
+       ENDIF
+    ENDIF
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !      
+  END SUBROUTINE Read_Ncdf_var2d_Int
+  !           
+  !
+  !           
+  !**************************************************************
+  !   subroutine Read_Ncdf_var3d_Int
+  !**************************************************************          
+  SUBROUTINE Read_Ncdf_var3d_Int(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER, DIMENSION(:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2,dim3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)  
+    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)          
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,dim3))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,dim3/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2,dim3))      
+       ENDIF
+    ENDIF
+    ! 
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !      
+  END SUBROUTINE Read_Ncdf_var3d_Int
+  !           
+  !
+  !
+  !**************************************************************
+  !   subroutine Read_Ncdf_var4d_int
+  !**************************************************************          
+  SUBROUTINE Read_Ncdf_var4d_Int(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2,dim3,dim4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)  
+    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)   
+    status=nf90_inquire_dimension(ncid,dimIDS(4),len=dim4)       
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,dim3,dim4))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,dim3,dim4/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2,dim3,dim4))      
+       ENDIF
+    ENDIF
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var4d_Int
+  !           
+  !  
+  !
+  !****************************************************************
+  !                subroutine Write_Ncdf_var					*
+  !			                                 					*
+  !       subroutine to write a variable in a given file 		*
+  !	                                							*
+  !     varname : name of variable to store		            	*     
+  !     dimname : name of dimensions of the given variable	    *
+  !     file    : netcdf file name				                *
+  !     tabvar  : values of the variable to write		     	*
+  !								                                *
+  !****************************************************************
+  !    
+  !      
+  !**************************************************************
+  !      subroutine Write_Ncdf_var1d_real
+  !**************************************************************    
+  SUBROUTINE Write_Ncdf_var1d_Real(varname,dimname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,dimname,typevar
+    REAL*8, DIMENSION(:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname, dimid)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    SELECT CASE(TRIM(typevar))
+    CASE('double')
+       status = nf90_def_var(ncid,varname,nf90_double,(/dimid/),varid)
+    CASE('float')
+       status = nf90_def_var(ncid,varname,nf90_float,(/dimid/),varid)      
+    END SELECT
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var1d_Real
+  !      
+  !
+  !   
+  !**************************************************************
+  !   subroutine Write_Ncdf_var2d_real
+  !**************************************************************    
+  SUBROUTINE Write_Ncdf_var2d_Real_bis(varname,dimname,file,tabvar,nbdim,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    INTEGER,INTENT(in) :: nbdim
+    CHARACTER(*), DIMENSION(4) :: dimname
+    REAL*8, DIMENSION(:,:) :: tabvar
+    REAL*8, DIMENSION(:,:,:),POINTER :: tabtemp3d
+    REAL*8, DIMENSION(:,:,:,:),POINTER :: tabtemp4d
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3,dimid4
+    INTEGER :: status,ncid,ncid2
+    INTEGER :: varid,varid2             
+    ! 
+    IF(nbdim==4) THEN      
+       ALLOCATE(tabtemp4d(SIZE(tabvar,1),SIZE(tabvar,2),1,1))
+       tabtemp4d(:,:,1,1) = tabvar(:,:)
+    ELSE IF(nbdim==3) THEN
+       ALLOCATE(tabtemp3d(SIZE(tabvar,1),SIZE(tabvar,2),1))
+       tabtemp3d(:,:,1) = tabvar(:,:)
+    END IF
+    !      
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+    !      
+    IF(nbdim==4) status = nf90_inq_dimid(ncid,dimname(4), dimid4)
+    !      
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    IF(nbdim==4 .AND. typevar == 'double') THEN
+       status = nf90_def_var(ncid,varname,nf90_double,     &
+            (/dimid1,dimid2,dimid3,dimid4/),varid)
+       !                              
+    ELSE IF(nbdim==4 .AND. typevar == 'float') THEN
+       status = nf90_def_var(ncid,varname,nf90_float,     &
+            (/dimid1,dimid2,dimid3,dimid4/),varid)                        
+       !          
+    ELSE IF(nbdim==3 .AND. typevar == 'float') THEN
+       status = nf90_def_var(ncid,varname,nf90_float,     &
+            (/dimid1,dimid2,dimid3/),varid)
+       !
+    ELSE IF(nbdim==3 .AND. typevar == 'double') THEN
+       status = nf90_def_var(ncid,varname,nf90_double,     &
+            (/dimid1,dimid2,dimid3/),varid)
+       !     			      			      
+    ENDIF
+    !      			      
+    status = nf90_enddef(ncid)
+    IF(nbdim==4) status = nf90_put_var(ncid,varid,tabtemp4d)
+    IF(nbdim==3) status = nf90_put_var(ncid,varid,tabtemp3d)
+    !      
+    IF(ASSOCIATED( tabtemp3d ) ) DEALLOCATE( tabtemp3d )   
+    IF(ASSOCIATED( tabtemp4d ) ) DEALLOCATE( tabtemp4d )     
+    !
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var2d_Real_bis
+  !      
+  !
+  !      
+  !**************************************************************
+  !   subroutine Write_Ncdf_var2d_real
+  !**************************************************************    
+  SUBROUTINE Write_Ncdf_var2d_Real(varname,dimname,file,tabvar,typevar)
+    !      
+	IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*), DIMENSION(2) :: dimname
+    REAL*8, DIMENSION(:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+
+    SELECT CASE(TRIM(typevar))
+    CASE('double')
+       status = nf90_def_var(ncid,varname,nf90_double,     &
+            (/dimid1,dimid2/),varid)
+    CASE('float')
+       status = nf90_def_var(ncid,varname,nf90_float,     &
+            (/dimid1,dimid2/),varid)     
+    END SELECT
+    !
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var2d_Real
+  !      
+  !
+  !      
+  !**************************************************************
+  !   subroutine Write_Ncdf_var3d_real
+  !**************************************************************
+  SUBROUTINE Write_Ncdf_var3d_Real(varname,dimname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(3),INTENT(in) :: dimname
+    REAL*8, DIMENSION(:,:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    !
+    SELECT CASE(TRIM(typevar))
+    CASE('double')
+       status = nf90_def_var(ncid,varname,nf90_double,     &
+            (/dimid1,dimid2,dimid3/),varid)
+    CASE('float')
+       status = nf90_def_var(ncid,varname,nf90_float,     &
+            (/dimid1,dimid2,dimid3/),varid)    
+    END SELECT
+    !
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var3d_Real
+  !      
+  !
+  !
+  !**************************************************************
+  !   subroutine Write_Ncdf_var4d_real
+  !**************************************************************
+  SUBROUTINE Write_Ncdf_var4d_Real(varname,dimname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(4),INTENT(in) :: dimname
+    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3,dimid4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !
+    status = nf90_inq_varid(ncid,varname,varid)
+    !      
+    IF(status/=nf90_noerr) THEN
+       !     
+       status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+       status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+       status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+       status = nf90_inq_dimid(ncid,dimname(4), dimid4)
+       status = nf90_redef(ncid)
+       !      
+       SELECT CASE(TRIM(typevar))
+       CASE('double')
+          status = nf90_def_var(ncid,varname,nf90_double,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)
+       CASE('float')
+          status = nf90_def_var(ncid,varname,nf90_float,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)   
+       END SELECT
+       !
+       status = nf90_enddef(ncid)
+    ENDIF
+    !         
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var4d_Real
+  !      
+  !
+  !  
+  !**************************************************************
+  !   subroutine Write_Ncdf_var1d_Int
+  !**************************************************************    
+  SUBROUTINE Write_Ncdf_var1d_Int(varname,dimname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,dimname
+    INTEGER, DIMENSION(:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname, dimid)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    status = nf90_def_var(ncid,varname,nf90_int,(/dimid/),varid)
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var1d_Int
+  !      
+  ! 
+  !      
+  !**************************************************************
+  !   subroutine Write_Ncdf_var2d_Int
+  !**************************************************************    
+  SUBROUTINE Write_Ncdf_var2d_Int(varname,dimname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    CHARACTER(*), DIMENSION(2) :: dimname
+    INTEGER, DIMENSION(:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    status = nf90_def_var(ncid,varname,nf90_int,     &
+         (/dimid1,dimid2/),varid)
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var2d_Int
+  !      
+  !
+  !      
+  !**************************************************************
+  !   subroutine Write_Ncdf_var3d_Int
+  !**************************************************************
+  SUBROUTINE Write_Ncdf_var3d_Int(varname,dimname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    CHARACTER(*),DIMENSION(3),INTENT(in) :: dimname
+    INTEGER, DIMENSION(:,:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    status = nf90_def_var(ncid,varname,nf90_int,     &
+         (/dimid1,dimid2,dimid3/),varid)
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var3d_Int
+  !      
+  !
+  !
+  !**************************************************************
+  !   subroutine Write_Ncdf_var4d_Int
+  !**************************************************************
+  SUBROUTINE Write_Ncdf_var4d_Int(varname,dimname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    CHARACTER(*),DIMENSION(4),INTENT(in) :: dimname
+    INTEGER, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3,dimid4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+    status = nf90_inq_dimid(ncid,dimname(4), dimid4)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    status = nf90_def_var(ncid,varname,nf90_int,     &
+         (/dimid1,dimid2,dimid3,dimid4/),varid)
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var4d_Int
+  !      
+  !
+  !
+  !****************************************************************
+  !               subroutine Read_Ncdf_var_t					*
+  !						                                		*
+  !  subroutine to read a variable in a given file for time t	*
+  !						                                		*
+  !     varname : name of variable to read		            	*     
+  !     file    : netcdf file name				                *
+  !     tabvar  : values of the read variable	         		*
+  !     time    : time corresponding to the values to read	    *	
+  !								                                *
+  !****************************************************************
+  !
+  !
+  !**************************************************************
+  !          subroutine Read_Ncdf_var3d_real_t
+  !**************************************************************          
+  SUBROUTINE Read_Ncdf_var3d_Real_t(varname,file,tabvar,time)
+    !      
+    USE types     
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER,INTENT(in) :: time
+    REAL*8, DIMENSION(:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(3) :: dimIDS
+    INTEGER :: dim1,dim2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    !        
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)
+    !
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,1))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,1/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2,1))      
+       ENDIF
+    ENDIF
+
+    status=nf90_get_var(ncid,varid,tabvar,start=(/1,1,time/))
+
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to retrieve netcdf variable : ",TRIM(varname)
+       STOP
+    ENDIF
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var3d_Real_t
+  !           
+  !
+  !
+  !****************************************************************
+  !              subroutine Write_Ncdf_var_t					*
+  !		                                						*
+  ! subroutine to write a variable in a given file for time t	*
+  !		                                						*
+  !     varname : name of variable to store		            	*     
+  !     dimname : name of dimensions of the given variable   	*
+  !     file    : netcdf file name				                *
+  !     tabvar  : values of the variable to write		    	*
+  !     time    : time corresponding to the values to store	    *	
+  !								                                *
+  !****************************************************************
+  !
+  !      
+  !**************************************************************
+  !          subroutine Write_Ncdf_var3d_real_t
+  !**************************************************************
+  SUBROUTINE Write_Ncdf_var3d_Real_t(varname,dimname,file,tabvar,time,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(3),INTENT(in) :: dimname
+    INTEGER :: time
+    REAL*8, DIMENSION(:,:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    IF(time==1) THEN
+       !      
+       status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+       status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+       status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+       status = nf90_redef(ncid)
+
+       !      
+       SELECT CASE(TRIM(typevar))
+       CASE('double')
+          status = nf90_def_var(ncid,varname,nf90_double,     &
+               (/dimid1,dimid2,dimid3/),varid) 
+       CASE('float')
+          status = nf90_def_var(ncid,varname,nf90_float,     &
+               (/dimid1,dimid2,dimid3/),varid)    
+       END SELECT
+       !
+       status = nf90_enddef(ncid)
+
+    ELSE
+       status = nf90_inq_varid(ncid, varname, varid)
+    ENDIF
+    !      
+    status = nf90_put_var(ncid,varid,tabvar,start=(/1,1,time/))
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to store variable ",varname, &
+	    " in file ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var3d_Real_t
+  !      
+  !
+  !
+  !****************************************************************
+  !               subroutine Read_Ncdf_var_t					*
+  !			                                					*
+  !  subroutine to read a variable in a given file for time t	*
+  !					    	at level n	                        *
+  !     varname : name of variable to read           			*     
+  !     file    : netcdf file name			                	*
+  !     tabvar  : values of the read variable	        		*
+  !     time    : time corresponding to the values to read   	*	
+  !     level   : level corresponding to the values to read	    *
+  !								                                *
+  !****************************************************************
+  !
+  !
+  !**************************************************************
+  !   subroutine Read_Ncdf_var4d_real_nt
+  !**************************************************************          
+  SUBROUTINE Read_Ncdf_var4d_Real_nt(varname,file,tabvar,time,level)
+    !      
+    USE types     
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER,INTENT(in) :: time,level
+    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(4) :: dimIDS
+    INTEGER :: dim1,dim2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    !        
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)
+    !
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,1,1))  
+    ELSE
+       IF ((SIZE(tabvar,1) /= dim1) .OR. (SIZE(tabvar,2) /= dim2)) THEN
+          DEALLOCATE(tabvar)
+          ALLOCATE(tabvar(dim1,dim2,1,1))
+       ENDIF
+    ENDIF
+    !
+    status=nf90_get_var(ncid,varid,tabvar,start=(/1,1,level,time/),count=(/dim1,dim2,1,1/))
+    !                                             
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to retrieve netcdf variable : ",TRIM(varname)
+       STOP
+    ENDIF
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var4d_Real_nt
+  !           
+  !
+  !
+  !**************************************************************
+  !   subroutine Read_Ncdf_var4d_real_t
+  !**************************************************************          
+  SUBROUTINE Read_Ncdf_var4d_Real_t(varname,file,tabvar,time)
+    !      
+    USE types     
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER,INTENT(in) :: time
+    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(4) :: dimIDS
+    INTEGER :: dim1,dim2,dim3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    !        
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)
+    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)
+    !
+    IF(.NOT. ASSOCIATED(tabvar)) ALLOCATE(tabvar(dim1,dim2,dim3,1))  
+    status=nf90_get_var(ncid,varid,tabvar,start=(/1,1,1,time/))
+
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to retrieve netcdf variable : ",TRIM(varname)
+       STOP
+    ENDIF
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var4d_Real_t
+  !           
+  !
+  !
+  !****************************************************************
+  !               subroutine Write_Ncdf_var_t					*
+  !				                                 				*
+  !  subroutine to write a variable in a given file for time t	*
+  !						    at level n	                        *
+  !                                                             *
+  !     varname : name of variable to store		            	*     
+  !     dimname : name of dimensions of the given variable   	*
+  !     file    : netcdf file name				                *
+  !     tabvar  : values of the variable to write			    *
+  !     time    : time corresponding to the values to store	    *	
+  !     level   : level corresponding to the values to store	*
+  !								                                *
+  !****************************************************************
+  !
+  !      
+  !**************************************************************
+  !   subroutine Write_Ncdf_var4d_real_t
+  !**************************************************************
+  SUBROUTINE Write_Ncdf_var4d_Real_t(varname,dimname,file,tabvar,time,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(4),INTENT(in) :: dimname
+    INTEGER :: time,level
+    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3,dimid4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !      
+    IF(time==1) THEN
+       !      
+       status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+       status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+       status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+       status = nf90_inq_dimid(ncid,dimname(4), dimid4)
+       status = nf90_redef(ncid)
+       !      
+       SELECT CASE(TRIM(typevar))
+       CASE('double')
+          status = nf90_def_var(ncid,TRIM(varname),nf90_double,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)  
+       CASE('float')
+          status = nf90_def_var(ncid,TRIM(varname),nf90_float,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)    
+       END SELECT
+       !
+       status = nf90_enddef(ncid)
+
+    ELSE
+       status = nf90_inq_varid(ncid, varname, varid)
+    ENDIF
+    !    
+    status = nf90_put_var(ncid,varid,tabvar,start=(/1,1,1,time/))
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to store variable ",varname, &
+	    " in file ",file
+       STOP
+    ENDIF
+    !    
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var4d_Real_t
+  !      
+  !
+  !      
+  !**************************************************************
+  !   subroutine Write_Ncdf_var4d_real_nt
+  !**************************************************************
+  SUBROUTINE Write_Ncdf_var4d_Real_nt(varname,dimname,file,tabvar,time,level,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(4),INTENT(in) :: dimname
+    INTEGER :: time,level
+    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3,dimid4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !      
+    IF(time==1.AND.level==1) THEN
+       !      
+       status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+       status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+       status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+       status = nf90_inq_dimid(ncid,dimname(4), dimid4)
+       status = nf90_redef(ncid)
+       !      
+       SELECT CASE(TRIM(typevar))
+       CASE('double')
+          status = nf90_def_var(ncid,TRIM(varname),nf90_double,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)  
+       CASE('float')
+          status = nf90_def_var(ncid,TRIM(varname),nf90_float,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)    
+       END SELECT
+       !
+       status = nf90_enddef(ncid)
+
+    ELSE
+       status = nf90_inq_varid(ncid, varname, varid)
+    ENDIF
+    !    
+    status = nf90_put_var(ncid,varid,tabvar,start=(/1,1,level,time/))
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to store variable ",varname, &
+	    " in file ",file
+       STOP
+    ENDIF
+    !    
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var4d_Real_nt
+
+  SUBROUTINE Write_Ncdf_var0d_Real(varname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    INTEGER :: time,level
+    REAL*8 :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !      
+
+    status = nf90_redef(ncid)
+    !      
+    SELECT CASE(TRIM(typevar))
+    CASE('double')
+       status = nf90_def_var(ncid,TRIM(varname),nf90_double,     &
+            varid=varid)  
+    CASE('float')
+       status = nf90_def_var(ncid,TRIM(varname),nf90_float,     &
+            varid=varid)    
+    END SELECT
+    !
+    status = nf90_enddef(ncid)
+
+    !    
+    status = nf90_put_var(ncid,varid,tabvar)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to store variable ",varname, &
+	    " in file ",file
+       STOP
+    ENDIF
+    !    
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var0d_Real
+  !      
+  !
+  !****************************************************************
+  !                 subroutine Read_Ncdf_VarName				*
+  !			                                 					*
+  !           subroutine to retrieve of all variables 			*
+  !                  included in a given file					*
+  !					                                			*
+  !     filename    : netcdf file name	             			*
+  !     tabvarname  : array containing various variables names	*
+  !								                                *
+  !****************************************************************
+  !
+  !**************************************************************
+  !   subroutine Read_Ncdf_VarName
+  !**************************************************************          
+  SUBROUTINE Read_Ncdf_VarName(filename,tabvarname)
+    !      
+    CHARACTER(*),INTENT(in) :: filename
+    CHARACTER*20,DIMENSION(:),POINTER :: tabvarname
+    INTEGER :: nDimensions,nVariables
+    INTEGER :: nAttributes,unlimitedDimId,i
+    INTEGER :: ncid,status,dimid
+    !     
+    status = nf90_open(filename,NF90_NOWRITE,ncid)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",filename
+       STOP
+    ENDIF
+    !      
+    status = nf90_inquire(ncid,nDimensions,nVariables,nAttributes, &                                                      
+         unlimitedDimId) 
+    !
+    ALLOCATE(tabvarname(nVariables))
+    !
+    DO i=1,nVariables
+       status = nf90_inquire_variable(ncid,i,tabvarname(i))
+    END DO
+    !
+  END SUBROUTINE Read_Ncdf_Varname
+  !
+  !
+  !
+  !**************************************************************
+  !   subroutine Copy_Ncdf_att
+  !**************************************************************          
+  SUBROUTINE Copy_Ncdf_att_var(varname,filein,fileout)
+    !      
+    CHARACTER(*),INTENT(in) :: filein,fileout
+    CHARACTER(*),INTENT(in) :: varname
+    INTEGER :: ncid_in,ncid_out,status,varid_in,varid_out
+    !     
+    status = nf90_open(filein,NF90_NOWRITE,ncid_in)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open input netcdf file : ",filein
+       STOP
+    ENDIF
+    !     							     	   
+    status = nf90_open(fileout,NF90_WRITE,ncid_out)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open output netcdf file : ",fileout
+       STOP
+    ENDIF
+    !  
+    status = nf90_inq_varid(ncid_in,varname,varid_in)
+    status = nf90_inq_varid(ncid_out,varname,varid_out)
+    !
+    status = nf90_redef(ncid_out)
+    !      
+    status = nf90_copy_att(ncid_in,varid_in,'units',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'valid_min',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'valid_max',ncid_out,varid_out) 
+    status = nf90_copy_att(ncid_in,varid_in,'long_name',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'calendar',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'title',ncid_out,varid_out)     
+    status = nf90_copy_att(ncid_in,varid_in,'time_origin',ncid_out,varid_out) 
+    status = nf90_copy_att(ncid_in,varid_in,'positive',ncid_out,varid_out)                 
+    status = nf90_copy_att(ncid_in,varid_in,'tstep_sec',ncid_out,varid_out)          
+    status = nf90_copy_att(ncid_in,varid_in,'nav_model',ncid_out,varid_out)   
+    status = nf90_copy_att(ncid_in,varid_in,'Minvalue=',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'Maxvalue=',ncid_out,varid_out)  
+    status = nf90_copy_att(ncid_in,varid_in,'short_name',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'online_operation',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'axis',ncid_out,varid_out)            
+    status = nf90_copy_att(ncid_in,varid_in,'interval_operation',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'interval_write',ncid_out,varid_out) 
+    status = nf90_copy_att(ncid_in,varid_in,'associate',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'actual_range',ncid_out,varid_out) 
+    status = nf90_copy_att(ncid_in,varid_in,'longitude',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'latitude',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'scale_factor',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'add_offset',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'missing_value',ncid_out,varid_out) 
+    !      
+    status = nf90_enddef(ncid_out)  
+    !
+    status = nf90_close(ncid_in)
+    status = nf90_close(ncid_out)
+    ! 
+  END SUBROUTINE Copy_Ncdf_att_var
+  !
+  !
+  !         
+  !**************************************************************
+  !       subroutine Copy_Ncdf_att
+  !**************************************************************          
+  SUBROUTINE Copy_Ncdf_att_latlon(varname,filein,fileout,min,max)
+    !      
+    CHARACTER(*),INTENT(in) :: filein,fileout
+    CHARACTER(*),INTENT(in) :: varname
+    REAL*8 :: min,max
+    INTEGER :: ncid_in,ncid_out,status,varid_in,varid_out
+    !     
+    status = nf90_open(filein,NF90_NOWRITE,ncid_in)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",filein
+       STOP
+    ENDIF
+    !     							     	   
+    status = nf90_open(fileout,NF90_WRITE,ncid_out)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",fileout
+       STOP
+    ENDIF
+    !  
+    status = nf90_inq_varid(ncid_in,varname,varid_in)
+    status = nf90_inq_varid(ncid_out,varname,varid_out)
+    !
+    status = nf90_redef(ncid_out)
+    !      
+    SELECT CASE (varname)
+       !      
+    CASE('nav_lon')     
+       status = nf90_copy_att(ncid_in,varid_in,'units',ncid_out,varid_out) 
+       status = nf90_put_att(ncid_out,varid_out,'valid_min',REAL(min,4))
+       status = nf90_put_att(ncid_out,varid_out,'valid_max',REAL(max,4))
+       status = nf90_copy_att(ncid_in,varid_in,'long_name',ncid_out,varid_out)
+       status = nf90_copy_att(ncid_in,varid_in,'nav_model',ncid_out,varid_out)
+       status = nf90_copy_att(ncid_in,varid_in,'title',ncid_out,varid_out)
+       !
+    CASE('nav_lat')
+       status = nf90_copy_att(ncid_in,varid_in,'units',ncid_out,varid_out) 
+       status = nf90_put_att(ncid_out,varid_out,'valid_min',REAL(min,4))
+       status = nf90_put_att(ncid_out,varid_out,'valid_max',REAL(max,4))
+       status = nf90_copy_att(ncid_in,varid_in,'long_name',ncid_out,varid_out)
+       status = nf90_copy_att(ncid_in,varid_in,'nav_model',ncid_out,varid_out)
+       status = nf90_copy_att(ncid_in,varid_in,'title',ncid_out,varid_out) 
+       !
+    END SELECT
+    !      
+    status = nf90_enddef(ncid_out)  
+    !
+    status = nf90_close(ncid_in)
+    status = nf90_close(ncid_out)
+  END SUBROUTINE Copy_Ncdf_att_latlon
+  !
+  !
+  !
+  !**************************************************************
+  !   function Get_NbDims
+  !**************************************************************          
+  INTEGER FUNCTION Get_NbDims( varname , filename )
+    !
+    CHARACTER(*),INTENT(in) :: varname,filename
+    INTEGER :: status,ncid,varid    
+    !      
+    status = nf90_open(TRIM(filename),NF90_NOWRITE,ncid)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",TRIM(filename)
+       STOP
+    ENDIF
+    status = nf90_inq_varid(ncid,TRIM(varname),varid)     
+    status = nf90_inquire_variable(ncid, varid , ndims = Get_NbDims)
+    !
+    RETURN
+    !
+  END FUNCTION Get_NbDims
+  !
+  !
+  !
+  !**************************************************************
+  !   function Get_NbDims
+  !**************************************************************          
+  LOGICAL FUNCTION Dims_Existence( dimname , filename )
+    !
+    CHARACTER(*),INTENT(in) :: dimname,filename
+    INTEGER :: status,ncid,dimid    
+    !      
+    status = nf90_open(TRIM(filename),NF90_NOWRITE,ncid)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",TRIM(filename)
+       STOP
+    ENDIF
+    status = nf90_inq_dimid(ncid,dimname,dimid)
+    !      
+    IF (status/=nf90_noerr) THEN
+       Dims_Existence = .FALSE.
+    ELSE
+       Dims_Existence = .TRUE.
+    ENDIF
+    !
+    RETURN
+    !
+  END FUNCTION Dims_Existence
+  !
+END MODULE io_netcdf
Index: /utils/tools_ticket2413/GRIDGEN/src/mixed_grid.f90
===================================================================
--- /utils/tools_ticket2413/GRIDGEN/src/mixed_grid.f90	(revision 12863)
+++ /utils/tools_ticket2413/GRIDGEN/src/mixed_grid.f90	(revision 12863)
@@ -0,0 +1,267 @@
+MODULE mixed_grid
+!!-----------------------------------------------------------
+!!
+!!       tools box to create a mixed grid storing 
+!!           the known values of grids U,V,T,F
+!!
+!!	        Created by Brice Lemaire on 01/2010.
+!!
+!!-----------------------------------------------------------
+  USE readwrite
+  !
+  IMPLICIT NONE
+  PUBLIC
+  !
+  CONTAINS
+  !********************************************************
+  !            SUBROUTINE define_mixed_grid             *
+  !												        *
+  !         to define the size of the mixed grid        *
+  !														*
+  !            CALL from create_coordinates             *
+  !********************************************************
+  SUBROUTINE define_mixed_grid
+    !
+    INTEGER :: ixgmix, iygmix
+    INTEGER :: ii, ij
+    ! 
+	WRITE(*,*) ''
+	WRITE(*,*) ' ### SUBROUTINE define_mixed_grid ### '
+	WRITE(*,*) ''
+	!
+	WRITE(*,*) ' *** CHECKING SIZE OF COARSE DOMAIN *** '
+	WRITE(*,*) nxcoag, 'x', nycoag
+	WRITE(*,*) ''
+	!
+    !*************************************
+	!!!Calculate size of mixed grid (ixgmix x iygmix)
+    !*************************************
+	IF(.NOT.nglobal) THEN
+	  ixgmix = (nxcoag) * 2                              !known points (T,U,V,F) along x
+	  ixgmix = ixgmix + (nn_rhox-1)*(ixgmix)!-1)           !points to interpolate    ''
+	  ! 
+	  iygmix = (nycoag) * 2                              !known points (T,U,V,F) along y
+	  iygmix = iygmix + (nn_rhoy-1)*(iygmix)!-1)           !points to interpolate    ''
+	ELSEIF(nglobal) THEN
+	  ixgmix = (nxcoag) * 2                             
+	  ixgmix = ixgmix + (nn_rhox-1)*(ixgmix)              
+	  ! 
+	  iygmix = (nycoag) * 2                            
+	  iygmix = iygmix + (nn_rhoy-1)*(iygmix)     
+	ENDIF
+	!
+	nxgmix = ixgmix
+	nygmix = iygmix
+	!
+	WRITE(*,*) ''
+	WRITE(*,*) '*** SIZE OF MIXED GRID ***'
+	WRITE(*,*) nxgmix, ' x ', nygmix
+	WRITE(*,*) ''
+    !
+    CALL mixed_grid_allocate(smixgrd,ixgmix,iygmix)     !using type.f90
+    !
+	IF(nglobal)THEN
+	  ii = 1
+      ij = 1
+    ELSE
+	  ii = nn_imin-1
+	  ij = nn_jmin-1
+	ENDIF
+	!
+    CALL write_mixed_grid(ixgmix,iygmix,ii,ij)   
+    !
+	WRITE(*,*) ''
+	WRITE(*,*) ' ### END SUBROUTINE define_mixed_grid ### '
+	WRITE(*,*) ''  
+	!
+  END SUBROUTINE
+  !
+  !
+  !
+  !********************************************************
+  !           SUBROUTINE write_mixed_grid   			  *
+  !									        			  *
+  !  to write the known values into the mixed grid		  *
+  !	These known values are spaced every (nn_rho-1) points *
+  !	    for allowing to compute the interpolation         *
+  !               inside this same grid	     			  *
+  !														  *
+  !******************************************************** 
+  SUBROUTINE write_mixed_grid(ki_end,kj_end,ki_min,kj_min)
+    !
+	INTEGER, INTENT(IN) :: ki_end, kj_end
+	INTEGER, INTENT(INOUT) :: ki_min, kj_min
+	INTEGER :: ji_start, jj_start
+	INTEGER :: ji,jj
+	INTEGER :: isym_x, isym_y
+	INTEGER :: itmp1, itmp2, itmp3, itmp4, itmp5, itmp6, itmp7
+    INTEGER :: icorrxt, icorrxu, icorrxv, icorrxf      !correction factor for i-indexation
+    INTEGER :: icorryt, icorryu, icorryv, icorryf      !correction factor for j-indexation
+	LOGICAL :: llp = .TRUE.
+	LOGICAL :: llq = .TRUE.
+	!
+	WRITE(*,*) ''
+	WRITE(*,*) ' ### SUBROUTINE write_mixed_grid ### '
+	WRITE(*,*) '' 
+	!
+	ji_start = 1
+	jj_start = 1   
+    !
+	isym_y = 1
+	!
+	! correction factor for symmetry along north boundary
+	icorrxt = 0
+	icorrxu = 0
+	icorrxv = 0
+	icorrxf = 0
+    !
+	icorryt = 0
+	icorryu = 0
+	icorryv = 0
+	icorryf = 0
+	!
+	DO jj=nn_rhoy,kj_end,2*nn_rhoy
+      !
+	  DO ji=nn_rhox,ki_end,2*nn_rhox
+        !
+		smixgrd%nav_lon(ji,jj)              =  scoagrd%nav_lon(ki_min + icorrxt, kj_min + icorryt)
+		smixgrd%nav_lat(ji,jj)              =  scoagrd%nav_lat(ki_min + icorrxt, kj_min + icorryt)	    
+		!
+		smixgrd%glam(ji,jj)                 =  scoagrd%glamt(ki_min + icorrxt, kj_min + icorryt)
+		smixgrd%glam(ji+nn_rhox,jj)         =  scoagrd%glamu(ki_min + icorrxu, kj_min + icorryu)
+		smixgrd%glam(ji,jj+nn_rhoy)         =  scoagrd%glamv(ki_min + icorrxv, kj_min + icorryv)
+		smixgrd%glam(ji+nn_rhox,jj+nn_rhoy) =  scoagrd%glamf(ki_min + icorrxf, kj_min + icorryf)		    
+		!
+		smixgrd%gphi(ji,jj)                 =  scoagrd%gphit(ki_min + icorrxt, kj_min + icorryt)
+		smixgrd%gphi(ji+nn_rhox,jj)         =  scoagrd%gphiu(ki_min + icorrxu, kj_min + icorryu)		 
+		smixgrd%gphi(ji,jj+nn_rhoy)         =  scoagrd%gphiv(ki_min + icorrxv, kj_min + icorryv)
+		smixgrd%gphi(ji+nn_rhox,jj+nn_rhoy) =  scoagrd%gphif(ki_min + icorrxf, kj_min + icorryf)
+		!
+		smixgrd%e1(ji,jj)                   =  scoagrd%e1t(ki_min + icorrxt, kj_min + icorryt)
+		smixgrd%e1(ji+nn_rhox,jj)           =  scoagrd%e1u(ki_min + icorrxu, kj_min + icorryu)		 
+		smixgrd%e1(ji,jj+nn_rhoy)           =  scoagrd%e1v(ki_min + icorrxv, kj_min + icorryv)
+		smixgrd%e1(ji+nn_rhox,jj+nn_rhoy)   =  scoagrd%e1f(ki_min + icorrxf, kj_min + icorryf)	
+		!	
+		smixgrd%e2(ji,jj)                   =  scoagrd%e2t(ki_min + icorrxt, kj_min + icorryt)
+		smixgrd%e2(ji+nn_rhox,jj)           =  scoagrd%e2u(ki_min + icorrxu, kj_min + icorryu)		 
+		smixgrd%e2(ji,jj+nn_rhoy)           =  scoagrd%e2v(ki_min + icorrxv, kj_min + icorryv)
+		smixgrd%e2(ji+nn_rhox,jj+nn_rhoy)   =  scoagrd%e2f(ki_min + icorrxf, kj_min + icorryf)
+        !
+		IF(.NOT.nglobal)THEN
+		  IF(ki_min.EQ.nsizex.AND.nn_imin.NE.2) THEN          ! across right/left boundary BUT not all around the earth
+			ki_min = 3
+		  ELSEIF(isym_y.EQ.1) THEN                            ! normal case
+			ki_min = ki_min + 1                                
+		  ELSEIF(isym_y.EQ.-1) THEN                           ! symetry along north boundary
+			ki_min = ki_min - 1              
+		  ENDIF
+		ELSE
+		  ki_min = ki_min + 1
+		ENDIF
+        !
+	  ENDDO
+      !	 
+	  !
+	  ! when we reach north boundary
+	  IF(.NOT.nglobal)THEN
+		IF(kj_min.EQ.nsizey-npivot-1.AND.llp) THEN           ! npivot => pivot located on T-point or F-point
+		  llp = .FALSE.
+		  kj_min = nsizey 
+		  isym_y = -1
+		  IF(nn_imin.LT.nmid.AND.nn_imax.LT.nmid) THEN       ! no bipole (from Asia to Canada)                               
+			itmp1 = nsizex - nn_imin + 2 + npivot              
+			isym_x = 1
+		  ELSEIF(nn_imin.GT.nmid.AND.nn_imax.GT.nmid) THEN   ! no bipole (from Canada to Asia)
+			itmp2 = nsizex - nn_imin + 2 + npivot               		  
+			isym_x = 2
+		  ELSEIF(nn_imin.LT.nmid.AND.nn_imax.GT.nmid) THEN   ! canadian bipole
+			IF(nval1.LT.nval2) THEN
+			  itmp3 = nmid + nval2 
+			  isym_x = 3
+			ELSEIF(nval1.GE.nval2) THEN                      ! canadian bipole
+			  itmp4 = nmid + nval1 + 2 - npivot
+			  isym_x = 4
+			ENDIF
+		  ELSEIF(ki_min.EQ.nsizex.AND.nval1.GT.nval2) THEN   ! asian bipole
+			  itmp5 = nval1 + 1 + npivot
+			  isym_x = 5
+		  ELSEIF(ki_min.EQ.nsizex.AND.nval1.LT.nval2) THEN   ! asian bipole
+			  itmp6 = nval2 + 1
+			  isym_x = 6		
+		  ELSEIF(ki_min.GE.nmid) THEN                        ! all around the earth (2 bipoles)
+			  itmp7 = nsizex 
+			  isym_x = 7
+		  ENDIF
+		ENDIF
+	    !
+	    !
+	    !
+	    IF(isym_y.EQ.1) THEN
+          kj_min = kj_min + 1                   ! cas normal
+          ki_min = nn_imin - 1   
+	    ELSEIF(isym_y.EQ.-1) THEN                             
+		  kj_min = kj_min - 1  
+		  !
+		  icorrxt = 0   
+		  icorrxu = -1  
+		  icorrxv = 0   
+		  icorrxf = -1  
+		  !
+		  icorryt = 0   
+		  icorryu = 0    
+		  icorryv = -1  
+		  icorryf = -1  
+		  !      		
+		  IF(isym_x.EQ.1) THEN                  ! no bipole
+			ki_min = itmp1
+			IF(llq)THEN
+			  icorrxt = 0   
+			  icorrxu = -1 + npivot
+			  icorrxv = 0   
+			  !
+			  icorryt = 0   
+			  icorryu = 0    
+			  icorryv = -1 + npivot 
+			  !  
+			  llq = .FALSE.
+			ENDIF		
+          ELSEIF(isym_x.EQ.2) THEN              ! no bipole
+		    ki_min = itmp2 
+	      ELSEIF(isym_x.EQ.3) THEN              ! canadian bipole
+		    ki_min = itmp3	
+	      ELSEIF(isym_x.EQ.4) THEN              ! canadian bipole
+		    ki_min = itmp4 
+		    IF(llq)THEN
+			  icorrxt = 0   
+			  icorrxu = -1 + npivot
+			  icorrxv = 0   
+			  !
+			  icorryt = 0   
+			  icorryu = 0    
+			  icorryv = -1 + npivot 
+			  !  
+			  llq = .FALSE.
+		    ENDIF	
+		  ELSEIF(isym_x.EQ.5) THEN              ! asian bipole
+		    ki_min = itmp5		    
+	      ELSEIF(isym_x.EQ.6) THEN              ! asian bipole
+		    ki_min = itmp6      
+		  ELSEIF(isym_x.EQ.7) THEN              ! all around the earth (2 bipoles)
+		    ki_min = itmp7	
+		  ENDIF
+		  !
+	    ENDIF
+		!
+	  ELSEIF(nglobal) THEN
+        kj_min = kj_min + 1                    
+	    ki_min = 1 	  
+	  ENDIF
+	ENDDO
+	!
+	WRITE(*,*) ''
+	WRITE(*,*) ' ### END SUBROUTINE write_mixed_grid ### '
+	WRITE(*,*) ''   
+	! 
+  END SUBROUTINE
+  !
+END MODULE
Index: /utils/tools_ticket2413/GRIDGEN/src/projection.f90
===================================================================
--- /utils/tools_ticket2413/GRIDGEN/src/projection.f90	(revision 12863)
+++ /utils/tools_ticket2413/GRIDGEN/src/projection.f90	(revision 12863)
@@ -0,0 +1,240 @@
+MODULE projection
+!!-----------------------------------------------------------
+!!
+!!          to make a polar stereographic projection 
+!!              in the area of the north pole
+!!
+!!	         Created by Brice Lemaire on 05/2010.
+!!
+!!-----------------------------------------------------------
+  USE readwrite
+  !
+  IMPLICIT NONE
+  PUBLIC
+  !
+  REAL*8,DIMENSION(4) :: dmixlam, dmixphi
+  REAL*8 :: dray = 6357          !rayon polaire de la Terre (km)    
+  REAL*8 :: PI = ACOS(-1.0)
+  REAL*8 :: dlong0 = 0.          !longitude du centre de projection (origine)
+  REAL*8 :: dlat0 = 90.          !latitude       ''    
+  INTEGER :: idisc = 0           !to check the +/- 180 discontinuity
+  INTEGER :: m
+  !
+  CONTAINS  
+  !********************************************************
+  !            SUBROUTINE stereo_projection      	    *
+  !									        			*
+  !												        *
+  !		          CALLED by cfg_tools.F90	            *
+  !********************************************************
+  SUBROUTINE stereo_projection(kji,kjj,kjk,knorth_pole,kway)
+    !
+    INTEGER,INTENT(IN) :: kji,kjj,kjk
+	LOGICAL,INTENT(IN) :: knorth_pole
+	INTEGER,INTENT(IN) :: kway
+	INTEGER :: klon, klat
+	REAL*8,DIMENSION(4) :: dlx, dly
+	REAL*8,DIMENSION(4) :: dllam, dlphi, dlk
+	REAL*8 :: dl_lat0, dl_long0
+	!
+    dl_lat0 = dlat0 * PI/180.
+    dl_long0 = dlong0 * PI/180.
+    !
+	!Either we interpolate along longitude or along latitude
+	IF(kway.EQ.1)THEN
+	  klon = 1
+	  klat = 0
+	ELSEIF(kway.EQ.2) THEN
+	  klon = 0
+	  klat = 1
+	ENDIF
+	!
+	! Check the discontinuity +/- 180
+	IF(kway.EQ.1)THEN
+	  IF(smixgrd%glam(kji,kjj).LT.180..AND.smixgrd%glam(kji+3*nn_rhox,kjj).GT.180.) THEN
+	    IF(smixgrd%glam(kji+2*nn_rhox,kjj).LT.180.) THEN
+	      idisc = 1
+	    ELSEIF(smixgrd%glam(kji+1*nn_rhox,kjj).GT.180.) THEN 
+	      idisc = 2
+        ELSEIF(smixgrd%glam(kji+2*nn_rhox,kjj).GT.180.AND.smixgrd%glam(kji+1*nn_rhox,kjj).LT.180.)THEN
+	      idisc = 3
+	    ENDIF
+	  ELSE
+	  idisc = 0
+	  ENDIF
+	ENDIF
+	!
+	dllam(1) = smixgrd%glam(kji,kjj) * PI/180.
+	dlphi(1) = smixgrd%gphi(kji,kjj) * PI/180.
+	dlk(1)   = (2*dray) / (1 + (SIN(dl_lat0)*SIN(dlphi(1))) + (COS(dl_lat0)*COS(dlphi(1))*COS(dllam(1) - dl_long0)))
+	!
+	dllam(2) = smixgrd%glam(kji+1*nn_rhox*klon,kjj+1*nn_rhoy*klat) * PI/180.
+	dlphi(2) = smixgrd%gphi(kji+1*nn_rhox*klon,kjj+1*nn_rhoy*klat) * PI/180.
+	dlk(2)   = (2*dray) / (1 + (SIN(dl_lat0)*SIN(dlphi(2))) + (COS(dl_lat0)*COS(dlphi(2))*COS(dllam(2) - dl_long0)))
+	!
+	dllam(3) = smixgrd%glam(kji+2*nn_rhox*klon,kjj+2*nn_rhoy*klat) * PI/180.
+	dlphi(3) = smixgrd%gphi(kji+2*nn_rhox*klon,kjj+2*nn_rhoy*klat) * PI/180.
+	dlk(3)   = (2*dray) / (1 + (SIN(dl_lat0)*SIN(dlphi(3))) + (COS(dl_lat0)*COS(dlphi(3))*COS(dllam(3) - dl_long0)))
+	!
+	dllam(4) = smixgrd%glam(kji+3*nn_rhox*klon,kjj+3*nn_rhoy*klat) * PI/180.
+	dlphi(4) = smixgrd%gphi(kji+3*nn_rhox*klon,kjj+3*nn_rhoy*klat) * PI/180.
+	dlk(4)   = (2*dray) / (1 + (SIN(dl_lat0)*SIN(dlphi(4))) + (COS(dl_lat0)*COS(dlphi(4))*COS(dllam(4) - dl_long0)))
+	!	
+	dlx(1) = dlk(1) * COS(dlphi(1)) * SIN(dllam(1) - dl_long0)
+	dly(1) = dlk(1) * ((COS(dl_lat0) * SIN(dlphi(1))) - (SIN(dl_lat0) * COS(dlphi(1)) * COS(dllam(1) - dl_long0)))
+    !
+	dlx(2) = dlk(2) * COS(dlphi(2)) * SIN(dllam(2) - dl_long0)
+	dly(2) = dlk(2) * ((COS(dl_lat0) * SIN(dlphi(2))) - (SIN(dl_lat0) * COS(dlphi(2)) * COS(dllam(2) - dl_long0)))
+    !
+	dlx(3) = dlk(3) * COS(dlphi(3)) * SIN(dllam(3) - dl_long0)
+	dly(3) = dlk(3) * ((COS(dl_lat0) * SIN(dlphi(3))) - (SIN(dl_lat0) * COS(dlphi(3)) * COS(dllam(3) - dl_long0)))
+    !
+	dlx(4) = dlk(4) * COS(dlphi(4)) * SIN(dllam(4) - dl_long0)
+	dly(4) = dlk(4) * ((COS(dl_lat0) * SIN(dlphi(4))) - (SIN(dl_lat0) * COS(dlphi(4)) * COS(dllam(4) - dl_long0)))
+    ! 
+	dmixlam(1) = smixgrd%glam(kji,kjj)         
+	dmixlam(2) = smixgrd%glam(kji+1*nn_rhox*klon,kjj+1*nn_rhoy*klat) 
+    dmixlam(3) = smixgrd%glam(kji+2*nn_rhox*klon,kjj+2*nn_rhoy*klat) 
+    dmixlam(4) = smixgrd%glam(kji+3*nn_rhox*klon,kjj+3*nn_rhoy*klat)
+	!
+	dmixphi(1) = smixgrd%gphi(kji,kjj)       
+	dmixphi(2) = smixgrd%gphi(kji+1*nn_rhox*klon,kjj+1*nn_rhoy*klat) 
+    dmixphi(3) = smixgrd%gphi(kji+2*nn_rhox*klon,kjj+2*nn_rhoy*klat) 
+    dmixphi(4) = smixgrd%gphi(kji+3*nn_rhox*klon,kjj+3*nn_rhoy*klat)
+	!
+	smixgrd%glam(kji,kjj)                               = dlx(1)
+	smixgrd%glam(kji+1*nn_rhox*klon,kjj+1*nn_rhoy*klat) = dlx(2)
+	smixgrd%glam(kji+2*nn_rhox*klon,kjj+2*nn_rhoy*klat) = dlx(3)
+	smixgrd%glam(kji+3*nn_rhox*klon,kjj+3*nn_rhoy*klat) = dlx(4)
+	!
+	smixgrd%gphi(kji,kjj)                               = dly(1)
+	smixgrd%gphi(kji+1*nn_rhox*klon,kjj+1*nn_rhoy*klat) = dly(2)
+    smixgrd%gphi(kji+2*nn_rhox*klon,kjj+2*nn_rhoy*klat) = dly(3)
+    smixgrd%gphi(kji+3*nn_rhox*klon,kjj+3*nn_rhoy*klat) = dly(4)
+	!
+  END SUBROUTINE stereo_projection
+  ! 
+  !
+  !
+  !********************************************************
+  !          SUBROUTINE stereo_projection_inv    	    *
+  !									        			*
+  !												        *
+  !		            CALLED from here	                *
+  !********************************************************
+  SUBROUTINE stereo_projection_inv(kji,kjj,kjk,knorth_pole,kway)
+    !
+    INTEGER,INTENT(IN) :: kji,kjj,kjk
+	LOGICAL,INTENT(IN) :: knorth_pole
+	INTEGER,INTENT(IN) :: kway
+	INTEGER :: klon, klat
+	REAL*8,DIMENSION(5) :: dlx, dly
+	REAL*8,DIMENSION(5)  :: dllam, dlphi
+    REAL*8,DIMENSION(5)  :: dlro, dlc
+	REAL*8 :: dl_long0, dl_lat0
+	!	
+    dl_lat0 = dlat0 * PI/180.
+    dl_long0 = dlong0 * PI/180.
+    !
+ 	IF(kway.EQ.1)THEN
+	  klon = 1
+	  klat = 0
+	ELSEIF(kway.EQ.2) THEN
+	  klon = 0
+	  klat = 1
+	ENDIF
+	!
+	!
+	dlx(1) = smixgrd%glam(kji,kjj)
+	dlx(2) = smixgrd%glam(kji+1*nn_rhox*klon,kjj+1*nn_rhoy*klat)
+	dlx(3) = smixgrd%glam(kji+2*nn_rhox*klon,kjj+2*nn_rhoy*klat)
+	dlx(4) = smixgrd%glam(kji+3*nn_rhox*klon,kjj+3*nn_rhoy*klat)	
+	dlx(5) = smixgrd%glam(kji+(nn_rhox+kjk)*klon,kjj+(nn_rhoy+kjk)*klat) 
+	!
+	dly(1) = smixgrd%gphi(kji,kjj)
+	dly(2) = smixgrd%gphi(kji+1*nn_rhox*klon,kjj+1*nn_rhoy*klat)
+	dly(3) = smixgrd%gphi(kji+2*nn_rhox*klon,kjj+2*nn_rhoy*klat)
+	dly(4) = smixgrd%gphi(kji+3*nn_rhox*klon,kjj+3*nn_rhoy*klat)	
+	dly(5) = smixgrd%gphi(kji+(nn_rhox+kjk)*klon,kjj+(nn_rhoy+kjk)*klat) 	
+	!
+	dlro(1) = SQRT(dlx(1)*dlx(1) + dly(1)*dly(1))
+	dlro(2) = SQRT(dlx(2)*dlx(2) + dly(2)*dly(2))
+	dlro(3) = SQRT(dlx(3)*dlx(3) + dly(3)*dly(3))
+	dlro(4) = SQRT(dlx(4)*dlx(4) + dly(4)*dly(4))
+	dlro(5) = SQRT(dlx(5)*dlx(5) + dly(5)*dly(5))
+	!
+	dlc(1) = 2*ATAN(dlro(1)/(2*dray))
+	dlc(2) = 2*ATAN(dlro(2)/(2*dray))
+	dlc(3) = 2*ATAN(dlro(3)/(2*dray))
+	dlc(4) = 2*ATAN(dlro(4)/(2*dray))
+	dlc(5) = 2*ATAN(dlro(5)/(2*dray))
+	!
+	dlphi(1) =  ASIN(COS(dlc(1))*SIN(dl_lat0) + (dly(1)*SIN(dlc(1))*COS(dl_lat0) / dlro(1)))
+	dlphi(2) =  ASIN(COS(dlc(2))*SIN(dl_lat0) + (dly(2)*SIN(dlc(2))*COS(dl_lat0) / dlro(2)))
+	dlphi(3) =  ASIN(COS(dlc(3))*SIN(dl_lat0) + (dly(3)*SIN(dlc(3))*COS(dl_lat0) / dlro(3)))
+	dlphi(4) =  ASIN(COS(dlc(4))*SIN(dl_lat0) + (dly(4)*SIN(dlc(4))*COS(dl_lat0) / dlro(4)))
+	dlphi(5) =  ASIN(COS(dlc(5))*SIN(dl_lat0) + (dly(5)*SIN(dlc(5))*COS(dl_lat0) / dlro(5)))
+    !	
+	dlphi(:) = dlphi(:) * 180./PI
+    !
+	dllam(1) = dl_long0 + ATAN(dlx(1)*SIN(dlc(1) / ((dlro(1)*COS(dl_lat0)*COS(dlc(1)))-(dly(1)*SIN(dl_lat0)*SIN(dlc(1))))))
+	dllam(2) = dl_long0 + ATAN(dlx(2)*SIN(dlc(2) / ((dlro(2)*COS(dl_lat0)*COS(dlc(2)))-(dly(2)*SIN(dl_lat0)*SIN(dlc(2))))))
+	dllam(3) = dl_long0 + ATAN(dlx(3)*SIN(dlc(3) / ((dlro(3)*COS(dl_lat0)*COS(dlc(3)))-(dly(3)*SIN(dl_lat0)*SIN(dlc(3))))))
+	dllam(4) = dl_long0 + ATAN(dlx(4)*SIN(dlc(4) / ((dlro(4)*COS(dl_lat0)*COS(dlc(4)))-(dly(4)*SIN(dl_lat0)*SIN(dlc(4))))))
+	dllam(5) = dl_long0 + ATAN(dlx(5)*SIN(dlc(5) / ((dlro(5)*COS(dl_lat0)*COS(dlc(5)))-(dly(5)*SIN(dl_lat0)*SIN(dlc(5))))))
+    !
+	dllam(1) = dllam(1) * 180./PI
+	dllam(2) = dllam(2) * 180./PI 
+	dllam(3) = dllam(3) * 180./PI 
+	dllam(4) = dllam(4) * 180./PI 
+    !
+	dllam(5) = dllam(5) * 180./PI 
+	!
+	IF(kway.EQ.1)THEN		
+	  IF(idisc.EQ.1) THEN
+		dllam(5) = dllam(5) + 180.
+	  ELSEIF(idisc.EQ.2) THEN
+		dllam(5) = dllam(5) - 180.
+	  ELSEIF(idisc.EQ.3) THEN
+		 dllam(5) = dllam(5) - 180.
+	  ELSE
+		dllam(5) = dllam(5)  
+	  ENDIF
+	  !
+	ELSEIF(kway.EQ.2)THEN
+	  IF(smixgrd%glam(kji,kjj+1*nn_rhoy).GT.0.AND.smixgrd%glam(kji,kjj+2*nn_rhoy).GT.0)THEN
+	    IF(dllam(5).LT.0.)THEN
+	      dllam(5) = dllam(5) + 180
+		ENDIF
+	  ELSEIF(smixgrd%glam(kji,kjj+1*nn_rhoy).LT.0.AND.smixgrd%glam(kji,kjj+2*nn_rhoy).LT.0)THEN
+	    IF(dllam(5).GT.0.)THEN
+		  dllam(5) = dllam(5) - 180
+	    ENDIF
+	  ELSEIF(smixgrd%glam(kji,kjj+1*nn_rhoy)*smixgrd%glam(kji,kjj+2*nn_rhoy).LT.0)THEN
+	    IF(dllam(5).LT.0.)THEN
+	      dllam(5) = dllam(5) + 180
+	    ELSEIF(dllam(5).GT.0.)THEN
+	      dllam(5) = dllam(5) - 180
+	    ENDIF
+	  ENDIF
+	ENDIF
+	!
+	smixgrd%glam(kji,kjj)                                       = dmixlam(1)
+	smixgrd%glam(kji+1*nn_rhox*klon,kjj+1*nn_rhoy*klat)         = dmixlam(2)
+    smixgrd%glam(kji+2*nn_rhox*klon,kjj+2*nn_rhoy*klat)         = dmixlam(3)
+    smixgrd%glam(kji+3*nn_rhox*klon,kjj+3*nn_rhoy*klat)         = dmixlam(4)
+	!
+    smixgrd%glam(kji+(nn_rhox+kjk)*klon,kjj+(nn_rhoy+kjk)*klat) = dllam(5)
+	!
+	smixgrd%gphi(kji,kjj)                                       = dmixphi(1)
+	smixgrd%gphi(kji+1*nn_rhox*klon,kjj+1*nn_rhoy*klat)         = dmixphi(2)
+    smixgrd%gphi(kji+2*nn_rhox*klon,kjj+2*nn_rhoy*klat)         = dmixphi(3)
+    smixgrd%gphi(kji+3*nn_rhox*klon,kjj+3*nn_rhoy*klat)         = dmixphi(4)
+	!
+    smixgrd%gphi(kji+(nn_rhox+kjk)*klon,kjj+(nn_rhoy+kjk)*klat) = dlphi(5)
+	!
+  END SUBROUTINE stereo_projection_inv
+  !
+  !
+  !
+END MODULE projection
Index: /utils/tools_ticket2413/GRIDGEN/src/readwrite.f90
===================================================================
--- /utils/tools_ticket2413/GRIDGEN/src/readwrite.f90	(revision 12863)
+++ /utils/tools_ticket2413/GRIDGEN/src/readwrite.f90	(revision 12863)
@@ -0,0 +1,182 @@
+MODULE readwrite
+  !
+  USE types
+  !
+  IMPLICIT NONE
+  !
+CONTAINS
+  !       
+  !*****************************************************
+  !   function Read_Coordinates(name,Grid)
+  !*****************************************************
+  INTEGER FUNCTION read_coordinates(name,Grid)
+    !
+    USE io_netcdf
+    !         
+    CHARACTER(*) name
+    TYPE(coordinates) :: Grid
+    !      
+    CALL Read_Ncdf_var('glamt',name,Grid%glamt)
+    CALL Read_Ncdf_var('glamu',name,Grid%glamu)
+    CALL Read_Ncdf_var('glamv',name,Grid%glamv)
+    CALL Read_Ncdf_var('glamf',name,Grid%glamf)
+    CALL Read_Ncdf_var('gphit',name,Grid%gphit)
+    CALL Read_Ncdf_var('gphiu',name,Grid%gphiu)
+    CALL Read_Ncdf_var('gphiv',name,Grid%gphiv)
+    CALL Read_Ncdf_var('gphif',name,Grid%gphif)
+    CALL Read_Ncdf_var('e1t',name,Grid%e1t)
+    CALL Read_Ncdf_var('e1u',name,Grid%e1u)
+    CALL Read_Ncdf_var('e1v',name,Grid%e1v)
+    CALL Read_Ncdf_var('e1f',name,Grid%e1f)
+    CALL Read_Ncdf_var('e2t',name,Grid%e2t)
+    CALL Read_Ncdf_var('e2u',name,Grid%e2u)
+    CALL Read_Ncdf_var('e2v',name,Grid%e2v)
+    CALL Read_Ncdf_var('e2f',name,Grid%e2f)
+    CALL Read_Ncdf_var('nav_lon',name,Grid%nav_lon)
+    CALL Read_Ncdf_var('nav_lat',name,Grid%nav_lat)       
+    !            
+    WRITE(*,*) ' '
+    WRITE(*,*) '*** Reading coordinates file: ',name
+    WRITE(*,*) ' '
+    !      
+    read_coordinates = 1
+    !      
+  END FUNCTION read_coordinates
+  !
+  !
+  !
+  !*****************************************************
+  !   function Write_Coordinates(name,Grid)
+  !*****************************************************
+  INTEGER FUNCTION write_coordinates(name,Grid,kxfine,kyfine)
+    !
+    USE io_netcdf
+	!
+    CHARACTER(*) name
+    TYPE(coordinates) :: Grid
+    INTEGER :: status,ncid,z
+    REAL*8,DIMENSION(:),POINTER :: tabtemp
+    INTEGER,DIMENSION(:),POINTER :: tabint
+    CHARACTER(len=20),DIMENSION(4) :: dimnames
+	INTEGER :: kxfine, kyfine
+    !
+    status = nf90_create(name,NF90_WRITE,ncid)
+    status = nf90_close(ncid)
+    !           
+	CALL Write_Ncdf_dim('x',name,nxfine)
+    CALL Write_Ncdf_dim('y',name,nyfine)
+    IF(.NOT. ln_iom_activated) CALL Write_Ncdf_dim('z',name,1)
+    CALL Write_Ncdf_dim('time',name,0)
+    !      
+    dimnames(1)='x'
+    dimnames(2)='y'
+    CALL Write_Ncdf_var('nav_lon',dimnames(1:2),name,Grid%nav_lon,'float')      
+    CALL Write_Ncdf_var('nav_lat',dimnames(1:2),name,Grid%nav_lat,'float')
+    !
+    IF(.NOT. ln_iom_activated) THEN
+       ! copy nav_lev variable -> IOIPSL
+       CALL Read_Ncdf_dim('z',cn_parent_coordinate_file,z)
+       ALLOCATE(tabtemp(z))
+       CALL Read_Ncdf_var('nav_lev',TRIM(cn_parent_coordinate_file),tabtemp)
+       CALL Write_Ncdf_var('nav_lev','z',name,tabtemp,'float')           
+       DEALLOCATE(tabtemp)
+    ENDIF
+    !
+    CALL Read_Ncdf_var('time',TRIM(cn_parent_coordinate_file),tabtemp)
+    CALL Write_Ncdf_var('time','time',name,tabtemp,'float')           
+    DEALLOCATE(tabtemp)      
+    CALL Read_Ncdf_var('time_steps',TRIM(cn_parent_coordinate_file),tabint)
+    CALL Write_Ncdf_var('time_steps','time',name,tabint) 
+    !      
+    dimnames(1)='x'
+    dimnames(2)='y'
+    IF(ln_iom_activated) THEN
+       dimnames(3)='time'
+    ELSE
+       dimnames(3)='z'
+       dimnames(4)='time'
+    ENDIF
+
+    CALL Write_Ncdf_var('glamt',dimnames,name,Grid%glamt,3,'double')
+    CALL Write_Ncdf_var('glamu',dimnames,name,Grid%glamu,3,'double')
+    CALL Write_Ncdf_var('glamv',dimnames,name,Grid%glamv,3,'double')
+    CALL Write_Ncdf_var('glamf',dimnames,name,Grid%glamf,3,'double')
+    CALL Write_Ncdf_var('gphit',dimnames,name,Grid%gphit,3,'double')
+    CALL Write_Ncdf_var('gphiu',dimnames,name,Grid%gphiu,3,'double')
+    CALL Write_Ncdf_var('gphiv',dimnames,name,Grid%gphiv,3,'double')
+    CALL Write_Ncdf_var('gphif',dimnames,name,Grid%gphif,3,'double')      
+    CALL Write_Ncdf_var('e1t',dimnames,name,Grid%e1t,3,'double')      
+    CALL Write_Ncdf_var('e1u',dimnames,name,Grid%e1u,3,'double')     
+    CALL Write_Ncdf_var('e1v',dimnames,name,Grid%e1v,3,'double')      
+    CALL Write_Ncdf_var('e1f',dimnames,name,Grid%e1f,3,'double')
+    CALL Write_Ncdf_var('e2t',dimnames,name,Grid%e2t,3,'double')
+    CALL Write_Ncdf_var('e2u',dimnames,name,Grid%e2u,3,'double')
+    CALL Write_Ncdf_var('e2v',dimnames,name,Grid%e2v,3,'double')
+    CALL Write_Ncdf_var('e2f',dimnames,name,Grid%e2f,3,'double')
+    !      
+    CALL Copy_Ncdf_att('nav_lon',TRIM(cn_parent_coordinate_file),name,&
+         MINVAL(Grid%nav_lon),MAXVAL(Grid%nav_lon))
+    CALL Copy_Ncdf_att('nav_lat',TRIM(cn_parent_coordinate_file),name,&
+         MINVAL(Grid%nav_lat),MAXVAL(Grid%nav_lat))
+    CALL Copy_Ncdf_att('nav_lev',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('time',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('time_steps',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('glamt',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('glamu',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('glamv',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('glamf',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('gphit',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('gphiu',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('gphiv',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('gphif',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('e1t',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('e1u',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('e1v',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('e1f',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('e2t',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('e2u',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('e2v',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('e2f',TRIM(cn_parent_coordinate_file),name)            
+    !
+    WRITE(*,*) ' '
+    WRITE(*,*) 'Writing coordinates file: ',name
+    IF(.NOT. ln_iom_activated) WRITE(*,*) 'IOISPL format'
+    IF(ln_iom_activated) WRITE(*,*) 'IOM format'      
+    WRITE(*,*) ' '
+    !
+    write_coordinates = 1
+    !      
+  END FUNCTION write_coordinates
+  !
+  !
+  !
+  !*****************************************************
+  !   function set_child_name(Parentname,Childname)
+  !*****************************************************
+  SUBROUTINE set_child_name(Parentname,Childname)
+    !
+    CHARACTER(*),INTENT(in) :: Parentname
+    CHARACTER(*),INTENT(out) :: Childname
+    CHARACTER(2) :: prefix
+    INTEGER :: pos
+    !   
+    pos  = INDEX(TRIM(Parentname),'/',back=.TRUE.)
+    !
+    prefix=Parentname(pos+1:pos+2)
+    IF (prefix == '1_') THEN
+       Childname = '2_'//Parentname(pos+3:LEN(Parentname)) 
+    ELSEIF (prefix == '2_') THEN
+       Childname = '3_'//Parentname(pos+3:LEN(Parentname)) 
+    ELSEIF (prefix == '3_') THEN
+       Childname = '4_'//Parentname(pos+3:LEN(Parentname)) 
+    ELSEIF (prefix == '4_') THEN
+       Childname = '5_'//Parentname(pos+3:LEN(Parentname)) 
+    ELSE
+       Childname = '1_'//Parentname(pos+1:LEN(Parentname)) 
+    ENDIF
+    !   
+  END SUBROUTINE set_child_name
+  !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!             
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+END MODULE readwrite
Index: /utils/tools_ticket2413/GRIDGEN/src/types.f90
===================================================================
--- /utils/tools_ticket2413/GRIDGEN/src/types.f90	(revision 12863)
+++ /utils/tools_ticket2413/GRIDGEN/src/types.f90	(revision 12863)
@@ -0,0 +1,210 @@
+MODULE types
+  !
+  PUBLIC
+  !   
+  !*****************************
+  ! Coordinates type definition 
+  !*****************************
+  TYPE coordinates
+     REAL*8, DIMENSION(:,:), POINTER  :: nav_lon,nav_lat              => NULL()
+     REAL*8, DIMENSION(:,:), POINTER  :: glamv, glamu, glamt, glamf   => NULL()
+     REAL*8, DIMENSION(:,:), POINTER  :: gphit, gphiu, gphiv, gphif   => NULL()
+     REAL*8, DIMENSION(:,:), POINTER  :: e1t, e1u, e1v, e1f           => NULL()
+     REAL*8, DIMENSION(:,:), POINTER  :: e2t, e2u, e2v, e2f           => NULL()
+     INTEGER, DIMENSION(:) , POINTER  :: time_steps                   => NULL()
+  END TYPE coordinates
+  !
+  !
+  !
+  TYPE mixed_coordinates
+     REAL*8, DIMENSION(:,:), POINTER  :: nav_lon,nav_lat              => NULL()
+     REAL*8, DIMENSION(:,:), POINTER  :: glam                         => NULL()
+     REAL*8, DIMENSION(:,:), POINTER  :: gphi                         => NULL()
+     REAL*8, DIMENSION(:,:), POINTER  :: e1                           => NULL()
+     REAL*8, DIMENSION(:,:), POINTER  :: e2                           => NULL()
+     INTEGER, DIMENSION(:) , POINTER  :: time_steps                   => NULL()
+  END TYPE mixed_coordinates
+  !
+  !**************************************************************
+  ! Declaration of global variables
+  !**************************************************************
+  !size of input ORCA grid
+  INTEGER :: nsizex, nsizey    
+  INTEGER :: nmid            
+  !
+  !kind of input grid
+  INTEGER :: npivot 
+  !
+  INTEGER :: nequator
+  !
+  LOGICAL :: nglobal
+  !
+  INTEGER :: nresx, nresy
+  !
+  !distance between middle of input grid and the border of sub-domain 
+  INTEGER :: nval1, nval2
+  !
+  INTEGER :: nxcoag, nycoag     !size of the sub-domain inside input ORCA grid 
+  INTEGER :: nxgmix, nygmix     !size of the mixed grid 
+  INTEGER :: nxfine, nyfine     !size of fine grid 
+  !
+  TYPE(coordinates), SAVE :: scoagrd         !coarse grid
+  TYPE(coordinates), SAVE :: sfingrd         !fine grid
+  TYPE(mixed_coordinates), SAVE :: smixgrd   !mixed grid to store all components (T,U,V,F) 
+  !                                           of the coarse grid in the same one
+  !
+  !
+  !
+  !**************************************************************
+  ! Declaration of various input file variables (namelist.input) 
+  !**************************************************************
+  INTEGER nn_imin,nn_jmin,nn_imax,nn_jmax,nn_rhox,nn_rhoy
+  LOGICAL ln_iom_activated
+  CHARACTER*100 cn_parent_coordinate_file, cn_position_pivot
+  !      
+  NAMELIST /input_output/ln_iom_activated
+  NAMELIST /coarse_grid_files/cn_parent_coordinate_file,cn_position_pivot
+  NAMELIST /nesting/nn_imin,nn_jmin,nn_imax,nn_jmax,nn_rhox,nn_rhoy      
+  !
+  !
+  !
+CONTAINS
+  !********************************************************
+  !             subroutine grid_allocate				*
+  !					                            		*
+  !         allocation of grid type elements 			*
+  !             according to nx and ny	     			*
+  !							                            *
+  !********************************************************
+  SUBROUTINE grid_allocate(Grid,nx,ny)
+    !
+    TYPE(coordinates) :: Grid
+    INTEGER :: nx,ny
+    !
+    ALLOCATE(Grid%nav_lon(nx,ny),Grid%nav_lat(nx,ny))
+    ALLOCATE(Grid%glamt(nx,ny),Grid%glamu(nx,ny),Grid%glamv(nx,ny),Grid%glamf(nx,ny))
+    ALLOCATE(Grid%gphit(nx,ny),Grid%gphiu(nx,ny),Grid%gphiv(nx,ny),Grid%gphif(nx,ny))
+    ALLOCATE(Grid%e1t(nx,ny),Grid%e1u(nx,ny),Grid%e1v(nx,ny),Grid%e1f(nx,ny))
+    ALLOCATE(Grid%e2t(nx,ny),Grid%e2u(nx,ny),Grid%e2v(nx,ny),Grid%e2f(nx,ny))
+	!
+  END SUBROUTINE grid_allocate
+  !
+  !
+  !
+  SUBROUTINE grid_deallocate(Grid)
+    !
+    TYPE(coordinates) :: Grid
+    !
+    DEALLOCATE(Grid%nav_lon,Grid%nav_lat)
+    DEALLOCATE(Grid%glamt,Grid%glamu,Grid%glamv,Grid%glamf)
+    DEALLOCATE(Grid%gphit,Grid%gphiu,Grid%gphiv,Grid%gphif)
+    DEALLOCATE(Grid%e1t,Grid%e1u,Grid%e1v,Grid%e1f)
+    DEALLOCATE(Grid%e2t,Grid%e2u,Grid%e2v,Grid%e2f)
+	!
+  END SUBROUTINE grid_deallocate
+  !
+  !
+  !
+  !********************************************************
+  !           subroutine mixed_grid_allocate			*
+  !							                            *
+  !          allocation of grid type elements 			*
+  !               according to nx and ny				*
+  !						                            	*
+  !********************************************************
+  SUBROUTINE mixed_grid_allocate(Grid,nx,ny)
+    !
+    TYPE(mixed_coordinates) :: Grid
+    INTEGER :: nx,ny
+    !
+    ALLOCATE(Grid%nav_lon(nx,ny),Grid%nav_lat(nx,ny))
+    ALLOCATE(Grid%glam(nx,ny))
+    ALLOCATE(Grid%gphi(nx,ny))
+    ALLOCATE(Grid%e1(nx,ny))
+    ALLOCATE(Grid%e2(nx,ny))
+	!
+  END SUBROUTINE mixed_grid_allocate
+  !
+  !
+  !
+  SUBROUTINE mixed_grid_deallocate(Grid)
+    !
+    TYPE(mixed_coordinates) :: Grid
+    !
+    DEALLOCATE(Grid%nav_lon,Grid%nav_lat)
+    DEALLOCATE(Grid%glam)
+    DEALLOCATE(Grid%gphi)
+    DEALLOCATE(Grid%e1)
+    DEALLOCATE(Grid%e2)
+	!
+  END SUBROUTINE mixed_grid_deallocate
+  !
+  !
+  !
+  !********************************************************
+  !             subroutine read_namelist				*
+  !				                     					*
+  !   read variables contained in namelist.input file   *
+  !                filled in by user 					*
+  !								                    	*
+  !********************************************************
+  SUBROUTINE read_namelist(namelistname)
+    !
+    IMPLICIT NONE
+    CHARACTER(len=80) :: namelistname
+    CHARACTER*255 :: output
+    LOGICAL :: is_it_there
+    INTEGER unit_nml
+    !
+    unit_nml = Get_Unit()
+    !      
+    INQUIRE ( FILE = namelistname , EXIST = is_it_there )      
+    !
+    IF ( is_it_there ) THEN 
+       !
+       OPEN ( FILE   =  namelistname, &
+              UNIT   =  unit_nml,	  &
+              STATUS = 'OLD',		  &
+              FORM   = 'FORMATTED',	  &
+              ACTION = 'READ',		  &
+              ACCESS = 'SEQUENTIAL'     )	  
+       !
+       REWIND(unit_nml)
+       READ (unit_nml , NML = coarse_grid_files)
+       READ (unit_nml , NML = nesting) 
+       CLOSE(unit_nml)
+	   !
+    ELSE
+       !
+       PRINT *,'namelist file ''',TRIM(namelistname),''' not found'
+       STOP	 
+       !
+    END IF
+    !
+  END SUBROUTINE read_namelist
+  !
+  !
+  !
+  !*************************************************
+  !              function Get_Unit                             
+  !*************************************************
+  INTEGER FUNCTION Get_Unit()
+    !
+    INTEGER n
+    LOGICAL op
+    INTEGER :: nunit
+    INTEGER :: iii,out,iiimax 
+    ! 
+    DO n = 7,1000
+       ! 
+       INQUIRE(Unit=n,Opened=op)
+       !
+       IF (.NOT.op) EXIT
+       !      
+    ENDDO
+    !
+    Get_Unit=n
+    !
+  END FUNCTION Get_Unit
+  !
+END MODULE types
Index: /utils/tools_ticket2413/MISCELLANEOUS/README_uspcfg
===================================================================
--- /utils/tools_ticket2413/MISCELLANEOUS/README_uspcfg	(revision 12863)
+++ /utils/tools_ticket2413/MISCELLANEOUS/README_uspcfg	(revision 12863)
@@ -0,0 +1,134 @@
+Instructions for using unsupported configurations on systems without wget access to
+the internet
+
+The unsupported configurations in NEMO are provided as a way for users to provide
+alternative configurations to the wider community without having to rely on system team
+sponsership and support. The idea is to provide minimal but sufficient information
+with the standard distribution to allow ancillary files to be fetched from remote
+servers at compile time. Thus a makenemo command such as:
+
+./makenemo -n MYISOMIP -u ISOMIP -m some_arch
+
+will create a new configuration called MYISOMIP with MY_SRC and EXP00 directories
+populated from a remote server. It does this by first using the wget command to fetch a
+list of remote files and then using wget repeatedly to fetch each of the files listed
+therein. The location of the remote list is contained in one line of information held
+in the uspcfg.txt file (in CONFIG).
+
+These instructions provide a work-around for systems without direct access to the
+internet or on which wget has been disabled/not installed. On these systems it is
+possible to create local copies of the remote files and replace the wget function
+with a local copy command. It will be the user's responsibility to ensure that the
+local copies reflect any changes made in the remote sources.
+
+The procedure requires the following steps:
+
+1. From the target NEMOGCM directory on your target system copy the following
+   files into a working directory on a system that does have internet access
+   and a working wget command:
+
+      a. TOOLS/MISCELLANEOUS/make_usp_tar.sh
+      b. CONFIG/uspcfg.txt
+
+2. On that alternative system and in the working directory containing the newly
+   copied files, run the make_usp_tar.sh script. The script takes three arguments:
+
+      a. The name of the uspcfg.txt file
+      b. The name of the unsupported configuration you wish to use
+      c. The name of a directory that will be created and filled with the remote
+         files in the current working directory. This directory will be tarred and
+         eventually transferred to the target system. There it will be unpacked and
+         will form the local archive for this configuration. A meaningful name is
+         therefore recommended.
+
+   For example:
+
+   ./make_usp_tar.sh uspcfg.txt ISOMIP ISOMIP_ARCHIVE
+
+3. Copy the resulting tarball (in this case: ISOMIP_ARCHIVE.tar) to the target 
+   system and unpack (tar xvf ISOMIP_ARCHIVE.tar) in a location that is visible to 
+   the node on which you intend to compile nemo. The unpacked directory will contain
+   the files retrieved from the remote server, modified versions of the file list and
+   uspcfg.txt files and two new scripts. For example:
+
+   ls -1R ISOMIP_ARCHIVE
+   cpp_ISOMIP.fcm             - downloaded from remote server
+   def_wget                   - newly constructed script
+   local_template.ctl         - file list modified for local copy
+   uspcfg_local_template.txt  - a copy of uspcfg.txt with modification for local copy
+   remote_file.list           - downloaded from remote server
+   set_local_uspcfg           - newly constructed script
+   EXP00                      - new subdirectory
+   MY_SRC                     - new subdirectory
+
+   ./EXP00:
+   iodef.xml                  - downloaded from remote server
+   namelist_cfg               - downloaded from remote server
+
+   ./MY_SRC:
+   domzgr.F90                 - downloaded from remote server
+   istate.F90                 - downloaded from remote server
+
+4. The final stage is to enter the directory and execute the set_local_uspcfg script.
+   This script will prompt for a full path to the target CONFIG directory and then:
+
+   a. Edit the templates and create local.ctl and uspcfg_local.txt files by inserting 
+      the full path to the archive directory (i.e. the current working directory)
+   b. move uspcfg_local.txt to the named CONFIG directory
+   c. rename any existing uspcfg.txt file in the CONFIG directory to uspcfg_remote.txt
+   d. insert symbolic link (uspcfg.txt) to uspcfg_local.txt in the CONFIG directory
+   e. redefine/define wget as an exported bash function to simply copy
+
+   This last action is needed so that subsequent use of makenemo with the -u argument
+   will not invoke wget. For this to be effective the set_local_usp script should be run
+   within the same bash shell as makenemo will be run in. I.e.:
+
+   . ./set_local_usp
+
+   If this is not possible or the makenemo command is run at a later date, then the
+   def_wget script should be run in the bash shell before any attempt to use the -u
+   option of makenemo. I.e.:
+
+   . ./def_wget
+
+   [ Tip: check that the definition/re-definition of wget has worked correctly by
+     issuing this command:
+
+     wget a b c
+
+     If you get messages such as:
+
+       wget a b c
+       --2016-10-27 10:14:52--  http://a/
+       Resolving a... failed: Name or service not known.
+       wget: unable to resolve host address `a'
+       .
+       .
+
+     then the re-definition of wget has not been retained by the current shell. Run
+     . ./def_wget and try again. You should get a response such as:
+
+     wget a b c
+     Expected wget usage: wget src -O dest
+     -O not found. No action taken
+
+     if the environment is set correctly
+   ]
+
+5. The setup is now complete and moving to the CONFIG directory and issuing a command
+   such as:
+
+    ./makenemo -n MYISOMIP -u ISOMIP -m target_arch
+
+   should correctly configure from local archives only.   
+
+   [ Tip: the -u argument ( and hence the need to switch wget to local copies on isolated
+     systems ) is only required when compiling for the first time. Subsequent compilations
+     following code changes in the MYISOMIP directories can be carried out in your
+     default nemo environment. I.e.:
+
+     ./makenemo -n MYISOMIP -m target_arch
+
+     will not require any of the preceeding steps in future sessions.
+   ]
+
Index: /utils/tools_ticket2413/MISCELLANEOUS/chk_ifdef.sh
===================================================================
--- /utils/tools_ticket2413/MISCELLANEOUS/chk_ifdef.sh	(revision 12863)
+++ /utils/tools_ticket2413/MISCELLANEOUS/chk_ifdef.sh	(revision 12863)
@@ -0,0 +1,31 @@
+#!/bin/bash
+#
+# check the propper syntax of C preprocessor directives.
+# for example:
+#if defined key_traldf_c3d && key_traldf_smag
+# is not good and should be
+#if defined key_traldf_c3d && defined key_traldf_smag
+#
+# use: go to TOOLS/MISCELLANEOUS/ and simply execute:
+#  ./chk_ifdef.sh 
+#
+set -u
+#
+grep -r "^ *#if" ../../NEMO | grep -v "~:" > tmp$$      # get each lines of the code starting with #if
+grep -r "^ *#elif" ../../NEMO | grep -v "~:" >> tmp$$   # get each lines of the code starting with #elif
+#
+for ll in $( seq 1 $( cat tmp$$ | wc -l  ) )            # for each of these lines
+do
+    lll=$( sed -n -e "${ll}p" tmp$$ )
+    nbdef=$( echo $lll | grep -o defined  | wc -l )         # number of occurences of "defined"
+    nband=$( echo $lll | grep -o   "&&"   | wc -l )         # number of occurences of "&&"
+    nbor=$(  echo $lll | grep -o   "||"   | wc -l )         # number of occurences of "||"
+    [ $nbdef -ne $(( $nband + $nbor + 1 )) ] && echo $lll   # print bad line
+done
+rm -f tmp$$ 
+
+#
+# add other basic tests
+#
+grep -ir  ":,:.*ji,jj" * | grep -v "~:"
+grep -ir  "ji,jj.*:,:" *  | grep -v "~:"
Index: /utils/tools_ticket2413/MISCELLANEOUS/chk_iomput.sh
===================================================================
--- /utils/tools_ticket2413/MISCELLANEOUS/chk_iomput.sh	(revision 12863)
+++ /utils/tools_ticket2413/MISCELLANEOUS/chk_iomput.sh	(revision 12863)
@@ -0,0 +1,167 @@
+#!/bin/bash
+#------------------------------------------------
+#$Id$
+#------------------------------------------------
+#
+set -u
+#
+# if not argument -> get the help
+[ $# -eq 0 ] && ./$0 --help && exit
+#
+inxml=0
+insrc=0
+while [ $# -gt 0 ]   # Until you run out of parameters . . . 
+do    
+    case "$1" in 
+	-h|--help)
+	    echo
+	    echo 'Description:'
+	    echo '      check that an xml file is coherant with the source code:'
+	    echo '         - all variable ids defined by "call iom_put" must have their counterpart'
+	    echo '           in the variable definition in xml file'
+	    echo '         - list variable ids defined in xml file without any corresponding call'
+	    echo '           to iom_put. This can be done but it is useless as iom will only ouput zeros'
+	    echo '         - all variable ids used in the files definition in xml file must have'
+	    echo '           their counterpart in the variable definition in xml file'
+	    echo 'Usage:'
+	    echo '      chk_iomput.sh [OPTION]'
+	    echo '  or  chk_iomput.sh [OPTION] xmlfile DIRECTORIES'
+	    echo '         with:'
+	    echo '           xmlfile:  the xml file to test'
+	    echo '           DIRECTORIES: a list of directories containing the source code'
+	    echo 'Options'
+	    echo ' -h, --help           to get this help'
+	    echo ' --inxml              only print all variable definitions found in the xml file'
+	    echo ' --insrc              only print all variable definitions found in the source code'
+	    echo 'Examples'
+	    echo '      ./chk_iomput.sh'
+	    echo '      ./chk_iomput.sh --help'
+	    echo '      ./chk_iomput.sh ../../cfgs/ORCA2_LIM/EXP00/context_nemo.xml "../../src/OCE/ ../../src/ICE/"'
+	    echo
+	    exit ;;
+        --inxml) inxml=1 ;;
+        --insrc) insrc=1 ;;
+	-*) echo ; echo "illegal option" ; ./$0 --help && exit ;;
+	*) [ $# -ne 2 ] && echo && echo "wrong number of arguments" && ./$0 --help && exit
+	    xmlfile=${1}
+	    srcdir=${2}
+	   shift
+    esac
+    shift       # Check next set of parameters. 
+done 
+#
+echo $xmlfile
+echo $srcdir
+
+for i in $xmlfile
+do
+    [ ! -f "$xmlfile" ] && echo "$xmlfile not found, we stop..." && exit
+done
+for i in $srcdir 
+do
+    [ ! -d $i ] && echo "$i is not a directory, we stop..." && exit
+done
+#
+#------------------------------------------------
+#
+external=$( grep -c "<field_definition  *\([^ ].* \)*src=" $xmlfile )
+if [ $external -ge 1 ]
+then
+    xmlfield_def=$( grep "<field_definition  *\([^ ].* \)*src=" $xmlfile | sed -e 's/.*src="\([^"]*\)".*/\1/' )
+    tmp_def=""
+    for fdef in $xmlfield_def ; do tmp_def="$tmp_def $( dirname $xmlfile )/$fdef" ; done
+    xmlfield_def=$tmp_def
+    echo $xmlfield_def
+else
+    xmlfield_def=$xmlfile
+fi
+external=$( grep -c "<file_definition  *\([^ ].* \)*src=" $xmlfile )
+if [ $external -ge 1 ]
+then
+    xmlfile_def=$( grep "<file_definition  *\([^ ].* \)*src=" $xmlfile | sed -e 's/.*src="\([^"]*\)".*/\1/' )
+    tmp_def=""
+    for fdef in $xmlfile_def ; do tmp_def="$tmp_def $( dirname $xmlfile )/$fdef" ; done
+    xmlfile_def=$tmp_def
+    echo $xmlfile_def
+else
+    xmlfile_def=$xmlfile
+fi
+
+[ $inxml -eq 1 ] && grep "< *field  *\([^ ].* \)*id *=" $xmlfield_def
+[ $insrc -eq 1 ] && find $srcdir -name "*.[Ffh]90" -exec grep -iH "^[^\!]*call  *iom_put *(" {} \;
+[ $(( $insrc + $inxml )) -ge 1 ] && exit
+#
+#------------------------------------------------
+#
+# list of file containing "CALL iom_put" in $srcdir
+#
+srclist=$( find $srcdir -name "*.[Ffh]90" -exec grep -il "^[^\!]*call  *iom_put *(" {} \; )
+#
+# list of variables used in "CALL iom_put"
+#
+badvarsrc=$( find $srcdir -name "*.[Ffh]90" -exec grep -i  "^[^\!]*call  *iom_put *(" {} \; | sed -e "s/.*iom_put *( *[\"\']\([^\"\']*\)[\"\'] *,.*/\1/" | grep -ic iom_put )
+if [ $badvarsrc -ne 0 ]
+then
+    echo "The following call to iom_put cannot be checked"
+    echo
+    find $srcdir -name "*.[Ffh]90" -exec grep -i  "^[^\!]*call  *iom_put *(" {} \; | sed -e "s/.*iom_put *( *[\"\']\([^\"\']*\)[\"\'] *,.*/\1/" | grep -i iom_put | sort -d 
+    echo
+fi
+varlistsrc=$( find $srcdir -name "*.[Ffh]90" -exec grep -i  "^[^\!]*call  *iom_put *(" {} \; | sed -e "s/.*iom_put *( *[\"\']\([^\"\']*\)[\"\'] *,.*/\1/" | grep -vi iom_put | sort -d )
+#
+# list of variables defined in the xml file
+#
+varlistxml=$( grep "< *field  *\([^ ].* \)*id *=" $xmlfield_def  | sed -e "s/^.*< *field .*id *= *[\"\']\([^\"\']*\)[\"\'].*/\1/" | sort -d )
+#
+# list of variables to be outputed in the xml file
+#
+varlistout=$( grep "< *field  *\([^ ].* \)*field_ref *=" $xmlfile_def  | sed -e "s/^.*< *field .*field_ref *= *[\"\']\([^\"\']*\)[\"\'].*/\1/" | sort -d )
+#
+echo "--------------------------------------------------"
+echo  check if all iom_put found in $srcdir
+echo  have a corresponding variable definition in $xmlfield_def
+echo "--------------------------------------------------"
+for var in $varlistsrc
+do
+    tst=$( echo " "$varlistxml" " | grep -c " $var " )
+    if [ $tst -ne 1 ] 
+    then
+	echo "problem with $var: $tst lines corresponding to its definition in $xmlfield_def, but defined in the code in"
+	for f in $srclist
+	do
+	    grep -iH "^[^\!]*call  *iom_put *( *[\"\']${var}[\"\'] *," $f
+	done
+	echo
+    fi
+done
+#
+echo "--------------------------------------------------"
+echo  check if all variables defined in $xmlfile
+echo  have a corresponding \"call iom_put\" in sources found in $srcdir
+echo "--------------------------------------------------"
+#
+for var in $varlistxml
+do
+    found=$( echo " "$varlistsrc" " | grep -c " $var " )
+    if [ $found -eq 0 ] 
+    then
+	echo \"call iom_put\" not found for variable $var
+	grep "< *field * id *= *[\"\']${var}[\"\']" $xmlfile
+	echo
+    fi
+done
+#
+echo "--------------------------------------------------"
+echo  ${xmlfile}: check if all variables to be outputed in files are really defined...
+echo "--------------------------------------------------"
+#
+# list of variables defined in the xml file
+for var in $varlistout
+do
+    found=$( echo " "$varlistxml" " | grep -c " $var " )
+    [ $found -eq 0 ] && echo variable to be outputed but not defined: $var 
+done
+
+
+
+exit
Index: /utils/tools_ticket2413/MISCELLANEOUS/icb_pp.py
===================================================================
--- /utils/tools_ticket2413/MISCELLANEOUS/icb_pp.py	(revision 12863)
+++ /utils/tools_ticket2413/MISCELLANEOUS/icb_pp.py	(revision 12863)
@@ -0,0 +1,208 @@
+from netCDF4 import Dataset
+from argparse import ArgumentParser
+import numpy as np
+import sys
+
+#
+# Basic iceberg trajectory post-processing python script.
+# This script collates iceberg trajectories from the distributed datasets written
+# out by each processing region and rearranges the ragged arrays into contiguous
+# streams for each unique iceberg. The output arrays are 2D (ntraj, ntimes) arrays.
+# Note that some icebergs may only exist for a subset of the possible times. In these
+# cases the missing instances are filled with invalid (NaN) values.
+#
+# Version 2.0 August 2017. Adapted to process all variables and retain original
+#                          datatypes. (acc@noc.ac.uk)
+
+parser = ArgumentParser(description='produce collated trajectory file \
+                                     from distributed output files, e.g. \
+                                     \n python ./icb_pp.py \
+                                     -t  trajectory_icebergs_004248_ \
+                                     -n 296 -o trajsout.nc' )
+
+parser.add_argument('-t',dest='froot',
+                         help='fileroot_of_distrbuted_data; root name \
+                               of  distributed trajectory output (usually \
+                               completed with XXXX.nc, where  XXXX is the \
+                               4 digit processor number)', 
+                      default='trajectory_icebergs_004248_')
+
+parser.add_argument('-n',dest='fnum',help='number of distributed files to process', 
+                         type=int, default=None)
+
+parser.add_argument('-o',dest='fout',
+                         help='collated_output_file; file name to receive \
+                              the collated trajectory data', default='trajsout.nc')
+
+args = parser.parse_args()
+
+default_used = 0
+if args.froot is None:
+    pathstart = 'trajectory_icebergs_004248_'
+    default_used = 1
+else:
+    pathstart = args.froot
+
+if args.fnum is None:
+    procnum = 0
+    default_used = 1
+else:
+    procnum = args.fnum
+
+if args.fout is None:
+    pathout = 'trajsout.nc'
+    default_used = 1
+else:
+    pathout = args.fout
+
+if default_used == 1:
+   print('At least one default value will be used; command executing is:')
+   print('icb_pp.py -t ',pathstart,' -n ',procnum,' -o ',pathout)
+
+if procnum < 1:
+   print('Need some files to collate! procnum = ',procnum)
+   sys.exit(11)
+
+icu = []
+times = []
+#
+# Loop through all distributed datasets to obtain the complete list
+# of iceberg identification numbers and timesteps
+#
+for n in range(procnum):
+    nn = '%4.4d' % n
+    fw = Dataset(pathstart+nn+'.nc')
+    # keep a list of the variables in the first dataset
+    if n == 0:
+        varlist = fw.variables
+    #
+    # skip any files with no icebergs
+    if len(fw.dimensions['n']) > 0:
+        print pathstart+nn+'.nc'
+        ic = fw.variables['iceberg_number'][:,0]
+        ts = fw.variables['timestep'][:]
+        icv = np.unique(ic)
+        ts = np.unique(ts)
+        print('Min Max ts: ',ts.min(), ts.max())
+        print('Number unique icebergs= ',icv.shape[0])
+        icu.append(icv)
+        times.append(ts)
+    fw.close()
+#
+# Now flatten the lists and reduce to the unique spanning set
+#
+try:
+    icu = np.concatenate(icu)
+except ValueError:
+    # No icebergs: create an empty output file.
+    print 'No icebergs in the model.'
+    fw = Dataset(pathstart+'0000.nc')
+    fo = Dataset(pathout, 'w', format='NETCDF4_CLASSIC')
+    ntrj = fo.createDimension('ntraj', None)
+    icbn = fo.createVariable('iceberg_number', 'i4',('ntraj'))
+    n = 0
+    for key, value in varlist.iteritems() :
+        if key != "iceberg_number" :
+            print 'key is ',key
+            oout = fo.createVariable(key, value.dtype, ('ntraj'),
+                                 zlib=True, complevel=1)
+            oout.long_name = fw.variables[key].getncattr('long_name')
+            oout.units = fw.variables[key].getncattr('units')
+            n = n + 1
+    fw.close()
+    fo.close()    
+    sys.exit()
+
+icu = np.unique(icu)
+times = np.concatenate(times)
+times = np.unique(times)
+ntraj = icu.shape[0]
+print(ntraj, ' unique icebergs found across all datasets')
+print('Icebergs ids range from: ',icu.min(), 'to: ',icu.max())
+print('times range from:        ',times.min(), 'to: ', times.max())
+#
+# Declare array to receive data from all files
+#
+nt = times.shape[0]
+#
+n=0
+for key, value in varlist.iteritems() :
+    if key != "iceberg_number" :
+        n = n + 1
+inarr = np.zeros((n, ntraj, nt))
+#
+# initially fill with invalid data
+#
+inarr.fill(np.nan)
+#
+# Declare some lists to store variable names, types and long_name and units attributes
+# iceberg_number gets special treatment
+innam = []
+intyp = []
+inlngnam = []
+inunits = []
+for key, value in varlist.iteritems() :
+    if key != "iceberg_number" :
+        innam.append(key)
+#
+# reopen the first datset to collect variable attributes
+# (long_name and units only)
+#
+nn = '%4.4d' % 0
+fw = Dataset(pathstart+nn+'.nc')
+for key, value in varlist.iteritems() :
+    if key != "iceberg_number" :
+        intyp.append(fw.variables[key].dtype)
+        inlngnam.append(fw.variables[key].getncattr('long_name'))
+        inunits.append(fw.variables[key].getncattr('units'))
+fw.close()
+#
+# loop through distributed datasets again, this time
+# checking indices against icu and times lists and
+# inserting data into the correct locations in the 
+# collated sets.
+#
+for n in range(procnum):
+    nn = '%4.4d' % n
+    fw = Dataset(pathstart+nn+'.nc')
+#
+# Note many distributed datafiles will contain no iceberg data
+# so skip quickly over these
+    m  = len(fw.dimensions['n'])
+    if m > 0:
+        inx = np.zeros(m, dtype=int)
+        tsx = np.zeros(m, dtype=int)
+        #print pathstart+nn+'.nc'
+        ic = fw.variables['iceberg_number'][:,0]
+        ts = fw.variables['timestep'][:]
+        for k in range(m):
+            inxx   = np.where(icu == ic[k])
+            inx[k] = inxx[0]
+        for k in range(m):
+            inxx   = np.where(times == ts[k])
+            tsx[k] = inxx[0]
+        n = 0
+        for key, value in varlist.iteritems() :
+            if key != "iceberg_number" :
+                insmall = fw.variables[innam[n]][:]
+                inarr[n,inx[:],tsx[:]] = insmall[:]
+                n = n + 1
+    fw.close()
+#
+# Finally create the output file and write out the collated sets
+#
+fo = Dataset(pathout, 'w', format='NETCDF4_CLASSIC')
+ntrj = fo.createDimension('ntraj', ntraj)
+nti  = fo.createDimension('ntime', None)
+icbn = fo.createVariable('iceberg_number', 'i4',('ntraj'))
+icbn[:] = icu
+n = 0
+for key, value in varlist.iteritems() :
+    if key != "iceberg_number" :
+        oout = fo.createVariable(innam[n], intyp[n], ('ntraj','ntime'),
+                                 zlib=True, complevel=1, chunksizes=(1,nt))
+        oout[:,:] = inarr[n,:,:]
+        oout.long_name = inlngnam[n]
+        oout.units = inunits[n]
+        n = n + 1
+fo.close()
Index: /utils/tools_ticket2413/MISCELLANEOUS/make_usp_tar.sh
===================================================================
--- /utils/tools_ticket2413/MISCELLANEOUS/make_usp_tar.sh	(revision 12863)
+++ /utils/tools_ticket2413/MISCELLANEOUS/make_usp_tar.sh	(revision 12863)
@@ -0,0 +1,235 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+# ===============
+# make_usp_tar.sh
+# ===============
+# ---------------
+# Fetch and tar a unsupported configuration setup.
+# This script is only needed when target systems do
+# not have wget access to the internet. To configure
+# unsupported conigurations on these systems it will
+# first be necessary to run this script on a system that
+# does have access. Then copy access the resulting tar file,
+# unpack and run the enclosed set_local_uspcfg script in a 
+# bash shell to complete the process. That script redefines/
+# defines wget as a bash function to perform local copies 
+# from this unpacked tarball. If you wish to create a new 
+# configuration based on this local copy of an unsupported 
+# configuration in future sessions then you may need to 
+# redefine wget again before running makenemo with the 
+# appropriate -u setting. A simple script: def_wget is included
+# for such situations.
+# ---------------
+# SYNOPSIS
+# ========
+#  $ make_usp_tar.sh uspcfg.txt target_conf target_dir
+# Note target_dir.tar will be created
+#
+# DESCRIPTION
+# ===========
+# - Extract target configuration details from uspcfg.txt
+# - Create target directory
+# - Recursively use wget to retrieve remote configuration files
+#   into target directory
+# - Copy uspcfg.txt into target directory and alter remote paths
+#   to local (relative) versions
+# - tar target_directory and remove originals
+#----------------------------------------------------------------
+#
+#----------------------------------------------------------------
+# Check the correct number of arguments have been provided
+#----------------------------------------------------------------
+#
+   if [ "$#" != "3" ]; then
+    echo "Expected usage: make_usp_tar.sh uspcfg.txt target_conf target_dir"
+    exit
+   fi
+#
+#----------------------------------------------------------------
+# Check the named uspcfg.txt file exists
+#----------------------------------------------------------------
+#
+   if [ ! -f $1 ]; then
+    echo "named uspcfg.txt file does not exist ($1); attempt abandoned"
+    exit
+   fi
+#
+#----------------------------------------------------------------
+# Check the requested configuration is listed in the named uspcfg.txt file
+#----------------------------------------------------------------
+#
+   inthere=$( grep -c "$2" $1 )
+   if [ "$inthere" -lt 1 ]; then
+    echo "requested configuration is not in named uspcfg.txt file ($2); attempt abandoned"
+    exit
+   fi
+#
+#----------------------------------------------------------------
+# Create the target directory if it does not already exist
+# and cd into it
+#----------------------------------------------------------------
+#
+   if [ ! -d $3 ]; then
+    mkdir $3
+   else
+    echo "target directory already exists; attempt abandoned"
+    exit
+   fi
+   basedir=$(pwd)
+#
+   cd ${3}
+#
+#----------------------------------------------------------------
+# Copy named uspcfg.txt file into target directory
+#----------------------------------------------------------------
+#
+   cp $basedir/$1 .
+#
+#----------------------------------------------------------------
+# Extract information on target configuration and
+# retrieve full file list from remote server
+#----------------------------------------------------------------
+#
+   grep "$2 " $1 > ./cfg.tmp
+#
+   LOCAL_REF=$(cat cfg.tmp | awk 'BEGIN {FS = "#" }{print $2}')
+   TAB=$(cat cfg.tmp | awk 'BEGIN {FS = "#" }{print $3}')
+   REMOTE_CTL=$(cat cfg.tmp | awk 'BEGIN {FS = "#" }{print $4}')
+   wget ${REMOTE_CTL} -O remote_file.list
+#
+#----------------------------------------------------------------
+# Retrieve each remote file and create local directory structure
+# At the same time prepare a local version of the control file
+# by replacing http links with a string that will be replaced later
+# with a local directory path
+#----------------------------------------------------------------
+#
+   if [ -f remote_file.list ] ; then
+    cat remote_file.list | grep -v '^#' |
+     while
+      read remfile locfile
+      do
+       if [ $remfile == 'create_directory' ] ;then
+         mkdir $locfile
+         echo $remfile "                 " $locfile >> local_template.ctl
+       else
+         wget $remfile -O $locfile
+         remfile=$(echo $remfile | sed -e "s;.*$locfile;SET_LOCAL_DIRECTORY_HERE/$locfile;")
+         echo $remfile "  " $locfile >> local_template.ctl
+       fi
+      done
+   else
+    echo "Unable to find remote_file.list. Attempt abandoned"
+    echo "Files may be left in "$(pwd)
+    exit
+   fi
+#
+#----------------------------------------------------------------
+# Construct a modified version of the named uspcfg.txt file
+# First copy across all the other untouched configuration listed
+#----------------------------------------------------------------
+#
+   grep -v "$2 " $1 >  uspcfg_local_template.txt
+#
+#----------------------------------------------------------------
+# Now append the modified entry, replacing http links as before
+#----------------------------------------------------------------
+#
+   cat cfg.tmp | sed -e "s;http.*$;SET_LOCAL_DIRECTORY_HERE/local.ctl;" >> uspcfg_local_template.txt
+#
+#
+#----------------------------------------------------------------
+# Construct a script that can be used later to complete a local installation
+#----------------------------------------------------------------
+#
+cat > set_local_uspcfg << EOF
+#!/bin/bash
+   if [ "\$( echo $SHELL | grep -c bash )" -lt 1 ]; then
+    echo "WARNING: This is only going to be effective in a bash shell"
+    echo "since it redefines the wget command as a bash function."
+    echo "(ignore this comment if you are in a bash shell)"
+   fi
+   basedir=\$(pwd)
+#
+   echo "Enter full path to the CONFIG directory on your target system: "
+   read confdir
+#
+# Edit the local.ctl file to set the local directory path
+#
+   sed -e "s;SET_LOCAL_DIRECTORY_HERE;\$basedir;" local_template.ctl > local.ctl
+#
+# Edit the uspcfg_local.txt file to set the local directory path
+#
+   sed -e "s;SET_LOCAL_DIRECTORY_HERE;\$basedir;" uspcfg_local_template.txt > uspcfg_local.txt
+#
+# Install local versions in the named CONFIG directory
+#
+   if [ -f \$confdir/uspcfg.txt ] && [ ! -L \$confdir/uspcfg.txt ]; then
+    mv \$confdir/uspcfg.txt \$confdir/uspcfg_remote.txt
+    echo "\$confdir/uspcfg.txt moved to \$confdir/uspcfg_remote.txt"
+   fi
+   if [ -f \$confdir/uspcfg_local.txt ]; then
+    echo "Existing uspcfg_local.txt file found in \$confdir"
+    echo "This has been moved to: "\$confdir/uspcfg_local.txt\$\$
+    mv \$confdir/uspcfg_local.txt \$confdir/uspcfg_local.txt\$\$
+   fi
+   mv uspcfg_local.txt \$confdir/uspcfg_local.txt
+   ln -s \$confdir/uspcfg_local.txt \$confdir/uspcfg.txt
+#
+# define/redefine the wget command
+#
+function wget {
+   if [ "\$2" != "-O" ]; then
+    echo "Expected wget usage: wget src -O dest"
+    echo "-O not found. No action taken"
+   else
+    cp \$1 \$3
+   fi
+}
+export -f wget
+EOF
+#----------------------------------------------------------------
+# Construct a script that can be used later to just redefine wget 
+# in bash shell sessions
+#----------------------------------------------------------------
+#
+cat > def_wget << EOFC
+#!/bin/bash
+   if [ "\$( echo $SHELL | grep -c bash )" -lt 1 ]; then
+    echo "WARNING: This is only going to be effective in a bash shell"
+    echo "since it redefines the wget command as a bash function."
+    echo "(ignore this comment if you are in a bash shell)"
+   fi
+function wget {
+   if [ "\$2" != "-O" ]; then
+    echo "Expected wget usage: wget src -O dest"
+    echo "-O not found. No action taken"
+   else
+    cp \$1 \$3
+   fi
+}
+export -f wget
+EOFC
+#----------------------------------------------------------------
+# Make sure these scripts have execute permission
+#----------------------------------------------------------------
+   chmod 755 set_local_uspcfg
+   chmod 755 def_wget
+#
+#----------------------------------------------------------------
+# Tidy up and tar the contents of the downloaded configuration
+#----------------------------------------------------------------
+   rm cfg.tmp
+   cd $basedir
+   tar cvf ${3}.tar $3
+   echo ${3}.tar " file successfully created and prepared for local references. Move this"
+   echo "tar file to your target system, unpack and run the set_local_uspcfg script in a "
+   echo "bash shell to complete the process. This script redefines/defines wget as a bash"
+   echo "function to perform local copies from this unpacked tarball. If you wish to create"
+   echo "a new configuration based on this local copy of an unsupported configuration in "
+   echo "future sessions then you may need to rerun the def_wget script"
+exit
Index: /utils/tools_ticket2413/MPP_PREP/README.rst
===================================================================
--- /utils/tools_ticket2413/MPP_PREP/README.rst	(revision 12863)
+++ /utils/tools_ticket2413/MPP_PREP/README.rst	(revision 12863)
@@ -0,0 +1,185 @@
+============
+MPP_PREP
+============
+
+Description
+===========
+MPP_PREP proposes possible domain decompositions for a given 
+bathymetric file, which is particularly intersting when
+we want to eliminate land-only domain. 
+All solution are proposed and written to output file.
+The ratio between the effective number of computed 
+point and the total number of points in the domain is 
+given and is probably a major criteria for choosing a 
+domain decomposition.
+
+Tools mpp_optimiz_zoom_nc.exe as been tested on one eORCA12 and one eORCA025 configuration at trunk@10036
+
+Tools mppopt_showproc_nc.exe has not been tested.
+
+Method
+======
+Use mpp_init like code for setting up the decomposition
+and evaluate the efficiency of the decomposition.
+
+How to compile it
+=================
+MPP_PREP is compiled in the same manner as all the other tools. 
+The compilation script is maketools and the option are very similar to makenemo. 
+
+Here an example of how to compile MPP_PREP on the MetOffice XC40 HPC:
+
+.. code-block:: console
+                      
+        $ ./maketools -n MPP_PREP -m XC40_METO
+
+Usage
+=====
+
+the MPP_PREP executable is named mpp_optimiz_zoom_nc.exe. The input file needed are:
+
+ * a netcdf file containing a variable with 0 on land and data > 0 on ocean (typically a bathymetry file)
+
+ * a namelist to specify the number of vertical levels, netcdf input file, variable and dimension names (...).
+   A namelist template is available in the file 'namelist'. Default namelist is set up for input file domain_cfg.nc (output of Domaincfg tool)
+   and will find decomposition between 100 and 4000 processors.
+
+.. code-block:: console
+
+ $ ./mpp_optimiz_zoom_nc.exe -h
+   usage : mpp_optimize [ -h ]  [-keep jpni jpnj] [ -o file out ] 
+                [ -modulo val ] [-r ratio] [-minocean procs] -n namelist
+       
+      PURPOSE :
+          This program is build to optimize the domain beakdown into
+          subdomain for mpp computing.
+          Once the grid size, and the land/sea mask is known, it looks
+          for all the possibilities within a range of setting parameters
+          and determine the optimal.
+ 
+          Optimization is done with respect to the maximum number of
+          sea processors and to the maximum numbers of procs (nn_procmax)
+                 
+          Optional optimization can be performed taking into account
+          the maximum available processor memory rn_ppmcal. This is
+          activated if ln_memchk is set true in the namelist
+       
+          Additional criteria can be given on the command line to reduce
+          the amount of possible choices.
+       
+      ARGUMENTS :
+          -n namelist : indicate the name of the namelist to use
+       
+      OPTIONS :
+          -h : print this help message
+          -keep jpni jpnj : print a file suitable for plotting,
+                  corresponding to the given decomposition
+          -o output file : give the name of the output file
+                  default is processor.layout
+          -modulo val : only retain decomposition whose total number
+                  of util processors (sea) are a multiple of val
+          -r ratio : only retain decomposition with a ratio computed/global
+                  less or equal to the given ratio
+          -minocean procs : only retain decomposition with a number of 
+                  ocean procs greater of equal to procs
+       
+      REQUIRED FILES :
+        A bathymetric file and an ad-hoc namelist are required.
+        The file name of the bathymetry is specified in the namelist
+       
+      OUTPUT : 
+        processor.layout : an ascii file with all found possibilities
+       
+      SEE ALSO :
+        script screen.ksh helps a lot in the analysis of the output file.
+       
+ STOP  
+
+Example
+=======
+
+Here is an example of usage of ./mpp_optimiz_zoom_nc.exe on the the eORCA025 bathymetry. We keep in the output only domain decomposition with a ratio (computed/global) lower than 1, using namelist_eORCA025 and output the list of domain decomposition in processor.layout_eORCA025
+
+.. code-block:: console
+
+ $ ./mpp_optimiz_zoom_nc.exe -r 1 -n namelist_eORCA025 -o processor.layout_eORCA025
+ 
+  ocean/land file used is: domcfg_eORCA025.nc
+  variable used to find ocean domain is: bottom_level
+  Dimensions (jpi x jpj) are:  1442 x 1207
+ 
+ Loop over all the decompositions (can take a while) ...
+ 
+ STOP
+
+The output for one specific decomposition contains this information:
+
+.. code-block:: console
+
+  iresti= 14  irestj= 9
+ --> Total number of domains  1612
+
+  jpni= 31  jpnj= 52
+  jpi=  49  jpj=  26
+  Number of ocean processors        1074
+  Number of land processors         538
+  Mean ocean coverage per domain    0.7542637596508307
+  Minimum ocean coverage            7.849293761E-4
+  Maximum ocean coverage            1.
+  nb of proc with coverage         < 10 %  68
+  nb of proc with coverage 10 < nb < 30 %  99
+  nb of proc with coverage 30 < nb < 50 %  59
+  Number of computed points         1368276
+  Overhead of computed points       -372218
+  % sup (computed / global)         0.786142349
+
+Sorting phase
+=============
+The processor.layout can be very long and hard to exploit.
+To sort out what is the best model decomposition for a specific application, there is a suggestion at the end of the processor.layout file. Otherwise you can use the python script find_layout.py to dig into it.
+
+.. code-block:: console
+
+ $ python2.7 find_layout.py                                                       
+ usage: find_layout.py [-h] -f layout_file --rmax max_ratio --noce min/max_noce
+
+Below an example to extract all decomposition with a ratio (computed/global) < 0.8 and a number of ocean domain between 300 and 350. All the decomposition fitting the criterions are listed. At the end, a summary of the one with the smallest ratio, the largest number of ocean domains and the smallest computed domain.
+
+.. code-block:: console
+
+ $ python2.7 find_layout.py -f processor.layout_eORCA025 --rmax 0.8 --noce 300 350
+ Domain decomposition 0
+ domain decomposition (jpni, jpnj) = (13, 32)
+ number of ocean domain            = 300
+ ratio computed/global             = 0.779089153
+ domain size (jpi, jpj)            = (113, 40)
+ ...
+ Domain decomposition 76
+ domain decomposition (jpni, jpnj) = (37, 13)
+ number of ocean domain            = 350
+ ratio computed/global             = 0.783254623
+ domain size (jpi, jpj)            = (41, 95)
+ 
+ =====================================================================
+ 
+ Among the layouts fitting the constraint on : ratio (computed/global) < 0.8 and 300 <= number of ocean domain <= 350
+
+  3 layouts are highlighted : 
+
+ Domain decomposition SMALLEST RATIO
+ domain decomposition (jpni, jpnj) = (24, 18)
+ number of ocean domain            = 310
+ ratio computed/global             = 0.761956096
+ domain size (jpi, jpj)            = (62, 69)
+ 
+ Domain decomposition LARGEST NUMBER OF OCEAN DOMAINS
+ domain decomposition (jpni, jpnj) = (21, 23)
+ number of ocean domain            = 350
+ ratio computed/global             = 0.785265565
+ domain size (jpi, jpj)            = (71, 55)
+ 
+ Domain decomposition SMALLEST COMPUTED DOMAIN
+ domain decomposition (jpni, jpnj) = (18, 27)
+ number of ocean domain            = 350
+ ratio computed/global             = 0.775009871
+ domain size (jpi, jpj)            = (82, 47)
Index: /utils/tools_ticket2413/MPP_PREP/find_layout.py
===================================================================
--- /utils/tools_ticket2413/MPP_PREP/find_layout.py	(revision 12863)
+++ /utils/tools_ticket2413/MPP_PREP/find_layout.py	(revision 12863)
@@ -0,0 +1,220 @@
+"""
+ script to sort and select processor layout from MPP_PREP output
+ wrote by P. Mathiot 10/2018
+"""
+
+# import module
+from __future__ import print_function
+import argparse
+import sys
+
+# define class layout
+class layout(object):
+    """
+    Class containing all the information about a specific model layout
+   
+    Output:
+    self.jpnij = (i domain along i dimension, j domain along j dimension, total number of domain (land+ocean))
+    self.nproc = (total number of domain (land+ocean), n ocean domain, nland domain)
+    self.jpij  = (dimension along i, dimension along j) of a domain
+    self.ratio = (total computed point, overhead, ratio computed point / global)
+    """
+    def __init__(self, txtlst):
+        """
+        Initialisation of a layout class object:
+
+        Input: list of string containing 1 layout description 
+           extracted from the processor layout file
+        """
+        self.jpnij = extract_jpnij(txtlst)  # (jpni, jpnj, jpnij)
+        self.nproc = extract_nproc(txtlst)  # (ntot, noce, nland)
+        self.jpij = extract_jpij(txtlst)    # (jpi , jpj)
+        self.ratio = extract_point(txtlst)  # (total computed point, overhead, ratio computed point / global)
+
+    def test_criterion(self, rmax, nocemin, nocemax):
+        """
+        function to decide if yes or no a specific layout has to be selected
+        Input: 
+        float rmax: maximal ratio (computed/global) accepted
+        int   nocemin and nocemax: range of number of ocean processor accepted
+
+        output: logical
+        """
+        if ( nocemin <= self.nproc[1] <= nocemax ) and ( self.ratio[2] <= rmax ):
+            return True
+        else:
+            return False
+
+    def print_layout(self, cidx):
+        """
+        function to print specific information about a specific layout
+        """
+        print( 'Domain decomposition {}'.format(cidx) )
+        print( 'domain decomposition (jpni, jpnj) = {}'.format((self.jpnij[0], self.jpnij[1])) )
+        print( 'number of ocean domain            = {}'.format(self.nproc[1]) )
+        print( 'ratio computed/global             = {}'.format(self.ratio[2]) )
+        print( 'domain size (jpi, jpj)            = {}'.format(self.jpij) )
+        print('')
+
+# define sorting function
+def noce_proc(elem):
+    """
+    function used as key to sort list of layout 
+    by number of ocean domain in the list sorting algorithm
+    """
+    return elem.nproc[1]
+
+def ratio_proc(elem):
+    """
+    function used as key to sort list of layout 
+    by ratio (computed/global) in the list sorting algorithm
+    """
+    return elem.ratio[2]
+
+def jpij_proc(elem):
+    """
+    function used as key to sort list of layout 
+    by domain size in the list sorting algorithm
+    """
+    return elem.jpij[0]*elem.jpij[1]
+
+# txt extraction function to feed class layout
+def extract_jpnij(txtlst):
+    """
+    function to extract total number of domain
+    for a specific domain layout txt output
+
+    Input: list of string containing 1 layout description 
+           extracted from the processor layout file
+    
+    Output: tuple (jpni, jpnj, jpni*jpnj)
+    """
+    jpnij = int(txtlst[1].split()[-1])
+    ctmp = txtlst[3].split()
+    jpni = int(ctmp[1])
+    jpnj = int(ctmp[3])
+    return (jpni, jpnj, jpnij)
+
+def extract_nproc(txtlst):
+    """
+    function to extract total number of ocean domain
+    for a specific domain layout txt output
+    
+    Input: list of string containing 1 layout description 
+           extracted from the processor layout file
+    
+    Output: tuple (jpni*jpnj, n oce domain, n land domain)
+    """
+    ntot = int(txtlst[1].split()[-1])
+    noce = int(txtlst[5].split()[-1])
+    nland = int(txtlst[6].split()[-1])
+    return (ntot, noce, nland)
+
+def extract_jpij(txtlst):
+    """
+    function to extract domain dimension
+    for a specific domain layout txt output
+
+    Input: list of string containing 1 layout description 
+           extracted from the processor layout file
+
+    Output: tuple (jpi, jpj)
+    """
+    ctmp = txtlst[4].split()
+    jpi = int(ctmp[1])
+    jpj = int(ctmp[3])
+    return (jpi, jpj)
+
+def extract_point(txtlst):
+    """
+    function to extract ration (computed/global)
+    for a specific domain layout txt output
+
+    Input: list of string containing 1 layout description 
+           extracted from the processor layout file
+
+    Output: tuple (total number of point, overhead, ratio (computed/global))
+    """
+    npoint = int(txtlst[13].split()[-1])
+    noverh = int(txtlst[14].split()[-1])
+    ratio = float(txtlst[15].split()[-1])
+    return (npoint, noverh, ratio)
+
+# main
+def main():
+    """
+    script to sort and select processor layout from MPP_PREP output based on user constrains
+    """
+   
+    parser = argparse.ArgumentParser()
+    parser.add_argument("-f", metavar='layout_file' , help="names of domain layout file to sort", type=str, nargs=1, required=True)
+    parser.add_argument("--rmax", metavar='max_ratio' , help="max ratio allowed (computed/global)", type=float, nargs=1, required=True)
+    parser.add_argument("--noce", metavar='min/max_noce' , help="min and max number of ocean domain allowed", type=int, nargs=2, required=True)
+    
+    args = parser.parse_args()
+    
+    # read file
+    filein = args.f[0]
+    fid = open(filein,"r") #opens file with name of "test.txt"
+    txtdata = []
+    for cline in fid:
+        txtdata.extend([cline])
+
+    # skip header and tail of file
+    txtdata = txtdata[4:-20]
+    
+    # loop on different domain decomposition
+    ilinepl = 17 # number of line of a specific decomposition
+    ilayout = 0
+    lst_layout = []
+    ratio_min = 9999.0
+    noce_min = 9999999
+    noce_max = 0
+    for iline in range(0, len(txtdata)):
+        if iline % ilinepl == 0:
+            # initialise layout
+            conf_layout = layout( txtdata[iline:iline+ilinepl] )
+            ratio_min = min( conf_layout.ratio[2], ratio_min )           
+            noce_min = min( conf_layout.nproc[1], noce_min )           
+            noce_max = max( conf_layout.nproc[1], noce_max )           
+ 
+            # select layout based on condition
+            if conf_layout.test_criterion(args.rmax[0], args.noce[0], args.noce[1]): 
+                ilayout = ilayout + 1
+                lst_layout.extend([conf_layout])
+
+    if lst_layout == []:
+        print('')
+        print( 'E R R O R: constrains are too strong, no domain are found' )
+        print('')
+        if ratio_min > args.rmax[0] :
+            print( 'min ratio is      {} and you ask for a ratio smaller than {}'.format(ratio_min, args.rmax[0]) )
+        if noce_min > args.noce[1] :
+            print( 'min ocean proc is {} and you ask for a number of ocean proc lower than {}'.format(noce_min, args.noce[1]) )
+        if noce_max < args.noce[0] :
+            print( 'max ocean proc is {} and you ask for a number of ocean proc larger than {}'.format(noce_max, args.noce[0]) )
+        print('')
+        sys.exit()
+    
+    lst_layout.sort(key=noce_proc)
+    for idx, ilayout in enumerate(lst_layout):
+        ilayout.print_layout(str(idx))
+    
+    print( '=====================================================================' )
+    print('')
+    print( 'Among the layouts fitting the constraint on : ratio (computed/global) < {} and {} <= number of ocean domain <= {}' \
+        .format(args.rmax[0], args.noce[0], args.noce[1]) )
+    print('')
+    print( ' 3 layouts are highlighted : ' )
+    print('')
+    lst_layout.sort(key=ratio_proc)
+    lst_layout[0].print_layout('SMALLEST RATIO')
+#
+    lst_layout.sort(key=noce_proc)
+    lst_layout[-1].print_layout('LARGEST NUMBER OF OCEAN DOMAINS')
+#
+    lst_layout.sort(key=jpij_proc)
+    lst_layout[0].print_layout('SMALLEST COMPUTED DOMAIN')
+    
+if __name__ == "__main__":
+    main()
Index: /utils/tools_ticket2413/MPP_PREP/namelist
===================================================================
--- /utils/tools_ticket2413/MPP_PREP/namelist	(revision 12863)
+++ /utils/tools_ticket2413/MPP_PREP/namelist	(revision 12863)
@@ -0,0 +1,47 @@
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!  MPP_OPTIMIZE namelist template
+! -------------------------------
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!'''''''''''''''''''''''''''''''''''''''''
+!       namspace  spatial indexes
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+&namspace
+    nn_jpk   = 75           ! number of vertical level
+    nn_izoom = 1            ! i-index of point (1,1) of the zoomed region/ jpidta
+    nn_jzoom = 1            ! j-index of point (1,1) of the zoomed region/ jpjdta
+/
+!'''''''''''''''''''''''''''''''''''''
+!      namproc
+!''''''''''''''''''''''''''''''''''''
+&namproc
+     nn_procmax = 4000      ! maximum number of proc to look for
+     nn_procmin = 100       ! minimum number of proc 
+     ln_memchk  = .false.   ! optimization of memory
+/
+!''''''''''''''''''''''''''''''''''''''
+!      namparam
+!''''''''''''''''''''''''''''''''''''''
+&namparam
+   rn_ppmcal = 225000000.    ! maximum memory for 1 processor
+   rn_ppmin  = 0.4           ! minimum ratio for filling the available memory
+   rn_ppmax  = 0.9           ! maximum ratio for filling the available memory
+/
+!'''''''''''''''''''''''''''''''''''''''
+!      namfile  of filename
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+&namfile
+     cn_fbathy = 'domain_cfg.nc'  ! bathy file name
+     cn_var    = 'bottom_level'   ! Bathy variable name
+     cn_x      = 'x'              ! bathy x dimension name
+     cn_y      = 'y'              ! bathy y dimension name
+     ln_zps    = .true.           ! partial step flag
+/
+!
+!''''''''''''''''''''''''''''''''''''''
+!      namkeep  option -keep.  Specify the root name of the overdata file
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+&namkeep
+    cn_fovdta = 'domain_cfg'   ! Root for the overdata file name
+                               ! complete name will be {covdta}.{jpni}x{jpnj}_{jpnij}
+/
Index: /utils/tools_ticket2413/MPP_PREP/src/mpp_optimiz_zoom_nc.f90
===================================================================
--- /utils/tools_ticket2413/MPP_PREP/src/mpp_optimiz_zoom_nc.f90	(revision 12863)
+++ /utils/tools_ticket2413/MPP_PREP/src/mpp_optimiz_zoom_nc.f90	(revision 12863)
@@ -0,0 +1,535 @@
+PROGRAM mpp_optimize
+   !!======================================================================
+   !!                     ***  PROGRAM  mpp_optimize  ***
+   !!=====================================================================
+   !!  ** Purpose : Propose possible domain decompositions for a given 
+   !!               bathymetric file, which is particularly intersting when
+   !!               we want to eliminate land-only domain. 
+   !!               All solution are proposed and written to output file.
+   !!               The ratio between the effective number of computed 
+   !!               point and the total number of points in the domain is 
+   !!               given and is probably a major criteria for choosing a 
+   !!               domain decomposition.
+   !!
+   !!  ** Method  : Use mpp_init like code for seting up the decomposition
+   !!               and evaluate the efficiency of the decomposition.
+   !! History
+   !!       original  : 95-12 (Imbard M) for OPA8.1, CLIPPER
+   !!       f90       : 03-06 (Molines JM), namelist as input
+   !!                 : 05-05 (Molines JM), bathy in ncdf
+   !!                 : 13-03 (Molines JM), Nemo-like coding and license.
+   !!                 : 18-10 (Mathiot  P), upgrade the NEMO 4.0
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   routines      : description
+   !!----------------------------------------------------------------------
+
+
+   !!----------------------------------------------------------------------
+   !! MPP-PREP, MEOM 2013
+   !! $Id$
+   !! Copyright (c) 2013, J.-M. Molines
+   !! Software governed by the CeCILL licence (Licence/MPP-PREPCeCILL.txt)
+   !!----------------------------------------------------------------------
+   USE netcdf
+
+   IMPLICIT NONE
+
+   INTEGER, PARAMETER :: jpreci=1 ,jprecj=1   !: overlap between processors
+
+   ! Namelist declaration and definition
+   ! -----------------------------------
+   INTEGER ::  nn_procmax  =250    !: maximum number of proc. (Read from namelist)
+   INTEGER ::  nn_procmin  = 1     !: maximum number of proc. (Read from namelist)
+   LOGICAL ::  ln_memchk = .FALSE. ! add a memory constraint if true (obsolete)
+   NAMELIST /namproc/ nn_procmax, nn_procmin, ln_memchk
+   !
+   INTEGER ::  nn_jpk = 46   !: vertical levels 
+   INTEGER ::  nn_izoom = 1  !: I zoom indicator
+   INTEGER ::  nn_jzoom = 1  !: J zoom indicator
+   NAMELIST /namspace/ nn_jpk, nn_izoom, nn_jzoom
+   !
+   ! Following variables are used only if ln_memchk=.true.
+   REAL(KIND=4) ::  required_memory, rppmpt !: not in namelist working array
+   REAL(KIND=4) ::  rn_ppmcal = 225000000. !: maximum memory of one processor for a 
+   !: given machine (in 8 byte words)
+   REAL(KIND=4) ::  rn_ppmin  = 0.4        !: minimum ratio to fill the memory
+   REAL(KIND=4) ::  rn_ppmax = 0.9         !: maximum ratio to fill the memory
+   NAMELIST /namparam/ rn_ppmcal, rn_ppmin, rn_ppmax
+   !
+   CHARACTER(LEN=80) :: cn_var='none'   !: Variable name of the bathymetry
+   CHARACTER(LEN=80) :: cn_x='x'        !: X dimension name
+   CHARACTER(LEN=80) :: cn_y='y'        !: Y dimension name
+   CHARACTER(LEN=80) :: cn_fbathy       !: File name of the netcdf bathymetry (namelist)
+   LOGICAL           :: ln_zps=.FALSE.  !: Logical flag for partial cells.
+   NAMELIST /namfile/ cn_fbathy, cn_var, cn_x, cn_y,  ln_zps
+   !
+   CHARACTER(LEN=80) :: cn_fovdta     !: root file name for keep output
+   NAMELIST /namkeep/ cn_fovdta
+   !
+   INTEGER            :: numnam = 4       ! logical unit for namelist
+   INTEGER            :: numout = 10        ! logical unit for output
+   INTEGER            :: npiglo, npjglo   ! domain size
+   INTEGER            :: npidta, npjdta   ! domain size
+
+   INTEGER            :: ji, jj, jni, jnj ! dummy loop index
+   INTEGER            :: ii, ij, jjc  ! dummy loop index
+   INTEGER            :: narg, iargc, ijarg      ! browsing command line
+
+   ! Decomposition related arrays (using same meaning than in NEMO)
+   INTEGER, DIMENSION(:,:), ALLOCATABLE :: ilci, ilcj ,iimppt, ijmppt
+   INTEGER, DIMENSION(:)  , ALLOCATABLE :: nlei_ocea, nldi_ocea
+   INTEGER, DIMENSION(:)  , ALLOCATABLE :: nlej_ocea, nldj_ocea
+   INTEGER, DIMENSION(:)  , ALLOCATABLE :: nlei_land, nldi_land
+   INTEGER, DIMENSION(:)  , ALLOCATABLE :: nlej_land, nldj_land
+   INTEGER                              :: nimpp, njmpp
+   INTEGER                              :: nreci, nrecj
+   INTEGER                              :: ili, ilj
+   INTEGER                              :: jarea, iarea, iarea0
+   INTEGER                              :: iresti, irestj
+   !
+   INTEGER :: ioce, isurf             !: number of ocean points cumulated, per_proc
+   INTEGER :: ioce_opt                !: number of ocean points cumulated for optimal case
+   INTEGER :: nland, nocea, nvalid    !: number of land, ocean, memory_valid  procs 
+   INTEGER :: nland_opt               !: optimal number of land procs
+   INTEGER :: ii1, ii2, ij1, ij2      !: limit of subdomain in global domain
+   INTEGER :: jpimax,     jpjmax            !: size of sub domain
+   INTEGER :: jpimax_opt, jpjmax_opt        !: size of sub domain for optimal case
+   INTEGER :: inf10,     inf30,     inf50      !: 
+   INTEGER :: inf10_opt, inf30_opt, inf50_opt  !:  in optimal case
+   INTEGER :: npni_opt, npnj_opt      !: optimal domain decomposition
+
+   INTEGER :: iminproci, imaxproci    !: limits of the processor loop
+   INTEGER :: iminprocj, imaxprocj    !: can be reduded to  nkeepi, nkeepj
+
+   ! Saving criteria
+   REAL(KIND=4) :: ratio_min=99999.   !: keep only decomposition with ration less than ratio_min
+   INTEGER      :: nocea_min = 1      !: minimum number of ocean procs for saving
+   INTEGER      :: nmodulo = 1        !: Only keep solution multiple of nmodulo
+   LOGICAL      :: ll_criteria=.TRUE. !:
+   !
+   REAL(KIND=4)                              ::  oce_cover
+   REAL(KIND=4)                              ::  oce_cover_min,     oce_cover_max,     ratio
+   REAL(KIND=4)                              ::  oce_cover_min_opt, oce_cover_max_opt, ratio_opt
+   REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE ::  tmask     ! npiglo x npjglo
+   REAL(KIND=4), DIMENSION(:,:), ALLOCATABLE ::  bathy     ! npidta x npjdta
+
+   ! CDF stuff
+   INTEGER :: ncid, istatus, id
+   LOGICAL ::  ll_good = .FALSE.
+
+   CHARACTER(LEN=80) :: cf_namlist='namelist'
+   CHARACTER(LEN=80) :: cf_out='processor.layout'
+   CHARACTER(LEN=80) :: cdum                       ! dummy character variable
+
+   ! Keep stuff      
+   LOGICAL ::  ll_keep = .FALSE.
+   INTEGER :: nkeepi, nkeepj          !: for option -keep : the retained decomposition
+  !
+
+   !!----------------------------------------------------------------------
+   narg=iargc()
+   ijarg=1
+   IF ( narg == 0 ) THEN
+      PRINT *,' try mpp_optimize -h for instructions !'
+      STOP
+   ENDIF
+   !
+   DO WHILE ( ijarg <= narg )
+      CALL getarg(ijarg,cdum) ; ijarg=ijarg+1
+      SELECT CASE ( cdum )
+      CASE ('-h') 
+         PRINT *,'  usage : mpp_optimize [ -h ]  [-keep jpni jpnj] [ -o file out ] '
+         PRINT *,'               [ -modulo val ] [-r ratio] [-minocean procs] -n namelist'
+         PRINT *,'      '
+         PRINT *,'     PURPOSE :'
+         PRINT *,'         This program is build to optimize the domain beakdown into'
+         PRINT *,'         subdomain for mpp computing.'
+         PRINT *,'         Once the grid size, and the land/sea mask is known, it looks'
+         PRINT *,'         for all the possibilities within a range of setting parameters'
+         PRINT *,'         and determine the optimal.'
+         PRINT *,''
+         PRINT *,'         Optimization is done with respect to the maximum number of'
+         PRINT *,'         sea processors and to the maximum numbers of procs (nn_procmax)'
+         PRINT *,'                '
+         PRINT *,'         Optional optimization can be performed taking into account'
+         PRINT *,'         the maximum available processor memory rn_ppmcal. This is'
+         PRINT *,'         activated if ln_memchk is set true in the namelist'
+         PRINT *,'      '
+         PRINT *,'         Additional criteria can be given on the command line to reduce'
+         PRINT *,'         the amount of possible choices.'
+         PRINT *,'      '
+         PRINT *,'     ARGUMENTS :'
+         PRINT *,'         -n namelist : indicate the name of the namelist to use'
+         PRINT *,'      '
+         PRINT *,'     OPTIONS :'
+         PRINT *,'         -h : print this help message'
+         PRINT *,'         -keep jpni jpnj : print a file suitable for plotting,'
+         PRINT *,'                 corresponding to the given decomposition'
+         PRINT *,'         -o output file : give the name of the output file'
+         PRINT *,'                 default is ',TRIM(cf_out)
+         PRINT *,'         -modulo val : only retain decomposition whose total number'
+         PRINT *,'                 of util processors (sea) are a multiple of val'
+         PRINT *,'         -r ratio : only retain decomposition with a ratio computed/global'
+         PRINT *,'                 less or equal to the given ratio'
+         PRINT *,'         -minocean procs : only retain decomposition with a number of '
+         PRINT *,'                 ocean procs greater of equal to procs'
+         PRINT *,'      '
+         PRINT *,'     REQUIRED FILES :'
+         PRINT *,'       A bathymetric file and an ad-hoc namelist are required.'
+         PRINT *,'       The file name of the bathymetry is specified in the namelist'
+         PRINT *,'      '
+         PRINT *,'     OUTPUT : '
+         PRINT *,'       ',TRIM(cf_out),' : an ascii file with all found possibilities'
+         PRINT *,'      '
+         STOP
+      CASE ('-n' )
+         CALL getarg(ijarg,cf_namlist) ; ijarg=ijarg+1
+      CASE ('-o' )
+         CALL getarg(ijarg,cf_out) ; ijarg=ijarg+1
+      CASE ('-keep' )
+         ll_keep=.TRUE.
+         CALL getarg(ijarg,cdum) ; ijarg=ijarg+1 ; READ( cdum,*) nkeepi
+         CALL getarg(ijarg,cdum) ; ijarg=ijarg+1 ; READ( cdum,*) nkeepj
+      CASE ('-modulo' )
+         CALL getarg(ijarg,cdum) ; ijarg=ijarg+1 ; READ( cdum,*) nmodulo
+      CASE ('-r' )
+         CALL getarg(ijarg,cdum) ; ijarg=ijarg+1 ; READ( cdum,*) ratio_min
+      CASE ('-minocean' )
+         CALL getarg(ijarg,cdum) ; ijarg=ijarg+1 ; READ( cdum,*) nocea_min
+      END SELECT
+   ENDDO
+
+   ! Open and read the namelist
+   OPEN(numnam,FILE=cf_namlist)
+   REWIND(numnam)
+   READ(numnam,namspace)
+
+   REWIND(numnam)
+   READ(numnam,namfile)
+
+   REWIND(numnam)
+   READ(numnam,namparam)
+
+   REWIND(numnam)
+   READ(numnam,namproc)
+
+   REWIND(numnam)
+   READ(numnam,namkeep)  ! only used for -keep option but still ...
+   CLOSE(numnam)
+
+   ! estimated code size expressed in number of 3D arrays (valid for OPA8.1) to be tuned for OPA9.0/Nemo
+   rppmpt = 55.+73./nn_jpk
+
+   ! Open bathy file an allocate required memory
+   INQUIRE( FILE=cn_fbathy, EXIST=ll_good )
+   IF( ll_good ) THEN
+      istatus = NF90_OPEN(cn_fbathy, NF90_NOWRITE, ncid)
+      istatus = NF90_INQ_DIMID(ncid, cn_x, id) ; istatus = NF90_INQUIRE_DIMENSION(ncid, id, len=npiglo)
+      istatus = NF90_INQ_DIMID(ncid, cn_y, id) ; istatus = NF90_INQUIRE_DIMENSION(ncid, id, len=npjglo)
+      npidta  = npiglo ; npjdta=npjglo
+   ELSE
+      PRINT *,' File missing : ', TRIM(cn_fbathy)
+      STOP 42
+   ENDIF
+
+   ALLOCATE (tmask(npiglo,npjglo), bathy(npidta,npjdta) )
+   ALLOCATE (ilci(nn_procmax,nn_procmax), ilcj(nn_procmax,nn_procmax) )
+   ALLOCATE (iimppt(nn_procmax,nn_procmax), ijmppt(nn_procmax,nn_procmax) )
+
+   ! Open output file for results
+   IF ( ll_keep ) THEN
+      nn_procmax = nkeepi*nkeepj  ! reduce nn_procmax
+      ! File will be open later
+   ELSE
+      OPEN(numout,FILE=cf_out)
+      WRITE(numout,*)
+      WRITE(numout,*) ' Domain decomposition optimization '
+      WRITE(numout,*) ' ----------------------------------'
+      WRITE(numout,*)
+   ENDIF
+   !
+   ALLOCATE ( nlei_ocea(nn_procmax), nldi_ocea(nn_procmax), nlej_ocea(nn_procmax), nldj_ocea(nn_procmax) )
+   ALLOCATE ( nlei_land(nn_procmax), nldi_land(nn_procmax), nlej_land(nn_procmax), nldj_land(nn_procmax) )
+   !
+   ! Read cdf bathy file
+   IF ( cn_var == 'none' ) THEN  ! automatic detection of variable name according to partial step
+      IF ( ln_zps ) THEN           ! partial steps
+         cn_var = 'Bathymetry'
+      ELSE 
+         cn_var = 'Bathy_level'    ! full steps
+      ENDIF
+   ENDIF
+   PRINT *,''
+   PRINT *,' ocean/land file used is: ', TRIM(cn_fbathy)
+   PRINT *,' variable used to find ocean domain is: ', TRIM(cn_var)
+   PRINT *,' Dimensions (jpi x jpj) are: ',npiglo,'x',npjglo
+   PRINT *,''
+
+   istatus = NF90_INQ_VARID (ncid, cn_var, id)
+   istatus = NF90_GET_VAR   (ncid, id,   bathy)
+   istatus = NF90_CLOSE     (ncid)
+   !
+   ! Building the mask ( eventually on a smaller domain than the bathy)
+   tmask(:,:) = bathy(nn_izoom:nn_izoom+npiglo -1,  nn_jzoom:nn_jzoom+npjglo -1)
+
+   WHERE ( tmask > 0 ) 
+      tmask = 1.
+   ELSEWHERE
+      tmask = 0.
+   ENDWHERE
+
+   !  Main loop on processors
+   ! ------------------------
+   ! initialization of working variables
+   npni_opt=1       ; npnj_opt=1
+   jpimax_opt=npiglo ; jpjmax_opt=npjglo
+   nland_opt=0   
+   ioce_opt=0
+   oce_cover_min_opt=0. ; oce_cover_max_opt=0.
+   inf10_opt=0 ; inf30_opt=0 ; inf50_opt=0
+   ratio_opt=1.
+
+   nvalid=0       ! counter for valid case ( ln_memchk true )
+   IF ( ll_keep ) THEN
+      iminproci = nkeepi    ; imaxproci = iminproci
+      iminprocj = nkeepj    ; imaxprocj = iminprocj
+   ELSE
+      iminproci = 1    ; imaxproci = MIN( nn_procmax, npiglo )
+      iminprocj = 1    ; imaxprocj = MIN( nn_procmax, npjglo )
+   ENDIF
+
+   ! loop on all decomposition a priori
+   PRINT *, 'Loop over all the decomposition (can take a while) ...'
+   PRINT *, ''
+   DO jni=iminproci, imaxproci
+      DO jnj=iminprocj, imaxprocj
+         ! Limitation of the maxumun number of PE's
+         IF ( jni*jnj <=  nn_procmax .AND. jni*jnj >= nn_procmin )  THEN
+            !
+            !  1. Dimension arrays for subdomains
+            ! -----------------------------------
+            !
+            ! Partition : size of sub-domain 
+            jpimax=(npiglo-2*jpreci + (jni-1))/jni + 2*jpreci
+            jpjmax=(npjglo-2*jprecj + (jnj-1))/jnj + 2*jprecj
+            !
+            ! Memory optimization ?
+            IF ( ln_memchk ) THEN
+               required_memory=rppmpt*jpimax*jpjmax*nn_jpk
+               IF( required_memory > rn_ppmcal ) EXIT
+               IF( required_memory > rn_ppmax*rn_ppmcal .OR. required_memory < rn_ppmin*rn_ppmcal) EXIT
+            ENDIF
+            nvalid=nvalid+1
+            !
+            ! Position of each sub domain   (jni x jni in total )
+            nreci  = 2*jpreci                      ; nrecj  = 2*jprecj
+            iresti = 1 + MOD ( npiglo - nreci - 1 , jni )  ; irestj = 1 + MOD ( npjglo - nrecj - 1 , jnj )
+            !
+            ! 
+            ilci(       1:iresti, 1:jnj) = jpimax
+            ilci(iresti+1:jni   , 1:jnj) = jpimax-1
+
+            ilcj(1:jni,       1:irestj) = jpjmax
+            ilcj(1:jni,irestj+1:jnj   ) = jpjmax-1
+
+            !  2. Index arrays for subdomains
+            ! -------------------------------
+            iimppt(1:jni, 1:jnj) =  1
+            ijmppt(1:jni, 1:jnj) =  1
+            IF( jni > 1 ) THEN
+               DO jj=1,jnj
+                  DO ji=2,jni
+                     iimppt(ji,jj)= iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
+                  END DO
+               END DO
+            ENDIF
+
+            IF( jnj > 1 ) THEN
+               DO jj=2,jnj
+                  DO ji=1,jni
+                     ijmppt(ji,jj)= ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj
+                  END DO
+               END DO
+            ENDIF
+            !
+            ! Loop on each subdomain to look for land proportion
+            nland = 0
+            nocea = 0
+            ioce  = 0
+            oce_cover_min = 1.e+20
+            oce_cover_max = -1.e+20
+            inf10=0
+            inf30=0
+            inf50=0
+            !
+            ! 3. Subdomain description in the Regular Case
+            ! --------------------------------------------
+            !
+            DO jarea = 1, jni*jnj
+                  iarea0 = jarea - 1
+                  ii = 1 + MOD(iarea0,jni)
+                  ij = 1 +     iarea0/jni
+                  ili = ilci(ii,ij)
+                  ilj = ilcj(ii,ij)
+
+                  isurf = 0
+                  ! loop on inner point of sub-domain
+                  DO jj=1, ilj
+                     DO  ji=1, ili
+                        IF( tmask(ji + iimppt(ii,ij) - 1, jj + ijmppt(ii,ij) - 1) == 1 ) isurf=isurf+1
+                     END DO
+                  END DO
+
+                  nimpp = iimppt(ii,ij)
+                  njmpp = ijmppt(ii,ij)
+                  ii1   = nimpp+jpreci      ; ii2 = nimpp+ili-1 -jpreci
+                  ij1   = njmpp+jprecj      ; ij2 = njmpp+ilj-1 -jprecj
+                  IF ( isurf == 0 ) THEN
+                     nland = nland+1
+                     nldi_land(nland) = ii1
+                     nlei_land(nland) = ii2
+                     nldj_land(nland) = ij1
+                     nlej_land(nland) = ij2
+                  ELSE
+                     nocea = nocea+1
+                     ioce  = ioce + isurf
+                     nldi_ocea(nocea) = ii1
+                     nlei_ocea(nocea) = ii2
+                     nldj_ocea(nocea) = ij1
+                     nlej_ocea(nocea) = ij2
+                  ENDIF
+
+                  ! ratio of wet points over total number of point per proc.
+                  oce_cover = float(isurf)/float(jpimax*jpjmax)
+
+                  IF(oce_cover_min > oce_cover .AND. isurf /= 0) oce_cover_min=oce_cover
+                  IF(oce_cover_max < oce_cover .AND. isurf /= 0) oce_cover_max=oce_cover
+                  IF(oce_cover     < 0.1       .AND. isurf /= 0) inf10=inf10+1
+                  IF(oce_cover     < 0.3       .AND. isurf /= 0) inf30=inf30+1
+                  IF(oce_cover     < 0.5       .AND. isurf /= 0) inf50=inf50+1
+                  !
+               !END DO  ! loop on processors
+            END DO     ! loop on processors
+            ! 
+            ratio=float(nocea)*float(jpimax*jpjmax)/float(npiglo*npjglo)
+
+            ! criteria for printing results
+            ll_criteria = ( ( MOD ( nocea, nmodulo ) == 0 ) .AND. &
+                 &          ( ratio <= ratio_min          ) .AND. &
+                 &          ( nocea >= nocea_min           )  )
+            IF ( ll_keep ) THEN   ! the loop in done only once !
+               WRITE(cdum,'(a,"-",i3.3,"x",i3.3,"_",i4.4)') TRIM(cn_fovdta), nkeepi, nkeepj, nocea
+               OPEN(numout, file=cdum )
+               WRITE(numout,'("# ocean ",i5)') nocea
+               DO jjc=1, nocea
+                  WRITE(numout,'("#",i5)') jjc
+                  WRITE(numout,'(2i5)') nldi_ocea(jjc)-1+nn_izoom-1, nldj_ocea(jjc)-1+nn_jzoom -1
+                  WRITE(numout,'(2i5)') nlei_ocea(jjc)+1+nn_izoom-1, nldj_ocea(jjc)-1+nn_jzoom -1
+                  WRITE(numout,'(2i5)') nlei_ocea(jjc)+1+nn_izoom-1, nlej_ocea(jjc)+1+nn_jzoom -1
+                  WRITE(numout,'(2i5)') nldi_ocea(jjc)-1+nn_izoom-1, nlej_ocea(jjc)+1+nn_jzoom -1
+                  WRITE(numout,'(2i5)') nldi_ocea(jjc)-1+nn_izoom-1, nldj_ocea(jjc)-1+nn_jzoom -1
+                  WRITE(numout,'(2i5)') 9999, 9999
+               ENDDO
+               !
+               WRITE(numout,'("# land ",i5)') nland
+               DO jjc=1, nland
+                  WRITE(numout,'("# land ",i5)') jjc
+                  WRITE(numout,'(2i5)') nldi_land(jjc)-1+nn_izoom-1, nldj_land(jjc)-1+nn_jzoom -1
+                  WRITE(numout,'(2i5)') nlei_land(jjc)+1+nn_izoom-1, nldj_land(jjc)-1+nn_jzoom -1
+                  WRITE(numout,'(2i5)') nlei_land(jjc)+1+nn_izoom-1, nlej_land(jjc)+1+nn_jzoom -1
+                  WRITE(numout,'(2i5)') nldi_land(jjc)-1+nn_izoom-1, nlej_land(jjc)+1+nn_jzoom -1
+                  WRITE(numout,'(2i5)') nldi_land(jjc)-1+nn_izoom-1, nldj_land(jjc)-1+nn_jzoom -1
+                  WRITE(numout,'(2i5)') nlei_land(jjc)+1+nn_izoom-1, nlej_land(jjc)+1+nn_jzoom -1
+                  WRITE(numout,'(2i5)') nldi_land(jjc)-1+nn_izoom-1, nlej_land(jjc)+1+nn_jzoom -1
+                  WRITE(numout,'(2i5)') nlei_land(jjc)+1+nn_izoom-1, nldj_land(jjc)-1+nn_jzoom -1
+                  WRITE(numout,'(2i5)') 9999, 9999
+               ENDDO
+               !
+            ELSE
+               IF ( ll_criteria ) THEN
+                  WRITE(numout,*) ' iresti=',iresti,' irestj=',irestj
+                  WRITE(numout,*) '--> Total number of domains ',jni*jnj
+                  WRITE(numout,*) ' '
+                  WRITE(numout,*) ' jpni=',jni ,' jpnj=',jnj
+                  WRITE(numout,*) ' jpi= ',jpimax ,' jpj= ',jpjmax
+                  WRITE(numout,*) ' Number of ocean processors       ', nocea
+                  WRITE(numout,*) ' Number of land processors        ', nland
+                  WRITE(numout,*) ' Mean ocean coverage per domain   ', float(ioce)/float(nocea)/float(jpimax*jpjmax)
+                  WRITE(numout,*) ' Minimum ocean coverage           ', oce_cover_min
+                  WRITE(numout,*) ' Maximum ocean coverage           ', oce_cover_max
+                  WRITE(numout,*) ' nb of proc with coverage         < 10 % ', inf10
+                  WRITE(numout,*) ' nb of proc with coverage 10 < nb < 30 % ', inf30 - inf10
+                  WRITE(numout,*) ' nb of proc with coverage 30 < nb < 50 % ', inf50 - inf30
+                  WRITE(numout,*) ' Number of computed points        ', nocea*jpimax*jpjmax
+                  WRITE(numout,*) ' Overhead of computed points      ', nocea*jpimax*jpjmax-npiglo*npjglo
+                  WRITE(numout,*) ' % sup (computed / global)        ', ratio
+                  WRITE(numout,*)
+               ENDIF   ! note that indication of optimum does not take modulo into account (for information)
+               ! 
+               ! Look for optimum 
+               IF( nland > nland_opt ) THEN
+                  npni_opt          = jni
+                  npnj_opt          = jnj
+                  jpimax_opt           = jpimax
+                  jpjmax_opt           = jpjmax
+                  nland_opt         = nland
+                  ioce_opt          = ioce
+                  oce_cover_min_opt = oce_cover_min
+                  oce_cover_max_opt = oce_cover_max
+                  inf10_opt         = inf10
+                  inf30_opt         = inf30
+                  inf50_opt         = inf50
+                  ratio_opt         = ratio
+               ELSE IF( nland == nland_opt .AND. ratio_opt < ratio) THEN
+                  npni_opt          = jni
+                  npnj_opt          = jnj
+                  jpimax_opt           = jpimax
+                  jpjmax_opt           = jpjmax
+                  ioce_opt          = ioce
+                  oce_cover_min_opt = oce_cover_min
+                  oce_cover_max_opt = oce_cover_max
+                  inf10_opt         = inf10
+                  inf30_opt         = inf30
+                  inf50_opt         = inf50
+                  ratio_opt         = ratio
+               ENDIF
+            ENDIF
+         ENDIF
+      END DO
+   END DO
+   !
+   ! print optimal result
+   IF ( .NOT. ll_keep ) THEN
+      IF ( nvalid == 0 ) THEN
+         WRITE(numout,*) ' no possible choice ...'
+         WRITE(numout,*)
+         WRITE(numout,*) 'insufficient number of processors for the available memory'
+         STOP 
+      ENDIF
+
+      WRITE(numout,*) ' Optimal choice'
+      WRITE(numout,*) ' =============='
+      WRITE(numout,*) 
+      WRITE(numout,*) '--> Total number of domains ',npni_opt*npnj_opt
+      WRITE(numout,*) ' '
+      WRITE(numout,*) ' jpni=',npni_opt ,' jpnj=',npnj_opt
+      WRITE(numout,*) ' jpi= ',jpimax_opt ,' jpj= ',jpjmax_opt
+      WRITE(numout,*) 
+      WRITE(numout,*) ' Number of ocean processors  ', npni_opt*npnj_opt-nland_opt
+      WRITE(numout,*) ' Number of land processors   ', nland_opt
+      WRITE(numout,*) ' Mean ocean coverage         ', float(ioce_opt)/float(npni_opt*npnj_opt-nland_opt)/float(jpimax_opt*jpjmax_opt)
+      WRITE(numout,*) ' Minimum ocean coverage      ', oce_cover_min_opt
+      WRITE(numout,*) ' Maximum ocean coverage      ', oce_cover_max_opt
+      WRITE(numout,*) ' nb of proc with coverage         < 10 % ', inf10_opt
+      WRITE(numout,*) ' nb of proc with coverage 10 < nb < 30 % ', inf30_opt - inf10_opt
+      WRITE(numout,*) ' nb of proc with coverage 30 < nb < 50 % ', inf50_opt - inf30_opt
+      WRITE(numout,*) ' Number of computed points   ', (npni_opt*npnj_opt-nland_opt)*jpimax_opt*jpjmax_opt
+      WRITE(numout,*) ' Overhead of computed points ', (npni_opt*npnj_opt-nland_opt)*jpimax_opt*jpjmax_opt-npiglo*npjglo
+      WRITE(numout,*) ' % sup (computed / global)   ', ratio_opt
+      WRITE(numout,*)
+   ENDIF
+   CLOSE(numout)
+   !
+   STOP
+END PROGRAM mpp_optimize
Index: /utils/tools_ticket2413/MPP_PREP/src/mppopt_showproc_nc.f90
===================================================================
--- /utils/tools_ticket2413/MPP_PREP/src/mppopt_showproc_nc.f90	(revision 12863)
+++ /utils/tools_ticket2413/MPP_PREP/src/mppopt_showproc_nc.f90	(revision 12863)
@@ -0,0 +1,452 @@
+PROGRAM mppopt_showproc_nc
+ !!---------------------------------------------------------------------
+ !!
+ !!                       PROGRAM MPP_showproc_nc
+ !!                     ***********************
+ !!
+ !!  PURPOSE :
+ !!  ---------
+ !!              Build a ascii file (suitable for the overlay function of
+ !!              chart) holding the chosen domain decomposition, formely
+ !!              determined by mpp_opatimize_nc.
+ !!              It takes the same namelist than  mpp_optimize_nc, with
+ !!              the jpni, jpnj given in the namelist (NAMKEEP)
+ !!              
+ !!
+ !!              The output file is called from a root name in the namelist
+ !!              (covdta) with the jpni, jpnj, and jpnij added to the name.
+ !!   MODIFICATIONS:
+ !!   --------------
+ !!       original  : 95-12 (Imbard M)
+ !!       modif pour chart : 98-12 ( J.M. Molines)
+ !!             26/05/2005 : English documentation (partial ..) JMM
+ !!----------------------------------------------------------------------
+  !
+  USE netcdf
+  IMPLICIT NONE
+  !
+  INTEGER ::  jprocx=250
+  !
+  INTEGER :: jpmem=0
+  !
+  ! les dimensions du modele
+  !
+  INTEGER :: jpk,jpiglo,jpjglo, jpidta, jpjdta
+  NAMELIST /namspace/ jpk,jpiglo,jpjglo, jpidta, jpjdta,nizoom,njzoom
+  NAMELIST /namproc/ jprocx, jpmem
+
+  INTEGER :: jpni,jpnj, jpnij
+  CHARACTER(LEN=80) :: covdta, cdum
+  NAMELIST /namkeep/ jpni,jpnj,covdta
+
+  CHARACTER(LEN=80) ::  cbathy
+  LOGICAL :: ln_zps=.false.
+  NAMELIST /namfile / cbathy, ln_zps
+  !!
+  ! quelques parametres
+  !
+  INTEGER ::  jpnix,jpnjx
+  !
+  INTEGER,PARAMETER ::  jpreci=1,jprecj=1
+  !
+  ! les dimensions de la memoire du modele et du calculateur (T3E)
+  !
+  REAL(KIND=4) ::  ppmpt ,   &
+       ppmcal = 1000000000., &
+       ppmin  = 0.4,         &
+       ppmax  = 1.0
+  ! Aleph
+  !     PARAMETER(ppmcal=16000000.)
+  !Brodie
+  !     PARAMETER(ppmcal=250000000.)
+  ! Uqbar
+  !     PARAMETER(ppmcal=3750000000.)
+  ! Zahir
+  !     PARAMETER(ppmcal=1000000000.)
+  NAMELIST /namparam/ ppmcal, ppmin, ppmax
+
+
+  !
+  INTEGER,PARAMETER ::  iumout=8, numnam=4, iumbat=11
+  INTEGER           :: ji,jj,jn,jni,jnj,jni2,jnj2
+  INTEGER           ::  ifreq,il1,il2
+  INTEGER           :: ii,iim,ij,ijm,imoy,iost,iresti,irestj,isurf,ivide
+  INTEGER           :: iilb,ijlb,ireci,irecj,in
+  INTEGER           :: ipi,ipj
+  INTEGER           :: inf10,inf30,inf50,iptx,isw
+  INTEGER           :: iii,iij,iiii,iijj,iimoy,iinf10,iinf30,iinf50
+  !
+  INTEGER,DIMENSION(:,:),ALLOCATABLE     ::  ibathy    ! jpidta -jpjdta
+  INTEGER,DIMENSION(:,:),ALLOCATABLE     ::  ippdi, ippdj ,iidom, ijdom
+  INTEGER,DIMENSION(:)  ,ALLOCATABLE     :: nlei, nldi,nlej,nldj,ICOUNT
+  INTEGER,DIMENSION(:)  ,ALLOCATABLE     :: nleiv, nldiv,nlejv,nldjv
+  INTEGER           :: jjc, nizoom, njzoom
+  !
+  REAL(KIND=4) :: zmin,zmax,zper,zmem
+  REAL(KIND=4) :: zzmin,zzmax,zperx
+  REAL(KIND=4),DIMENSION(:,:),ALLOCATABLE  ::  zmask, zdta, &   ! jpiglo -jpjglo
+                   zlamt, zphit
+  REAL(KIND=4),DIMENSION(:),ALLOCATABLE  ::  zdept   ! jpk
+  LOGICAL :: llbon, lwp=.true.
+  CHARACTER(LEN=80) ::  clvar
+  INTEGER :: numout=6, itime, ipk, istep,  inum
+  REAL(KIND=4) :: zdt, zdate0
+  ! CDF stuff
+  INTEGER :: ncid, ivarid, istatus
+
+  !
+  !
+  !
+  ! 0. Initialisation
+  ! -----------------
+  !
+  OPEN(numnam,FILE='namelist')
+
+  REWIND(numnam)
+  READ(numnam,namspace)
+  ALLOCATE ( ibathy(jpidta,jpjdta), zmask(jpiglo,jpjglo) ,zdta(jpidta,jpjdta))
+  ALLOCATE ( zlamt(jpidta,jpjdta), zphit(jpidta,jpjdta))
+
+  REWIND(numnam)
+  READ(numnam,namparam)
+
+  REWIND(numnam)
+  READ(numnam,namproc)
+
+  ppmpt = 55.+73./jpk
+  jpnix = jprocx ; jpnjx=jprocx
+
+  ALLOCATE (ippdi(jpnix,jpnjx), ippdj(jpnix,jpnjx) )
+  ALLOCATE (iidom(jpnix,jpnjx), ijdom(jpnix,jpnjx) )
+  ALLOCATE (nlei(jprocx), nldi(jprocx) )
+  ALLOCATE (nlej(jprocx), nldj(jprocx) )
+! empty processors
+  ALLOCATE (nleiv(jprocx), nldiv(jprocx) )
+  ALLOCATE (nlejv(jprocx), nldjv(jprocx) )
+  ALLOCATE (ICOUNT(jprocx), zdept(jpk) )
+
+  REWIND(numnam)
+  READ(numnam,namfile) 
+
+  REWIND(numnam)
+  READ(numnam,namkeep)
+
+  WRITE(iumout,*)
+  WRITE(iumout,*) ' optimisation de la partition'
+  WRITE(iumout,*) ' ----------------------------'
+  WRITE(iumout,*)
+
+  !
+  ! Lecture de la bathymetrie
+  !
+      ! open the file
+         IF ( ln_zps ) THEN
+            clvar = 'Bathymetry'
+
+         ELSE
+            clvar = 'Bathy_level'
+         ENDIF
+
+         INQUIRE( FILE=cbathy, EXIST=llbon )
+      IF( llbon ) THEN
+            istatus=NF90_OPEN(cbathy,NF90_NOWRITE,ncid)
+            istatus=NF90_INQ_VARID(ncid,clvar,ivarid)
+            istatus=NF90_GET_VAR(ncid,ivarid,zdta)
+            istatus=NF90_CLOSE(ncid)
+      ELSE
+          WRITE(numout,*)'    mppini_2 : unable to read the file', cbathy
+      ENDIF
+
+      ! land/sea mask over the global/zoom domain
+
+!     imask(:,:)=1
+!     WHERE ( zdta(jpizoom:jpiglo+jpizoom-1, jpjzoom:jpjglo+jpjzoom-1) == 0.e0 ) imask = 0
+      ibathy(:,:)=zdta(:,:)
+
+  DO jj=1,jpjglo
+     DO ji=1,jpiglo
+        zmask(ji,jj) = float(ibathy(ji+nizoom -1,jj+njzoom -1))
+     END DO
+  END DO
+  DO jj=1,jpjglo
+     DO ji=1,jpiglo
+        zmask(ji,jj)= min(REAL(1.,kind=4),max(REAL(0.,kind=4),zmask(ji,jj)))
+     END DO
+  END DO
+  print *,'Nombre de pts mer :', sum(zmask)
+  !
+  !
+  !  1. Boucle sur le nombre de processeurs
+  ! ---------------------------------------
+  !
+  iii=1
+  iij=1
+  iiii=jpiglo
+  iijj=jpjglo
+  iptx=0
+  iimoy=0
+  zzmin=0.
+  zzmax=0.
+  iinf10=0
+  iinf30=0
+  iinf50=0
+  zperx=1.
+  in=0
+! Next loop corresponds to just 1 case, which is the one kept from mpp_optimize.
+  DO jni=jpni,jpni
+     DO jnj=jpnj,jpnj
+        !
+        ! Limitation nombre de pe
+        !
+        IF(jni*jnj.GT.jprocx) go to 1000
+        !
+        ! Partition
+        !
+        ipi=(jpiglo-2*jpreci + (jni-1))/jni + 2*jpreci
+        ipj=(jpjglo-2*jprecj + (jnj-1))/jnj + 2*jprecj
+        !
+        ! Optimisation memoire ?
+        !
+        isw=0
+        zmem=ppmpt*ipi*ipj*jpk + jpiglo*jpjglo
+        IF(zmem.GT.ppmcal) go to 1000
+        IF(jpmem.EQ.1) THEN
+           IF(zmem.GT.ppmax*ppmcal.OR.zmem.LT.ppmin*ppmcal) isw=1
+        ENDIF
+        IF(isw.EQ.1) go to 1000
+        in=in+1
+        !
+        WRITE(iumout,*) '--> nombre de processeurs ',jni*jnj
+        WRITE(iumout,*) ' '
+        WRITE(iumout,*) " jpni=",jni ," jpnj=",jnj
+        WRITE(iumout,*) " jpi= ",ipi ," jpj= ",ipj
+        zper=(jni*jnj*ipi*ipj)/float(jpiglo*jpjglo)
+        WRITE(iumout,*) " rapport jpnij*domain/global domain ",zper
+        !
+        ! Coin en bas a gauche de chaque processeur
+        !
+        iilb=1
+        ijlb=1
+        ireci=2*jpreci
+        irecj=2*jprecj
+        iresti = MOD ( jpiglo - ireci , jni )
+        irestj = MOD ( jpjglo - irecj , jnj )
+        !
+        IF (iresti.EQ.0) iresti = jni
+        DO jj=1,jnj
+           DO ji=1,iresti
+              ippdi(ji,jj) = ipi
+           END DO
+           DO ji=iresti+1,jni
+              ippdi(ji,jj) = ipi -1
+           END DO
+        END DO
+        IF (irestj.EQ.0) irestj = jnj
+        DO ji=1,jni
+           DO jj=1,irestj
+              ippdj(ji,jj) = ipj
+           END DO
+           DO jj=irestj+1,jnj
+              ippdj(ji,jj) = ipj -1
+           END DO
+        END DO
+        DO jj=1,jnj
+           DO ji=1,jni
+              iidom(ji,jj)=iilb
+              ijdom(ji,jj)=ijlb
+           END DO
+        END DO
+        !
+        !  2. Boucle sur les processeurs
+        ! ------------------------------
+        !
+        ivide=0
+        imoy=0
+        zmin=1.e+20
+        zmax=-1.e+20
+        inf10=0
+        inf30=0
+        inf50=0
+        jjc=0
+        !
+        DO jni2=1,jni
+           DO jnj2=1,jnj
+
+              IF(jni.GT.1)THEN
+                 DO jj=1,jnj
+                    DO ji=2,jni
+                       iidom(ji,jj)=iidom(ji-1,jj)+ippdi(ji-1,jj)-ireci
+                    END DO
+                 END DO
+                 iilb=iidom(jni2,jnj2)
+              ENDIF
+              IF(jnj.GT.1)THEN
+                 DO jj=2,jnj
+                    DO ji=1,jni
+                       ijdom(ji,jj)=ijdom(ji,jj-1)+ippdj(ji,jj-1)-irecj
+                    END DO
+                 END DO
+                 ijlb=ijdom(jni2,jnj2)
+              ENDIF
+
+              ! Check wet points over the entire domain to preserve the MPI communication stencil
+              isurf=0
+              DO jj=1,ippdj(jni2,jnj2)
+                 DO  ji=1,ippdi(jni2,jnj2)
+                    IF(zmask(ji+iilb-1,jj+ijlb-1).EQ.1.) isurf=isurf+1
+                 END DO
+              END DO
+
+              IF(isurf.EQ.0) THEN
+                 ivide=ivide+1
+                 nldiv(ivide)=jpreci+iilb
+                 nleiv(ivide)=iilb+ippdi(jni2,jnj2)-1-jpreci
+                 nldjv(ivide)=jprecj+ijlb
+                 nlejv(ivide)=ijlb+ippdj(jni2,jnj2)-1-jprecj
+              ELSE
+                 imoy=imoy+isurf
+                 jjc=jjc+1
+                 icount(jjc)=isurf 
+                 nldi(jjc)=jpreci+iilb
+                 nlei(jjc)=iilb+ippdi(jni2,jnj2)-1-jpreci
+                 nldj(jjc)=jprecj+ijlb
+                 nlej(jjc)=ijlb+ippdj(jni2,jnj2)-1-jprecj
+              ENDIF
+              zper=float(isurf)/float(ipi*ipj)
+              IF(zmin.GT.zper.AND.isurf.NE.0) zmin=zper
+              IF(zmax.LT.zper.AND.isurf.NE.0) zmax=zper
+              IF(zper.LT.0.1.AND.isurf.NE.0) inf10=inf10+1
+              IF(zper.LT.0.3.AND.isurf.NE.0) inf30=inf30+1
+              IF(zper.LT.0.5.AND.isurf.NE.0) inf50=inf50+1
+              !
+              !
+              ! 3. Fin de boucle sur les processeurs, impression
+              ! ------------------------------------------------
+              !
+           END DO
+        END DO
+        WRITE(iumout,*) ' nombre de processeurs       ',jni*jnj
+        WRITE(iumout,*) ' nombre de processeurs mer   ',jni*jnj-ivide
+        WRITE(iumout,*) ' nombre de processeurs terre ',ivide
+        WRITE(iumout,*) ' moyenne de recouvrement     ',float(imoy)/float(jni*jnj-ivide)/float(ipi*ipj)
+        WRITE(iumout,*) ' minimum de recouvrement     ',zmin
+        WRITE(iumout,*) ' maximum de recouvrement     ',zmax
+        WRITE(iumout,*) ' nb de p recouvrement < 10 % ',inf10
+        WRITE(iumout,*) ' nb de p      10 < nb < 30 % ',inf30-inf10
+        WRITE(iumout,*) ' nb de p      30 < nb < 50 % ',inf50-inf10-inf30
+        WRITE(iumout,*) ' nombre de points integres   ',(jni*jnj-ivide)*ipi*ipj
+        WRITE(iumout,*) ' nbr de pts supplementaires  ',(jni*jnj-ivide)*ipi*ipj-jpiglo*jpjglo
+        zper=float((jni*jnj-ivide))*float(ipi*ipj)/float(jpiglo*jpjglo)
+        WRITE(iumout,*) ' % sup                       ',zper
+        WRITE(iumout,*)
+        WRITE(iumout,*) ' PROCESSORS WITH LESS THAN 100 WATER POINTS'
+
+        WRITE(cdum,'(a,1h-,i3.3,1hx,i3.3,1h_,i3.3)') TRIM(covdta),jpni,jpnj,jni*jnj -ivide
+        OPEN (10,file=cdum)
+        WRITE(10,'(a,i5)')'#',jni*jnj -ivide
+        DO jjc=1,jni*jnj-ivide
+           WRITE(10,'(a,i5)')'#',jjc
+           WRITE(10,'(2i5)')nldi(jjc)-1+nizoom-1,nldj(jjc)-1+njzoom -1
+           WRITE(10,'(2i5)')nlei(jjc)+1+nizoom-1,nldj(jjc)-1+njzoom -1
+           WRITE(10,'(2i5)')nlei(jjc)+1+nizoom-1,nlej(jjc)+1+njzoom -1
+           WRITE(10,'(2i5)')nldi(jjc)-1+nizoom-1,nlej(jjc)+1+njzoom -1
+           WRITE(10,'(2i5)')nldi(jjc)-1+nizoom-1,nldj(jjc)-1+njzoom -1
+           WRITE(10,'(2i5)') 9999,9999 
+           IF (icount(jjc).LT.100) THEN
+              WRITE(iumout,*)' proc ji=',jjc,' water points:', icount(jjc)
+              WRITE(iumout,*) ' ji from ',nldi(jjc), ' to :',nlei(jjc)
+              WRITE(iumout,*) ' jj /  mask value for all ji'
+              DO jj=nldj(jjc),nlej(jjc)
+                 WRITE(iumout,900) jj,(INT(zmask(ji,jj)),ji=nldi(jjc),nlei(jjc))
+              ENDDO
+900           FORMAT(1x,i4,1x,9(10i1,1x))
+           ENDIF
+        ENDDO
+        WRITE(10,'(a,i5)')'# vides:',ivide
+        DO jjc=1,ivide
+           WRITE(10,'(a,i5)')'# vide ',jjc
+           WRITE(10,'(2i5)')nldiv(jjc)-1+nizoom-1,nldjv(jjc)-1+njzoom -1
+           WRITE(10,'(2i5)')nleiv(jjc)+1+nizoom-1,nldjv(jjc)-1+njzoom -1
+           WRITE(10,'(2i5)')nleiv(jjc)+1+nizoom-1,nlejv(jjc)+1+njzoom -1
+           WRITE(10,'(2i5)')nldiv(jjc)-1+nizoom-1,nlejv(jjc)+1+njzoom -1
+           WRITE(10,'(2i5)')nldiv(jjc)-1+nizoom-1,nldjv(jjc)-1+njzoom -1
+           WRITE(10,'(2i5)')nleiv(jjc)+1+nizoom-1,nlejv(jjc)+1+njzoom -1
+           WRITE(10,'(2i5)')nldiv(jjc)-1+nizoom-1,nlejv(jjc)+1+njzoom -1
+           WRITE(10,'(2i5)')nleiv(jjc)+1+nizoom-1,nldjv(jjc)-1+njzoom -1
+           WRITE(10,'(2i5)') 9999,9999
+        END DO
+
+        ! 
+        ! 
+        ! 4. Recherche de l optimum
+        ! -------------------------
+        !
+        IF(ivide.GT.iptx) THEN
+           iii=jni
+           iij=jnj
+           iiii=ipi
+           iijj=ipj
+           iptx=ivide
+           iimoy=imoy
+           zzmin=zmin
+           zzmax=zmax
+           iinf10=inf10
+           iinf30=inf30
+           iinf50=inf50
+           zperx=zper
+        ELSE IF(ivide.EQ.iptx.AND.zperx.LT.zper) THEN
+           iii=jni
+           iij=jnj
+           iiii=ipi
+           iijj=ipj
+           iimoy=imoy
+           zzmin=zmin
+           zzmax=zmax
+           iinf10=inf10
+           iinf30=inf30
+           iinf50=inf50
+           zperx=zper
+        ENDIF
+        !
+        ! 5. Fin de boucle sur le nombre de processeurs
+        ! ---------------------------------------------
+        !
+1000    CONTINUE
+     END DO
+  END DO
+  !
+  !
+  ! 6. Affichage resultat
+  ! ---------------------
+  !
+  IF(in.EQ.0) THEN
+     WRITE(iumout,*) ' le choix n a pas pu etre fait '
+     WRITE(iumout,*)
+     WRITE(iumout,*) 'le nombre de processeurs maximum est insuffisant'
+     STOP 
+  ENDIF
+  WRITE(iumout,*) ' choix optimum'
+  WRITE(iumout,*) ' ============='
+  WRITE(iumout,*) 
+  WRITE(iumout,*) '--> nombre de processeurs ',iii*iij
+  WRITE(iumout,*) ' '
+  WRITE(iumout,*) " jpni=",iii ," jpnj=",iij
+  WRITE(iumout,*) " jpi= ",iiii ," jpj= ",iijj
+  WRITE(iumout,*) 
+  WRITE(iumout,*) ' nombre de processeurs mer   ',iii*iij-iptx
+  WRITE(iumout,*) ' nombre de processeurs terre ',iptx
+  WRITE(iumout,*) ' moyenne de recouvrement     ',float(iimoy)/float(iii*iij-iptx)/float(iiii*iijj)
+  WRITE(iumout,*) ' minimum de recouvrement     ',zzmin
+  WRITE(iumout,*) ' maximum de recouvrement     ',zzmax
+  WRITE(iumout,*) ' nb de p recouvrement < 10 % ',iinf10
+  WRITE(iumout,*) ' nb de p      10 < nb < 30 % ',iinf30-iinf10
+  WRITE(iumout,*) ' nb de p      30 < nb < 50 % ',iinf50-iinf10-iinf30
+  WRITE(iumout,*) ' nombre de points integres   ',(iii*iij-iptx)*iiii*iijj
+  WRITE(iumout,*) ' nbr de pts supplementaires  ',(iii*iij-iptx)*iiii*iijj-jpiglo*jpjglo
+  WRITE(iumout,*) ' % sup                       ',zperx
+  WRITE(iumout,*)
+  !
+  !
+  !
+  STOP
+END PROGRAM mppopt_showproc_nc
Index: /utils/tools_ticket2413/NESTING/README
===================================================================
--- /utils/tools_ticket2413/NESTING/README	(revision 12863)
+++ /utils/tools_ticket2413/NESTING/README	(revision 12863)
@@ -0,0 +1,70 @@
+=============================================================
+How to build a doubly nested configuration such as AGRIF_DEMO
+=============================================================
+
+:::::::::::::::::::::::::::::::::::::::::::::::::
+1) Files needed from root (parent) grid
+:::::::::::::::::::::::::::::::::::::::::::::::::
+- coordinates.nc
+- bathy_meter.nc
+- bathymetry database (For example GEBCO 2014 dataset)
+
+
+:::::::::::::::::::::::::::::::::::::::::::::::::
+2) Compile the tool
+:::::::::::::::::::::::::::::::::::::::::::::::::
+
+$NEMOPATH/NEMOGCM/TOOLS/maketools -n NESTING -m X64_ADA -j 4
+
+It creates 5 executables:
+- agrif_create_coordinates.exe
+- agrif_create_bathy.exe
+- agrif_create_restart.exe
+- agrif_create_restart_trc.exe
+- agrif_create_data.exe
+
+
+:::::::::::::::::::::::::::::::::::::::::::::::::
+3) Create coordinates and bathymetries
+:::::::::::::::::::::::::::::::::::::::::::::::::
+
+a) agrif_create_coordinates.exe namelist_nordic1
+   It creates level 1 child grid coordinates: 1_coordinates.nc
+
+b) agrif_create_bathy.exe namelist_nordic1
+   It creates level 1 child grid bathymetry: 1_bathymeter.nc
+   It updates        parent grid bathymetry: bathy_updated.nc
+
+c) agrif_create_coordinates.exe namelist_nordic2
+   It creates level 2 child grid coordinates: 2_coordinates.nc
+
+d) agrif_create_bathy.exe namelist_nordic2
+   It creates level 2 child grid bathymetry: 2_bathymeter.nc
+   It updates level 1 child grid bathymetry: 1_bathy_updated.nc
+
+e) agrif_create_bathy.exe namelist_nordic1_update
+   It updates        parent grid bathymetry: bathy_updated_parent.nc
+
+Note: This last step takes into account both levels 1 and 2 bathymetries to update the parent grid bathymetry
+      to make sure that volumes match between child grids and parent grid.
+      To only perform an update as in step e), i.e. without interpolation, one has to set in the namelist:
+      - elevation_database = 1_bathy_updated.nc
+      - type_bathy_interp = 2
+
+** Files needed for your model to run:
+   -   bathy_updated_parent.nc  +    coordinates.nc
+   - 1_bathy_updated.nc         +  1_coordinates.nc
+   - 2_bathy_meter.nc           +  2_coordinates.nc
+
+
+:::::::::::::::::::::::::::::::::::::::::::::::::
+4) Create data
+:::::::::::::::::::::::::::::::::::::::::::::::::
+
+a) agrif_create_data.exe namelist_nordic1
+   It creates level 1 child grid data: 1_chlorophyll.nc etc
+
+b) agrif_create_data.exe namelist_nordic2
+   It creates level 2 child grid data: 2_chlorophyll.nc etc
+
+
Index: /utils/tools_ticket2413/NESTING/namelist_nordic1
===================================================================
--- /utils/tools_ticket2413/NESTING/namelist_nordic1	(revision 12863)
+++ /utils/tools_ticket2413/NESTING/namelist_nordic1	(revision 12863)
@@ -0,0 +1,107 @@
+&input_output
+    iom_activated = .true. 
+/
+
+&coarse_grid_files    
+    parent_coordinate_file = 'coordinates.nc'
+    parent_bathy_level     = 'meshmask.nc'  
+    parent_level_name      = 'mbathy'
+    parent_bathy_meter     = 'bathy_meter.nc'
+    parent_meter_name      = 'Bathymetry'
+    parent_domcfg_out      = 'domain_cfg.nc'
+    parent_jperio          = 4
+/    
+    
+&bathymetry    
+    new_topo = .true.
+    elevation_database = 'GEBCO_2014_2D.nc'
+    elevation_name     = 'elevation'
+    smoothing          = .true.
+    smoothing_factor   = 0.6
+    ln_agrif_domain    = .true.
+    npt_connect        = 2      ! default = 3
+    npt_copy           = 2      ! default = 2
+    removeclosedseas   = .true.
+    type_bathy_interp  = 0 
+    rn_hmin            = -3 
+/   
+
+&nesting    
+    imin = 122
+    imax = 153
+    jmin = 110
+    jmax = 143
+    rho  = 4
+    rhot = 4
+    nbghostcellsfine = 3
+    bathy_update = .true.
+    parent_bathy_meter_updated = 'bathy_updated.nc'				
+    parent_domcfg_updated = 'domain_cfg_updated.nc'
+/
+
+&vertical_grid    
+    ln_e3_dep = .true.
+    ppkth     = 21.4333619793800
+    ppacr     = 3
+    ppdzmin   = 0
+    pphmax    = 0
+    psur      = -4762.96143546300
+    pa0       = 255.58049070440
+    pa1       = 245.58132232490
+    N         = 31
+    ldbletanh = .false.
+    pa2       = 0
+    ppkth2    = 0
+    ppacr2    = 0
+/    
+    
+&partial_cells    	
+    partial_steps      = .true.
+    e3zps_min          = 20.
+    e3zps_rat          = 0.1
+/
+
+&nemo_coarse_grid    
+    jpizoom = 1			
+    jpjzoom = 1			
+/
+&forcing_files		   
+    FLX_FILES = 
+    'data_1m_salinity_nomask.nc',
+    'data_1m_potential_temperature_nomask.nc',
+    'geothermal_heating.nc'
+    'mixing_power_bot.nc',
+    'mixing_power_pyc.nc',
+    'mixing_power_cri.nc',
+    'chlorophyll.nc'
+/
+
+&interp
+    VAR_INTERP =
+    'votemper/bilinear',
+    'vosaline/bilinear',
+    'heatflow/bilinear'
+    'field/bilinear',
+    'field/bilinear',
+    'field/bilinear',
+    'CHLA/bilinear'
+/
+
+&restart
+    restart_file = 'restart.nc'   
+    shlat = 0
+    dimg = false
+    dimg_output_file = 'test_dimg'
+    adatrj = 360.25 
+    interp_type = 'bilinear'
+/ 
+
+&restart_trc
+    restart_trc_file = 'restart_trc.nc'   
+    interp_type = 'bilinear'
+/ 
+
+&restart_ice
+    restart_ice_file = 'restart_ice.nc'
+    interp_type = 'bilinear'
+/
Index: /utils/tools_ticket2413/NESTING/namelist_nordic1_update
===================================================================
--- /utils/tools_ticket2413/NESTING/namelist_nordic1_update	(revision 12863)
+++ /utils/tools_ticket2413/NESTING/namelist_nordic1_update	(revision 12863)
@@ -0,0 +1,108 @@
+&input_output
+    iom_activated = .true. 
+/
+
+&coarse_grid_files    
+    parent_coordinate_file = 'coordinates.nc'
+    parent_bathy_level     = 'meshmask.nc'  
+    parent_level_name      = 'mbathy'
+    parent_bathy_meter     = 'bathy_meter.nc'
+    parent_meter_name      = 'Bathymetry'
+    parent_domcfg_out      = 'domain_cfg.nc'
+    parent_jperio          = 4
+/    
+    
+&bathymetry    
+    new_topo = .true.
+    elevation_database = '1_bathy_updated.nc'
+    elevation_name     = 'Bathymetry'
+    smoothing          = .true.
+    smoothing_factor   = 0.6
+    ln_agrif_domain    = .true.
+    npt_connect        = 2    
+    npt_copy           = 2 
+    removeclosedseas   = .true.
+    type_bathy_interp  = 2 
+    rn_hmin            = -3 
+/   
+
+&nesting    
+    imin = 122
+    imax = 153
+    jmin = 110
+    jmax = 143
+    rho  = 4
+    rhot = 4
+    nbghostcellsfine = 3
+    bathy_update = .true.
+    parent_bathy_meter_updated = 'bathy_updated_parent.nc'
+    parent_domcfg_updated = 'domain_cfg_updated_parent.nc'
+/
+
+&vertical_grid    
+    ln_e3_dep = .true.
+    ppkth     = 21.4333619793800
+    ppacr     = 3
+    ppdzmin   = 0
+    pphmax    = 0
+    psur      = -4762.96143546300
+    pa0       = 255.58049070440
+    pa1       = 245.58132232490
+    N         = 31
+    ldbletanh = .false.
+    pa2       = 0
+    ppkth2    = 0
+    ppacr2    = 0
+/    
+    
+&partial_cells    	
+    partial_steps      = .true.
+    e3zps_min          = 20.
+    e3zps_rat          = 0.1
+/
+
+&nemo_coarse_grid    
+    jpizoom = 1			
+    jpjzoom = 1			
+/
+
+&forcing_files		   
+    FLX_FILES = 
+    'data_1m_salinity_nomask.nc',
+    'data_1m_potential_temperature_nomask.nc',
+    'geothermal_heating.nc'
+    'mixing_power_bot.nc',
+    'mixing_power_pyc.nc',
+    'mixing_power_cri.nc',
+    'chlorophyll.nc'
+/
+
+&interp
+    VAR_INTERP =
+    'votemper/bilinear',
+    'vosaline/bilinear',
+    'heatflow/bilinear'
+    'field/bilinear',
+    'field/bilinear',
+    'field/bilinear',
+    'CHLA/bilinear'
+/
+
+&restart
+    restart_file = 'restart.nc'   
+    shlat = 0
+    dimg = false
+    dimg_output_file = 'test_dimg'
+    adatrj = 360.25 
+    interp_type = 'bilinear'
+/ 
+
+&restart_trc
+    restart_trc_file = 'restart_trc.nc'   
+    interp_type = 'bilinear'
+/ 
+
+&restart_ice
+    restart_ice_file = 'restart_ice.nc'
+    interp_type = 'bilinear'
+/
Index: /utils/tools_ticket2413/NESTING/namelist_nordic2
===================================================================
--- /utils/tools_ticket2413/NESTING/namelist_nordic2	(revision 12863)
+++ /utils/tools_ticket2413/NESTING/namelist_nordic2	(revision 12863)
@@ -0,0 +1,108 @@
+&input_output
+    iom_activated = .true.
+/
+
+&coarse_grid_files    
+    parent_coordinate_file = '1_coordinates.nc'
+    parent_bathy_level     = '1_meshmask.nc'
+    parent_level_name      = 'mbathy'
+    parent_bathy_meter     = '1_bathy_meter.nc'
+    parent_meter_name      = 'Bathymetry'
+    parent_domcfg_out      = '1_domain_cfg.nc'
+    parent_jperio          = 0
+/    
+    
+&bathymetry    
+    new_topo           = .true.
+    elevation_database = 'GEBCO_2014_2D.nc'
+    elevation_name     = 'elevation'
+    smoothing          = .true.
+    smoothing_factor   = 0.6
+    ln_agrif_domain    = .true.
+    npt_connect        = 2 
+    npt_copy           = 2 
+    removeclosedseas   = .true.
+    type_bathy_interp  = 0 
+    rn_hmin            = -3
+/   
+
+&nesting    
+    imin = 38
+    imax = 80
+    jmin = 71
+    jmax = 111
+    rho  = 3
+    rhot = 3
+    nbghostcellsfine = 3
+    bathy_update = .true.
+    parent_bathy_meter_updated = '1_bathy_updated.nc'
+    parent_domcfg_updated = '1_domain_cfg_updated.nc'
+/
+
+&vertical_grid    
+    ln_e3_dep = .true.
+    ppkth     = 21.4333619793800
+    ppacr     = 3
+    ppdzmin   = 0
+    pphmax    = 0
+    psur      = -4762.96143546300
+    pa0       = 255.58049070440
+    pa1       = 245.58132232490
+    N         = 31
+    ldbletanh = .false.
+    pa2       = 0
+    ppkth2    = 0
+    ppacr2    = 0
+/    
+    
+&partial_cells    	
+    partial_steps      = .true.
+    e3zps_min          = 20.
+    e3zps_rat          = 0.1
+/
+
+&nemo_coarse_grid
+    jpizoom = 1
+    jpjzoom = 1
+/
+
+&forcing_files		   
+    FLX_FILES = 
+    '1_data_1m_salinity_nomask.nc',
+    '1_data_1m_potential_temperature_nomask.nc',
+    '1_geothermal_heating.nc'
+    '1_mixing_power_bot.nc',
+    '1_mixing_power_pyc.nc',
+    '1_mixing_power_cri.nc',
+    '1_chlorophyll.nc'
+/
+
+&interp
+    VAR_INTERP =
+    'votemper/bilinear',
+    'vosaline/bilinear',
+    'heatflow/bilinear'
+    'field/bilinear',
+    'field/bilinear',
+    'field/bilinear',
+    'CHLA/bilinear'
+/
+
+&restart
+    restart_file = 'restart.nc'   
+    shlat = 0
+    dimg = false
+    dimg_output_file = 'test_dimg'
+    adatrj = 360.25 
+    interp_type = 'bilinear'
+/ 
+
+&restart_trc
+    restart_trc_file = 'restart_trc.nc'   
+    interp_type = 'bilinear'
+/ 
+
+&restart_ice
+    restart_ice_file = 'restart_ice.nc'
+    interp_type = 'bilinear'
+/
Index: /utils/tools_ticket2413/NESTING/src/agrif_connect_topo.f90
===================================================================
--- /utils/tools_ticket2413/NESTING/src/agrif_connect_topo.f90	(revision 12863)
+++ /utils/tools_ticket2413/NESTING/src/agrif_connect_topo.f90	(revision 12863)
@@ -0,0 +1,948 @@
+!************************************************************************
+! Fortran 95 OPA Nesting tools						*
+!									*
+!     Copyright (C) 2005 Florian Lemarié (Florian.Lemarie@imag.fr)	*
+!                        Laurent Debreu (Laurent.Debreu@imag.fr)	*
+!************************************************************************
+!
+!Smoothing procedures : Pierrick Penven 2004
+!
+MODULE agrif_connect_topo
+  !
+  USE agrif_types
+  !
+  IMPLICIT NONE           
+  !
+CONTAINS
+  !
+  !
+  !************************************************************************
+  ! 									*
+  ! MODULE  CONNECT_TOPO							*
+  !									*
+  ! module containing subroutine used for : 				*
+  !   - Parent-Child bathymetry connection				*
+  !   - Bathymetry smoothing						*
+  !   - Meters to levels conversion					*
+  !   - Parent Bathymetry update 						*
+  !									*
+  !************************************************************************
+  !
+  !****************************************************************
+  !   subroutine init_constant_bathy				*
+  !								*
+  !								*
+  ! - input :							*
+  !     coarse_bathy : coarse grid bathymetry 			*
+  ! - ouput :							*
+  !    bathy_fin_constant : coarse bathymetry on fine grid	*
+  !								*
+  !****************************************************************
+  !
+  SUBROUTINE init_constant_bathy(coarse_bathy,bathy_fin_constant)
+    !       
+    IMPLICIT NONE 
+    !      
+    INTEGER :: i,j,ii,jj,ji
+    INTEGER :: jpt,ipt,diff,indx,indy,bornex,borney,bornex2,borney2
+    INTEGER :: jdeb,ideb,ifin,jfin
+    REAL*8, DIMENSION(:,:)  :: coarse_bathy
+    REAL*8, DIMENSION(:,:),POINTER :: bathy_fin_constant
+    TYPE(Coordinates) :: Grid     
+    !
+    IF( ln_agrif_domain ) THEN
+    !
+       diff = 0
+       IF(MOD(rho,2) .EQ. 0) diff = 1
+       !
+       indx = 1 + nbghostcellsfine + CEILING(irafx/2.0) + diff      
+       indy = 1 + nbghostcellsfine + CEILING(irafy/2.0) + diff
+       bornex = 1+nbghostcellsfine + CEILING(irafx/2.0) + diff - irafx
+       borney = 1+nbghostcellsfine + CEILING(irafy/2.0) + diff - irafy
+       bornex2 = nxfin - (nbghostcellsfine) + irafx - CEILING(irafx/2.0) 
+       borney2 = nyfin - (nbghostcellsfine) + irafy - CEILING(irafy/2.0) 
+       !    
+       ALLOCATE(bathy_fin_constant(bornex-FLOOR(irafx/2.0):bornex2+FLOOR(irafx/2.0), &
+          borney-FLOOR(irafy/2.0):borney2+FLOOR(irafy/2.0)))
+       !
+       DO j = borney,borney2,irafy
+          
+          jpt = jmin + 1 + nbghostcellsfine + (j-indy)/irafy
+          IF(j<=1) jpt = jmin + 1
+          
+          DO i = bornex,bornex2,irafx
+             
+             ipt = imin + 1 + nbghostcellsfine + (i-indx)/irafx
+             IF(i<=1) ipt = imin + 1
+             !       
+             DO jj = j-FLOOR(irafy/2.0),j+FLOOR(irafy/2.0)-diff
+                DO ii = i-FLOOR(irafx/2.0),i+FLOOR(irafx/2.0)-diff
+                   
+                   bathy_fin_constant(ii,jj) = coarse_bathy(ipt,jpt)
+                   
+                END DO
+             END DO
+             
+          END DO
+       END DO
+       
+    ELSE
+
+       ALLOCATE(bathy_fin_constant(1:nxfin,1:nyfin))
+
+       DO j = 1,nyfin-irafy+1,irafy
+          jpt = jmin + FLOOR( (j - 1.) / irafy )
+          !
+          DO i = 1,nxfin-irafx+1,irafx
+             ipt = imin + FLOOR( (i - 1.) / irafx )
+             !
+             bathy_fin_constant(i:i+irafx-1,j:j+irafy-1) = coarse_bathy(ipt,jpt)
+             !
+          END DO
+       END DO
+ 
+    ENDIF
+    !
+    !
+  END SUBROUTINE init_constant_bathy
+  !
+  !****************************************************************
+  !   subroutine meter_to_levels					*
+  !								*
+  ! subroutine to convert bathymetry in meters to bathymetry	*
+  ! in vertical levels						*
+  !								*
+  ! - input/output :						*
+  !     Grid : grid where conversion is required			*
+  !								*
+  !various input parameters come from namelist.input files	*
+  !****************************************************************
+  !
+  SUBROUTINE meter_to_levels(Grid)
+    !
+    IMPLICIT NONE
+    !
+    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin,zmax
+    TYPE(Coordinates) :: Grid
+    INTEGER :: i,j
+    INTEGER, DIMENSION(1) :: k
+    INTEGER :: k1,ji,jj,jpi,jpj
+    REAL*8, POINTER, DIMENSION(:) :: gdepw,gdept,e3w,e3t
+    !       
+    WRITE(*,*) 'convert bathymetry from etopo to vertical levels'
+    !
+    jpi = SIZE(Grid%bathy_meter,1)
+    jpj = SIZE(Grid%bathy_meter,2)
+    !                     
+    IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) &
+         .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN 
+       !    
+       za1=( ppdzmin - pphmax / (N-1) )          &
+            / ( TANH((1-ppkth)/ppacr) - ppacr/(N-1) &
+            *  (  LOG( COSH( (N - ppkth) / ppacr) )      &
+            - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
+
+       za0  = ppdzmin - za1 * TANH( (1-ppkth) / ppacr )
+       zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
+       !
+    ELSE IF ( (ppdzmin == 0 .OR. pphmax == 0) .AND. psur.NE.0 .AND. &
+         pa0.NE.0 .AND. pa1.NE.0 ) THEN
+       !       
+       zsur = psur
+       za0  = pa0
+       za1  = pa1
+       za2  = pa2
+       !
+    ELSE
+       !       
+       WRITE(*,*) 'ERROR ***** bad vertical grid parameters ...' 
+       WRITE(*,*) ' '
+       WRITE(*,*) 'please check values of variables'
+       WRITE(*,*) 'in namelist vertical_grid section'
+       WRITE(*,*) ' ' 
+       STOP     
+       !       
+    ENDIF
+
+    zacr = ppacr
+    zkth = ppkth
+    zacr2 = ppacr2
+    zkth2 = ppkth2   
+    !
+    ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N))
+    !
+    IF( ppkth == 0. ) THEN            !  uniform vertical grid 
+       za1 = pphmax / FLOAT(N-1) 
+       DO i = 1, N
+          gdepw(i) = ( i - 1   ) * za1
+          gdept(i) = ( i - 0.5 ) * za1
+          e3w  (i) =  za1
+          e3t  (i) =  za1
+       END DO
+    ELSE                            ! Madec & Imbard 1996 function
+       IF( .NOT. ldbletanh ) THEN
+          DO i = 1,N
+             ! 
+             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+             gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
+             e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
+             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+             !
+          END DO
+       ELSE
+          DO i = 1,N
+             ! Double tanh function
+             gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               &
+                &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  )
+             gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr  ) )    &
+                &                            + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) )  )
+             e3w  (i) =          za0         + za1        * TANH(       (i-zkth ) / zacr  )            &
+                &                            + za2        * TANH(       (i-zkth2) / zacr2 )
+             e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      &
+                &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 )
+            END DO
+       ENDIF
+    ENDIF
+    !
+    gdepw(1) = 0.0
+    !
+    IF ( ln_e3_dep ) THEN      ! e3. = dk[gdep]   
+       !
+       DO i = 1, N-1 
+          e3t(i) = gdepw(i+1)-gdepw(i)
+       END DO
+       e3t(N) = e3t(N-1)
+
+       DO i = 2, N 
+          e3w(i) = gdept(i) - gdept(i-1)
+       END DO
+       e3w(1  ) = 2. * (gdept(1) - gdepw(1))
+    END IF  
+    !
+    zmax = gdepw(N) + e3t(N)
+    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level
+    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth
+    ENDIF
+    zmin = gdepw(i+1)
+    !
+    IF ( .NOT. ASSOCIATED(Grid%bathy_level)) &
+         ALLOCATE(Grid%bathy_level(jpi,jpj))    
+    !
+    Grid%bathy_level = N-1
+    !
+    DO jj = 1, jpj
+       DO ji= 1, jpi
+          IF( Grid%bathy_meter(ji,jj) <= 0. )   &
+               Grid%bathy_level(ji,jj) = INT( Grid%bathy_meter(ji,jj) )
+       END DO
+    END DO
+    !
+    DO jj = 1, jpj
+       DO ji= 1, jpi
+          IF( Grid%bathy_meter(ji,jj) <= 0. ) THEN
+             Grid%bathy_meter(ji,jj) = 0.e0
+          ELSE
+             Grid%bathy_meter(ji,jj) = MAX( Grid%bathy_meter(ji,jj), zmin )
+             Grid%bathy_meter(ji,jj) = MIN( Grid%bathy_meter(ji,jj), zmax )
+          ENDIF
+       END DO
+    END DO
+    !
+    !
+    !
+    DO jj = 1,jpj
+       DO ji = 1,jpi
+          !
+          IF (Grid%bathy_meter(ji,jj) .EQ. 0.0 ) THEN
+             Grid%bathy_level(ji,jj)=0
+          ELSE
+             !	
+             k1=2  ! clem: minimum levels = 2 ???
+             DO WHILE (k1 .LT. (N-1))
+                IF ((Grid%bathy_meter(ji,jj).GE.gdepw(k1)) &
+                     .AND.(Grid%bathy_meter(ji,jj).LE.gdepw(k1+1))) EXIT
+                k1=k1+1
+             END DO
+             Grid%bathy_level(ji,jj)=k1
+             !
+          ENDIF
+          !
+       END DO
+    END DO
+    !
+  END SUBROUTINE meter_to_levels
+  !
+  !!
+  !****************************************************************
+  !   subroutine levels_to_meter					*
+  !								*
+  ! subroutine to convert bathymetry in meters to bathymetry	*
+  ! in vertical levels						*
+  !								*
+  ! - input/output :						*
+  !     Grid : grid where conversion is required			*
+  !								*
+  !various input parameters come from namelist.input files	*
+  !****************************************************************
+  !
+  SUBROUTINE levels_to_meter(Grid)
+    !
+    IMPLICIT NONE
+    !
+    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin,zmax
+    TYPE(Coordinates) :: Grid
+    INTEGER :: i,j
+    INTEGER, DIMENSION(1) :: k
+    INTEGER :: k1,ji,jj,jpi,jpj
+    REAL*8, POINTER, DIMENSION(:) :: gdepw,gdept,e3w,e3t
+    !       
+    WRITE(*,*) 'convert bathymetry in meters for smoothing'
+    !
+    jpi = SIZE(Grid%bathy_level,1)
+    jpj = SIZE(Grid%bathy_level,2)
+    !              
+    !             
+    IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) &
+         .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN 
+       !    
+       za1=( ppdzmin - pphmax / (N-1) )          &
+            / ( TANH((1-ppkth)/ppacr) - ppacr/(N-1) &
+            *  (  LOG( COSH( (N - ppkth) / ppacr) )      &
+            - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
+
+       za0  = ppdzmin - za1 * TANH( (1-ppkth) / ppacr )
+       zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
+       !
+    ELSE IF ( (ppdzmin == 0 .OR. pphmax == 0) .AND. psur.NE.0 .AND. &
+         pa0.NE.0 .AND. pa1.NE.0 ) THEN
+       !       
+       zsur = psur
+       za0  = pa0
+       za1  = pa1
+       za2  = pa2
+       !
+    ELSE
+       !       
+       WRITE(*,*) 'ERROR ***** bad vertical grid parameters ...' 
+       WRITE(*,*) ' '
+       WRITE(*,*) 'please check values of variables'
+       WRITE(*,*) 'in namelist vertical_grid section'
+       WRITE(*,*) ' ' 
+       STOP     
+       !       
+    ENDIF
+
+    zacr = ppacr
+    zkth = ppkth
+    zacr2 = ppacr2
+    zkth2 = ppkth2   
+    !
+    ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N))
+    !
+    IF( ppkth == 0. ) THEN            !  uniform vertical grid 
+       za1 = pphmax / FLOAT(N-1) 
+       DO i = 1, N
+          gdepw(i) = ( i - 1   ) * za1
+          gdept(i) = ( i - 0.5 ) * za1
+          e3w  (i) =  za1
+          e3t  (i) =  za1
+       END DO
+    ELSE                            ! Madec & Imbard 1996 function
+       IF( .NOT. ldbletanh ) THEN
+          DO i = 1,N
+             ! 
+             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+             gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
+             e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
+             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+             !
+          END DO
+       ELSE
+          DO i = 1,N
+             ! Double tanh function
+             gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               &
+                &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  )
+             gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr  ) )    &
+                &                            + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) )  )
+             e3w  (i) =          za0         + za1        * TANH(       (i-zkth ) / zacr  )            &
+                &                            + za2        * TANH(       (i-zkth2) / zacr2 )
+             e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      &
+                &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 )
+         END DO
+       ENDIF
+    ENDIF
+    !
+    gdepw(1) = 0.0  
+    !
+    IF ( ln_e3_dep ) THEN      ! e3. = dk[gdep]   
+       !
+       DO i = 1, N-1
+          e3t(i) = gdepw(i+1)-gdepw(i)
+       END DO
+       e3t(N) = e3t(N-1)
+
+       DO i = 2, N
+          e3w(i) = gdept(i) - gdept(i-1)
+       END DO
+       e3w(1  ) = 2. * (gdept(1) - gdepw(1))
+    END IF
+    !
+    IF(.NOT. ASSOCIATED(Grid%bathy_meter)) THEN
+       ALLOCATE(Grid%bathy_meter(jpi,jpj))  
+    ELSE
+       IF( ANY(SHAPE(Grid%bathy_meter)/=(/jpi,jpj/)) ) THEN	   
+          DEALLOCATE(Grid%bathy_meter)   
+          ALLOCATE(Grid%bathy_meter(jpi,jpj))     
+       ENDIF
+    ENDIF
+    !      
+    DO jj = 1, jpj
+       DO ji= 1, jpi
+          !
+          Grid%bathy_meter(ji,jj) = gdepw( INT( Grid%bathy_level(ji,jj) ) + 1 )
+          !
+       END DO
+    END DO
+    !
+  END SUBROUTINE levels_to_meter
+  !
+
+  !****************************************************************
+  !   subroutine smooth_topo					*
+  !								*
+  ! subroutine to smooth a given bathymetry (in meters)		*
+  !  hanning filter is used (smoothing criterion : rfactor)	*
+  !								*
+  ! - input/output :						*
+  !     h : bathymetry						*
+  !								*
+  !various input parameters are stored in namelist.input files	*
+  !****************************************************************
+  !
+  SUBROUTINE smooth_topo(h,nbiter)
+    !
+    IMPLICIT NONE
+    ! 
+    REAL*8, DIMENSION(:,:) :: h
+    REAL*8 :: hmin,cff,nu,r
+    REAL*8, DIMENSION(:,:), ALLOCATABLE :: rx,ry,cx,cy,f_x,f_y
+    INTEGER :: Mm,Mmm,Lm,Lmm,M,L,nbiter,i,j
+    REAL*8,DIMENSION(:,:),ALLOCATABLE :: maskedtopo
+    !
+    M = SIZE(h,1)
+    L = SIZE(h,2)     
+    !       
+    ALLOCATE(cx(M,L),cy(M,L))
+    ALLOCATE(rx(M,L),ry(M,L))
+    ALLOCATE(f_x(M,L),f_y(M,L))
+    ALLOCATE(maskedtopo(M,L))
+    !
+    WRITE(*,*) ''
+    WRITE(*,*) 'smooth the topography (Hanning filter)'
+    WRITE(*,*) 'slope parameter = ',smoothing_factor
+    !
+    hmin = 1.1
+    WHERE(h <= hmin)
+       h = hmin
+    END WHERE
+    !       
+    WHERE (h == hmin)
+       maskedtopo = 0.
+    ELSEWHERE
+       maskedtopo = 1.
+    END WHERE
+    !
+    Mm = M-1
+    Mmm = Mm - 1
+    Lm = L-1
+    Lmm = Lm - 1
+    cff = 0.8
+    nu = 3.0/16.0
+    rx=0.
+    ry=0.      
+    CALL rfact(h,rx,ry,maskedtopo)    
+    r = MAX(MAXVAL(rx),MAXVAL(ry))
+    h = LOG(h)         
+    nbiter = 0
+    !       
+    DO WHILE (r.GT.smoothing_factor .AND. nbiter < 500  )         
+       !       
+       nbiter=nbiter+1       
+       WHERE(rx > cff*smoothing_factor)
+          cx = 1
+       ELSEWHERE
+          cx = 0
+       END WHERE
+       CALL hanningx(cx,maskedtopo)      
+       WHERE(ry > cff*smoothing_factor)
+          cy = 1
+       ELSEWHERE
+          cy = 0
+       END WHERE
+       CALL hanningy(cy,maskedtopo)      
+       CALL FX(h,f_x,cx,maskedtopo)
+       CALL FY(h,f_y,cy,maskedtopo)       
+       h(2:Mm,2:Lm) = h(2:Mm,2:Lm) + maskedtopo(2:Mm,2:Lm)*nu *                 &
+            ((f_x(2:Mm,3:L)-f_x(2:Mm,2:Lm)) + &     
+            (f_y(3:M,2:Lm)-f_y(2:Mm,2:Lm)))       
+       CALL rfact(EXP(h),rx,ry,maskedtopo)
+       r = MAX(MAXVAL(rx(2:Mm,2:L)),MAXVAL(ry(2:M,2:Lm)))
+       !
+    END DO
+    !       
+    WRITE(*,*) 'iterations = ',nbiter
+    WRITE(*,*) ''
+    h = EXP(h)               
+    WHERE( ABS(h-hmin) <= 0.001 )
+       h = 0.
+    END WHERE
+    DEALLOCATE(rx,ry,cx,cy,f_x,f_y,maskedtopo)
+    !
+  END SUBROUTINE smooth_topo
+  !       
+  !************************************************************************
+  ! subroutine hanning(bathy_meter)
+  !************************************************************************
+  !
+  SUBROUTINE hanning(h,maskedtopo)
+    !
+    IMPLICIT NONE
+    !
+    REAL*8, DIMENSION(:,:) :: h,maskedtopo
+    !
+    INTEGER :: Mm,Mmm,Lm,Lmm,M,L
+    !      
+    M = SIZE(h,1)
+    L = SIZE(h,2)
+    Mm = M-1
+    Mmm = Mm - 1
+    Lm = L-1
+    Lmm = Lm - 1
+    !      
+    h(2:Mm,2:Lm) = maskedtopo(2:Mm,2:Lm)*0.125*(   h(1:Mmm,2:Lm) + &
+         h(3:M,2:Lm)   + &
+         h(2:Mm,1:Lmm) + &
+         h(2:Mm,3:L)   + &
+         4*h(2:Mm,2:Lm))+(1.-maskedtopo(2:Mm,2:Lm))*h(2:Mm,2:Lm)
+    !
+  END SUBROUTINE hanning
+  !      
+  !************************************************************************
+  ! subroutine hanningx(bathy_meter)
+  !************************************************************************
+  !
+  SUBROUTINE hanningx(h,maskedtopo)
+    !
+    IMPLICIT NONE
+    !
+    REAL*8, DIMENSION(:,:) :: h,maskedtopo
+    REAL*8, DIMENSION(:,:), ALLOCATABLE ::  htemp 
+    !
+    INTEGER :: Mm,Mmm,Lm,Lmm,M,L
+    INTEGER :: i,j
+    !      
+    M = SIZE(h,1)
+    L = SIZE(h,2)
+    Mm = M-1
+    Mmm = Mm - 1
+    Lm = L-1
+    Lmm = Lm - 1
+
+    ALLOCATE(htemp(M,L))
+    !      
+    htemp = h      
+    DO j=3,Lm
+       DO i=2,Mm
+          IF ((maskedtopo(i,j)*maskedtopo(i,j-1)) .NE.0.) THEN
+             h(i,j)=0.125*(htemp(i-1,j)+htemp(i+1,j) &
+                  +htemp(i,j+1)+htemp(i,j-1)+4.*htemp(i,j))
+          ENDIF
+       ENDDO
+    ENDDO
+    j=2
+    DO i=2,Mm
+       IF ((maskedtopo(i,j)*maskedtopo(i,j-1)) .NE.0.) THEN
+          h(i,j)=0.25*(htemp(i+1,j)+htemp(i-1,j)+2.*htemp(i,j))
+       ENDIF
+    ENDDO
+    j=L
+    DO i=2,Mm
+       IF ((maskedtopo(i,j)*maskedtopo(i,j-1)) .NE.0.) THEN
+          h(i,j)=0.25*(htemp(i+1,j)+htemp(i-1,j)+2.*htemp(i,j))
+       ENDIF
+    ENDDO
+    DEALLOCATE(htemp)
+    !
+  END SUBROUTINE hanningx
+
+  !************************************************************************
+  ! subroutine hanning(bathy_meter)
+  !************************************************************************
+  !
+  SUBROUTINE hanningy(h,maskedtopo)
+    !
+    IMPLICIT NONE
+    !
+    REAL*8, DIMENSION(:,:) :: h,maskedtopo
+    REAL*8, DIMENSION(:,:), ALLOCATABLE ::  htemp 
+    !
+    INTEGER :: Mm,Mmm,Lm,Lmm,M,L
+    INTEGER :: i,j
+    !      
+    M = SIZE(h,1)
+    L = SIZE(h,2)
+    Mm = M-1
+    Mmm = Mm - 1
+    Lm = L-1
+    Lmm = Lm - 1      
+    ALLOCATE(htemp(M,L))
+    !      
+    htemp = h
+
+    DO j=2,Lm
+       DO i=3,Mm
+          IF ((maskedtopo(i,j)*maskedtopo(i-1,j)) .NE.0.) THEN
+             h(i,j)=0.125*(htemp(i-1,j)+htemp(i+1,j) &
+                  +htemp(i,j+1)+htemp(i,j-1)+4.*htemp(i,j))
+          ENDIF
+       ENDDO
+    ENDDO
+
+    i=2
+    DO j=2,Lm
+       IF ((maskedtopo(i,j)*maskedtopo(i-1,j)) .NE.0.) THEN
+          h(i,j)=0.25*(htemp(i,j+1)+htemp(i,j-1)+2.*htemp(i,j))
+       ENDIF
+    ENDDO
+
+    i=M
+    DO j=2,Lm
+       IF ((maskedtopo(i,j)*maskedtopo(i-1,j)) .NE.0.) THEN
+          h(i,j)=0.25*(htemp(i,j+1)+htemp(i,j-1)+2.*htemp(i,j))
+       ENDIF
+    ENDDO
+
+    DEALLOCATE(htemp)
+    !
+  END SUBROUTINE hanningy
+
+  !      
+  !************************************************************************
+  ! subroutine FX(bathy_meter,fx)
+  !************************************************************************
+  !
+  SUBROUTINE FX(h,f,c,maskedtopo)
+    !
+    IMPLICIT NONE
+    !
+    REAL*8, DIMENSION(:,:)  :: h,c
+    REAL*8, DIMENSION(:,:)  :: f,maskedtopo
+    REAL*8, DIMENSION(SIZE(h,1),SIZE(h,2))  :: floc
+    !
+    INTEGER :: Mm,Mmm,Lm,Lmm,M,L,i,j
+    !
+    f = 0.0     
+    M = SIZE(h,1)
+    L = SIZE(h,2)
+    Mm = M-1
+    Mmm = Mm - 1
+    Lm = L-1
+    Lmm = Lm - 1
+    floc = 0.  
+
+    DO j=2,L
+       DO i=1,M
+
+          IF ((maskedtopo(i,j)*maskedtopo(i,j-1)).EQ.0.) THEN
+             floc(i,j)=0.
+          ELSEIF ((i.EQ.1).OR.(i.EQ.M)) THEN     
+             floc(i,j)=(7./12.)*(h(i,j)-h(i,j-1))              
+          ELSEIF ((maskedtopo(i-1,j)*maskedtopo(i-1,j-1)).EQ.0.) THEN
+             floc(i,j)=(7./12.)*(h(i,j)-h(i,j-1))    
+          ELSEIF ((maskedtopo(i+1,j)*maskedtopo(i+1,j-1)).EQ.0.) THEN
+             floc(i,j)=(7./12.)*(h(i,j)-h(i,j-1))       
+          ELSE               
+             floc(i,j)=(5./12.)*(h(i,j)-h(i,j-1)) &
+                  +(1./12.)*(h(i-1,j)-h(i-1,j-1)+h(i+1,j)-h(i+1,j-1))
+          ENDIF
+       ENDDO
+    ENDDO
+    !      
+    DO j = 1,L
+       DO i = 1,M
+          f(i,j) = c(i,j)*floc(i,j) 
+       END DO
+    END DO
+    !           	       
+    !
+  END SUBROUTINE FX
+  !
+  !
+  !      
+  !************************************************************************
+  ! subroutine FY(bathy_meter,fy)
+  !************************************************************************
+  !
+  SUBROUTINE FY(h,f,c,maskedtopo)
+    !
+    IMPLICIT NONE
+    !
+    REAL*8, DIMENSION(:,:) :: h,c
+    REAL*8, DIMENSION(:,:) :: f,maskedtopo
+    REAL*8, DIMENSION(SIZE(h,1),SIZE(h,2))  :: floc
+    INTEGER :: Mm,Mmm,Lm,Lmm,M,L,i,j
+    f=0.0 
+    !            
+    M = SIZE(h,1)
+    L = SIZE(h,2)
+    Mm = M-1
+    Mmm = Mm - 1
+    Lm = L-1
+    Lmm = Lm - 1
+    !
+    floc = 0.
+
+    DO j=1,L
+       DO i=2,M
+          IF ((maskedtopo(i,j)*maskedtopo(i-1,j)).EQ.0.) THEN
+             floc(i,j) = 0.
+          ELSEIF ((j.EQ.1).OR.(j.EQ.L)) THEN
+             floc(i,j)=(7./12.)*(h(i,j)-h(i-1,j))
+          ELSEIF ((maskedtopo(i,j-1)*maskedtopo(i-1,j-1)).EQ.0.) THEN
+             floc(i,j)=(7./12.)*(h(i,j)-h(i-1,j))
+          ELSEIF ((maskedtopo(i,j+1)*maskedtopo(i-1,j+1)).EQ.0.) THEN
+             floc(i,j)=(7./12.)*(h(i,j)-h(i-1,j))
+          ELSE      
+             floc(i,j)=(5./12.)*(h(i,j)-h(i-1,j)) &
+                  +(1./12.)*(h(i,j-1)-h(i-1,j-1)+h(i,j+1)-h(i-1,j+1))
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    DO j = 1,L
+       DO i = 1,M
+          f(i,j) = c(i,j)*floc(i,j) 
+       END DO
+    END DO
+    !      
+  END SUBROUTINE FY
+  !
+  !
+  !****************************************************************
+  !   subroutine rfact						*
+  !								*
+  ! subroutine to check if smoothing criterion 			*
+  !                     is verified everywhere			*
+  !								*
+  ! - input :							*
+  !     h : bathymetry						*
+  ! - ouput :							*
+  !    rx,ry : delta(theta)/theta in x and y directions		*
+  !****************************************************************
+  !
+  SUBROUTINE rfact(h,rx,ry,maskedtopo)
+    !
+    IMPLICIT NONE
+    !
+    REAL*8, DIMENSION(:,:)  :: h
+    REAL*8, DIMENSION(:,:)  :: rx,ry
+    REAL*8, DIMENSION(:,:)  :: maskedtopo
+    INTEGER M,L,i,j,Mm,Mmm,Lm,Lmm
+    !
+    M = SIZE(h,1)
+    L = SIZE(h,2)
+    Mm = M-1
+    Mmm = Mm - 1
+    Lm = L-1
+    Lmm = Lm - 1
+    !
+    rx=0.
+    ry=0.
+    !      
+    DO j=2,L
+       DO i=1,M	     
+          rx(i,j) = ABS(h(i,j)-h(i,j-1))/(h(i,j)+h(i,j-1))
+          IF ((maskedtopo(i,j)*maskedtopo(i,j-1)) .EQ.0.) THEN
+             rx(i,j)=0.
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    DO j=1,L
+       DO i=2,M
+          ry(i,j) = ABS(h(i,j)-h(i-1,j))/(h(i,j)+h(i-1,j))
+          IF ((maskedtopo(i,j)*maskedtopo(i-1,j)) .EQ.0.) THEN
+             ry(i,j)=0.
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+  END SUBROUTINE rfact
+  !
+  !
+  !****************************************************************
+  !   subroutine Update_Parent_Bathy				*
+  !								*
+  ! (if desired) subroutine to update parent grid bathymetry	*
+  ! for consistency with fine grid bathymetry			*
+  !								*
+  ! if a given coarse grid point is masked and one of the	  *
+  ! child grid points contained in this coarse cell is not masked *
+  ! the corresponding coarse grid point is unmasked with rn_hmin  *
+  ! value						          *
+  !								*
+  ! - input :							*
+  !     G0,G1 : both grids involved				*
+  ! - ouput :							*
+  !    G0 parent grid containing updated bathymetry		*
+  !****************************************************************
+  !
+  !
+  SUBROUTINE Update_Parent_Bathy( G0,G1 )
+    !
+    IMPLICIT NONE
+
+    TYPE(coordinates) :: G0,G1
+    INTEGER :: ii,jj,jk,ipt,jpt,diff,indx,indy,bornex,borney,bornex2,borney2
+    !
+    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin
+    INTEGER :: i,j
+    INTEGER :: k1
+    INTEGER :: compt, compt_oce
+    REAL*8, POINTER, DIMENSION(:) :: gdepw,gdept,e3w,e3t
+    !                     
+    IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) &
+         .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN 
+       !    
+       za1=( ppdzmin - pphmax / (N-1) )          &
+            / ( TANH((1-ppkth)/ppacr) - ppacr/(N-1) &
+            *  (  LOG( COSH( (N - ppkth) / ppacr) )      &
+            - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
+
+       za0  = ppdzmin - za1 * TANH( (1-ppkth) / ppacr )
+       zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
+       !
+    ELSE IF ( (ppdzmin == 0 .OR. pphmax == 0) .AND. psur.NE.0 .AND. &
+         pa0.NE.0 .AND. pa1.NE.0 ) THEN
+       !       
+       zsur = psur
+       za0  = pa0
+       za1  = pa1
+       za2  = pa2
+       !
+    ELSE
+       !       
+       WRITE(*,*) 'ERROR ***** bad vertical grid parameters ...' 
+       WRITE(*,*) ' '
+       WRITE(*,*) 'please check values of variables'
+       WRITE(*,*) 'in namelist vertical_grid section'
+       WRITE(*,*) ' ' 
+       STOP     
+       !       
+    ENDIF
+
+    zacr = ppacr
+    zkth = ppkth
+    zacr2 = ppacr2
+    zkth2 = ppkth2   
+    !
+    ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N))
+    !
+    IF( ppkth == 0. ) THEN            !  uniform vertical grid 
+       za1 = pphmax / FLOAT(N-1) 
+       DO i = 1, N
+          gdepw(i) = ( i - 1   ) * za1
+          gdept(i) = ( i - 0.5 ) * za1
+          e3w  (i) =  za1
+          e3t  (i) =  za1
+       END DO
+    ELSE                            ! Madec & Imbard 1996 function
+       IF( .NOT. ldbletanh ) THEN
+          DO i = 1,N
+             ! 
+             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+             gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
+             e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
+             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+             !
+          END DO
+       ELSE
+          DO i = 1,N
+             ! Double tanh function
+             gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               &
+                &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  )
+             gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr  ) )    &
+                &                            + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) )  )
+             e3w  (i) =          za0         + za1        * TANH(       (i-zkth ) / zacr  )            &
+                &                            + za2        * TANH(       (i-zkth2) / zacr2 )
+             e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      &
+                &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 )
+          END DO
+       ENDIF
+    ENDIF
+    !
+    gdepw(1)=0. 
+    IF ( ln_e3_dep ) THEN      ! e3. = dk[gdep]   
+       !
+       DO i = 1, N-1
+          e3t(i) = gdepw(i+1)-gdepw(i)
+       END DO
+       e3t(N) = e3t(N-1)
+
+       DO i = 2, N
+          e3w(i) = gdept(i) - gdept(i-1)
+       END DO
+       e3w(1  ) = 2. * (gdept(1) - gdepw(1))
+    END IF
+    !
+    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level
+    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth
+    ENDIF
+    zmin = gdepw(i+1)
+    !      
+    diff = 0
+    IF(MOD(rho,2) .EQ. 0) diff = 1
+    !
+    indx = 1+nbghostcellsfine + CEILING(irafx/2.0) + diff      
+    indy = 1+nbghostcellsfine + CEILING(irafy/2.0) + diff
+    bornex = 1+nbghostcellsfine + CEILING(irafx/2.0) + diff
+    borney = 1+nbghostcellsfine + CEILING(irafy/2.0) + diff
+    bornex2 = nxfin - (nbghostcellsfine) - CEILING(irafx/2.0) 
+    borney2 = nyfin - (nbghostcellsfine) - CEILING(irafy/2.0) 
+    !
+    DO j = borney,borney2,irafy
+
+       jpt = jmin + 1 + nbghostcellsfine + (j-indy)/irafy
+       IF(j<=1) jpt = jmin + 1
+
+       DO i = bornex,bornex2,irafx
+
+          ipt = imin + 1 + nbghostcellsfine + (i-indx)/irafx
+          IF(i<=1) ipt = imin + 1
+          IF ((i==bornex).AND.(j==borney)) print *, 'Coarse grid Corner', ipt,jpt
+          !   
+          G0%Bathy_meter(ipt,jpt) = 0.
+          compt = 0 
+          compt_oce = 0
+          DO jj = j-FLOOR(irafy/2.0),j+FLOOR(irafy/2.0)-diff
+             DO ii = i-FLOOR(irafx/2.0),i+FLOOR(irafx/2.0)-diff
+                G0%Bathy_meter(ipt,jpt) = G0%Bathy_meter(ipt,jpt) + G1%Bathy_meter(ii,jj)
+                IF (G1%Bathy_meter(ii,jj)>0.) compt_oce = compt_oce + 1
+                compt = compt + 1
+             END DO
+          END DO
+!          IF (compt_oce > 0.5*irafx*irafy)    G0%Bathy_meter(ipt,jpt) = G0%Bathy_meter(ipt,jpt) / FLOAT(compt)
+          G0%Bathy_meter(ipt,jpt) = G0%Bathy_meter(ipt,jpt) / FLOAT(compt)
+          IF(G0%Bathy_meter(ipt,jpt).GT.0.)   G0%Bathy_meter(ipt,jpt) = MAX(G0%Bathy_meter(ipt,jpt),zmin)
+          !
+          G0%wgt(ipt,jpt) = 1. ! Flag for output
+       END DO
+    END DO
+
+    !
+    WRITE(*,*) ' Number of coarse grid points updated = ',compt
+    WRITE(*,*) '---------------------------------'
+    !      
+  END SUBROUTINE Update_Parent_Bathy
+
+END MODULE agrif_connect_topo
Index: /utils/tools_ticket2413/NESTING/src/agrif_create_bathy.f90
===================================================================
--- /utils/tools_ticket2413/NESTING/src/agrif_create_bathy.f90	(revision 12863)
+++ /utils/tools_ticket2413/NESTING/src/agrif_create_bathy.f90	(revision 12863)
@@ -0,0 +1,504 @@
+!************************************************************************
+! Fortran 95 OPA Nesting tools						*
+!									*
+!     Copyright (C) 2005 Florian Lemarié (Florian.Lemarie@imag.fr)	*
+!                        Laurent Debreu (Laurent.Debreu@imag.fr)	*
+!************************************************************************
+!
+PROGRAM create_bathy
+  !
+  USE NETCDF
+  USE bilinear_interp
+  USE agrif_readwrite
+  USE agrif_partial_steps
+  USE agrif_connect_topo
+  USE agrif_interpolation
+  !
+  IMPLICIT NONE
+  !
+  !************************************************************************
+  ! 									*
+  ! PROGRAM  CREATE_BATHY						*
+  !									*
+  ! program to implement bathymetry interpolation to generate 		*
+  ! child grid bathymetry file						*
+  !									*
+  ! various options :							*
+  !									*
+  ! 1- Interpolation directly from parent bathymetry file (z-coord)	*
+  ! 2- Use new topo file in meters (for example etopo)  		*
+  !									*
+  ! vertical coordinates permitted : z-coord and partial steps		*
+  ! sigma coordinates is not yet implemented				*
+  !									*
+  !Interpolation is carried out using bilinear interpolation		*
+  !routine from SCRIP package or median average				*		
+  !									*
+  !http://climate.lanl.gov/Software/SCRIP/				*
+  !************************************************************************
+  !
+  ! variables declaration
+  !      
+  CHARACTER(len=80) ::   namelistname
+  CHARACTER*100     ::   child_coordinates, child_level, child_meter, child_domcfg    
+  LOGICAL ::   identical_grids     
+  INTEGER ::   nbadd,status,narg,iargc     
+  INTEGER ::   jpj,jpi
+  LOGICAL,DIMENSION(:,:),POINTER     ::   masksrc => NULL()  
+  INTEGER,DIMENSION(:,:),ALLOCATABLE ::   mask_oce,trouble_points
+  INTEGER,DIMENSION(:)  ,POINTER     ::   src_add,dst_add => NULL() 
+  REAL*8, DIMENSION(:,:),POINTER     ::   matrix,interpdata => NULL()     
+  REAL*8, DIMENSION(:,:),POINTER     ::   bathy_fin_constant => NULL()  
+  REAL*8, DIMENSION(:,:),ALLOCATABLE ::   bathy_test,vardep
+  REAL*8, DIMENSION(:)  ,ALLOCATABLE ::   vardep1d
+  REAL*8, DIMENSION(:,:),POINTER     ::   gdepw_ps_interp => NULL() 
+  REAL*8  ::   Cell_lonmin,Cell_lonmax,Cell_latmin,Cell_latmax,wghts
+  LOGICAL ::   Pacifique = .FALSE.
+  INTEGER ::   boundary,iimin,iimax,jjmax,jjmin
+  INTEGER ::   nxhr,nyhr,nxyhr,ji,jj,nbiter
+
+  TYPE(Coordinates) :: G0,G1 
+  !      
+  narg = iargc()      
+  IF (narg == 0) THEN
+     namelistname = 'namelist.input'
+  ELSE
+     CALL getarg(1,namelistname)
+  ENDIF
+  !
+  ! read input file (namelist.input)
+  CALL read_namelist(namelistname)
+
+  ! if level or meter name is missing
+  IF( TRIM(parent_level_name) == '' )   parent_level_name='mbathy'
+  IF( TRIM(parent_meter_name) == '' )   parent_meter_name='Bathymetry'
+
+  ! define names of child grid files
+  CALL set_child_name(parent_coordinate_file,child_coordinates) 
+  IF( TRIM(parent_bathy_level) /= '' )   CALL set_child_name(parent_bathy_level,child_level)            
+  IF( TRIM(parent_bathy_meter) /= '' )   CALL set_child_name(parent_bathy_meter,child_meter)
+  IF( TRIM(parent_domcfg_out)  /= '' )   CALL set_child_name(parent_domcfg_out,child_domcfg) 
+  !
+  IF( TRIM(parent_bathy_level) == '' .AND. TRIM(parent_bathy_meter) == '') THEN
+     WRITE(*,*) 'ERROR ***** one needs at least to define parent_bathy_level or parent_bathy_meter ...'
+     STOP
+  ENDIF
+  !
+  ! read fine and coarse grids coordinates file
+  status = Read_Coordinates(TRIM(parent_coordinate_file),G0)
+  status = Read_Coordinates(TRIM(child_coordinates),G1,Pacifique)
+  !
+  ! check error in size
+  IF( imax > SIZE(G0%nav_lon,1) .OR. jmax > SIZE(G0%nav_lon,2) .OR. imax <= imin .OR. jmax <= jmin ) THEN
+     WRITE(*,*) 'ERROR ***** bad child grid definition ...'
+     WRITE(*,*) 'please check imin,jmin,imax,jmax,jpizoom,jpjzoom values'       
+     STOP
+  ENDIF
+  IF( SIZE(G1%nav_lon,1) .NE. nxfin .OR. SIZE(G1%nav_lon,2) .NE. nyfin ) THEN
+     WRITE(*,*) 'ERROR ***** bad child coordinates file ...'
+     WRITE(*,*) 'please check that child coordinates file has been created with the same namelist'
+     STOP
+  ENDIF
+  !
+  ! read bathymetry data set => G0%bathy_meter
+  IF( new_topo ) THEN                                       ! read G0%bathy_meter (on a reduced grid) and G1 coordinates
+     DEALLOCATE( G0%nav_lon, G0%nav_lat )
+     status = read_bathy_coord(TRIM(elevation_database),G0,G1,Pacifique)
+  ELSE                                                      ! read G0%bathy_meter (on the global grid)
+     IF( TRIM(parent_bathy_meter) /= '') THEN
+        status = read_bathy_meter(TRIM(parent_bathy_meter),G0)
+     ELSE
+        status = Read_bathy_level(TRIM(parent_bathy_level),G0)
+        CALL levels_to_meter(G0)
+     ENDIF     
+     ! change longitudes (from -180:180 to 0:360)
+     IF(Pacifique) THEN
+        WHERE(G0%nav_lon < 0.001)   G0%nav_lon = G0%nav_lon + 360.
+     ENDIF
+  ENDIF
+  !
+  ! 1st allocation of child grid bathy
+  ALLOCATE(G1%bathy_meter(nxfin,nyfin))
+  G1%bathy_meter(:,:)=0.
+
+  ! check grids: if identical then do not interpolate
+  identical_grids = .FALSE.
+  
+  IF(  SIZE(G0%nav_lat,1) == SIZE(G1%nav_lat,1) .AND. SIZE(G0%nav_lat,2) == SIZE(G1%nav_lat,2) .AND. &
+     & SIZE(G0%nav_lon,1) == SIZE(G1%nav_lon,1) .AND. SIZE(G0%nav_lon,2) == SIZE(G1%nav_lon,2) ) THEN
+     IF(  MAXVAL( ABS(G0%nav_lat(:,:)- G1%nav_lat(:,:)) ) < 0.0001 .AND. &
+        & MAXVAL( ABS(G0%nav_lon(:,:)- G1%nav_lon(:,:)) ) < 0.0001 ) THEN
+        WRITE(*,*) ''
+        WRITE(*,*) 'same grid between parent and child domains => NO INTERPOLATION'
+        WRITE(*,*) ''
+        G1%bathy_meter = G0%bathy_meter
+        identical_grids = .TRUE.
+     ENDIF
+  ENDIF
+  
+  IF( .NOT.new_topo )   type_bathy_interp = 2   ! only one which works
+  !
+  !
+  ! what type of interpolation for bathymetry
+  IF( type_bathy_interp == 0 ) THEN
+     WRITE(*,*) 'Interpolation of high resolution bathymetry on child grid: Arithmetic average ...'
+  ELSE IF( type_bathy_interp == 1 ) THEN
+     WRITE(*,*) 'Interpolation of high resolution bathymetry on child grid: Median average ...'
+  ELSE IF( type_bathy_interp == 2 ) THEN     
+     WRITE(*,*) 'Interpolation of high resolution bathymetry on child grid: Bilinear interpolation ...'
+  ELSE     
+     WRITE(*,*) 'bad value for type_bathy_interp variable ( must be 0, 1 or 2 )'
+     STOP 
+  ENDIF
+  !
+  !
+  ! ---------------------------------------------------------------------------------
+  ! ===                 Bathymetry of the fine grid (step1)                       ===
+  ! ---------------------------------------------------------------------------------
+  ! ==> It gives G1%bathy_meter from G0%bathy_meter
+  ! ---------------------------------------------------------------------------------
+  
+  ! === Here: G0 is the grid associated with the new topography (as gebco or etopo) ===
+  
+  IF( .NOT. identical_grids ) THEN
+     !                                                               ! ----------------------------- 
+     IF( type_bathy_interp == 0 .OR. type_bathy_interp == 1 ) THEN   ! arithmetic or median averages
+        !                                                            ! ----------------------------- 
+        ALLOCATE(trouble_points(nxfin,nyfin))
+        trouble_points(:,:) = 0
+        !                       
+        DO jj = 2, nyfin
+           DO ji = 2, nxfin
+              !	    
+              ! fine grid cell extension               
+              Cell_lonmin = MIN(G1%glamf(ji-1,jj-1),G1%glamf(ji,jj-1),G1%glamf(ji,jj),G1%glamf(ji-1,jj))
+              Cell_lonmax = MAX(G1%glamf(ji-1,jj-1),G1%glamf(ji,jj-1),G1%glamf(ji,jj),G1%glamf(ji-1,jj))
+              Cell_latmin = MIN(G1%gphif(ji-1,jj-1),G1%gphif(ji,jj-1),G1%gphif(ji,jj),G1%gphif(ji-1,jj))
+              Cell_latmax = MAX(G1%gphif(ji-1,jj-1),G1%gphif(ji,jj-1),G1%gphif(ji,jj),G1%gphif(ji-1,jj)) 
+              !               
+              ! look for points in G0 (bathy dataset) contained in the fine grid cells  
+              iimin = 1
+              DO WHILE( G0%nav_lon(iimin,1) < Cell_lonmin ) 
+                 iimin = iimin + 1
+              ENDDO
+              !               
+              jjmin = 1
+              DO WHILE( G0%nav_lat(iimin,jjmin) < Cell_latmin ) 
+                 jjmin = jjmin + 1
+              ENDDO
+              !                
+              iimax = iimin 
+              DO WHILE( G0%nav_lon(iimax,1) <= Cell_lonmax ) 
+                 iimax = iimax + 1
+                 iimax = MIN( iimax,SIZE(G0%bathy_meter,1))
+              ENDDO
+              !                               
+              jjmax = jjmin 
+              DO WHILE( G0%nav_lat(iimax,jjmax) <= Cell_latmax ) 
+                 jjmax = jjmax + 1
+                 jjmax = MIN( jjmax,SIZE(G0%bathy_meter,2))
+              ENDDO
+              !
+              IF( ln_agrif_domain ) THEN
+                 iimax = iimax-1
+                 jjmax = jjmax-1
+              ELSE
+                 iimax = MAX(iimin,iimax-1)
+                 jjmax = MAX(jjmin,jjmax-1)
+              ENDIF
+              !               
+              iimin = MAX( iimin,1 )
+              jjmin = MAX( jjmin,1 )
+              iimax = MIN( iimax,SIZE(G0%bathy_meter,1))
+              jjmax = MIN( jjmax,SIZE(G0%bathy_meter,2))
+
+              nxhr = iimax - iimin + 1
+              nyhr = jjmax - jjmin + 1                    
+
+              IF( nxhr == 0 .OR. nyhr == 0 ) THEN
+                 !
+                 trouble_points(ji,jj) = 1
+                 !
+              ELSE
+                 !
+                 ALLOCATE( vardep(nxhr,nyhr), mask_oce(nxhr,nyhr) )
+                 vardep(:,:) = G0%bathy_meter(iimin:iimax,jjmin:jjmax)
+                 !
+                 WHERE( vardep(:,:) .GT. 0. )   ;   mask_oce = 1 ;
+                 ELSEWHERE                      ;   mask_oce = 0 ;
+                 ENDWHERE
+                 !
+                 nxyhr = nxhr*nyhr
+                 IF( SUM(mask_oce) < 0.5*(nxyhr) ) THEN ! if more than half of the points are on land then bathy fine = 0
+                    G1%bathy_meter(ji,jj) = 0.
+                 ELSE
+                    IF( type_bathy_interp == 0 ) THEN     ! Arithmetic average
+                       G1%bathy_meter(ji,jj) = SUM( vardep(:,:) * mask_oce(:,:) ) / SUM( mask_oce(:,:) )
+                    ELSE                                  ! Median average
+                       ALLOCATE(vardep1d(nxyhr))
+                       vardep1d = RESHAPE(vardep,(/ nxyhr /) )
+                       !!CALL ssort(vardep1d,nxyhr)
+                       CALL quicksort(vardep1d,1,nxyhr)
+                       !
+                       ! Calculate median
+                       IF (MOD(nxyhr,2) .NE. 0) THEN
+                          G1%bathy_meter(ji,jj) = vardep1d( nxyhr/2 + 1 )
+                       ELSE
+                          G1%bathy_meter(ji,jj) = 0.5 * ( vardep1d(nxyhr/2) + vardep1d(nxyhr/2+1) )
+                       END IF
+                       DEALLOCATE(vardep1d)   
+                    ENDIF
+                 ENDIF
+                 DEALLOCATE (mask_oce,vardep)
+                 !
+              ENDIF
+           ENDDO
+        ENDDO
+
+        IF( SUM( trouble_points ) > 0 ) THEN
+           PRINT*,'too much empty cells, proceed to bilinear interpolation'
+           type_bathy_interp = 2
+        ENDIF
+
+        DEALLOCATE(trouble_points)
+
+     ENDIF
+     !                                                       ! ----------------------------- 
+     IF( type_bathy_interp == 2) THEN                        ! Bilinear interpolation
+        !                                                    ! ----------------------------- 
+
+        ALLOCATE(masksrc(SIZE(G0%bathy_meter,1),SIZE(G0%bathy_meter,2)))
+        ALLOCATE(bathy_test(nxfin,nyfin))
+        !
+        WHERE(G0%bathy_meter.LE.0)   ;   masksrc = .FALSE.   ;
+        ELSEWHERE                    ;   masksrc = .TRUE.    ;
+        END WHERE
+        !            
+        ! compute remapping matrix thanks to SCRIP package            
+        CALL get_remap_matrix(G0%nav_lat,G1%nav_lat,G0%nav_lon,G1%nav_lon,masksrc,matrix,src_add,dst_add)
+        CALL make_remap(G0%bathy_meter,bathy_test,nxfin,nyfin,matrix,src_add,dst_add)  
+        !                                  
+        G1%bathy_meter = bathy_test               
+        !            
+        DEALLOCATE(masksrc)
+        DEALLOCATE(bathy_test) 
+
+     ENDIF
+     !            
+  ENDIF ! not identical grids
+  ! ---
+  ! At this stage bathymetry in meters has already been interpolated on fine grid
+  !                    => G1%bathy_meter(nxfin,nyfin)
+  !
+  ! Also G0 was the grid from the new bathymetry data set (etopo, gebco...) and not the coarse grid
+  ! ---
+  !
+  ! ---------------------------------------------------------------------------------
+  ! ===                 Bathymetry of the fine grid (step2)                       ===
+  ! ---------------------------------------------------------------------------------
+  ! ==> It gives an update of G1%bathy_meter and G1%bathy_level
+  ! ---------------------------------------------------------------------------------
+  ! From here on: G0 is the coarse grid
+  !
+  ! Coarse grid bathymetry : G0%bathy_meter (on the global grid)
+  IF( TRIM(parent_bathy_meter) /= '') THEN
+     status = read_bathy_meter(TRIM(parent_bathy_meter),G0)
+  ELSE
+     status = Read_bathy_level(TRIM(parent_bathy_level),G0)
+     CALL levels_to_meter(G0)
+  ENDIF
+
+  ! Coarse grid coordinatees : G0 coordinates
+  DEALLOCATE(G0%nav_lat,G0%nav_lon)
+  status = Read_coordinates(TRIM(parent_coordinate_file),G0)
+
+  ! allocate temporary arrays                  
+  IF (.NOT.ASSOCIATED(G0%gdepw_ps))       ALLOCATE(G0%gdepw_ps    (SIZE(G0%bathy_meter,1),SIZE(G0%bathy_meter,2)))
+  IF (.NOT.ASSOCIATED(G1%gdepw_ps))       ALLOCATE(G1%gdepw_ps    (SIZE(G1%bathy_meter,1),SIZE(G1%bathy_meter,2)))
+  IF (.NOT.ASSOCIATED(gdepw_ps_interp))   ALLOCATE(gdepw_ps_interp(SIZE(G1%bathy_meter,1),SIZE(G1%bathy_meter,2)))
+  !                       
+  IF( ln_agrif_domain ) THEN
+     boundary = npt_copy*irafx + nbghostcellsfine + 1
+  ELSE
+     boundary = npt_copy*irafx
+  ENDIF
+  !
+  ! compute G0%gdepw_ps and G1%gdepw_ps
+  CALL get_partial_steps(G0) 
+  CALL get_partial_steps(G1)
+  CALL bathymetry_control(G0%Bathy_level)
+  
+  ! ---------------------------------------
+  ! Bathymetry at the boundaries (npt_copy)                      
+  ! ---------------------------------------
+  ! 1st step: interpolate coarse bathy on the fine grid (using partial steps or not)
+  IF( ln_agrif_domain ) THEN                   
+     CALL Check_interp(G0,gdepw_ps_interp)
+  ELSE
+     gdepw_ps_interp = 0. * G1%gdepw_ps
+     !!CALL agrif_interp(G0%gdepw_ps,gdepw_ps_interp,'T')
+     CALL init_constant_bathy(G0%gdepw_ps,gdepw_ps_interp)
+  ENDIF
+
+  IF (.NOT.ASSOCIATED(G1%wgt))   ALLOCATE(G1%wgt(SIZE(G1%bathy_meter,1),SIZE(G1%bathy_meter,2)))
+  G1%wgt(:,:) = 0.
+  IF ((.NOT.ASSOCIATED(G0%wgt)).AND.bathy_update) THEN 
+     ALLOCATE(G0%wgt(SIZE(G0%nav_lat,1),SIZE(G0%nav_lat,2)))
+     G0%wgt(:,:) = 0.
+  ENDIF
+  !
+!!$  IF( new_topo ) THEN ! clem: no, do it even when there is no new topo
+  ! 2nd step: copy parent bathymetry at the boundaries
+  DO jj=1,nyfin   ! West and East
+     IF ( gdepw_ps_interp(nbghostcellsfine+1,jj) > 0. ) THEN
+        G1%gdepw_ps(1:boundary,jj) = gdepw_ps_interp(1:boundary,jj) 
+        G1%wgt(1:boundary,jj) = 1.
+     ELSE
+        G1%gdepw_ps(1:nbghostcellsfine+1,jj)=0. 
+     ENDIF
+     !
+     IF ( gdepw_ps_interp(nxfin-nbghostcellsfine,jj) > 0.) THEN
+        G1%gdepw_ps(nxfin-boundary+1:nxfin,jj)=gdepw_ps_interp(nxfin-boundary+1:nxfin,jj)
+        G1%wgt(nxfin-boundary+1:nxfin,jj) = 1.
+     ELSE
+        G1%gdepw_ps(nxfin-nbghostcellsfine:nxfin,jj) = 0.
+     ENDIF
+  END DO
+  !
+  DO ji=1,nxfin    ! South and North
+     IF (gdepw_ps_interp(ji,nbghostcellsfine+1)>0.) THEN
+        G1%gdepw_ps(ji,1:boundary) = gdepw_ps_interp(ji,1:boundary)
+        G1%wgt(ji,1:boundary) = 1.
+     ELSE
+        G1%gdepw_ps(ji,1:nbghostcellsfine+1)=0. 
+     ENDIF
+     !
+     IF (gdepw_ps_interp(ji,nyfin-nbghostcellsfine)>0.) THEN
+        G1%gdepw_ps(ji,nyfin-boundary+1:nyfin)=gdepw_ps_interp(ji,nyfin-boundary+1:nyfin)
+        G1%wgt(ji,nyfin-boundary+1:nyfin) = 1.
+     ELSE
+        G1%gdepw_ps(ji,nyfin-nbghostcellsfine:nyfin) = 0.
+     ENDIF
+  END DO
+  !
+  !clem: recalculate interpolation everywhere before linear connection (useless to me??)
+  IF( ln_agrif_domain ) THEN                
+     gdepw_ps_interp = 0.
+     CALL Check_interp(G0,gdepw_ps_interp)
+  ENDIF
+  !
+  ! -------------------------------------------------------
+  ! Bathymetry between boundaries and interior (npt_connect)                 
+  ! --------------------------------------------------------
+  ! Make linear connection (on npt_connect*irafx points) between the boundaries and the interior
+  IF( ln_agrif_domain ) THEN
+     boundary = (npt_copy + npt_connect)*irafx + nbghostcellsfine + 1
+  ELSE
+     boundary = (npt_copy + npt_connect)*irafx
+  ENDIF
+
+  IF( npt_connect > 0 ) THEN
+     WRITE(*,*) ' linear connection on ',npt_connect,'coarse grid points'
+
+     wghts = 1.
+     DO ji = boundary - npt_connect*irafx + 1 , boundary
+        wghts = wghts - (1. / (npt_connect*irafx + 1. ) )
+        DO jj=1,nyfin
+           IF (G1%gdepw_ps(nbghostcellsfine+1,jj) > 0.)       G1%wgt(ji,jj) = MAX(wghts, G1%wgt(ji,jj))  
+        END DO
+     END DO
+
+     wghts = 1.
+     DO ji = nxfin - (boundary - npt_connect*irafx), nxfin - boundary +1 , -1
+        wghts = wghts - (1. / (npt_connect*irafx + 1. ) )
+        DO jj=1,nyfin
+           IF (G1%gdepw_ps(nxfin-nbghostcellsfine,jj) > 0.)   G1%wgt(ji,jj) = MAX(wghts, G1%wgt(ji,jj))
+        END DO
+     END DO
+
+     wghts = 1.
+     DO jj = boundary - npt_connect*irafy + 1 , boundary
+        wghts = wghts - (1. / (npt_connect*irafy + 1. ) )
+        DO ji=1,nxfin
+           IF (G1%gdepw_ps(ji,nbghostcellsfine+1) > 0.)       G1%wgt(ji,jj) = MAX(wghts, G1%wgt(ji,jj))
+        END DO
+     END DO
+
+     wghts = 1.
+     DO jj = nyfin - (boundary - npt_connect*irafy) , nyfin - boundary +1, -1
+        wghts = wghts - (1. / (npt_connect*irafy + 1. ) )
+        DO ji=1,nxfin
+           IF (G1%gdepw_ps(ji,nyfin-nbghostcellsfine) > 0.)   G1%wgt(ji,jj) = MAX(wghts, G1%wgt(ji,jj))
+        END DO
+     END DO
+     IF (.NOT.identical_grids) THEN
+        G1%gdepw_ps(:,:) = (1.-G1%wgt(:,:)) * G1%gdepw_ps(:,:) + gdepw_ps_interp(:,:)*G1%wgt(:,:)
+     ENDIF
+
+  ENDIF
+!!$  ENDIF
+
+  ! replace G1%bathy_meter by G1%gdepw_ps
+  G1%bathy_meter = G1%gdepw_ps
+  !                     
+  ! --------------------
+  ! Bathymetry smoothing                 
+  ! --------------------
+  IF( smoothing .AND. (.NOT.identical_grids) ) THEN
+     ! Chanut: smoothing everywhere then discard result in connection zone
+     CALL smooth_topo(G1%gdepw_ps(:,:),nbiter)
+     WHERE (G1%wgt(:,:)==0.) G1%bathy_meter(:,:) = G1%gdepw_ps(:,:)
+  ELSE
+     WRITE(*,*) 'No smoothing process only connection is carried out'
+  ENDIF
+  !
+  ! ------------------
+  ! Remove closed seas
+  ! ------------------
+  IF (removeclosedseas) THEN
+     ALLOCATE(bathy_test(nxfin,nyfin))
+     bathy_test=0.
+     WHERE (G1%bathy_meter(1,:)    .GT.0.)   bathy_test(1,:)=1
+     WHERE (G1%bathy_meter(nxfin,:).GT.0.)   bathy_test(nxfin,:)=1
+     WHERE (G1%bathy_meter(:,1)    .GT.0.)   bathy_test(:,1)=1
+     WHERE (G1%bathy_meter(:,nyfin).GT.0.)   bathy_test(:,nyfin)=1
+
+     nbadd = 1
+     DO WHILE (nbadd.NE.0)
+        nbadd = 0
+        DO jj=2,nyfin-1
+           DO ji=2,nxfin-1
+              IF (G1%bathy_meter(ji,jj).GT.0.) THEN
+                 IF (MAX(bathy_test(ji,jj+1),bathy_test(ji,jj-1),bathy_test(ji-1,jj),bathy_test(ji+1,jj)).EQ.1) THEN
+                    IF (bathy_test(ji,jj).NE.1.) nbadd = nbadd + 1
+                    bathy_test(ji,jj)=1.
+                 ENDIF
+
+              ENDIF
+           ENDDO
+        ENDDO
+     ENDDO
+     WHERE (bathy_test.EQ.0.)   G1%bathy_meter = 0.
+     DEALLOCATE(bathy_test)
+  ENDIF
+  !
+  CALL get_partial_steps(G1)  ! recompute bathy_level and gdepw_ps for G1 (and correct bathy_meter)
+  !
+  ! update parent grid
+  IF(bathy_update) THEN
+     CALL Update_Parent_Bathy( G0,G1 ) 
+     status = Write_Bathy_meter(TRIM(parent_bathy_meter_updated),G0)
+     status = write_domcfg(TRIM(parent_domcfg_updated),G0)
+  ENDIF
+  !
+  ! store interpolation result in output file
+  IF( TRIM(parent_bathy_level) /= '' )   status = Write_Bathy_level(TRIM(child_level),G1)
+  IF( TRIM(parent_bathy_meter) /= '' )   status = Write_Bathy_meter(TRIM(child_meter),G1)
+  IF( TRIM(parent_domcfg_out)  /= '' )   status = write_domcfg(TRIM(child_domcfg),G1)
+  !
+  WRITE(*,*) '****** Bathymetry successfully created ******'
+  STOP
+  !
+END PROGRAM create_bathy
+
+
Index: /utils/tools_ticket2413/NESTING/src/agrif_create_coordinates.f90
===================================================================
--- /utils/tools_ticket2413/NESTING/src/agrif_create_coordinates.f90	(revision 12863)
+++ /utils/tools_ticket2413/NESTING/src/agrif_create_coordinates.f90	(revision 12863)
@@ -0,0 +1,206 @@
+PROGRAM create_coordinate
+  !
+  USE NETCDF
+  USE agrif_readwrite
+  USE agrif_interpolation
+  !	     
+  !****************************************************************      
+  !								*
+  !************************************************************************
+  ! Fortran 95 OPA Nesting tools						*
+  !									*
+  !     Copyright (C) 2005 Florian Lemarié (Florian.Lemarie@imag.fr)	*
+  !									*
+  !************************************************************************
+  !
+  ! PROGRAM CREATE_COORDINATE 					*
+  !								*
+  ! program to create coordinates file for child grid		*
+  ! (child grid defined by imin,imax,jmin,jmax,rho)		*
+  !								*
+  !****************************************************************
+  !
+  ! variables declaration
+  !
+  REAL*8 :: rpi,ra,rad
+  CHARACTER*100 :: Child_filename 
+  INTEGER :: i
+  TYPE(Coordinates) :: G0,G1
+  INTEGER :: narg,iargc
+  CHARACTER(len=80) :: namelistname
+
+  narg = iargc()
+
+  IF (narg == 0) THEN
+     namelistname = 'namelist.input'
+  ELSE
+     CALL getarg(1,namelistname)
+  ENDIF
+  !
+  ! read input file (namelist.input)
+  CALL read_namelist(namelistname)
+  !      
+  ! read parent coodinates file
+  status = Read_Coordinates(TRIM(parent_coordinate_file),G0)
+  ! 
+  ! define name of child coordinate file
+  CALL set_child_name(parent_coordinate_file,Child_filename) 
+  !
+  IF( imax > SIZE(G0%glamt,1) .OR. jmax > SIZE(G0%glamt,2) .OR. imax <= imin .OR. jmax <= jmin ) THEN                    
+     WRITE(*,*) 'ERROR ***** bad child grid definition ...'
+     WRITE(*,*) 'please check imin,jmin,imax,jmax,jpizoom,jpjzoom values'       
+     WRITE(*,*) ' '
+     STOP
+  ENDIF
+  !                      
+  WRITE(*,*) ' '
+  WRITE(*,*)'Size of the High resolution grid: ',nxfin,' x ',nyfin
+  WRITE(*,*) ' '
+  !
+  ! allocation of child grid elements
+  CALL agrif_grid_allocate(G1,nxfin,nyfin)
+  !
+  !  check potential longitude problems 
+  IF( G0%glamt(imin,jmin) > G0%glamt(imax,jmax) ) THEN           
+     WHERE ( G0%glamt < 0 )   G0%glamt = G0%glamt + 360.
+     WHERE ( G0%glamf < 0 )   G0%glamf = G0%glamf + 360.
+  ENDIF
+  !      
+  ! interpolation from parent grid to child grid for
+  ! T points (cell center)
+  ! F points (lower left corner)
+  ! U points (cell left side)
+  ! V points (cell top side)
+  !    glam = longitude
+  !    gphi = latitude
+  !
+  !      
+  CALL agrif_interp(G0%glamt,G1%glamt,'T')
+  CALL agrif_interp(G0%glamf,G1%glamf,'F')
+  CALL agrif_interp(G0%glamu,G1%glamu,'U')
+  CALL agrif_interp(G0%glamv,G1%glamv,'V') 
+  !
+  CALL agrif_interp(G0%gphit,G1%gphit,'T')
+  CALL agrif_interp(G0%gphif,G1%gphif,'F')
+  CALL agrif_interp(G0%gphiu,G1%gphiu,'U')
+  CALL agrif_interp(G0%gphiv,G1%gphiv,'V')
+  !
+  !
+  rpi = 4.*ATAN(1.)
+  rad = rpi/180.
+  ra  = 6371229.
+  !
+  ! Compute scale factors e1 e2
+!  DO j=1,nyfin
+!     DO i=2,nxfin
+!        G1%e1t(i,j) = ra * rad * SQRT( (COS(rad*G1%gphit(i,j))*(G1%glamu(i,j)-G1%glamu(i-1,j)))**2 &
+!             + (G1%gphiu(i,j)-G1%gphiu(i-1,j))**2)
+!        G1%e1v(i,j) = ra * rad * SQRT( (COS(rad*G1%gphiv(i,j))*(G1%glamf(i,j)-G1%glamf(i-1,j)))**2 &
+!             + (G1%gphif(i,j)-G1%gphif(i-1,j))**2)                                                             
+!     END DO
+!  END DO
+!  !      
+!  G1%e1t(1,:)=G1%e1t(2,:)
+!  G1%e1v(1,:)=G1%e1v(2,:)
+!  !
+!  DO j=1,nyfin
+!     DO i=1,nxfin-1
+!        G1%e1u(i,j) = ra * rad * SQRT( (COS(rad*G1%gphiu(i,j))*(G1%glamt(i+1,j)-G1%glamt(i,j)))**2 &
+!             + (G1%gphit(i+1,j)-G1%gphit(i,j))**2)
+!        G1%e1f(i,j) = ra * rad * SQRT( (COS(rad*G1%gphif(i,j))*(G1%glamv(i+1,j)-G1%glamv(i,j)))**2 &
+!             + (G1%gphiv(i+1,j)-G1%gphiv(i,j))**2)                                                            
+!     END DO
+!  END DO
+!  !
+!  G1%e1u(nxfin,:)=G1%e1u(nxfin-1,:)
+!  G1%e1f(nxfin,:)=G1%e1f(nxfin-1,:)
+!  !
+!  DO j=2,nyfin
+!     DO i=1,nxfin                                     
+!        G1%e2t(i,j) = ra * rad * SQRT( (COS(rad*G1%gphit(i,j))*(G1%glamv(i,j)-G1%glamv(i,j-1)))**2 &
+!             + (G1%gphiv(i,j)-G1%gphiv(i,j-1))**2)
+!        G1%e2u(i,j) = ra * rad * SQRT( (COS(rad*G1%gphiu(i,j))*(G1%glamf(i,j)-G1%glamf(i,j-1)))**2 &
+!             + (G1%gphif(i,j)-G1%gphif(i,j-1))**2)                                                               
+!     END DO
+!  END DO
+!  !
+!  G1%e2t(:,1)=G1%e2t(:,2)
+!  G1%e2u(:,1)=G1%e2u(:,2)
+!  !
+!  DO j=1,nyfin-1
+!     DO i=1,nxfin
+!        G1%e2v(i,j) = ra * rad * SQRT( (COS(rad*G1%gphiv(i,j))*(G1%glamt(i,j+1)-G1%glamt(i,j)))**2 &
+!             + (G1%gphit(i,j+1)-G1%gphit(i,j))**2)
+!        G1%e2f(i,j) = ra * rad * SQRT( (COS(rad*G1%gphif(i,j))*(G1%glamu(i,j+1)-G1%glamu(i,j)))**2 &
+!             + (G1%gphiu(i,j+1)-G1%gphiu(i,j))**2)
+!     END DO
+!  END DO
+!  !
+!  G1%e2v(:,nyfin)=G1%e2v(:,nyfin-1)
+!  G1%e2f(:,nyfin)=G1%e2f(:,nyfin-1)
+
+
+  CALL agrif_interp(G0%e1t,G1%e1t,'T')   ;   G1%e1t = G1%e1t / REAL(irafx)
+  CALL agrif_interp(G0%e2t,G1%e2t,'T')   ;   G1%e2t = G1%e2t / REAL(irafy)
+
+  CALL agrif_interp(G0%e1u,G1%e1u,'U')   ;   G1%e1u = G1%e1u / REAL(irafx)
+  CALL agrif_interp(G0%e2u,G1%e2u,'U')   ;   G1%e2u = G1%e2u / REAL(irafy)  
+
+  CALL agrif_interp(G0%e1v,G1%e1v,'V')   ;   G1%e1v = G1%e1v / REAL(irafx)
+  CALL agrif_interp(G0%e2v,G1%e2v,'V')   ;   G1%e2v = G1%e2v / REAL(irafy) 
+
+  CALL agrif_interp(G0%e1f,G1%e1f,'F')   ;   G1%e1f = G1%e1f / REAL(irafx)
+  CALL agrif_interp(G0%e2f,G1%e2f,'F')   ;   G1%e2f = G1%e2f / REAL(irafy)
+  !
+  WHERE ( G1%glamt > 180 )   G1%glamt = G1%glamt - 360.
+  WHERE ( G1%glamf > 180 )   G1%glamf = G1%glamf - 360.
+  WHERE ( G1%glamu > 180 )   G1%glamu = G1%glamu - 360.
+  WHERE ( G1%glamv > 180 )   G1%glamv = G1%glamv - 360.
+  !
+  G1%nav_lon=G1%glamt
+  G1%nav_lat=G1%gphit 
+  !              
+  ! Write interpolation result in child coodinates file
+  status = Write_Coordinates(TRIM(Child_filename),G1)
+  !
+  WRITE(*,*) 'Position of the inner Child domain (i.e. without borders(masked) and ghostcells) : '
+  IF( ln_agrif_domain ) THEN
+     WRITE(*,*) 'latmin =',G1%gphit(2+nbghostcellsfine,2+nbghostcellsfine)
+     WRITE(*,*) 'latmax =',G1%gphit(nxfin-(1+nbghostcellsfine),nyfin-(1+nbghostcellsfine))
+     WRITE(*,*) 'lonmin =',G1%glamt(2+nbghostcellsfine,2+nbghostcellsfine)
+     WRITE(*,*) 'lonmax =',G1%glamt(nxfin-(1+nbghostcellsfine),nyfin-(1+nbghostcellsfine))
+  ELSE
+     WRITE(*,*) 'latmin =',G1%gphit(1,1)
+     WRITE(*,*) 'latmax =',G1%gphit(nxfin,nyfin)
+     WRITE(*,*) 'lonmin =',G1%glamt(1,1)
+     WRITE(*,*) 'lonmax =',G1%glamt(nxfin,nyfin)
+  ENDIF
+  STOP
+END PROGRAM create_coordinate
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /utils/tools_ticket2413/NESTING/src/agrif_create_data.f90
===================================================================
--- /utils/tools_ticket2413/NESTING/src/agrif_create_data.f90	(revision 12863)
+++ /utils/tools_ticket2413/NESTING/src/agrif_create_data.f90	(revision 12863)
@@ -0,0 +1,73 @@
+PROGRAM create_data
+  !
+  USE io_netcdf
+  USE bilinear_interp
+  USE agrif_readwrite
+  USE agrif_interpolation      
+  !
+  IMPLICIT NONE
+  !
+  !************************************************************************
+  ! 									*
+  ! PROGRAM  CREATE_DATA					        *
+  !									*
+  ! program to implement data interpolation to generate	 		*
+  ! child grid forcing files						*
+  !									*
+  !Interpolation is carried out using bilinear interpolation		*
+  !routine from SCRIP package						*		
+  !									*
+  !http://climate.lanl.gov/Software/SCRIP/				*
+  !************************************************************************
+  !
+  INTEGER           :: narg, iargc, ji
+  CHARACTER(len=80) :: namelistname
+
+  narg = iargc()
+
+  IF (narg == 0) THEN
+     namelistname = 'namelist.input'
+  ELSE
+     CALL getarg(1,namelistname)
+  ENDIF
+
+  ! read input file (namelist.input)
+  CALL read_namelist(namelistname)
+  !
+  ! Interpolate U grid  data
+  ji = 1
+  DO WHILE( TRIM(U_Files(ji)) /= '' )
+     PRINT *,'Grid U forcing files = ',u_files(ji)
+     !        
+     CALL Interp_Extrap_var(U_FILES(ji), 'U') 
+     ji = ji+1                
+     !             
+  END DO
+
+  !
+  ! Interpolate V grid  data
+  ji = 1
+  DO WHILE( TRIM(V_Files(ji)) /= '' )
+     PRINT *,'Grid V forcing files = ',v_files(ji)
+     !        
+     CALL Interp_Extrap_var(V_FILES(ji), 'V') 
+     ji = ji+1                
+     !             
+  END DO
+  !
+  ! Interpolate flux data
+  ji = 1
+  DO WHILE( TRIM(Flx_Files(ji)) /= '' )
+     PRINT *,'flxfiles = ',flx_files(ji)
+     !        
+     CALL Interp_Extrap_var(FLX_FILES(ji), 'T') 
+     ji = ji+1                
+     !             
+  END DO
+  !
+  WRITE(*,*) ' '
+  WRITE(*,*) '******* forcing files successfully created *******' 
+  WRITE(*,*) ' '  
+  !
+  STOP
+END PROGRAM create_data
Index: /utils/tools_ticket2413/NESTING/src/agrif_create_restart.f90
===================================================================
--- /utils/tools_ticket2413/NESTING/src/agrif_create_restart.f90	(revision 12863)
+++ /utils/tools_ticket2413/NESTING/src/agrif_create_restart.f90	(revision 12863)
@@ -0,0 +1,548 @@
+!
+!************************************************************************
+! Fortran 95 OPA Nesting tools						*
+!									*
+!     Copyright (C) 2005 Florian Lemari�(Florian.Lemarie@imag.fr)	*
+!									*
+!************************************************************************
+!
+PROGRAM create_rstrt
+  !
+  USE NETCDF
+  USE bilinear_interp
+  USE bicubic_interp
+  USE agrif_readwrite
+  USE io_netcdf 
+  USE agrif_extrapolation
+  USE agrif_interpolation
+  USE agrif_partial_steps        
+  USE agrif_connect_topo
+  !
+  IMPLICIT NONE
+  !
+  !************************************************************************
+  ! 									*
+  ! PROGRAM  CREATE_RSTRT							*
+  !									*
+  ! program to interpolate parent grid restart file to child grid		*
+  !									*
+  !									*
+  !Interpolation is carried out using bilinear interpolation		*
+  !routine from SCRIP package						*		
+  !									*
+  !http://climate.lanl.gov/Software/SCRIP/				*
+  !************************************************************************
+  !
+  ! variables declaration
+  !      
+  CHARACTER*20,DIMENSION(:),POINTER :: Ncdf_varname => NULL()
+  CHARACTER*20 :: vert_coord_name
+  CHARACTER*1 :: posvar
+  CHARACTER*100 :: Child_file,Childcoordinates,varname,Child_Bathy_Level,Child_Bathy_Meter   
+  REAL*8, POINTER, DIMENSION(:,:,:) :: tabvar3d => NULL()
+  REAL*8, POINTER, DIMENSION(:,:,:,:) :: un,ub,vn,vb,tn,tb,sn,sb,e3t_n,e3t_b => NULL()
+  REAL*8, POINTER, DIMENSION(:,:,:) :: sshn,sshb => NULL()      
+  REAL*8, POINTER, DIMENSION(:,:,:,:) :: tabinterp4d,tabvar1,tabvar2,tabvar3 => NULL()
+  REAL*8, POINTER, DIMENSION(:) :: tabtemp1D,nav_lev => NULL()
+  REAL*8, POINTER, DIMENSION(:,:) :: tabtemp2D => NULL()
+  REAL*8, POINTER, DIMENSION(:,:,:,:) :: tabtemp4D => NULL()
+  INTEGER,DIMENSION(:),POINTER :: src_add,dst_add  => NULL()
+  REAL*8,DIMENSION(:,:),POINTER :: matrix => NULL()
+  LOGICAL,DIMENSION(:,:),POINTER :: masksrc => NULL()
+  LOGICAL, DIMENSION(:,:,:), POINTER :: detected_pts
+  LOGICAL :: Interpolation,Extrapolation,Pacifique
+  INTEGER :: narg,iargc,ncid,x,y,z,z_a,x_a,y_a,z_b,nbvert_lev
+  REAL*8 :: now_wght,before_wght
+  INTEGER :: status,ii,jk
+  CHARACTER(len=20),DIMENSION(4) :: dimnames
+  CHARACTER(len=80) :: namelistname
+  TYPE(Coordinates) :: G0,G1
+  REAL*8 :: tabtemp0dreal
+  CHARACTER(len=20) :: timedimname
+
+  LOGICAL, PARAMETER :: conservation = .FALSE.
+  !      
+  !       
+  narg = iargc()
+  IF (narg == 0) THEN
+     namelistname = 'namelist.input'
+  ELSE
+     CALL getarg(1,namelistname)
+  ENDIF
+  !
+  ! read input file
+  !
+  CALL read_namelist(namelistname)
+  !      
+  IF(TRIM(restart_file) == '') THEN
+     WRITE(*,*) 'no restart file specified in ',TRIM(namelistname)
+     STOP
+  END IF
+
+  IF (iom_activated) THEN
+     timedimname = 'time_counter'
+  ELSE
+     timedimname='time'
+  ENDIF
+
+  !
+  WRITE(*,*) ''
+  WRITE(*,*) 'Interpolation of restart file : ',TRIM(restart_file)
+  WRITE(*,*) ''
+  !
+  CALL Read_Ncdf_VarName(restart_file,Ncdf_varname)
+  !       
+  CALL set_child_name(parent_coordinate_file,Childcoordinates)   
+  IF( TRIM(parent_bathy_level) /= '' )   CALL set_child_name(parent_bathy_level,Child_Bathy_Level) 
+  IF( TRIM(parent_bathy_meter) /= '' )   CALL set_child_name(parent_bathy_meter,Child_Bathy_Meter)   
+  !
+  ! create this file
+  !
+  CALL set_child_name(restart_file,Child_file)
+  status = nf90_create(Child_file,NF90_WRITE,ncid)
+  status = nf90_close(ncid)
+  WRITE(*,*) 'Child grid restart file name = ',TRIM(Child_file)      
+  WRITE(*,*) ''
+
+  ! 
+  ! read dimensions in parent restart file
+  !
+  CALL Read_Ncdf_dim('x',restart_file,x)
+  CALL Read_Ncdf_dim('y',restart_file,y) 
+  CALL Read_Ncdf_dim('nav_lev',restart_file,z)
+  IF (.NOT.iom_activated) THEN
+     CALL Read_Ncdf_dim('x_a',restart_file,x_a)
+     CALL Read_Ncdf_dim('y_a',restart_file,y_a)
+     CALL Read_Ncdf_dim('z_a',restart_file,z_a)
+     CALL Read_Ncdf_dim('z_b',restart_file,z_b)
+  ENDIF
+
+  IF( z .NE. N ) THEN
+     WRITE(*,*) '***'
+     WRITE(*,*) 'Number of vertical levels doesn t match between namelist and restart file'
+     WRITE(*,*) 'Please check the values in namelist file'
+     STOP
+  ENDIF
+  !
+  ! mask initialization for extrapolation and interpolation
+  ! 
+  WRITE(*,*) 'mask initialisation on coarse and fine grids'
+  !           
+  status = Read_Local_Coordinates(parent_coordinate_file,G0,(/jpizoom,jpjzoom/),(/x,y/))
+  status = Read_Coordinates(Childcoordinates,G1,Pacifique)
+  !
+  !longitude modification if child domain covers Pacific ocean area
+  !      
+  IF( Pacifique ) THEN
+     !
+     WHERE( G0%nav_lon < 0 )
+        G0%nav_lon = G0%nav_lon + 360.
+     END WHERE
+     !              
+     WHERE( G1%nav_lon < 0 )
+        G1%nav_lon = G1%nav_lon + 360.
+     END WHERE
+     !
+  ENDIF
+  !
+  ! one needs bathy_level
+  IF( TRIM(parent_bathy_level) /= '' ) THEN
+     status = Read_bathy_level(TRIM(parent_bathy_level),G0)
+     status = Read_bathy_level(TRIM(child_bathy_level),G1)
+  ELSE
+     status = read_bathy_meter(TRIM(parent_bathy_meter),G0)
+     status = read_bathy_meter(TRIM(child_bathy_meter),G1)
+     CALL meter_to_levels(G0)
+     CALL meter_to_levels(G1)
+  ENDIF
+  ! get masks
+  CALL Init_mask(parent_bathy_level,G0,x,y)
+  CALL Init_mask(child_bathy_level,G1,1,1)
+
+  G0%tmask = 1.    
+
+  DO jk=1,z
+     ALLOCATE(tabvar1(x,y,1,1))
+     CALL Read_Ncdf_var('sn',TRIM(restart_file),tabvar1,1,jk)
+     WHERE( tabvar1(:,:,1,1) == 0. ) 
+        G0%tmask(:,:,jk) = 0.
+     END WHERE
+     DEALLOCATE(tabvar1)
+  END DO
+  !
+  G0%umask(1:x-1,:,:) = G0%tmask(1:x-1,:,:)*G0%tmask(2:x,:,:)
+  G0%umask(x,:,:)     = G0%tmask(x,:,:)
+  G0%vmask(:,1:y-1,:) = G0%tmask(:,1:y-1,:)*G0%tmask(:,2:y,:)
+  G0%vmask(:,y,:)     = G0%tmask(:,y,:)
+  !      
+  G0%fmask(1:x-1,1:y-1,:) = G0%tmask(1:x-1,1:y-1,:)*G0%tmask(2:x,1:y-1,:)* &
+     &                      G0%tmask(1:x-1,2:y,:)*G0%tmask(2:x,2:y,:) 
+  G0%fmask(x,:,:) = G0%tmask(x,:,:)
+  G0%fmask(:,y,:) = G0%tmask(:,y,:)
+  !
+  !
+  ! write dimensions in output file
+  WRITE(*,*) 'write dimensions'
+  !          
+  CALL Write_Ncdf_dim('x',Child_file,nxfin)
+  CALL Write_Ncdf_dim('y',Child_file,nyfin)
+  CALL Write_Ncdf_dim('nav_lev',Child_file,z)
+  CALL Write_Ncdf_dim(TRIM(timedimname),Child_file,0) 
+  IF (.NOT.iom_activated) THEN
+     CALL Write_Ncdf_dim('x_a',Child_file,x_a)
+     CALL Write_Ncdf_dim('y_a',Child_file,y_a)
+     CALL Write_Ncdf_dim('z_a',Child_file,z_a)
+     CALL Write_Ncdf_dim('z_b',Child_file,z_b)
+  ENDIF
+  !
+  !
+  !
+  !
+  DO ii = 1,SIZE(Ncdf_varname)      
+     !      
+     ! loop on variables names
+     varname = TRIM(Ncdf_varname(ii))
+     WRITE(*,*) 'var = ',TRIM(varname)     
+     !      
+     SELECT CASE (TRIM(varname))
+        !
+     CASE('nav_lon')
+        CALL Read_Ncdf_var('nav_lon',TRIM(Childcoordinates),tabtemp2D) 
+        CALL Write_Ncdf_var('nav_lon',(/'x','y'/),Child_file,tabtemp2D,'float')
+        CALL Copy_Ncdf_att('nav_lon',TRIM(restart_file),Child_file,MINVAL(tabtemp2D),MAXVAL(tabtemp2D))
+        DEALLOCATE(tabtemp2D)
+        Interpolation = .FALSE.
+        !	     
+     CASE('nav_lat')             
+        CALL Read_Ncdf_var('nav_lat',TRIM(Childcoordinates),tabtemp2D) 
+        CALL Write_Ncdf_var('nav_lat',(/'x','y'/),Child_file,tabtemp2D,'float')
+        CALL Copy_Ncdf_att('nav_lat',TRIM(restart_file),Child_file,MINVAL(tabtemp2D),MAXVAL(tabtemp2D)) 
+        DEALLOCATE(tabtemp2D)
+        Interpolation = .FALSE.
+        !
+     CASE('nav_lev')
+        CALL Read_Ncdf_var('nav_lev',TRIM(restart_file),nav_lev) 
+        CALL Write_Ncdf_var('nav_lev','nav_lev',Child_file,nav_lev,'float')
+        CALL Copy_Ncdf_att('nav_lev',TRIM(restart_file),Child_file)      
+        Interpolation = .FALSE.
+        !
+     CASE('time')
+        CALL Read_Ncdf_var('time',TRIM(restart_file),tabtemp1D) 
+        CALL Write_Ncdf_var('time',TRIM(timedimname),Child_file,tabtemp1D,'float')
+        CALL Copy_Ncdf_att('time',TRIM(restart_file),Child_file) 
+        DEALLOCATE(tabtemp1D)
+        Interpolation = .FALSE.
+        !
+     CASE('time_counter')
+        CALL Read_Ncdf_var('time_counter',TRIM(restart_file),tabtemp1D) 
+        tabtemp1D = tabtemp1D * rhot
+        CALL Write_Ncdf_var('time_counter',TRIM(timedimname),Child_file,tabtemp1D,'double')
+        CALL Copy_Ncdf_att('time_counter',TRIM(restart_file),Child_file) 
+        DEALLOCATE(tabtemp1D)
+        Interpolation = .FALSE.
+        !
+     CASE('kt','ndastp','adatrj','ntime','nn_fsbc','rdt') 
+        IF (iom_activated) THEN
+           CALL Read_Ncdf_var(TRIM(varname),TRIM(restart_file),tabtemp0dreal)  
+           SELECT CASE (TRIM(varname))
+           CASE('rdt')
+              tabtemp0dreal = tabtemp0dreal / rhot
+           CASE('kt')
+              tabtemp0dreal = tabtemp0dreal * rhot
+           END SELECT
+           CALL Write_Ncdf_var(TRIM(varname),Child_file,tabtemp0dreal,'double')
+        ELSE
+           CALL Read_Ncdf_var(TRIM(varname),TRIM(restart_file),tabtemp4D) 
+           dimnames(1)='x_a'
+           dimnames(2)='y_a'
+           dimnames(3)='z_b'
+           dimnames(4)=TRIM(timedimname)            
+           CALL Write_Ncdf_var(TRIM(varname),dimnames,Child_file,tabtemp4D,'double')
+           DEALLOCATE(tabtemp4D)
+        ENDIF
+        CALL Copy_Ncdf_att(TRIM(varname),TRIM(restart_file),Child_file) 
+        Interpolation = .FALSE.
+        !
+     CASE('frc_v','frc_t','frc_s') 
+        CALL Read_Ncdf_var(varname,TRIM(restart_ice_file),tabtemp0dreal)  
+        CALL Write_Ncdf_var(varname,Child_file,tabtemp0dreal,'double')
+        CALL Copy_Ncdf_att(varname,TRIM(restart_ice_file),Child_file) 
+        Interpolation = .FALSE.
+        !
+        ! Variable interpolation according to their position on grid
+        !                                   
+     CASE('ssu_m','utau_b','un_bf','un','ub')  
+        IF( Get_NbDims(TRIM(varname),TRIM(restart_file)) == 4 ) THEN
+           vert_coord_name = 'nav_lev'
+        ELSEIF( Get_NbDims(TRIM(varname),TRIM(restart_file)) == 3 ) THEN
+           vert_coord_name = '1'
+        ENDIF
+        posvar='U'
+        Interpolation = .TRUE.  
+        !
+     CASE('ssv_m','vtau_b','vn_bf','vn','vb')  
+        IF( Get_NbDims(TRIM(varname),TRIM(restart_file)) == 4 ) THEN
+           vert_coord_name = 'nav_lev'
+        ELSEIF( Get_NbDims(TRIM(varname),TRIM(restart_file)) == 3 ) THEN
+           vert_coord_name = '1'
+        ENDIF
+        posvar='V'
+        Interpolation = .TRUE.  
+        !
+     CASE DEFAULT
+        IF( Get_NbDims(TRIM(varname),TRIM(restart_file)) == 4 ) THEN
+           vert_coord_name = 'nav_lev'
+        ELSEIF( Get_NbDims(TRIM(varname),TRIM(restart_file)) == 3 ) THEN
+           vert_coord_name = '1'
+        ENDIF
+        posvar='T'
+        Interpolation = .TRUE.            
+        !      
+     END SELECT
+     !      
+     ! --- start interpolation --- !
+     IF( Interpolation ) THEN
+        !		  
+        IF( vert_coord_name == '1' ) THEN
+           nbvert_lev = 1
+        ELSE
+           nbvert_lev = z
+        ENDIF
+        !
+
+        ALLOCATE(detected_pts(SIZE(G0%tmask,1),SIZE(G0%tmask,2),nbvert_lev))                             
+        ALLOCATE(tabvar1(x,y,1,2))
+        ALLOCATE(tabvar2(x,y,1,1))
+        ALLOCATE(tabvar3(x,y,1,1))
+        ALLOCATE(masksrc(x,y))
+        ALLOCATE(tabinterp4d(nxfin,nyfin,1,1)) 
+
+        !	    
+        DO n = 1,nbvert_lev
+           !
+           WRITE(*,*) 'interpolate/extrapolate for vertical level = ',n   
+           !                           
+           CALL Read_Ncdf_var(varname,TRIM(restart_file),tabvar1,1,n)
+           IF(n==1) THEN
+              !                            
+           ELSE IF (n==2) THEN
+              tabvar2(:,:,:,1) = tabvar1(:,:,:,2)
+           ELSE
+              tabvar3(:,:,:,1) = tabvar2(:,:,:,1)
+              tabvar2(:,:,:,1) = tabvar1(:,:,:,2)
+
+           ENDIF
+           !                            
+           SELECT CASE(posvar)
+              ! 
+           CASE('T')
+              !
+              IF(MAXVAL(G1%tmask(:,:,n)) == 0.) THEN		      
+                 tabinterp4d = 0.0
+                 WRITE(*,*) 'only land points on level ',n                     
+              ELSE		       		      
+
+                 CALL extrap_detect(G0,G1,detected_pts(:,:,n),n)                                            
+
+                 CALL correct_field(detected_pts(:,:,n),tabvar1,tabvar2,tabvar3,G0,nav_lev,masksrc,n)                                 
+
+                 ! for the following variables, you do not want to mask the values
+                 IF(  TRIM(varname) == 'e3t_n' .OR. TRIM(varname) == 'e3t_b' .OR. TRIM(varname) == 'e3t_m' .OR. &
+                    & TRIM(varname) == 'fraqsr_1lev' .OR. TRIM(varname) == 'frq_m' .OR. TRIM(varname) == 'surf_ini' ) THEN
+                    masksrc(:,:) = .TRUE.
+                 ENDIF
+                 
+                 SELECT CASE(TRIM(interp_type))
+                 CASE('bilinear')                                                       
+                    CALL get_remap_matrix(G0%nav_lat,G1%nav_lat, &
+                       G0%nav_lon,G1%nav_lon,masksrc,matrix,src_add,dst_add)
+                    CALL make_remap(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1),nxfin,nyfin, &
+                       matrix,src_add,dst_add)     
+                 CASE('bicubic')                                   
+                    CALL get_remap_bicub(G0%nav_lat,G1%nav_lat, &
+                       G0%nav_lon,G1%nav_lon,masksrc,matrix,src_add,dst_add)
+                    CALL make_bicubic_remap(tabvar1(:,:,1,1),masksrc,tabinterp4d(:,:,1,1),&
+                       nxfin,nyfin,matrix,src_add,dst_add) 
+                 END SELECT
+                 !
+                 IF( conservation ) THEN ! clem: it currently does not work
+                    CALL Correctforconservation(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1), &
+                       G0%e1t,G0%e2t,G1%e1t,G1%e2t,nxfin,nyfin,posvar,imin-jpizoom+1,jmin-jpjzoom+1)
+                 ENDIF
+
+              ENDIF
+              
+              IF( ALL(masksrc) ) THEN
+                 tabinterp4d(:,:,1,1) =  tabinterp4d(:,:,1,1)
+              ELSE
+                 tabinterp4d(:,:,1,1) =  tabinterp4d(:,:,1,1) * G1%tmask(:,:,n)
+              ENDIF
+              !
+           CASE('U')
+              !
+              IF(MAXVAL(G1%umask(:,:,n)) == 0) THEN
+                 tabinterp4d = 0.0
+                 WRITE(*,*) 'only land points on level ',n  
+              ELSE		
+                 !
+                 CALL extrap_detect(G0,G1,detected_pts(:,:,n),n,'U')  
+                 CALL correct_field(detected_pts(:,:,n),tabvar1,tabvar2,tabvar3,G0,nav_lev,masksrc,n,'U')
+                 !                                                           
+                 SELECT CASE(TRIM(interp_type))
+                 CASE('bilinear')                                                       
+                    CALL get_remap_matrix(G0%gphiu,G1%gphiu,   &
+                       G0%glamu,G1%glamu,masksrc,matrix,src_add,dst_add)
+                    CALL make_remap(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1),nxfin,nyfin, &
+                       matrix,src_add,dst_add)     
+                 CASE('bicubic')                                   
+                    CALL get_remap_bicub(G0%gphiu,G1%gphiu,   &
+                       G0%glamu,G1%glamu,masksrc,matrix,src_add,dst_add)
+                    CALL make_bicubic_remap(tabvar1(:,:,1,1),masksrc,tabinterp4d(:,:,1,1),&
+                       nxfin,nyfin,matrix,src_add,dst_add)                        
+                 END SELECT
+                 !                      
+                 IF( conservation ) THEN ! clem: not coded for U
+                    CALL Correctforconservation(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1), &
+                       G0%e1u,G0%e2u,G1%e1u,G1%e2u,nxfin,nyfin,posvar,imin-jpizoom+1,jmin-jpjzoom+1)
+                 ENDIF
+              ENDIF
+
+              tabinterp4d(:,:,1,1) =  tabinterp4d(:,:,1,1) * G1%umask(:,:,n)
+              !
+           CASE('V')
+              !		
+              IF(MAXVAL(G1%vmask(:,:,n)) == 0) THEN
+                 tabinterp4d = 0.0
+                 WRITE(*,*) 'only land points on level ',n 
+              ELSE		
+                 !
+
+                 CALL extrap_detect(G0,G1,detected_pts(:,:,n),n,'V')
+
+                 CALL correct_field(detected_pts(:,:,n),tabvar1,tabvar2,tabvar3,G0,nav_lev,masksrc,n,'V')
+                 !                                                           
+                 SELECT CASE(TRIM(interp_type))
+                 CASE('bilinear')                                                       
+                    CALL get_remap_matrix(G0%gphiv,G1%gphiv,   &
+                       G0%glamv,G1%glamv,masksrc,matrix,src_add,dst_add)
+                    CALL make_remap(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1),nxfin,nyfin, &
+                       matrix,src_add,dst_add)     
+                 CASE('bicubic')                                   
+                    CALL get_remap_bicub(G0%gphiv,G1%gphiv,   &
+                       G0%glamv,G1%glamv,masksrc,matrix,src_add,dst_add)
+                    CALL make_bicubic_remap(tabvar1(:,:,1,1),masksrc,tabinterp4d(:,:,1,1),&
+                       nxfin,nyfin,matrix,src_add,dst_add)                        
+                 END SELECT
+                 !                      
+                 IF( conservation ) THEN ! clem: not coded for V
+                    CALL Correctforconservation(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1), &
+                       G0%e1v,G0%e2v,G1%e1v,G1%e2v,nxfin,nyfin,posvar,imin-jpizoom+1,jmin-jpjzoom+1)
+                 ENDIF
+              ENDIF
+
+              tabinterp4d(:,:,1,1) =  tabinterp4d(:,:,1,1) * G1%vmask(:,:,n)
+              !
+           END SELECT
+           !
+           !
+           dimnames(1)='x'
+           dimnames(2)='y'
+           IF( vert_coord_name == '1' ) THEN
+              dimnames(3)=TRIM(timedimname)
+              
+              ALLOCATE(tabvar3d(SIZE(tabinterp4d,1),SIZE(tabinterp4d,2),SIZE(tabinterp4d,3)))
+              tabvar3d=tabinterp4d(:,:,:,1)
+              CALL Write_Ncdf_var(TRIM(varname),dimnames,Child_file,tabvar3d,1,'double')
+              DEALLOCATE(tabvar3d)
+           ELSE
+              dimnames(3)=vert_coord_name
+              dimnames(4)=TRIM(timedimname)
+              
+              CALL Write_Ncdf_var(TRIM(varname),dimnames,Child_file,tabinterp4d,1,n,'double')
+           ENDIF
+           !             
+           !
+           CALL Copy_Ncdf_att(TRIM(varname),TRIM(restart_file),Child_file)
+           !
+           !
+           IF(ASSOCIATED(matrix)) DEALLOCATE(matrix,src_add,dst_add)   
+           !
+        END DO
+        ! 
+        DEALLOCATE(detected_pts)
+        DEALLOCATE(tabinterp4d)
+        DEALLOCATE(tabvar1,tabvar2,tabvar3)
+        DEALLOCATE(masksrc)  
+        !                     
+     ENDIF
+
+  END DO
+
+  ! change the before fields
+  IF(rhot == 1) THEN
+     WRITE(*,*) ''	 
+     WRITE(*,*) 'no time interpolation (time refinement ratio = 1)'
+  ELSE   
+     now_wght = (rhot-1.)/rhot
+     before_wght = 1./rhot
+     !    
+     ! --- 4D variables --- !               
+     CALL Read_Ncdf_var('un',Child_file,un)      
+     CALL Read_Ncdf_var('vn',Child_file,vn)
+     CALL Read_Ncdf_var('ub',Child_file,ub)
+     CALL Read_Ncdf_var('vb',Child_file,vb)
+     ub = now_wght*un + before_wght*ub
+     vb = now_wght*vn + before_wght*vb
+     !
+     CALL Read_Ncdf_var('tb',Child_file,tb)
+     CALL Read_Ncdf_var('tn',Child_file,tn)
+     tb = now_wght*tn + before_wght*tb
+     !
+     CALL Read_Ncdf_var('sb',Child_file,sb)
+     CALL Read_Ncdf_var('sn',Child_file,sn)            
+     sb = now_wght*sn + before_wght*sb
+     !
+     CALL Read_Ncdf_var('e3t_b',Child_file,e3t_b)
+     CALL Read_Ncdf_var('e3t_n',Child_file,e3t_n)            
+     e3t_b = now_wght*e3t_n + before_wght*e3t_b
+     !
+     dimnames(1)='x'
+     dimnames(2)='y'
+     dimnames(3)='nav_lev'
+     dimnames(4)=TRIM(timedimname)
+     CALL Write_Ncdf_var('ub',dimnames,Child_file,ub,'double')
+     CALL Write_Ncdf_var('vb',dimnames,Child_file,vb,'double')
+     CALL Write_Ncdf_var('tb',dimnames,Child_file,tb,'double')
+     CALL Write_Ncdf_var('sb',dimnames,Child_file,sb,'double')
+     CALL Write_Ncdf_var('e3t_b',dimnames,Child_file,e3t_b,'double')
+     !
+     DEALLOCATE(un,ub,vn,vb,tn,tb,sn,sb,e3t_n,e3t_b)
+     !----------------------               
+     !
+     ! --- 3D variables --- !	       
+     CALL Read_Ncdf_var('sshb',Child_file,sshb)
+     CALL Read_Ncdf_var('sshn',Child_file,sshn)
+     sshb = now_wght*sshn + before_wght*sshb
+     !
+     dimnames(1)='x'
+     dimnames(2)='y'
+     dimnames(3)=TRIM(timedimname)
+     CALL Write_Ncdf_var('sshb',dimnames,Child_file,sshb,'double')
+     !               
+     DEALLOCATE(sshn,sshb) 
+     !----------------------               
+     !    
+  ENDIF
+  !
+  !
+  WRITE(*,*) ' '
+  WRITE(*,*) ' --- list of all the variables that have been interpolated --- '
+  WRITE(*,*) Ncdf_varname
+  WRITE(*,*) ' '
+  WRITE(*,*) '******* restart file successfully created *******' 
+  WRITE(*,*) ' '
+  !
+  STOP 
+END PROGRAM
+
+
Index: /utils/tools_ticket2413/NESTING/src/agrif_create_restart_ice.f90
===================================================================
--- /utils/tools_ticket2413/NESTING/src/agrif_create_restart_ice.f90	(revision 12863)
+++ /utils/tools_ticket2413/NESTING/src/agrif_create_restart_ice.f90	(revision 12863)
@@ -0,0 +1,346 @@
+!
+!************************************************************************
+! Fortran 95 OPA Nesting tools						*
+!									*
+!     Copyright (C) 2005 Florian Lemari�(Florian.Lemarie@imag.fr)	*
+!									*
+!************************************************************************
+!
+PROGRAM create_rstrt_ice
+  !
+  USE NETCDF
+  USE bilinear_interp
+  USE bicubic_interp
+  USE agrif_readwrite
+  USE io_netcdf 
+  USE agrif_extrapolation
+  USE agrif_interpolation
+  USE agrif_partial_steps
+  USE agrif_connect_topo
+  !
+  IMPLICIT NONE
+  !
+  !************************************************************************
+  ! 									*
+  ! PROGRAM  CREATE_RSTRT_ICE     					*
+  !									*
+  ! program to interpolate parent grid restart file to child grid		*
+  !									*
+  !									*
+  !Interpolation is carried out using bilinear interpolation		*
+  !routine from SCRIP package						*		
+  !									*
+  !http://climate.lanl.gov/Software/SCRIP/				*
+  !************************************************************************
+  !
+  ! variables declaration
+  !      
+  CHARACTER*20,DIMENSION(:),POINTER :: Ncdf_varname => NULL()
+  CHARACTER*20 :: vert_coord_name
+  CHARACTER*1 :: posvar
+  CHARACTER*100 :: Child_file,Childcoordinates,varname,Child_Bathy_Level,Child_Bathy_Meter   
+  REAL*8, POINTER, DIMENSION(:,:,:) :: tabvar00, tabvar3d,mask => NULL()
+  REAL*8, POINTER, DIMENSION(:,:,:,:) :: tabinterp4d,tabvar0,tabvar1,tabvar2,tabvar3 => NULL()
+  REAL*8, POINTER, DIMENSION(:) :: tabtemp1D,nav_lev => NULL()
+  REAL*8, POINTER, DIMENSION(:,:) :: tabtemp2D => NULL()
+  INTEGER,DIMENSION(:),POINTER :: src_add,dst_add  => NULL()
+  REAL*8,DIMENSION(:,:),POINTER :: matrix => NULL()
+  LOGICAL,DIMENSION(:,:),POINTER :: masksrc => NULL()
+  LOGICAL, DIMENSION(:,:,:), POINTER :: detected_pts
+  LOGICAL :: Interpolation,Extrapolation,Pacifique
+  INTEGER :: narg,iargc,ncid,x,y,z
+  INTEGER :: ii,jl,status,varid,numdims
+  CHARACTER(len=20),DIMENSION(4) :: dimnames
+  CHARACTER(len=80) :: namelistname
+  TYPE(Coordinates) :: G0,G1
+  INTEGER :: jpl 
+  REAL*8 :: tabtemp0dreal
+
+  LOGICAL, PARAMETER :: conservation = .FALSE.
+  !       
+  narg = iargc()
+  IF (narg == 0) THEN
+     namelistname = 'namelist.input'
+  ELSE
+     CALL getarg(1,namelistname)
+  ENDIF
+  !
+  ! read input file
+  !
+  CALL read_namelist(namelistname)
+  !      
+  IF(TRIM(restart_ice_file) == '') THEN
+     WRITE(*,*) 'no ice restart file specified in ',TRIM(namelistname)
+     STOP
+  ENDIF
+
+  !
+  WRITE(*,*) ''
+  WRITE(*,*) 'Interpolation of restart file : ',TRIM(restart_ice_file)
+  WRITE(*,*) ''
+  !
+  CALL Read_Ncdf_VarName(restart_ice_file,Ncdf_varname)
+  !       
+  CALL set_child_name(parent_coordinate_file,Childcoordinates)   
+  IF( TRIM(parent_bathy_level) /= '' )   CALL set_child_name(parent_bathy_level,Child_Bathy_Level) 
+  IF( TRIM(parent_bathy_meter) /= '' )   CALL set_child_name(parent_bathy_meter,Child_Bathy_Meter)   
+  !
+  ! create this file
+  !
+  CALL set_child_name(restart_ice_file,Child_file)
+  status = nf90_create(Child_file,NF90_WRITE,ncid)
+  status = nf90_close(ncid)
+  WRITE(*,*) 'Child grid restart file name = ',TRIM(Child_file)      
+  WRITE(*,*) ''
+  ! 
+  ! read dimensions in parent restart file
+  !
+  CALL Read_Ncdf_dim('x',restart_ice_file,x)
+  CALL Read_Ncdf_dim('y',restart_ice_file,y) 
+  CALL Read_Ncdf_dim('numcat',restart_ice_file,z)
+
+  !
+  ! mask initialization for extrapolation and interpolation
+  ! 
+  WRITE(*,*) 'mask initialisation on coarse and fine grids'
+  !           
+  status = Read_Local_Coordinates(parent_coordinate_file,G0,(/jpizoom,jpjzoom/),(/x,y/))
+  status = Read_Coordinates(Childcoordinates,G1,Pacifique)
+  !
+  !longitude modification if child domain covers Pacific ocean area
+  !      
+  IF( Pacifique ) THEN
+     WHERE( G0%nav_lon < 0 )
+        G0%nav_lon = G0%nav_lon + 360.
+     END WHERE
+     WHERE( G1%nav_lon < 0 )
+        G1%nav_lon = G1%nav_lon + 360.
+     END WHERE
+  ENDIF
+  !
+  ! one needs bathy_level
+  IF( TRIM(parent_bathy_level) /= '' ) THEN
+     status = Read_bathy_level(TRIM(parent_bathy_level),G0)
+     status = Read_bathy_level(TRIM(child_bathy_level),G1)
+  ELSE
+     status = read_bathy_meter(TRIM(parent_bathy_meter),G0)
+     status = read_bathy_meter(TRIM(child_bathy_meter),G1)
+     CALL meter_to_levels(G0)
+     CALL meter_to_levels(G1)
+  ENDIF
+  ! get masks
+  CALL Init_mask(parent_bathy_level,G0,x,y)
+  CALL Init_mask(child_bathy_level,G1,nxfin,nyfin)
+  
+  !
+  ! write dimensions in output file
+  WRITE(*,*) 'write dimensions'
+  !          
+  CALL Write_Ncdf_dim('x',Child_file,nxfin)
+  CALL Write_Ncdf_dim('y',Child_file,nyfin)
+  CALL Write_Ncdf_dim('numcat',Child_file,z)
+  CALL Write_Ncdf_dim('time_counter',Child_file,0) 
+  !
+  !
+  DO ii = 1,SIZE(Ncdf_varname)      
+     !      
+     ! loop on variables names
+     varname = TRIM(Ncdf_varname(ii))
+     !      
+     WRITE(*,*) 'var = ',TRIM(varname)     
+     !
+     SELECT CASE (varname)
+        !
+        !copy nav_lon from child coordinates to output file      
+        !
+     CASE('nav_lon')
+        CALL Read_Ncdf_var(varname,TRIM(Childcoordinates),tabtemp2D) 
+        CALL Write_Ncdf_var(varname,(/'x','y'/),Child_file,tabtemp2D,'float')
+        CALL Copy_Ncdf_att(varname,TRIM(restart_ice_file),Child_file, MINVAL(tabtemp2D),MAXVAL(tabtemp2D))
+        DEALLOCATE(tabtemp2D)
+        Interpolation = .FALSE.
+        !	     
+        !copy nav_lat from child coordinates to output file
+        !
+     CASE('nav_lat')             
+        CALL Read_Ncdf_var(varname,TRIM(Childcoordinates),tabtemp2D) 
+        CALL Write_Ncdf_var(varname,(/'x','y'/),Child_file,tabtemp2D,'float')
+        CALL Copy_Ncdf_att(varname,TRIM(restart_ice_file),Child_file,MINVAL(tabtemp2D),MAXVAL(tabtemp2D)) 
+        DEALLOCATE(tabtemp2D)
+        Interpolation = .FALSE.
+        !
+        !copy numcat from restart_ice_file to output file
+        !
+     CASE('numcat')
+        CALL Read_Ncdf_var(varname,TRIM(restart_ice_file),nav_lev) 
+        CALL Write_Ncdf_var(varname,varname,Child_file,nav_lev,'float')
+        CALL Copy_Ncdf_att(varname,TRIM(restart_ice_file),Child_file)      
+        Interpolation = .FALSE.
+        !
+        !copy time from restart_ice_file to output file                       
+        !
+     CASE('time_counter')
+        CALL Read_Ncdf_var(varname,TRIM(restart_ice_file),tabtemp1D) 
+        tabtemp1D = tabtemp1D * rhot
+        CALL Write_Ncdf_var(varname,'time_counter',Child_file,tabtemp1D,'double')
+        CALL Copy_Ncdf_att(varname,TRIM(restart_ice_file),Child_file) 
+        DEALLOCATE(tabtemp1D)
+        Interpolation = .FALSE.
+        !
+        !copy info from restart_ice_file to output file
+        !
+     CASE('kt_ice') 
+        CALL Read_Ncdf_var(varname,TRIM(restart_ice_file),tabtemp0dreal)  
+        tabtemp0dreal = tabtemp0dreal * rhot
+        CALL Write_Ncdf_var(varname,Child_file,tabtemp0dreal,'double')
+        CALL Copy_Ncdf_att(varname,TRIM(restart_ice_file),Child_file) 
+        Interpolation = .FALSE.
+        !
+     CASE('nn_fsbc') 
+        CALL Read_Ncdf_var(varname,TRIM(restart_ice_file),tabtemp0dreal)  
+        CALL Write_Ncdf_var(varname,Child_file,tabtemp0dreal,'double')
+        CALL Copy_Ncdf_att(varname,TRIM(restart_ice_file),Child_file) 
+        Interpolation = .FALSE.
+        !
+     CASE('frc_voltop','frc_volbot','frc_temtop','frc_tembot') 
+        CALL Read_Ncdf_var(varname,TRIM(restart_ice_file),tabtemp0dreal)  
+        CALL Write_Ncdf_var(varname,Child_file,tabtemp0dreal,'double')
+        CALL Copy_Ncdf_att(varname,TRIM(restart_ice_file),Child_file) 
+        Interpolation = .FALSE.
+        !
+     CASE('u_ice')
+        vert_coord_name = '1'             
+        posvar='U'
+        Interpolation = .TRUE.            
+        
+     CASE('v_ice')
+        vert_coord_name = '1'             
+        posvar='V'
+        Interpolation = .TRUE.            
+
+     CASE('stress12_i')
+        vert_coord_name = '1'             
+        posvar='F'
+        Interpolation = .TRUE.            
+        
+     CASE DEFAULT
+        IF( Get_NbDims(TRIM(varname),TRIM(restart_ice_file)) == 4 ) THEN
+           vert_coord_name = 'numcat'
+        ELSEIF( Get_NbDims(TRIM(varname),TRIM(restart_ice_file)) == 3 ) THEN
+           vert_coord_name = '1'
+        ENDIF
+        posvar='T'
+        Interpolation = .TRUE.            
+        !      
+     END SELECT
+
+     ! --- start interpolation --- !
+     IF( Interpolation ) THEN
+        !
+        !
+        IF( vert_coord_name == '1' ) THEN
+           jpl = 1
+        ELSE
+           jpl = z
+        ENDIF
+        !
+        ALLOCATE(detected_pts(SIZE(G0%tmask,1),SIZE(G0%tmask,2),jpl))                             
+        ALLOCATE(tabvar00(x,y,1))
+        ALLOCATE(tabvar0(x,y,jpl,1))
+        ALLOCATE(tabvar1(x,y,1,1))
+        ALLOCATE(tabvar2(x,y,1,1))
+        ALLOCATE(tabvar3(x,y,1,1))
+        ALLOCATE(masksrc(x,y))
+        ALLOCATE(tabinterp4d(nxfin,nyfin,jpl,1)) 
+
+        IF( vert_coord_name == '1' ) THEN
+           CALL Read_Ncdf_var(varname,TRIM(restart_ice_file),tabvar00)
+        ELSE
+           CALL Read_Ncdf_var(varname,TRIM(restart_ice_file),tabvar0)
+        ENDIF
+
+        DO jl = 1, jpl
+           !
+           WRITE(*,*) 'interpolate/extrapolate for category = ',jl   
+           !
+           IF( vert_coord_name == '1' ) THEN
+              tabvar1(:,:,1,1) = tabvar00(:,:,1)
+              tabvar2(:,:,1,1) = tabvar00(:,:,1)
+              tabvar3(:,:,1,1) = tabvar00(:,:,1)
+           ELSE
+              tabvar1(:,:,1,1) = tabvar0(:,:,jl,1)
+              tabvar2(:,:,1,1) = tabvar0(:,:,jl,1)
+              tabvar3(:,:,1,1) = tabvar0(:,:,jl,1)
+           ENDIF
+           !
+           CALL extrap_detect(G0,G1,detected_pts(:,:,jl),1,posvar)                                            
+           CALL correct_field(detected_pts(:,:,jl),tabvar1,tabvar2,tabvar3,G0,nav_lev,masksrc,1,posvar) !clem: nav_lev is useless here
+           
+           SELECT CASE(TRIM(interp_type))
+           CASE('bilinear')                                                       
+              CALL get_remap_matrix(G0%nav_lat,G1%nav_lat,G0%nav_lon,G1%nav_lon,masksrc,matrix,src_add,dst_add)
+              CALL make_remap(tabvar1(:,:,1,1),tabinterp4d(:,:,jl,1),nxfin,nyfin,matrix,src_add,dst_add)
+           CASE('bicubic')                                   
+              CALL get_remap_bicub(G0%nav_lat,G1%nav_lat,G0%nav_lon,G1%nav_lon,masksrc,matrix,src_add,dst_add)
+              CALL make_bicubic_remap(tabvar1(:,:,1,1),masksrc,tabinterp4d(:,:,jl,1),nxfin,nyfin,matrix,src_add,dst_add) 
+           END SELECT
+           !
+           IF( conservation ) THEN ! clem: currently this does not work (and is only coded for T)
+              SELECT CASE (posvar)
+              CASE( 'T' )
+                 CALL Correctforconservation(tabvar1(:,:,1,1),tabinterp4d(:,:,jl,1), &
+                    &                        G0%e1t,G0%e2t,G1%e1t,G1%e2t,nxfin,nyfin,posvar,imin-jpizoom+1,jmin-jpjzoom+1)
+              CASE( 'U' )
+                 CALL Correctforconservation(tabvar1(:,:,1,1),tabinterp4d(:,:,jl,1), &
+                    &                        G0%e1u,G0%e2u,G1%e1u,G1%e2u,nxfin,nyfin,posvar,imin-jpizoom+1,jmin-jpjzoom+1)
+              CASE( 'V' )
+                 CALL Correctforconservation(tabvar1(:,:,1,1),tabinterp4d(:,:,jl,1), &
+                    &                        G0%e1v,G0%e2v,G1%e1v,G1%e2v,nxfin,nyfin,posvar,imin-jpizoom+1,jmin-jpjzoom+1)
+              CASE( 'F' )
+                 CALL Correctforconservation(tabvar1(:,:,1,1),tabinterp4d(:,:,jl,1), &
+                    &                        G0%e1f,G0%e2f,G1%e1f,G1%e2f,nxfin,nyfin,posvar,imin-jpizoom+1,jmin-jpjzoom+1)
+              END SELECT
+           ENDIF
+           tabinterp4d(:,:,jl,1) =  tabinterp4d(:,:,jl,1) * G1%tmask(:,:,1)
+
+           IF(ASSOCIATED(matrix)) DEALLOCATE(matrix,src_add,dst_add)   
+
+        ENDDO
+
+        dimnames(1)='x'
+        dimnames(2)='y'
+        IF( vert_coord_name == '1' ) THEN
+           dimnames(3)='time_counter'
+
+           ALLOCATE(tabvar3d(SIZE(tabinterp4d,1),SIZE(tabinterp4d,2),SIZE(tabinterp4d,3)))
+           tabvar3d=tabinterp4d(:,:,:,1)
+           CALL Write_Ncdf_var(varname,dimnames,Child_file,tabvar3d,'double')
+           DEALLOCATE(tabvar3d)
+        ELSE
+           dimnames(3)='numcat'
+           dimnames(4)='time_counter'
+           
+           CALL Write_Ncdf_var(TRIM(varname),dimnames,Child_file,tabinterp4d,'double')
+        ENDIF
+        !             
+        CALL Copy_Ncdf_att(TRIM(varname),TRIM(restart_ice_file),Child_file)
+
+        DEALLOCATE(detected_pts)
+        DEALLOCATE(tabinterp4d)
+        DEALLOCATE(tabvar00, tabvar0, tabvar1,tabvar2,tabvar3)
+        DEALLOCATE(masksrc)  
+       
+     ENDIF
+  END DO
+  !
+  WRITE(*,*) ' '
+  WRITE(*,*) ' --- list of all the variables that have been interpolated --- '
+  WRITE(*,*) Ncdf_varname
+  WRITE(*,*) ' '
+  WRITE(*,*) '******* restart file successfully created *******' 
+  WRITE(*,*) ' '
+  !
+  STOP 
+END PROGRAM create_rstrt_ice
+
+
Index: /utils/tools_ticket2413/NESTING/src/agrif_create_restart_trc.f90
===================================================================
--- /utils/tools_ticket2413/NESTING/src/agrif_create_restart_trc.f90	(revision 12863)
+++ /utils/tools_ticket2413/NESTING/src/agrif_create_restart_trc.f90	(revision 12863)
@@ -0,0 +1,388 @@
+!
+!************************************************************************
+! Fortran 95 OPA Nesting tools						*
+!									*
+!     Copyright (C) 2005 Florian Lemari�(Florian.Lemarie@imag.fr)	*
+!									*
+!************************************************************************
+!
+PROGRAM create_rstrt_trc
+  !
+  USE NETCDF
+  USE bilinear_interp
+  USE bicubic_interp
+  USE agrif_readwrite
+  USE io_netcdf 
+  USE agrif_extrapolation
+  USE agrif_interpolation
+  USE agrif_partial_steps        
+  USE agrif_connect_topo
+  !
+  IMPLICIT NONE
+  !
+  !************************************************************************
+  ! 									*
+  ! PROGRAM  CREATE_RSTRT_TRC     					*
+  !									*
+  ! program to interpolate parent grid restart file to child grid		*
+  !									*
+  !									*
+  !Interpolation is carried out using bilinear interpolation		*
+  !routine from SCRIP package						*		
+  !									*
+  !http://climate.lanl.gov/Software/SCRIP/				*
+  !************************************************************************
+  !
+  ! variables declaration
+  !      
+  CHARACTER*20,DIMENSION(:),POINTER :: Ncdf_varname => NULL()
+  CHARACTER*20 :: vert_coord_name
+  CHARACTER*1 :: posvar
+  CHARACTER*3 :: prefix
+  CHARACTER*20:: suffix 
+  CHARACTER*100 :: Child_file,Childcoordinates,varname,varname2,Child_Bathy_Level,Child_Bathy_Meter   
+  REAL*8, POINTER, DIMENSION(:,:,:) :: tabvar3d => NULL()
+  REAL*8, POINTER, DIMENSION(:,:,:,:) :: trb,trn => NULL()
+  REAL*8, POINTER, DIMENSION(:,:,:,:) :: tabinterp4d,tabvar1,tabvar2,tabvar3 => NULL()
+  REAL*8, POINTER, DIMENSION(:) :: tabtemp1D,nav_lev => NULL()
+  REAL*8, POINTER, DIMENSION(:,:) :: tabtemp2D => NULL()
+  INTEGER,DIMENSION(:),POINTER :: src_add,dst_add  => NULL()
+  REAL*8,DIMENSION(:,:),POINTER :: matrix => NULL()
+  LOGICAL,DIMENSION(:,:),POINTER :: masksrc => NULL()
+  LOGICAL, DIMENSION(:,:,:), POINTER :: detected_pts
+  LOGICAL :: Interpolation,Extrapolation,Pacifique
+  INTEGER :: narg,iargc,ncid,x,y,z,nbvert_lev
+  REAL*8 :: now_wght,before_wght
+  INTEGER :: ii,ji,jj,jk,status,varid,numdims
+  CHARACTER(len=20),DIMENSION(4) :: dimnames
+  CHARACTER(len=80) :: namelistname
+  TYPE(Coordinates) :: G0,G1
+  REAL*8 :: tabtemp0dreal
+
+  LOGICAL, PARAMETER :: conservation = .FALSE.
+  !       
+  narg = iargc()
+  IF (narg == 0) THEN
+     namelistname = 'namelist.input'
+  ELSE
+     CALL getarg(1,namelistname)
+  ENDIF
+  !
+  ! read input file
+  !
+  CALL read_namelist(namelistname)
+  !      
+  IF(TRIM(restart_trc_file) == '') THEN
+     WRITE(*,*) 'no tracers restart file specified in ',TRIM(namelistname)
+     STOP
+  ENDIF
+
+  !
+  WRITE(*,*) ''
+  WRITE(*,*) 'Interpolation of restart file : ',TRIM(restart_trc_file)
+  WRITE(*,*) ''
+  !
+  CALL Read_Ncdf_VarName(restart_trc_file,Ncdf_varname)
+  !       
+  CALL set_child_name(parent_coordinate_file,Childcoordinates)   
+  IF( TRIM(parent_bathy_level) /= '' )   CALL set_child_name(parent_bathy_level,Child_Bathy_Level) 
+  IF( TRIM(parent_bathy_meter) /= '' )   CALL set_child_name(parent_bathy_meter,Child_Bathy_Meter)   
+  !
+  ! create this file
+  !
+  CALL set_child_name(restart_trc_file,Child_file)
+  status = nf90_create(Child_file,NF90_WRITE,ncid)
+  status = nf90_close(ncid)
+  WRITE(*,*) 'Child grid restart file name = ',TRIM(Child_file)      
+  WRITE(*,*) ''
+  ! 
+  ! read dimensions in parent restart file
+  !
+  CALL Read_Ncdf_dim('x',restart_trc_file,x)
+  CALL Read_Ncdf_dim('y',restart_trc_file,y) 
+  CALL Read_Ncdf_dim('nav_lev',restart_trc_file,z)
+
+  IF( z .NE. N ) THEN
+     WRITE(*,*) '***'
+     WRITE(*,*) 'Number of vertical levels doesn t match between namelist and restart file'
+     WRITE(*,*) 'Please check the values in namelist file'
+     STOP
+  ENDIF
+  !
+  ! mask initialization for extrapolation and interpolation
+  ! 
+  WRITE(*,*) 'mask initialisation on coarse and fine grids'
+  !           
+  status = Read_Local_Coordinates(parent_coordinate_file,G0,(/jpizoom,jpjzoom/),(/x,y/))
+  status = Read_Coordinates(Childcoordinates,G1,Pacifique)
+  !
+  !longitude modification if child domain covers Pacific ocean area
+  !      
+  IF( Pacifique ) THEN
+     WHERE( G0%nav_lon < 0 )
+        G0%nav_lon = G0%nav_lon + 360.
+     END WHERE
+     WHERE( G1%nav_lon < 0 )
+        G1%nav_lon = G1%nav_lon + 360.
+     END WHERE
+  ENDIF
+  !
+  ! one needs bathy_level
+  IF( TRIM(parent_bathy_level) /= '' ) THEN
+     status = Read_bathy_level(TRIM(parent_bathy_level),G0)
+     status = Read_bathy_level(TRIM(child_bathy_level),G1)
+  ELSE
+     status = read_bathy_meter(TRIM(parent_bathy_meter),G0)
+     status = read_bathy_meter(TRIM(child_bathy_meter),G1)
+     CALL meter_to_levels(G0)
+     CALL meter_to_levels(G1)
+  ENDIF
+  ! get masks
+  CALL Init_tmask(parent_bathy_level,G0,x,y)
+  CALL Init_tmask(child_bathy_level,G1,nxfin,nyfin)
+  
+!!clem  G0%tmask = 1.    
+
+  ! which dataset
+  status = nf90_open(TRIM(restart_trc_file), NF90_NOWRITE, ncid) ! Open dataset
+  DO jk = 1, z
+     ALLOCATE(tabvar1(x,y,1,1))
+     !
+     status = nf90_inq_varid(ncid, "TRNDIC", VarId) !PISCES
+     IF (status == nf90_noerr) THEN
+        CALL Read_Ncdf_var('TRNDIC',TRIM(restart_trc_file),tabvar1,1,jk)
+     ELSE
+        status = nf90_inq_varid(ncid, "TRNNO3"  , VarId) ! LOBSTER
+        IF (status == nf90_noerr) THEN
+           CALL Read_Ncdf_var('TRNNO3',TRIM(restart_trc_file),tabvar1,1,jk)
+        ELSE
+           status = nf90_inq_varid(ncid, "TRNCFC11", VarId) ! CFC
+           IF (status == nf90_noerr) THEN
+              CALL Read_Ncdf_var('TRNCFC11',TRIM(restart_trc_file),tabvar1,1,jk)
+           ELSE
+              status = nf90_inq_varid(ncid, "TRNCLR  ", VarId) ! My TRC
+              IF (status == nf90_noerr) THEN
+                 CALL Read_Ncdf_var('TRNCLR',TRIM(restart_trc_file),tabvar1,1,jk)
+              ELSE
+                 WRITE(*,*) 'No suitable tracer found to build the mask '
+              ENDIF
+           ENDIF
+        ENDIF
+     ENDIF
+     WHERE( tabvar1(:,:,1,1) == 0. ) 
+        G0%tmask(:,:,jk) = 0.
+     END WHERE
+     DEALLOCATE(tabvar1)
+  END DO
+
+  !
+  ! write dimensions in output file
+  WRITE(*,*) 'write dimensions'
+  !          
+  CALL Write_Ncdf_dim('x',Child_file,nxfin)
+  CALL Write_Ncdf_dim('y',Child_file,nyfin)
+  CALL Write_Ncdf_dim('nav_lev',Child_file,z)
+  CALL Write_Ncdf_dim('time_counter',Child_file,0) 
+  !
+  !
+  DO ii = 1,SIZE(Ncdf_varname)      
+     !      
+     ! loop on variables names
+     varname = TRIM(Ncdf_varname(ii))
+     WRITE(*,*) 'var = ',TRIM(varname)     
+     !      
+     SELECT CASE (TRIM(varname))
+        !
+     CASE('nav_lon')
+        CALL Read_Ncdf_var('nav_lon',TRIM(Childcoordinates),tabtemp2D) 
+        CALL Write_Ncdf_var('nav_lon',(/'x','y'/),Child_file,tabtemp2D,'float')
+        CALL Copy_Ncdf_att('nav_lon',TRIM(restart_trc_file),Child_file,MINVAL(tabtemp2D),MAXVAL(tabtemp2D))
+        DEALLOCATE(tabtemp2D)
+        Interpolation = .FALSE.
+        !	     
+     CASE('nav_lat')             
+        CALL Read_Ncdf_var('nav_lat',TRIM(Childcoordinates),tabtemp2D) 
+        CALL Write_Ncdf_var('nav_lat',(/'x','y'/),Child_file,tabtemp2D,'float')
+        CALL Copy_Ncdf_att('nav_lat',TRIM(restart_trc_file),Child_file,MINVAL(tabtemp2D),MAXVAL(tabtemp2D)) 
+        DEALLOCATE(tabtemp2D)
+        Interpolation = .FALSE.
+        !
+     CASE('nav_lev')
+        CALL Read_Ncdf_var('nav_lev',TRIM(restart_trc_file),nav_lev) 
+        CALL Write_Ncdf_var('nav_lev','z',Child_file,nav_lev,'float')
+        CALL Copy_Ncdf_att('nav_lev',TRIM(restart_trc_file),Child_file)      
+        Interpolation = .FALSE.
+        !
+     CASE('time_counter')
+        CALL Read_Ncdf_var('time_counter',TRIM(restart_trc_file),tabtemp1D) 
+        tabtemp1D = tabtemp1D * rhot
+        CALL Write_Ncdf_var('time_counter','time_counter',Child_file,tabtemp1D,'double')
+        CALL Copy_Ncdf_att('time_counter',TRIM(restart_trc_file),Child_file) 
+        DEALLOCATE(tabtemp1D)
+        Interpolation = .FALSE.
+        !
+     CASE('kt','ndastp','adatrj','ntime','rdttrc1') 
+        CALL Read_Ncdf_var(TRIM(varname),TRIM(restart_trc_file),tabtemp0dreal)  
+        SELECT CASE (TRIM(varname))
+        CASE('rdttrc1')
+           tabtemp0dreal = tabtemp0dreal / rhot
+        CASE('kt')
+           tabtemp0dreal = tabtemp0dreal * rhot
+        END SELECT
+        CALL Write_Ncdf_var(TRIM(varname),Child_file,tabtemp0dreal,'double')
+        CALL Copy_Ncdf_att(varname,TRIM(restart_trc_file),Child_file) 
+        Interpolation = .FALSE.
+        !
+     CASE DEFAULT
+        IF( Get_NbDims(TRIM(varname),TRIM(restart_trc_file)) == 4 ) THEN
+           vert_coord_name = 'nav_lev'
+        ELSEIF( Get_NbDims(TRIM(varname),TRIM(restart_trc_file)) == 3 ) THEN
+           vert_coord_name = '1'
+        ENDIF
+        posvar='T'
+        Interpolation = .TRUE.            
+        !      
+     END SELECT
+     !      
+     ! --- start interpolation --- !
+     IF( Interpolation ) THEN
+        !		  
+        IF( vert_coord_name == '1' ) THEN
+           nbvert_lev = 1
+        ELSE
+           nbvert_lev = z
+        ENDIF
+
+        ALLOCATE(detected_pts(SIZE(G0%tmask,1),SIZE(G0%tmask,2),nbvert_lev))                             
+        ALLOCATE(tabvar1(x,y,1,2))
+        ALLOCATE(tabvar2(x,y,1,1))
+        ALLOCATE(tabvar3(x,y,1,1))
+        ALLOCATE(masksrc(x,y))
+        ALLOCATE(tabinterp4d(nxfin,nyfin,1,1)) 
+
+        !	    
+        DO n = 1,nbvert_lev
+           !
+           WRITE(*,*) 'interpolate/extrapolate for vertical level = ',n   
+           !
+           CALL Read_Ncdf_var(varname,TRIM(restart_trc_file),tabvar1,1,n)
+           IF(n==1) THEN
+              !                            
+           ELSE IF (n==2) THEN
+              tabvar2(:,:,:,1) = tabvar1(:,:,:,2)
+           ELSE
+              tabvar3(:,:,:,1) = tabvar2(:,:,:,1)
+              tabvar2(:,:,:,1) = tabvar1(:,:,:,2)
+           ENDIF
+           ! 
+           !
+           IF(MAXVAL(G1%tmask(:,:,n)) == 0.) THEN
+              tabinterp4d = 0.0
+              WRITE(*,*) 'only land points on level ',n                     
+           ELSE
+              CALL extrap_detect(G0,G1,detected_pts(:,:,n),n)                                            
+
+              CALL correct_field(detected_pts(:,:,n),tabvar1,tabvar2,tabvar3,G0,nav_lev,masksrc,n)                                 
+              
+              ! for the following variables, you do not want to mask the values
+              IF(  TRIM(varname) == 'Silicalim' .OR. TRIM(varname) == 'Silicamax' ) THEN
+                 masksrc(:,:) = .TRUE.
+              ENDIF
+              
+              SELECT CASE(TRIM(interp_type))
+              CASE('bilinear')                                                       
+                 CALL get_remap_matrix(G0%nav_lat,G1%nav_lat, &
+                      G0%nav_lon,G1%nav_lon,masksrc,matrix,src_add,dst_add)
+                 CALL make_remap(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1),nxfin,nyfin, &
+                      matrix,src_add,dst_add)     
+              CASE('bicubic')                                   
+                 CALL get_remap_bicub(G0%nav_lat,G1%nav_lat, &
+                      G0%nav_lon,G1%nav_lon,masksrc,matrix,src_add,dst_add)
+                 CALL make_bicubic_remap(tabvar1(:,:,1,1),masksrc,tabinterp4d(:,:,1,1),&
+                      nxfin,nyfin,matrix,src_add,dst_add) 
+              END SELECT
+              !                      
+              IF( conservation ) THEN ! clem: it currently does not work
+                 CALL Correctforconservation(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1), &
+                    G0%e1t,G0%e2t,G1%e1t,G1%e2t,nxfin,nyfin,posvar,imin-jpizoom+1,jmin-jpjzoom+1)
+              ENDIF
+           ENDIF
+
+           IF( ALL(masksrc) ) THEN
+              tabinterp4d(:,:,1,1) =  tabinterp4d(:,:,1,1)
+           ELSE
+              tabinterp4d(:,:,1,1) =  tabinterp4d(:,:,1,1) * G1%tmask(:,:,n)
+           ENDIF
+
+           !
+           dimnames(1)='x'
+           dimnames(2)='y'
+           IF( vert_coord_name == '1' ) THEN
+              dimnames(3)='time_counter'
+              
+              ALLOCATE(tabvar3d(SIZE(tabinterp4d,1),SIZE(tabinterp4d,2),SIZE(tabinterp4d,3)))
+              tabvar3d=tabinterp4d(:,:,:,1)
+              CALL Write_Ncdf_var(TRIM(varname),dimnames,Child_file,tabvar3d,1,'double')
+              DEALLOCATE(tabvar3d)
+           ELSE
+              dimnames(3)=vert_coord_name
+              dimnames(4)='time_counter'
+              
+              CALL Write_Ncdf_var(TRIM(varname),dimnames,Child_file,tabinterp4d,1,n,'double')
+           ENDIF
+           !             
+           !
+           CALL Copy_Ncdf_att(TRIM(varname),TRIM(restart_trc_file),Child_file)
+           !
+           !
+           IF(ASSOCIATED(matrix)) DEALLOCATE(matrix,src_add,dst_add)   
+           !
+           !
+        END DO
+        ! 
+        DEALLOCATE(detected_pts)
+        DEALLOCATE(tabinterp4d)
+        DEALLOCATE(tabvar1,tabvar2,tabvar3)
+        DEALLOCATE(masksrc)  
+        !                     
+     ENDIF
+
+     ! change the before fields
+     prefix = varname(1:3)
+     suffix = varname(4:LEN_TRIM(varname))   
+
+     IF(rhot == 1 .OR. prefix/= 'TRB') THEN
+        WRITE(*,*) ''	 
+        WRITE(*,*) 'no time interpolation for ',TRIM(varname)
+     ELSE   
+        ALLOCATE(trn(nxfin,nyfin,z,1),trb(nxfin,nyfin,z,1))
+        varname2 = 'TRN'//TRIM(suffix)
+        now_wght = (rhot-1.)/rhot
+        before_wght = 1./rhot
+        !    
+        CALL Read_Ncdf_var(TRIM(varname),Child_file,trb)
+        CALL Read_Ncdf_var(TRIM(varname2),Child_file,trn)            
+        trb = now_wght*trn + before_wght*trb
+
+        dimnames(1)='x'
+        dimnames(2)='y'
+        dimnames(3)='nav_lev'
+        dimnames(4)='time_counter'
+        CALL Write_Ncdf_var(TRIM(varname),dimnames,Child_file,trb,'double')
+        DEALLOCATE(trn,trb)
+        !    
+     ENDIF
+
+  END DO
+  !
+  WRITE(*,*) ' '
+  WRITE(*,*) ' --- list of all the variables that have been interpolated --- '
+  WRITE(*,*) Ncdf_varname
+  WRITE(*,*) ' '
+  WRITE(*,*) '******* restart file successfully created *******' 
+  WRITE(*,*) ' '
+  !
+  STOP 
+END PROGRAM create_rstrt_trc
+
+
Index: /utils/tools_ticket2413/NESTING/src/agrif_extrapolation.f90
===================================================================
--- /utils/tools_ticket2413/NESTING/src/agrif_extrapolation.f90	(revision 12863)
+++ /utils/tools_ticket2413/NESTING/src/agrif_extrapolation.f90	(revision 12863)
@@ -0,0 +1,650 @@
+!************************************************************************
+! Fortran 95 OPA Nesting tools						*
+!									*
+!     Copyright (C) 2005 Florian Lemarié (Florian.Lemarie@imag.fr)	*
+!									*
+!************************************************************************
+!
+MODULE agrif_extrapolation
+  !
+  USE agrif_types
+  USE agrif_readwrite 
+  USE io_netcdf  
+  USE agrif_gridsearch  
+  
+  IMPLICIT NONE 
+
+CONTAINS
+  !
+  !************************************************************************
+  ! 									*
+  ! MODULE  AGRIF_EXTRAPOLATION						*
+  !									*
+  !************************************************************************   
+  !      
+  !****************************************************************
+  !     subroutine extrap_detect					*
+  !								*
+  !     detection on each level of points 			*
+  !     where extrapolation is required 				*
+  !								*
+  !****************************************************************          
+  !      
+  !
+  SUBROUTINE extrap_detect(G0,G1,detected,n,posvar) 
+    !      
+    LOGICAL, DIMENSION(:,:) :: detected
+    TYPE(Coordinates) :: G0,G1       
+    CHARACTER(*), OPTIONAL :: posvar
+    INTEGER :: i,j,k,ic,jc,compt,dst_add,n
+    INTEGER, DIMENSION(1) :: i_min,j_min     
+    !                                
+    IF( PRESENT(posvar) .AND. posvar == 'U' ) THEN      
+       CALL get_detected_pts(G0%gphiu,G1%gphiu,G0%glamu,G1%glamu,   &
+            G0%umask(:,:,n),G1%umask(:,:,n),detected(:,:))       
+    ELSEIF( PRESENT(posvar) .AND. posvar == 'V' ) THEN
+       CALL get_detected_pts(G0%gphiv,G1%gphiv,G0%glamv,G1%glamv,   &
+            G0%vmask(:,:,n),G1%vmask(:,:,n),detected(:,:))                                  
+    ELSEIF( PRESENT(posvar) .AND. posvar == 'F' ) THEN
+       CALL get_detected_pts(G0%gphif,G1%gphif,G0%glamf,G1%glamf,   &
+            G0%fmask(:,:,n),G1%fmask(:,:,n),detected(:,:))                                  
+    ELSE
+       CALL get_detected_pts(G0%gphit,G1%gphit,G0%glamt,G1%glamt,   &
+            G0%tmask(:,:,n),G1%tmask(:,:,n),detected(:,:))                                  
+!clem       CALL get_detected_pts(G0%nav_lat,G1%nav_lat,G0%nav_lon,G1%nav_lon,   &
+!clem            G0%tmask(:,:,n),G1%tmask(:,:,n),detected(:,:))        
+    ENDIF
+    !      
+  END SUBROUTINE extrap_detect
+  !      
+  !   
+  !****************************************************************
+  !     end subroutine extrap_detect				*
+  !**************************************************************** 
+  !      
+  !      
+  !****************************************************************
+  !    subroutine correct_field					*
+  ! correct field on detected points				*
+  !								*
+  !****************************************************************          
+  ! 
+  SUBROUTINE correct_field(detected_pts,tabin,tabinkm1,tabinkm2,G0,nav_lev,newmask,k,posvar)
+    !
+    LOGICAL, DIMENSION(:,:) :: detected_pts
+    LOGICAL, DIMENSION(:,:) :: newmask
+    CHARACTER(*),OPTIONAL :: posvar
+    INTEGER :: k
+    !
+    INTEGER :: i,j,ii,jj,nx,ny,n,lbi,ubi,lbj,ubj,kpos,ipos,jpos,r
+    !
+    REAL*8, DIMENSION(:,:,:,:) ::  tabin
+    REAL*8, DIMENSION(:,:,:,:) ::  tabinkm1
+    REAL*8, DIMENSION(:,:,:,:) ::  tabinkm2
+    REAL*8, DIMENSION(:) :: nav_lev
+    REAL*8, DIMENSION(:,:,:), ALLOCATABLE :: mask
+    REAL*8, DIMENSION(:,:), ALLOCATABLE :: lon,lat 
+    REAL*8 :: deriv,deriv_min
+    LOGICAL :: found
+    !      
+    TYPE(Coordinates) :: G0  
+    !
+    ! copy coarse grid mask in newmask 
+    !            
+    IF ( PRESENT(posvar) .AND. posvar == 'U' ) THEN
+       WHERE(G0%umask(:,:,k) == 1. )
+          newmask(:,:) = .TRUE.
+       ELSEWHERE
+          newmask(:,:) = .FALSE.
+       END WHERE
+       ALLOCATE(mask(SIZE(G0%umask,1),SIZE(G0%umask,2),SIZE(G0%umask,3)))
+       ALLOCATE(lat(SIZE(G0%umask,1),SIZE(G0%umask,2)))
+       ALLOCATE(lon(SIZE(G0%umask,1),SIZE(G0%umask,2)))
+       mask = G0%umask
+       lat = G0%gphiu 
+       lon = G0%glamu     
+    ELSE IF ( PRESENT(posvar) .AND. posvar == 'V' ) THEN
+       WHERE(G0%vmask(:,:,k) == 1. )
+          newmask(:,:) = .TRUE.
+       ELSEWHERE
+          newmask(:,:) = .FALSE.
+       END WHERE
+       ALLOCATE(mask(SIZE(G0%vmask,1),SIZE(G0%vmask,2),SIZE(G0%vmask,3)))
+       ALLOCATE(lat(SIZE(G0%vmask,1),SIZE(G0%vmask,2)))
+       ALLOCATE(lon(SIZE(G0%vmask,1),SIZE(G0%vmask,2)))
+       mask = G0%vmask        
+       lat = G0%gphiv 
+       lon = G0%glamv
+    ELSE IF ( PRESENT(posvar) .AND. posvar == 'F' ) THEN
+       WHERE(G0%fmask(:,:,k) == 1. )
+          newmask(:,:) = .TRUE.
+       ELSEWHERE
+          newmask(:,:) = .FALSE.
+       END WHERE
+       ALLOCATE(mask(SIZE(G0%fmask,1),SIZE(G0%fmask,2),SIZE(G0%fmask,3)))
+       ALLOCATE(lat(SIZE(G0%fmask,1),SIZE(G0%fmask,2)))
+       ALLOCATE(lon(SIZE(G0%fmask,1),SIZE(G0%fmask,2)))
+       mask = G0%fmask        
+       lat = G0%gphif 
+       lon = G0%glamf
+    ELSE      
+       WHERE(G0%tmask(:,:,k) == 1. )
+          newmask(:,:) = .TRUE.
+       ELSEWHERE
+          newmask(:,:) = .FALSE.
+       END WHERE
+       ALLOCATE(mask(SIZE(G0%tmask,1),SIZE(G0%tmask,2),SIZE(G0%tmask,3)))
+       ALLOCATE(lat(SIZE(G0%tmask,1),SIZE(G0%tmask,2)))
+       ALLOCATE(lon(SIZE(G0%tmask,1),SIZE(G0%tmask,2)))
+       mask = G0%tmask        
+       lat = G0%gphit 
+       lon = G0%glamt
+!clem       mask = G0%tmask
+!clem       lon = G0%nav_lon
+!clem       lat = G0%nav_lat
+    ENDIF
+    !
+    ! dimensions initialisation
+    !
+    nx = SIZE(tabin,1)
+    ny = SIZE(tabin,2)    
+    ! 
+    !       
+    DO j = 1,ny   
+       !
+       DO i = 1,nx         
+          !
+          IF( detected_pts(i,j) ) THEN       
+             !
+             r = 0
+             found = .FALSE.
+             deriv_min = 2000000.
+             ipos=0
+             jpos=0
+             !
+             DO WHILE(.NOT. found)
+                !
+                r = r + 1      
+                !       
+                IF(i-r < 1 ) THEN
+                   lbi = 1
+                   ubi = MIN(i+r,nx)
+                ELSE IF(i+r > nx) THEN
+                   lbi = MAX(i-r,1)
+                   ubi = nx
+                ELSE
+                   lbi = i-r
+                   ubi = i+r
+                ENDIF
+                !
+                IF(j-r < 1) THEN
+                   lbj = 1
+                   ubj = MIN(j+r,ny)
+                ELSE IF(j+r > ny) THEN
+                   lbj = MAX(j-r,1)
+                   ubj = ny
+                ELSE
+                   lbj = j-r
+                   ubj = j+r
+                ENDIF
+                !
+                DO jj = lbj,ubj,ubj-lbj
+                   DO ii = lbi,ubi,ubi-lbi
+                      !
+                      deriv = search_pts_h(ii,jj,k,i,j,k,tabin(:,:,1,1),mask,lon,lat)  
+                      !
+                      IF( ABS(deriv) < deriv_min ) THEN                                                    
+                         deriv_min = ABS(deriv)
+                         ipos = ii
+                         jpos = jj
+                         kpos = k
+                      ENDIF
+                      !                           
+                      deriv = search_pts_v(ii,jj,k-1,i,j,k,tabinkm1,tabinkm2,mask,nav_lev,lon,lat)
+                      !
+                      IF( ABS(deriv) < deriv_min ) THEN                                                    
+                         deriv_min = ABS(deriv)
+                         ipos = ii
+                         jpos = jj
+                         kpos = k-1
+                      ENDIF
+                      !                                       
+                   END DO
+                END DO
+                !
+                !                                  
+                IF( deriv_min < 2000000.  ) THEN 
+                   !                
+                   IF(kpos == k)   tabin(i,j,1,1) = tabin(ipos,jpos,1,1)
+                   IF(kpos == k-1) tabin(i,j,1,1) = tabinkm1(ipos,jpos,1,1)   
+                   found = .TRUE.
+                   newmask(i,j) = .TRUE.
+                ELSE IF ((lbi == 1).AND.(ubi == nx).AND.(lbj == 1).AND.(ubj == ny)) THEN
+                   found = .TRUE.
+                   newmask(i,j) = .FALSE.
+                   !
+                ENDIF
+                !
+             END DO !do while
+             !
+          ENDIF
+          !
+       END DO
+       !
+    END DO
+    !
+    DEALLOCATE(mask,lon,lat)
+    !
+  END SUBROUTINE correct_field
+  !      
+  !**************************************************************
+  !    end subroutine correct_field
+  !**************************************************************          
+  !  
+  SUBROUTINE correct_field_2d(detected_pts,tabin,G0,newmask,posvar)
+    !
+    LOGICAL, DIMENSION(:,:) :: detected_pts
+    LOGICAL, DIMENSION(:,:) :: newmask
+    CHARACTER(*), OPTIONAL :: posvar
+    LOGICAL :: found
+    INTEGER :: k
+    !
+    INTEGER :: i,j,ii,jj,nx,ny,n,lbi,ubi,lbj,ubj,ipos,jpos,r
+    !
+    REAL*8, DIMENSION(:,:,:), ALLOCATABLE :: mask
+    REAL*8, DIMENSION(:,:), ALLOCATABLE :: lon,lat 
+    REAL*8, DIMENSION(:,:,:) ::  tabin
+    REAL*8 :: deriv,deriv_min
+    !      
+    TYPE(Coordinates) :: G0  
+    !
+    ! copy coarse grid mask in newmask 
+    !            
+    mask = G0%tmask
+    lon = G0%nav_lon
+    lat = G0%nav_lat      
+    IF ( PRESENT(posvar) .AND. posvar == 'U' ) THEN
+       WHERE(G0%umask(:,:,1) == 1. )
+          newmask(:,:) = .TRUE.
+       ELSEWHERE
+          newmask(:,:) = .FALSE.
+       END WHERE
+       ALLOCATE(mask(SIZE(G0%umask,1),SIZE(G0%umask,2),SIZE(G0%umask,3)))
+       ALLOCATE(lat(SIZE(G0%umask,1),SIZE(G0%umask,2)))
+       ALLOCATE(lon(SIZE(G0%umask,1),SIZE(G0%umask,2)))
+       mask = G0%umask
+       lat = G0%gphiu 
+       lon = G0%glamu     
+    ELSE IF ( PRESENT(posvar) .AND. posvar == 'V' ) THEN
+       WHERE(G0%vmask(:,:,1) == 1. )
+          newmask(:,:) = .TRUE.
+       ELSEWHERE
+          newmask(:,:) = .FALSE.
+       END WHERE
+       ALLOCATE(mask(SIZE(G0%vmask,1),SIZE(G0%vmask,2),SIZE(G0%vmask,3)))
+       ALLOCATE(lat(SIZE(G0%vmask,1),SIZE(G0%vmask,2)))
+       ALLOCATE(lon(SIZE(G0%vmask,1),SIZE(G0%vmask,2)))
+       mask = G0%vmask        
+       lat = G0%gphiv 
+       lon = G0%glamv
+    ELSE      
+       WHERE(G0%tmask(:,:,1) == 1. )
+          newmask(:,:) = .TRUE.
+       ELSEWHERE
+          newmask(:,:) = .FALSE.
+       END WHERE
+       ALLOCATE(mask(SIZE(G0%tmask,1),SIZE(G0%tmask,2),SIZE(G0%tmask,3)))
+       ALLOCATE(lat(SIZE(G0%tmask,1),SIZE(G0%tmask,2)))
+       ALLOCATE(lon(SIZE(G0%tmask,1),SIZE(G0%tmask,2)))
+       mask = G0%tmask
+       lon = G0%nav_lon
+       lat = G0%nav_lat
+    ENDIF
+
+    !
+    ! dimensions initialisation
+    !
+    nx = SIZE(tabin,1)
+    ny = SIZE(tabin,2)    
+    !       
+    DO i = 1,nx         
+       !
+       DO j = 1,ny   
+          !                    
+          !                      
+          IF( detected_pts(i,j) ) THEN       
+             ! 
+             r = 0 
+             found = .FALSE.
+             deriv_min = 2000000.
+             ipos=0
+             jpos=0
+             !
+             DO WHILE (.NOT. found )
+
+                !
+                r = r + 1 
+                !
+                IF(i-r < 1 ) THEN
+                   lbi = 1
+                   ubi = MIN(i+r,nx)
+                ELSE IF(i+r > nx) THEN
+                   lbi = MAX(i-r,1)
+                   ubi = nx
+                ELSE
+                   lbi = i-r
+                   ubi = i+r
+                ENDIF
+                !
+                IF(j-r < 1) THEN
+                   lbj = 1
+                   ubj = MIN(j+r,ny)
+                ELSE IF(j+r > ny) THEN
+                   lbj = MAX(j-r,1)
+                   ubj = ny
+                ELSE
+                   lbj = j-r
+                   ubj = j+r
+                ENDIF
+                !                                 
+                DO ii = lbi,ubi
+                   DO jj = lbj,ubj
+                      !
+                      deriv = search_pts_h(ii,jj,1,i,j,1,tabin(:,:,1),mask,lon,lat)  
+                      !
+                      IF( ABS(deriv) < deriv_min ) THEN                                                    
+                         deriv_min = ABS(deriv)
+                         ipos = ii
+                         jpos = jj
+                      ENDIF
+                      !                                       
+                   END DO
+                END DO
+                !
+                !                                    
+                IF( deriv_min < 2000000.  ) THEN 
+                   !
+                   found = .TRUE.                                              
+                   tabin(i,j,1) = tabin(ipos,jpos,1) 
+                   newmask(i,j) = .TRUE.
+                   !
+                ENDIF
+                !
+             END DO !do while
+             !
+          ENDIF
+          !
+       END DO
+       !
+    END DO
+    !
+    DEALLOCATE(mask,lon,lat)
+    !
+  END SUBROUTINE correct_field_2d
+  !      
+  !**************************************************************
+  !    function get_dist
+  !**************************************************************          
+  ! 
+
+  !
+  REAL*8 FUNCTION  get_dist(plat1,plon1,plat2,plon2)
+    !
+    REAL*8 :: plat1,plon1,plat2,plon2
+    REAL*8 :: dist,ra,rad,rpi,lat,lon
+    !      
+    rpi = 3.141592653589793
+    rad = rpi/180.
+    ra  = 6371229.   
+    !      
+    lat = plat2-plat1
+    lon = plon2-plon1
+    !
+    dist = ra * rad * SQRT( (COS(rad*(plat1+plat2)/2.)*lon)**2 + lat**2 )          
+    get_dist = dist
+    RETURN
+    !
+  END FUNCTION get_dist
+
+  !
+  !      
+  !**************************************************************
+  !    end function get_dist
+  !**************************************************************
+  !
+  !      
+  !**************************************************************
+  !    subroutine check_extrap
+  !**************************************************************          
+  ! 
+
+  !
+  SUBROUTINE check_extrap(Grid,tabin,k)
+    !
+    REAL*8, DIMENSION(:,:,:,:) ::  tabin
+    TYPE(Coordinates) :: Grid 
+    INTEGER :: i,j,k  
+    !  
+    DO i = 2,SIZE(tabin,1)-1
+       DO j=2,SIZE(tabin,2)-1
+          !                     
+          IF( Grid%tmask(i,j,k) == 1. .AND. tabin(i,j,1,1)==0.) THEN
+             !      
+             WRITE(*,*) 'no masked point with value zero (',i,',',j,',',k,')'
+             !                    
+          ENDIF
+
+       END DO
+    END DO
+    !
+  END SUBROUTINE check_extrap
+
+  !
+  !      
+  !**************************************************************
+  !    end subroutine check_extrap
+  !**************************************************************  
+  !
+  !**************************************************************
+  !    subroutine search_pts_h
+  !************************************************************** 
+  !
+  REAL*8 FUNCTION search_pts_h(i,j,k,ipt,jpt,kpt,tabvar,mask,lon,lat)
+    !
+    REAL*8 :: hx,hy,fx,fy
+    REAL*8 :: h_x,h_y
+    REAL*8, DIMENSION(:,:) :: tabvar
+    INTEGER :: i,j,k,ipt,jpt,kpt,nx,ny
+    LOGICAL :: foundx,foundy
+    REAL*8, DIMENSION(:,:,:) :: mask
+    REAL*8, DIMENSION(:,:) :: lon,lat
+    !
+    !
+    foundx = .TRUE.
+    foundy = .TRUE.
+    !      
+    nx = SIZE(tabvar,1)
+    ny = SIZE(tabvar,2)
+    !
+    IF( i==ipt .AND. j==jpt ) THEN    
+       search_pts_h = 2000000.
+       RETURN
+    ENDIF
+    !      
+    IF( mask(i,j,k) == 0. ) THEN    
+       search_pts_h = 2000000.
+       RETURN
+    ENDIF
+    !
+    ! x direction
+    !
+    IF(i+1<=nx .AND. i-1>=1) THEN
+       IF(mask(i+1,j,k)==1. .AND. mask(i-1,j,k)==1.) THEN     
+          hx = get_dist(lat(i+1,j),lon(i+1,j),&
+               lat(i-1,j),lon(i-1,j))
+          fx = (tabvar(i+1,j) - tabvar(i-1,j))/hx
+       ELSE IF(mask(i+1,j,k)==1. .AND. mask(i-1,j,k)==0. .AND. mask(i,j,k)==1.) THEN
+          hx = get_dist(lat(i+1,j),lon(i+1,j),&
+               lat(i,j),lon(i,j))
+          fx = (tabvar(i+1,j) - tabvar(i,j))/hx
+       ELSE IF(mask(i+1,j,k)==0. .AND. mask(i-1,j,k)==1. .AND. mask(i,j,k)==1.) THEN
+          hx = get_dist(lat(i,j),lon(i,j),&
+               lat(i-1,j),lon(i-1,j))
+          fx = (tabvar(i,j) - tabvar(i-1,j))/hx
+       ELSE
+          foundx = .FALSE.                 
+       ENDIF
+       !           
+    ELSE IF(i+1<=nx .AND. i>=1) THEN    
+       !
+       IF(mask(i+1,j,k)==1. .AND. mask(i,j,k)==1.) THEN     
+          hx = get_dist(lat(i+1,j),lon(i+1,j),&
+               lat(i,j),lon(i,j))
+          fx = (tabvar(i+1,j) - tabvar(i,j))/hx
+       ELSE
+          foundx = .FALSE.             
+       ENDIF
+       !   
+    ELSE IF(i<=nx .AND. i-1>=1) THEN    
+       !
+       IF(mask(i,j,k)==1. .AND. mask(i-1,j,k)==1.) THEN     
+          hx = get_dist(lat(i,j),lon(i,j),&
+               lat(i-1,j),lon(i-1,j))
+          fx = (tabvar(i,j) - tabvar(i-1,j))/hx
+       ELSE
+          foundx = .FALSE.            
+       ENDIF
+       !
+    ELSE
+        foundy = .FALSE.             
+    ENDIF
+
+    !
+    ! y direction
+    !
+    IF(j+1<=ny .AND. j-1>=1) THEN      
+       IF( mask(i,j+1,k)==1. .AND. mask(i,j-1,k)==1. ) THEN      
+          hy = get_dist(lat(i,j+1),lon(i,j+1),&
+               lat(i,j-1),lon(i,j-1))                      
+          fy = (tabvar(i,j+1) - tabvar(i,j-1))/hy
+       ELSE IF( mask(i,j+1,k)==1. .AND. mask(i,j-1,k)==0. .AND. mask(i,j,k)==1.) THEN      
+          hy = get_dist(lat(i,j+1),lon(i,j+1),&
+               lat(i,j),lon(i,j))                      
+          fy = (tabvar(i,j+1) - tabvar(i,j))/hy      
+       ELSE IF( mask(i,j+1,k)==0. .AND. mask(i,j-1,k)==1. .AND. mask(i,j,k)==1.) THEN     
+          hy = get_dist(lat(i,j),lon(i,j),&
+               lat(i,j-1),lon(i,j-1))                      
+          fy = (tabvar(i,j) - tabvar(i,j-1))/hy      
+       ELSE
+          foundy = .FALSE.                    
+       ENDIF
+       !           
+    ELSE IF(j+1<=ny .AND. j>=1) THEN    
+       !
+       IF(mask(i,j+1,k)==1. .AND. mask(i,j,k)==1.) THEN     
+          hy = get_dist(lat(i,j+1),lon(i,j+1),&
+               lat(i,j),lon(i,j))
+          fy = (tabvar(i,j+1) - tabvar(i,j))/hy
+       ELSE
+          foundy = .FALSE.            
+       ENDIF
+       !   
+    ELSE IF(j<=ny .AND. j-1>=1) THEN    
+       !
+       IF(mask(i,j,k)==1. .AND. mask(i,j-1,k)==1.) THEN     
+          hy = get_dist(lat(i,j),lon(i,j),&
+               lat(i,j-1),lon(i,j-1))
+          fy = (tabvar(i,j) - tabvar(i,j-1))/hy
+       ELSE
+          foundy = .FALSE.             
+       ENDIF
+       !
+    ELSE
+        foundy = .FALSE.             
+    ENDIF
+    !                   
+    h_x = get_dist(lat(ipt,jpt),lon(ipt,jpt),lat(ipt,jpt),lon(i,j))
+    h_y = get_dist(lat(ipt,jpt),lon(ipt,jpt),lat(i,j),lon(ipt,jpt))
+    !
+    IF(.NOT.foundx .AND. .NOT.foundy)THEN      
+       search_pts_h = 2000000.
+    ELSE IF( foundx .AND. foundy) THEN        
+       search_pts_h = h_x * fx + h_y * fy
+    ELSE IF( .NOT.foundx .AND. foundy .AND. h_y.NE.0.) THEN        
+       search_pts_h = h_y * fy
+    ELSE IF( foundx .AND. .NOT.foundy .AND. h_x.NE.0.) THEN        
+       search_pts_h = h_x * fx
+    ELSE    
+       search_pts_h = 2000000.             
+    ENDIF
+
+    !      
+    RETURN          
+    !
+  END FUNCTION search_pts_h
+  !
+  !**************************************************************
+  !    end subroutine search_pts_h
+  !************************************************************** 
+  !
+  !**************************************************************
+  !    subroutine search_pts_v
+  !************************************************************** 
+  !
+  REAL*8 FUNCTION search_pts_v(i,j,k,ipt,jpt,kpt,tabvarkm1,tabvarkm2,mask,depth,lon,lat)
+    !
+    REAL*8 :: hz,fz,dz,fh
+    REAL*8, DIMENSION(:) :: depth 
+    REAL*8, DIMENSION(:,:,:,:) :: tabvarkm1,tabvarkm2
+    INTEGER :: i,j,k,ipt,jpt,kpt,nx,ny
+    LOGICAL :: foundz
+    REAL*8, DIMENSION(:,:,:) :: mask
+    REAL*8, DIMENSION(:,:) :: lon,lat
+    !          
+    IF( k <= 2 .OR. mask(i,j,k) == 0.   ) THEN
+       !
+       search_pts_v = 2000000.
+       RETURN
+       !
+    ELSE IF( i==ipt .AND. j==jpt .AND. mask(i,j,k-1) == 1. .AND. mask(i,j,k-2) == 1. ) THEN
+       !
+       dz = depth(k) - depth(k-1)
+       hz = depth(kpt) - depth(k)     
+       search_pts_v = ((tabvarkm2(i,j,1,1) - tabvarkm1(i,j,1,1))/dz)*hz
+       RETURN
+       ! 
+    ELSE
+       !
+       IF( mask(i,j,k) == 1. .AND. mask(i,j,k-1) == 1. ) THEN
+          !                         
+          dz = depth(k) - depth(k-1)
+          fz = (tabvarkm2(i,j,1,1) - tabvarkm1(i,j,1,1))/dz
+          hz = depth(kpt) - depth(k)
+          !
+       ELSE
+          foundz = .FALSE.
+       ENDIF
+       !             
+       fh = search_pts_h(i,j,k,ipt,jpt,k,tabvarkm1(:,:,1,1),mask,lon,lat)
+       !
+       IF(foundz) THEN
+          search_pts_v = hz * fz + fh
+          RETURN
+       ELSE       
+          search_pts_v = 2000000.  
+          RETURN 
+       ENDIF
+       !
+    ENDIF
+    WRITE(*,*) 'cas 2', search_pts_v
+    !     
+    RETURN          
+    !
+  END FUNCTION search_pts_v
+  !
+  !**************************************************************
+  !    end subroutine search_pts_v
+  !************************************************************** 
+  !
+  !
+END MODULE agrif_extrapolation
Index: /utils/tools_ticket2413/NESTING/src/agrif_gridsearch.f90
===================================================================
--- /utils/tools_ticket2413/NESTING/src/agrif_gridsearch.f90	(revision 12863)
+++ /utils/tools_ticket2413/NESTING/src/agrif_gridsearch.f90	(revision 12863)
@@ -0,0 +1,760 @@
+!
+MODULE agrif_gridsearch
+  !
+  USE agrif_modutil
+  !
+  !************************************************************************
+  ! 									*
+  ! MODULE  AGRIF_GRIDSEARCH						*
+  ! 									*
+  !************************************************************************
+  !     
+  !-----------------------------------------------------------------------
+  IMPLICIT NONE
+
+  !-----------------------------------------------------------------------
+  !     variables that describe each grid
+  !-----------------------------------------------------------------------
+  !
+  !      integer :: grid1_size,grid2_size,grid1_rank, grid2_rank      
+  !      integer, dimension(:), pointer :: grid1_dims, grid2_dims  
+  !      logical, dimension(:), pointer :: grid1_mask,grid2_mask        
+  !      real*8,dimension(:),pointer :: grid1_center_lat,grid1_center_lon,grid2_center_lat,grid2_center_lon
+  !
+  !      real*8,dimension(:,:), pointer :: grid1_bound_box,grid2_bound_box   
+  !      integer, parameter :: num_srch_bins = 90  
+  !      integer,dimension(:,:),pointer :: bin_addr1,bin_addr2 
+  !      real*8, dimension(:,:),pointer :: bin_lats,bin_lons 
+  REAL*8, PARAMETER :: zero   = 0.0,  &
+       one    = 1.0,  &
+       two    = 2.0,  &
+       three  = 3.0,  &
+       four   = 4.0,  &
+       five   = 5.0,  & 
+       half   = 0.5,  &
+       quart  = 0.25, &
+       bignum = 1.e+20, &
+       tiny   = 1.e-14, &
+       pi     = 3.14159265359, &
+       pi2    = two*pi, &
+       pih    = half*pi        
+  !      
+  REAL*8, PARAMETER :: deg2rad = pi/180.
+  ! 
+  !
+CONTAINS 
+  !     
+  !
+  SUBROUTINE get_detected_pts(grid1_lat,grid2_lat,grid1_lon,grid2_lon,maskC,maskF,detected_pts)
+    !
+    !-----------------------------------------------------------------------
+    !this routine makes any necessary changes (e.g. for 0,2pi longitude range)
+    !-----------------------------------------------------------------------
+    !
+    REAL*8,DIMENSION(:,:),POINTER :: grid1_lat,grid2_lat,grid1_lon,grid2_lon
+    LOGICAL, POINTER, DIMENSION(:,:) :: masksrc,maskdst 
+    LOGICAL, DIMENSION(:,:) :: detected_pts 
+    REAL*8,DIMENSION(:,:) :: maskF,maskC
+    LOGICAL,POINTER,DIMENSION(:) :: detected_pts_1D     
+    REAL*8 :: plat,plon
+    INTEGER :: lastsrc_add
+    INTEGER, DIMENSION(4) :: src_add 
+    REAL*8,DIMENSION(4) :: src_lats,src_lons      
+    INTEGER :: grid1_size,grid2_size,grid1_rank, grid2_rank      
+    INTEGER, DIMENSION(:), POINTER :: grid1_dims, grid2_dims  
+    LOGICAL, DIMENSION(:), POINTER :: grid1_mask,grid2_mask        
+    REAL*8,DIMENSION(:),POINTER :: grid1_center_lat,grid1_center_lon,grid2_center_lat,grid2_center_lon
+
+    REAL*8,DIMENSION(:,:), POINTER :: grid1_bound_box,grid2_bound_box   
+    !      integer, parameter :: num_srch_bins = 90  
+    INTEGER,DIMENSION(:,:),POINTER :: bin_addr1,bin_addr2 
+    REAL*8, DIMENSION(:,:),POINTER :: bin_lats,bin_lons 
+
+    REAL*8, PARAMETER :: zero   = 0.0,  &
+         one    = 1.0,  &
+         two    = 2.0,  &
+         three  = 3.0,  &
+         four   = 4.0,  &
+         five   = 5.0,  & 
+         half   = 0.5,  &
+         quart  = 0.25, &
+         bignum = 1.e+20, &
+         tiny   = 1.e-14, &
+         pi     = 3.14159265359, &
+         pi2    = two*pi, &
+         pih    = half*pi        
+
+    REAL*8, PARAMETER :: deg2rad = pi/180.
+    !
+    !-----------------------------------------------------------------------
+    ! local variables
+    !-----------------------------------------------------------------------
+    !
+    INTEGER :: n,nele,i,j,ip1,jp1,n_add,e_add,ne_add,nx,ny
+    INTEGER :: xpos,ypos,dst_add
+    !          
+    ! integer mask
+    ! 
+    INTEGER, DIMENSION(:), POINTER :: imask 
+    !
+    ! lat/lon intervals for search bins
+    !
+    REAL*8 :: dlat,dlon           
+    !      
+    ! temps for computing bounding boxes
+    !
+    REAL*8, DIMENSION(4) :: tmp_lats, tmp_lons  
+    !
+    !      write(*,*)'proceed to Bilinear interpolation ...'
+    !
+    ALLOCATE(grid1_dims(2),grid2_dims(2))
+    !      
+    grid1_dims(1) = SIZE(grid1_lat,2)
+    grid1_dims(2) = SIZE(grid1_lat,1)
+    grid2_dims(1) = SIZE(grid2_lat,2)
+    grid2_dims(2) = SIZE(grid2_lat,1)
+    grid1_size = SIZE(grid1_lat,2) * SIZE(grid1_lat,1)
+    grid2_size = SIZE(grid2_lat,2) * SIZE(grid2_lat,1)  
+    !      
+    !-----------------------------------------------------------------------
+    !     allocate grid coordinates/masks and read data
+    !-----------------------------------------------------------------------
+    !     
+    ALLOCATE( grid1_bound_box (4,grid1_size),grid2_bound_box (4,grid2_size))
+
+    ALLOCATE(detected_pts_1D(grid1_size))
+    ALLOCATE(masksrc(SIZE(maskC,1),SIZE(maskC,2)))
+    ALLOCATE(maskdst(SIZE(maskF,1),SIZE(maskF,2)))
+    !      
+    WHERE(maskC == 1.)
+       masksrc= .TRUE.
+    ELSEWHERE
+       masksrc= .FALSE.
+    END WHERE
+    !      
+    WHERE(maskF == 1.)
+       maskdst= .TRUE.
+    ELSEWHERE
+       maskdst= .FALSE.
+    END WHERE
+    !                 
+    !      
+    !
+    ! 2D array -> 1D array
+    !
+    ALLOCATE(grid1_center_lat(SIZE(grid1_lat,1)*SIZE(grid1_lat,2)))
+    CALL tab2Dto1D(grid1_lat,grid1_center_lat)
+
+    ALLOCATE(grid1_center_lon(SIZE(grid1_lon,1)*SIZE(grid1_lon,2)))
+    CALL tab2Dto1D(grid1_lon,grid1_center_lon)
+
+    ALLOCATE(grid2_center_lat(SIZE(grid2_lat,1)*SIZE(grid2_lat,2)))
+    CALL tab2Dto1D(grid2_lat,grid2_center_lat)
+
+    ALLOCATE(grid2_center_lon(SIZE(grid2_lon,1)*SIZE(grid2_lon,2)))      
+    CALL tab2Dto1D(grid2_lon,grid2_center_lon) 
+
+    ALLOCATE(grid1_mask(SIZE(grid1_lat,1)*SIZE(grid1_lat,2)))
+    CALL logtab2Dto1D(masksrc,grid1_mask)
+
+    ALLOCATE(grid2_mask(SIZE(grid2_lat,1)*SIZE(grid2_lat,2)))      
+    CALL logtab2Dto1D(maskdst,grid2_mask)
+    !                      
+    !
+    ! degrees to radian
+    !
+    grid1_center_lat = grid1_center_lat*deg2rad
+    grid1_center_lon = grid1_center_lon*deg2rad
+    grid2_center_lat = grid2_center_lat*deg2rad
+    grid2_center_lon = grid2_center_lon*deg2rad
+
+    !-----------------------------------------------------------------------
+    !     convert longitudes to 0,2pi interval
+    !-----------------------------------------------------------------------
+
+    WHERE (grid1_center_lon .GT. pi2)  grid1_center_lon =       &
+         grid1_center_lon - pi2
+    WHERE (grid1_center_lon .LT. zero) grid1_center_lon =       &
+         grid1_center_lon + pi2
+    WHERE (grid2_center_lon .GT. pi2)  grid2_center_lon =       &
+         grid2_center_lon - pi2
+    WHERE (grid2_center_lon .LT. zero) grid2_center_lon =       &
+         grid2_center_lon + pi2
+
+    !-----------------------------------------------------------------------
+    !
+    !     make sure input latitude range is within the machine values
+    !     for +/- pi/2 
+    !
+    !-----------------------------------------------------------------------
+
+    WHERE (grid1_center_lat >  pih) grid1_center_lat =  pih
+    WHERE (grid1_center_lat < -pih) grid1_center_lat = -pih
+    WHERE (grid2_center_lat >  pih) grid2_center_lat =  pih
+    WHERE (grid2_center_lat < -pih) grid2_center_lat = -pih
+
+    !-----------------------------------------------------------------------
+    !
+    !     compute bounding boxes for restricting future grid searches
+    !
+    !-----------------------------------------------------------------------
+    !
+    nx = grid1_dims(1)
+    ny = grid1_dims(2)
+
+    DO n=1,grid1_size
+
+       !*** find N,S and NE points to this grid point
+
+       j = (n - 1)/nx +1
+       i = n - (j-1)*nx
+
+       IF (i < nx) THEN
+          ip1 = i + 1
+       ELSE
+          !*** assume cyclic
+          ip1 = 1
+          !*** but if it is not, correct
+          e_add = (j - 1)*nx + ip1
+          IF (ABS(grid1_center_lat(e_add) -     &
+               grid1_center_lat(n   )) > pih) THEN
+             ip1 = i
+          ENDIF
+          ip1=nx
+       ENDIF
+
+       IF (j < ny) THEN
+          jp1 = j+1
+       ELSE
+          !*** assume cyclic
+          jp1 = 1
+          !*** but if it is not, correct
+          n_add = (jp1 - 1)*nx + i
+          IF (ABS(grid1_center_lat(n_add) -             &
+               grid1_center_lat(n   )) > pih) THEN
+             jp1 = j
+          ENDIF
+          jp1=ny
+       ENDIF
+
+       n_add = (jp1 - 1)*nx + i
+       e_add = (j - 1)*nx + ip1
+       ne_add = (jp1 - 1)*nx + ip1
+
+       !*** find N,S and NE lat/lon coords and check bounding box
+
+       tmp_lats(1) = grid1_center_lat(n)
+       tmp_lats(2) = grid1_center_lat(e_add)
+       tmp_lats(3) = grid1_center_lat(ne_add)
+       tmp_lats(4) = grid1_center_lat(n_add)
+
+       tmp_lons(1) = grid1_center_lon(n)
+       tmp_lons(2) = grid1_center_lon(e_add)
+       tmp_lons(3) = grid1_center_lon(ne_add)
+       tmp_lons(4) = grid1_center_lon(n_add)
+
+       grid1_bound_box(1,n) = MINVAL(tmp_lats)
+       grid1_bound_box(2,n) = MAXVAL(tmp_lats)
+
+       grid1_bound_box(3,n) = MINVAL(tmp_lons)
+       grid1_bound_box(4,n) = MAXVAL(tmp_lons)
+    END DO
+
+    nx = grid2_dims(1)
+    ny = grid2_dims(2)
+
+    DO n=1,grid2_size
+
+       !*** find N,S and NE points to this grid point
+
+       j = (n - 1)/nx +1
+       i = n - (j-1)*nx
+
+       IF (i < nx) THEN
+          ip1 = i + 1
+       ELSE
+          !*** assume cyclic
+          ip1 = 1
+          !*** but if it is not, correct
+          e_add = (j - 1)*nx + ip1
+          IF (ABS(grid2_center_lat(e_add) -  &
+               grid2_center_lat(n   )) > pih) THEN
+             ip1 = i
+          ENDIF
+       ENDIF
+
+       IF (j < ny) THEN
+          jp1 = j+1
+       ELSE
+          !*** assume cyclic
+          jp1 = 1
+          !*** but if it is not, correct
+          n_add = (jp1 - 1)*nx + i
+          IF (ABS(grid2_center_lat(n_add) -  &
+               grid2_center_lat(n   )) > pih) THEN
+             jp1 = j
+          ENDIF
+       ENDIF
+
+       n_add = (jp1 - 1)*nx + i
+       e_add = (j - 1)*nx + ip1
+       ne_add = (jp1 - 1)*nx + ip1
+
+       !*** find N,S and NE lat/lon coords and check bounding box
+
+       tmp_lats(1) = grid2_center_lat(n)
+       tmp_lats(2) = grid2_center_lat(e_add)
+       tmp_lats(3) = grid2_center_lat(ne_add)
+       tmp_lats(4) = grid2_center_lat(n_add)
+
+       tmp_lons(1) = grid2_center_lon(n)
+       tmp_lons(2) = grid2_center_lon(e_add)
+       tmp_lons(3) = grid2_center_lon(ne_add)
+       tmp_lons(4) = grid2_center_lon(n_add)
+
+       grid2_bound_box(1,n) = MINVAL(tmp_lats)
+       grid2_bound_box(2,n) = MAXVAL(tmp_lats)
+       grid2_bound_box(3,n) = MINVAL(tmp_lons)
+       grid2_bound_box(4,n) = MAXVAL(tmp_lons)
+    END DO
+    !
+    !
+    !
+    WHERE (ABS(grid1_bound_box(4,:) - grid1_bound_box(3,:)) > pi)
+       grid1_bound_box(3,:) = zero
+       grid1_bound_box(4,:) = pi2
+    END WHERE
+
+    WHERE (ABS(grid2_bound_box(4,:) - grid2_bound_box(3,:)) > pi)
+       grid2_bound_box(3,:) = zero
+       grid2_bound_box(4,:) = pi2
+    END WHERE
+
+    !***
+    !*** try to check for cells that overlap poles
+    !***
+
+    WHERE (grid1_center_lat > grid1_bound_box(2,:)) &
+         grid1_bound_box(2,:) = pih
+
+    WHERE (grid1_center_lat < grid1_bound_box(1,:)) &
+         grid1_bound_box(1,:) = -pih
+
+    WHERE (grid2_center_lat > grid2_bound_box(2,:)) &
+         grid2_bound_box(2,:) = pih
+
+    WHERE (grid2_center_lat < grid2_bound_box(1,:)) &
+         grid2_bound_box(1,:) = -pih
+
+    !-----------------------------------------------------------------------
+    !     set up and assign address ranges to search bins in order to 
+    !     further restrict later searches
+    !-----------------------------------------------------------------------
+
+    ALLOCATE(bin_addr1(2,90))
+    ALLOCATE(bin_addr2(2,90))
+    ALLOCATE(bin_lats (2,90))
+    ALLOCATE(bin_lons (2,90))
+
+    dlat = pi/90
+
+    DO n=1,90
+       bin_lats(1,n) = (n-1)*dlat - pih
+       bin_lats(2,n) =     n*dlat - pih
+       bin_lons(1,n) = zero
+       bin_lons(2,n) = pi2
+       bin_addr1(1,n) = grid1_size + 1
+       bin_addr1(2,n) = 0
+       bin_addr2(1,n) = grid2_size + 1
+       bin_addr2(2,n) = 0
+    END DO
+
+    DO nele=1,grid1_size
+       DO n=1,90
+          IF (grid1_bound_box(1,nele) <= bin_lats(2,n) .AND.   &
+               grid1_bound_box(2,nele) >= bin_lats(1,n)) THEN
+             bin_addr1(1,n) = MIN(nele,bin_addr1(1,n))
+             bin_addr1(2,n) = MAX(nele,bin_addr1(2,n))
+          ENDIF
+       END DO
+    END DO
+
+    DO nele=1,grid2_size
+       DO n=1,90
+          IF (grid2_bound_box(1,nele) <= bin_lats(2,n) .AND.    &
+               grid2_bound_box(2,nele) >= bin_lats(1,n)) THEN
+             bin_addr2(1,n) = MIN(nele,bin_addr2(1,n))
+             bin_addr2(2,n) = MAX(nele,bin_addr2(2,n))
+          ENDIF
+       END DO
+    END DO
+    !	
+    !	Call init_remap_vars 
+    !
+
+    lastsrc_add=1
+    detected_pts_1D = .FALSE.
+    !
+    DO dst_add = 1, grid2_size
+       !        
+       plat = grid2_center_lat(dst_add)
+       plon = grid2_center_lon(dst_add)
+       !***
+       !*** find nearest square of grid points on source grid
+       !***
+       CALL grid_search_bilin(bin_lons,bin_lats,src_add, src_lats, src_lons,          &
+            plat, plon, grid1_dims,               &
+            grid1_center_lat, grid1_center_lon,   & 
+            grid1_bound_box, bin_addr1, bin_addr2,lastsrc_add)
+       !
+       IF (src_add(1) > 0) THEN
+          !
+          IF(grid2_mask(dst_add)) THEN                  !mask true on destination grid	    
+             DO n=1,4
+                IF(.NOT. grid1_mask(src_add(n))) THEN
+                   detected_pts_1D(src_add(n)) = .TRUE.
+                ENDIF
+             END DO
+          ENDIF
+       ENDIF
+    END DO
+    !
+    !
+    CALL logtab1Dto2D(detected_pts_1D,detected_pts,SIZE(detected_pts,2),SIZE(detected_pts,1))	
+    !
+    DEALLOCATE(detected_pts_1D,grid1_bound_box,grid2_bound_box)
+    DEALLOCATE(grid1_center_lon,grid1_center_lat,grid2_center_lon,grid2_center_lat)
+    DEALLOCATE(grid1_mask,grid2_mask,masksrc,maskdst)
+    DEALLOCATE(bin_addr1,bin_addr2,bin_lats,bin_lons)
+    DEALLOCATE(grid1_dims,grid2_dims)
+    !	
+    !-----------------------------------------------------------------------
+
+  END SUBROUTINE get_detected_pts
+
+  !**********************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE GRID_SEARCH_BILIN
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  SUBROUTINE grid_search_bilin(bin_lons,bin_lats,src_add, src_lats, src_lons,   &
+       plat, plon, src_grid_dims,      &
+       src_center_lat, src_center_lon, & 
+       src_grid_bound_box,             &
+       src_bin_add, dst_bin_add,lastsrc_add)
+
+    !-----------------------------------------------------------------------
+    !
+    !     this routine finds the location of the search point plat, plon
+    !     in the source grid and returns the corners needed for a bilinear
+    !     interpolation.
+    !
+    !-----------------------------------------------------------------------
+
+    !-----------------------------------------------------------------------
+    !     output variables
+    !-----------------------------------------------------------------------
+    !
+    ! address of each corner point enclosing P
+    !
+    INTEGER,DIMENSION(4) :: src_add  
+    REAL*8,DIMENSION(4) :: src_lats,src_lons  
+    !      
+    !-----------------------------------------------------------------------
+    !     input variables
+    !-----------------------------------------------------------------------
+    ! 
+    ! latitude, longitude of the search point
+    !
+    REAL*8, DIMENSION(:,:) :: bin_lats,bin_lons 
+    REAL*8, INTENT(in) :: plat,plon   
+    !
+    ! size of each src grid dimension
+    !
+    INTEGER, DIMENSION(2), INTENT(in) :: src_grid_dims  
+    !
+    ! latitude, longitude of each src grid center
+    !
+    REAL*8, DIMENSION(:), INTENT(in) :: src_center_lat,src_center_lon  
+    !
+    ! bound box for source grid
+    !
+    REAL*8, DIMENSION(:,:), INTENT(in) :: src_grid_bound_box 
+    !
+    ! latitude bins for restricting searches
+    !
+    INTEGER, DIMENSION(:,:), INTENT(in) ::src_bin_add,dst_bin_add 
+
+    INTEGER,OPTIONAL :: lastsrc_add
+    INTEGER :: loopsrc,l1,l2
+    !      
+    !-----------------------------------------------------------------------
+    !     local variables
+    !-----------------------------------------------------------------------
+    !
+    INTEGER :: n,next_n,srch_add,nx, ny,min_add, max_add,  &
+         i, j, jp1, ip1, n_add, e_add, ne_add
+
+
+    REAL*8 ::  vec1_lat, vec1_lon,vec2_lat, vec2_lon, cross_product,  &
+         cross_product_last,coslat_dst, sinlat_dst, coslon_dst, &
+         sinlon_dst,dist_min, distance 
+
+    !-----------------------------------------------------------------------
+    !     restrict search first using bins
+    !-----------------------------------------------------------------------
+
+    src_add = 0
+
+    min_add = SIZE(src_center_lat)
+    max_add = 1
+    DO n=1,90
+       IF (plat >= bin_lats(1,n) .AND. plat <= bin_lats(2,n) .AND. &
+            plon >= bin_lons(1,n) .AND. plon <= bin_lons(2,n)) THEN
+          min_add = MIN(min_add, src_bin_add(1,n))
+          max_add = MAX(max_add, src_bin_add(2,n))
+       ENDIF
+    END DO
+
+    !-----------------------------------------------------------------------
+    !     now perform a more detailed search 
+    !-----------------------------------------------------------------------
+
+    nx = src_grid_dims(1)
+    ny = src_grid_dims(2)
+
+    loopsrc=0
+    DO WHILE (loopsrc <= max_add)
+
+
+       l1=MAX(min_add,lastsrc_add-loopsrc)
+       l2=MIN(max_add,lastsrc_add+loopsrc)      
+
+       loopsrc = loopsrc+1
+
+       srch_loop: DO srch_add = l1,l2,MAX(l2-l1,1)
+
+          !*** first check bounding box
+
+          IF (plat <= src_grid_bound_box(2,srch_add) .AND. & 
+               plat >= src_grid_bound_box(1,srch_add) .AND.  &
+               plon <= src_grid_bound_box(4,srch_add) .AND.  &
+               plon >= src_grid_bound_box(3,srch_add)) THEN
+             !***
+             !*** we are within bounding box so get really serious
+             !***
+             !*** determine neighbor addresses
+             !
+             j = (srch_add - 1)/nx +1
+             i = srch_add - (j-1)*nx
+             !
+             IF (i < nx) THEN
+                ip1 = i + 1
+             ELSE
+                ip1 = 1
+             ENDIF
+             !
+             IF (j < ny) THEN
+                jp1 = j+1
+             ELSE
+                jp1 = 1
+             ENDIF
+             !
+             n_add = (jp1 - 1)*nx + i
+             e_add = (j - 1)*nx + ip1
+             ne_add = (jp1 - 1)*nx + ip1
+             !
+             src_lats(1) = src_center_lat(srch_add)
+             src_lats(2) = src_center_lat(e_add)
+             src_lats(3) = src_center_lat(ne_add)
+             src_lats(4) = src_center_lat(n_add)
+             !
+             src_lons(1) = src_center_lon(srch_add)
+             src_lons(2) = src_center_lon(e_add)
+             src_lons(3) = src_center_lon(ne_add)
+             src_lons(4) = src_center_lon(n_add)
+             !
+             !***
+             !*** for consistency, we must make sure all lons are in
+             !*** same 2pi interval
+             !***
+             !
+             vec1_lon = src_lons(1) - plon
+             IF (vec1_lon >  pi) THEN
+                src_lons(1) = src_lons(1) - pi2
+             ELSE IF (vec1_lon < -pi) THEN
+                src_lons(1) = src_lons(1) + pi2
+             ENDIF
+             DO n=2,4
+                vec1_lon = src_lons(n) - src_lons(1)
+                IF (vec1_lon >  pi) THEN
+                   src_lons(n) = src_lons(n) - pi2
+                ELSE IF (vec1_lon < -pi) THEN
+                   src_lons(n) = src_lons(n) + pi2
+                ENDIF
+             END DO
+             !
+             corner_loop: DO n=1,4
+                next_n = MOD(n,4) + 1
+                !***
+                !*** here we take the cross product of the vector making 
+                !*** up each box side with the vector formed by the vertex
+                !*** and search point.  if all the cross products are 
+                !*** positive, the point is contained in the box.
+                !***
+                vec1_lat = src_lats(next_n) - src_lats(n)
+                vec1_lon = src_lons(next_n) - src_lons(n)
+                vec2_lat = plat - src_lats(n)
+                vec2_lon = plon - src_lons(n)
+                !***
+                !*** check for 0,2pi crossings
+                !***
+                IF (vec1_lon >  three*pih) THEN
+                   vec1_lon = vec1_lon - pi2
+                ELSE IF (vec1_lon < -three*pih) THEN
+                   vec1_lon = vec1_lon + pi2
+                ENDIF
+                IF (vec2_lon >  three*pih) THEN
+                   vec2_lon = vec2_lon - pi2
+                ELSE IF (vec2_lon < -three*pih) THEN
+                   vec2_lon = vec2_lon + pi2
+                ENDIF
+                !
+                cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+                !
+                !***
+                !*** if cross product is less than zero, this cell
+                !*** doesn't work
+                !***
+                IF (n == 1) cross_product_last = cross_product
+                IF (cross_product*cross_product_last < zero) &
+                     EXIT corner_loop
+                cross_product_last = cross_product
+                !
+             END DO corner_loop
+             !***
+             !*** if cross products all same sign, we found the location
+             !***
+             IF (n > 4) THEN
+                src_add(1) = srch_add
+                src_add(2) = e_add
+                src_add(3) = ne_add
+                src_add(4) = n_add
+                !
+                lastsrc_add = srch_add
+                RETURN
+             ENDIF
+             !***
+             !*** otherwise move on to next cell
+             !***
+          ENDIF !bounding box check
+       END DO srch_loop
+
+
+    ENDDO
+
+
+    !***
+    !*** if no cell found, point is likely either in a box that
+    !*** straddles either pole or is outside the grid.  fall back
+    !*** to a distance-weighted average of the four closest
+    !*** points.  go ahead and compute weights here, but store
+    !*** in src_lats and return -add to prevent the parent
+    !*** routine from computing bilinear weights
+    !***
+    !print *,'Could not find location for ',plat,plon
+    !print *,'Using nearest-neighbor average for this point'
+    !
+    coslat_dst = COS(plat)
+    sinlat_dst = SIN(plat)
+    coslon_dst = COS(plon)
+    sinlon_dst = SIN(plon)
+    !
+    dist_min = bignum
+    src_lats = bignum
+    DO srch_add = min_add,max_add
+       distance = ACOS(coslat_dst*COS(src_center_lat(srch_add))*   &
+            (coslon_dst*COS(src_center_lon(srch_add)) +   &
+            sinlon_dst*SIN(src_center_lon(srch_add)))+   &
+            sinlat_dst*SIN(src_center_lat(srch_add)))
+
+       IF (distance < dist_min) THEN
+          sort_loop: DO n=1,4
+             IF (distance < src_lats(n)) THEN
+                DO i=4,n+1,-1
+                   src_add (i) = src_add (i-1)
+                   src_lats(i) = src_lats(i-1)
+                END DO
+                src_add (n) = -srch_add
+                src_lats(n) = distance
+                dist_min = src_lats(4)
+                EXIT sort_loop
+             ENDIF
+          END DO sort_loop
+       ENDIF
+    END DO
+    !
+    src_lons = one/(src_lats + tiny)
+    distance = SUM(src_lons)
+    src_lats = src_lons/distance
+
+    !-----------------------------------------------------------------------
+
+  END SUBROUTINE grid_search_bilin
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE INIT_REMAP_VARS
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  !      subroutine init_remap_vars
+  !
+  !-----------------------------------------------------------------------
+  !
+  !     this routine initializes some variables and provides an initial
+  !     allocation of arrays (fairly large so frequent resizing 
+  !     unnecessary).
+  !
+  !-----------------------------------------------------------------------
+  !
+  !-----------------------------------------------------------------------
+  !     determine the number of weights
+  !-----------------------------------------------------------------------
+  !        num_wts = 1     ! bilinear interpolation
+  !-----------------------------------------------------------------------
+  !     initialize num_links and set max_links to four times the largest 
+  !     of the destination grid sizes initially (can be changed later).
+  !     set a default resize increment to increase the size of link
+  !     arrays if the number of links exceeds the initial size  
+  !!-----------------------------------------------------------------------
+  !      
+  !      num_links_map1 = 0
+  !      max_links_map1 = 4*grid2_size
+  !      if (num_maps > 1) then
+  !        num_links_map2 = 0
+  !        max_links_map1 = max(4*grid1_size,4*grid2_size)
+  !        max_links_map2 = max_links_map1
+  !      endif
+  !
+  !      resize_increment = 0.1*max(grid1_size,grid2_size)
+  !
+  !-----------------------------------------------------------------------
+  !     allocate address and weight arrays for mapping 1  
+  !-----------------------------------------------------------------------
+  !
+  !      allocate (grid1_add_map1(max_links_map1),    &
+  !                grid2_add_map1(max_links_map1),    &
+  !                wts_map1(num_wts, max_links_map1))
+  !		
+  !	grid1_add_map1 = 0.	
+  !	grid2_add_map1 = 0.
+  !	wts_map1 = 0.!
+  !
+  !!-----------------------------------------------------------------------
+  !
+  !      end subroutine init_remap_vars
+
+END MODULE agrif_gridsearch
Index: /utils/tools_ticket2413/NESTING/src/agrif_interpolation.f90
===================================================================
--- /utils/tools_ticket2413/NESTING/src/agrif_interpolation.f90	(revision 12863)
+++ /utils/tools_ticket2413/NESTING/src/agrif_interpolation.f90	(revision 12863)
@@ -0,0 +1,1054 @@
+!************************************************************************
+! Fortran 95 OPA Nesting tools						*
+!									*
+!     Copyright (C) 2005 Florian Lemarié (Florian.Lemarie@imag.fr)	*
+!									*
+!************************************************************************
+!
+MODULE agrif_interpolation
+  !
+  USE agrif_types
+  USE io_netcdf
+  USE bicubic_interp
+  USE bilinear_interp
+  USE agrif_extrapolation
+  USE agrif_readwrite 
+  !
+  !
+  !************************************************************************
+  ! 									*
+  ! MODULE  AGRIF_INTERPOLATION						*
+  !									*
+  ! module containing subroutine used for : 				*
+  !   - Forcing data interpolation					*
+  !   - Parent to Child coordinates interpolation			*
+  !									*
+  !************************************************************************
+  !          
+  ! 
+CONTAINS
+  !  
+  !
+  !****************************************************************
+  !   subroutine agrif_interp					*
+  !								*
+  ! subroutine to interpolate coordinates		 	*
+  !								*
+  ! - input :							*
+  !     tabin : coarse grid coordinate variable 		*
+  !   typevar : position of interpolated variable on cells	*
+  !								*
+  ! - ouput :							*
+  !    tabout : coordinate variable interpolated on fine grid	*
+  !								*
+  !****************************************************************
+  !     
+  SUBROUTINE agrif_interp(tabin,tabout,typevar)
+    !      
+    REAL*8,DIMENSION(:,:) :: tabin,tabout
+    CHARACTER(*) :: typevar
+    REAL*8 :: cff1
+    INTEGER :: ii,jj
+    REAL*8,DIMENSION(:,:),ALLOCATABLE :: tabouttemp
+    !
+    ! 
+    !
+    IF( ln_agrif_domain ) THEN
+       CALL agrif_base_interp2(tabin,tabout,imin,jmin,typevar)
+    ELSE
+       CALL agrif_base_interp3(tabin,tabout,imin,jmin,typevar)
+    ENDIF
+    
+    !
+  END SUBROUTINE agrif_interp
+  !
+  !      
+  SUBROUTINE agrif_base_interp2(tabin,tabout,i_min,j_min,typevar)
+    !
+    IMPLICIT NONE
+    REAL*8,DIMENSION(:,:) :: tabin,tabout
+    REAL*8 :: cff1
+    INTEGER :: i_min,j_min
+    INTEGER :: ii,jj,i,j
+    CHARACTER(*) :: typevar   
+    REAL*8,DIMENSION(:),ALLOCATABLE :: xc,yc,xf,yf
+    REAL*8,DIMENSION(:,:),ALLOCATABLE :: tabtemp
+    REAL*8 :: dxc,dyc,dxf,dyf
+    REAL*8 :: decalxc,decalyc,decalxf,decalyf
+
+    INTEGER :: ptx,pty
+    REAL*8 :: val(4),xval(4)
+
+    INTEGER :: nxc,nyc,nxf,nyf
+    REAL :: xmin,ymin,x,y
+    INTEGER :: ic,jc,itemp,jtemp
+
+    nxc = SIZE(tabin,1)
+    nyc = SIZE(tabin,2)
+
+    nxf = SIZE(tabout,1)
+    nyf = SIZE(tabout,2)      
+    !
+
+    ALLOCATE(xc(nxc))
+    ALLOCATE(yc(nyc))
+    ALLOCATE(xf(nxf))
+    ALLOCATE(yf(nyf))
+
+    ALLOCATE(tabtemp(nxc,nyf))
+
+    dxc = 1.
+    dyc = 1.
+    dxf = 1./REAL(irafx)
+    dyf = 1./REAL(irafy)
+
+    IF (typevar .EQ. 'F') THEN
+       ptx = 1 + nbghostcellsfine 
+       pty = 1 + nbghostcellsfine 
+       decalxc = 0.
+       decalyc = 0.
+       decalxf = 0.
+       decalyf = 0.
+    ELSEIF (typevar .EQ. 'T') THEN
+       ptx = 2 + nbghostcellsfine 
+       pty = 2 + nbghostcellsfine 
+       decalxc = dxc/2.
+       decalyc = dyc/2.
+       decalxf = dxf/2.
+       decalyf = dyf/2.
+    ELSEIF (typevar .EQ. 'U') THEN
+       ptx = 1 + nbghostcellsfine 
+       pty = 2 + nbghostcellsfine 
+       decalxc = 0.
+       decalyc = dyc/2.
+       decalxf = 0.
+       decalyf = dyf/2.
+    ELSEIF (typevar .EQ. 'V') THEN
+       ptx = 2 + nbghostcellsfine 
+       pty = 1 + nbghostcellsfine 
+       decalxc = dxc/2.
+       decalyc = 0.
+       decalxf = dxf/2.
+       decalyf = 0.
+    ENDIF
+
+    DO i=1,nxc
+       xc(i) = 0. + (i-ptx) * dxc + decalxc
+    ENDDO
+
+    DO j=1,nyc
+       yc(j) = 0. + (j-pty) * dyc + decalyc
+    ENDDO
+
+
+    xmin = (i_min - 1) * dxc
+    ymin = (j_min - 1) * dyc
+
+    DO i=1,nxf
+       xf(i) = xmin + (i-ptx) * dxf + decalxf
+    ENDDO
+
+    DO j=1,nyf
+       yf(j) = ymin + (j-pty) * dyf + decalyf
+    ENDDO
+
+
+    DO j = 1,nyf
+       DO i = 1,nxc
+	  x = xc(i)
+	  y = yf(j)
+
+	  ic = ptx + NINT((x-0.-decalxc)/dxc)
+	  jc = pty + agrif_int((y-0.-decalyc)/dyc)
+
+	  jc = jc - 1
+
+	  CALL polint(yc(jc:jc+3),tabin(ic,jc:jc+3),4,y,tabtemp(i,j))
+       ENDDO
+    ENDDO
+
+    DO j = 1,nyf
+       DO i = 1,nxf
+	  x = xf(i)
+	  y = yf(j)
+
+	  itemp = ptx + agrif_int((x-0.-decalxc)/dxc)
+	  jtemp = pty + NINT((y-ymin-decalyf)/dyf)
+
+	  itemp = itemp - 1
+
+	  val = tabtemp(itemp:itemp+3,jtemp)
+	  xval = xc(itemp:itemp+3)
+	  CALL polint(xval,val,4,x,tabout(i,j))
+
+       ENDDO
+    ENDDO
+
+    DEALLOCATE(xc,yc,xf,yf,tabtemp)
+
+
+  END SUBROUTINE agrif_base_interp2
+  !
+  !      
+  SUBROUTINE agrif_base_interp3(tabin,tabout,i_min,j_min,typevar)
+    !
+    IMPLICIT NONE
+    REAL*8,DIMENSION(:,:) :: tabin,tabout
+    INTEGER :: i_min,j_min
+    CHARACTER(*) :: typevar   
+
+    INTEGER :: nxf,nyf,nxc,nyc,zx,zy
+    INTEGER :: ji,jj,jif,jjf,jic,jjc,jic1,jjc1,jdecx,jdecy
+    REAL*8 :: Ax, Bx, Ay, By
+
+    nxf = SIZE(tabout,1)
+    nyf = SIZE(tabout,2)
+
+    nxc = SIZE(tabin,1)
+    nyc = SIZE(tabin,2)
+
+    SELECT CASE(typevar)
+    CASE('T')
+       IF(MOD(irafx,2)==1) THEN ! odd
+          zx = 1 ; zy = 1 ; jdecx = FLOOR(irafx/2.) ; jdecy = FLOOR(irafy/2.)
+       ELSE                     ! even
+          zx = 2 ; zy = 2 ; jdecx = FLOOR(irafx/2.) ; jdecy = FLOOR(irafy/2.)
+       ENDIF
+    CASE('U')
+       IF(MOD(irafx,2)==1) THEN ! odd
+          zx = 1 ; zy = 1 ; jdecx = irafx - 1 ; jdecy = FLOOR(irafy/2.)
+       ELSE                     ! even
+          zx = 1 ; zy = 2 ; jdecx = irafx - 1 ; jdecy = FLOOR(irafy/2.)
+       ENDIF
+    CASE('V')
+       IF(MOD(irafx,2)==1) THEN ! odd
+          zx = 1 ; zy = 1 ; jdecx = FLOOR(irafx/2.) ; jdecy = irafy - 1
+       ELSE                     ! even
+          zx = 2 ; zy = 1 ; jdecx = FLOOR(irafx/2.) ; jdecy = irafy - 1
+       ENDIF
+    CASE('F')
+       IF(MOD(irafx,2)==1) THEN ! odd
+          zx = 1 ; zy = 1 ; jdecx = irafx - 1 ; jdecy = irafy - 1
+       ELSE                     ! even
+          zx = 1 ; zy = 1 ; jdecx = irafx - 1 ; jdecy = irafy - 1
+       ENDIF
+    END SELECT
+
+    
+    DO jj = 1, nyf
+
+       jjf = jj - jdecy
+       jjc = j_min + FLOOR((jjf-1.) / irafy) 
+       
+       DO ji = 1, nxf
+          
+          jif = ji - jdecx 
+          jic = i_min + FLOOR((jif-1.) / irafx) 
+          
+          Bx = MOD( zx*jif-1, zx*irafx ) / REAL(zx*irafx)
+          By = MOD( zy*jjf-1, zy*irafy ) / REAL(zy*irafy)
+          Ax = 1. - Bx
+          Ay = 1. - By
+
+          jic1 = MIN( nxc, jic+1 ) ! avoid out of bounds for tabin below
+          jjc1 = MIN( nyc, jjc+1 ) !             --
+
+          tabout(ji,jj) = ( Bx * tabin(jic1,jjc ) + Ax * tabin(jic,jjc ) ) * Ay + &
+             &            ( Bx * tabin(jic1,jjc1) + Ax * tabin(jic,jjc1) ) * By
+       END DO
+    END DO
+    
+    !
+  END SUBROUTINE agrif_base_interp3
+
+  !       
+  SUBROUTINE polint(xin,valin,n,x,val)
+    IMPLICIT NONE
+    INTEGER n
+    REAL*8 xin(n), valin(n)
+    REAL*8 x,val
+
+    INTEGER ns,i,m
+    REAL *8 dif,dift
+    REAL*8 c(n),d(n),ho,hp,w,den,dy
+
+    ns = 1
+    dif = ABS(x-xin(1))
+
+    DO i=1,n
+       dift = ABS(x-xin(i))
+       IF (dift < dif) THEN
+	  ns = i
+	  dif = dift
+       ENDIF
+       c(i) = valin(i)
+       d(i) = valin(i)
+    ENDDO
+
+    val = valin(ns)
+    ns = ns - 1
+
+    DO m=1,n-1
+       DO i=1,n-m
+	  ho = xin(i)-x
+	  hp = xin(i+m)-x
+	  w=c(i+1)-d(i)
+	  den = w/(ho-hp)
+          d(i) = hp * den
+	  c(i) = ho * den
+       ENDDO
+       IF (2*ns < (n-m)) THEN
+          dy = c(ns+1)
+       ELSE
+          dy = d(ns)
+          ns = ns - 1
+       ENDIF
+       val = val + dy
+    ENDDO
+  END SUBROUTINE polint
+  !
+  !      
+  SUBROUTINE polcoe(xin,valin,n,cof)
+    IMPLICIT NONE
+    INTEGER n
+    REAL*8 xin(n),valin(n),cof(n)
+
+
+    INTEGER i,j,k
+    REAL*8 b,ff,phi,s(n)
+
+    s = 0.
+    cof = 0.
+
+    s(n)=-xin(1)
+    DO i=2,n
+       DO j=n+1-i,n-1
+          s(j) =s(j) -xin(i)*s(j+1)
+       ENDDO
+       s(n)=s(n)-xin(i)
+    ENDDO
+
+    DO j=1,n
+       phi=n
+       DO k=n-1,1,-1
+          phi = k*s(k+1)+xin(j)*phi
+       ENDDO
+       ff=valin(j)/phi
+       b=1.
+       DO k=n,1,-1
+	  cof(k)=cof(k)+b*ff
+	  b=s(k)+xin(j)*b
+       ENDDO
+    ENDDO
+
+    RETURN
+  END SUBROUTINE polcoe
+  !
+
+  !****************************************************************
+  !   subroutine Correctforconservation				*
+  !								*
+  ! Conservation on domain boundaries ( over 2 coarse grid cells)	*
+  !								*
+  !****************************************************************          
+  !
+  !
+  SUBROUTINE Correctforconservation(tabcoarse,tabfine,e1parent,e2parent,e1,e2,nxfin,nyfin,posvar,i_min,j_min)
+    IMPLICIT NONE
+    INTEGER :: nxfin,nyfin
+    REAL*8,DIMENSION(:,:) :: tabcoarse,tabfine,e1parent,e2parent,e1,e2
+    CHARACTER*1  :: posvar
+    INTEGER :: i_min,j_min,diff
+    INTEGER ji,jj,ipt,jpt,i,j
+    INTEGER ind1,ind2,ind3,ind4,ind5,ind6
+    REAL*8 cff1,cff2,cff3      
+    !
+    diff = 0      
+    IF ( MOD(irafx,2) .EQ. 0 ) diff = 1
+    !       
+    ind1 = 2 + CEILING(irafx/2.0) + diff
+    ind2 = nxfin-(2-1)-CEILING(irafx/2.0)
+    ind3 = 2 + CEILING(irafy/2.0) + diff
+    ind4 = nyfin-(2-1)-CEILING(irafy/2.0)
+    ind5 = nxfin - 1 - irafx - CEILING(irafx/2.0) 
+    ind6 = nyfin - 1 - irafy - CEILING(irafy/2.0) 
+    !       
+    IF (posvar.EQ.'T') THEN
+       !       
+       PRINT *,'correction'
+       !
+       DO ji=ind1,ind1+irafx,irafx
+          !       
+          ipt=i_min+(3-1)+(ji-ind1)/irafx
+          !            
+          DO jj=ind3,ind4,irafy
+             !            
+             jpt=j_min+(3-1)+(jj-ind3)/irafy
+
+             cff1=SUM(e1(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)* &
+                  e2(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff))
+
+             cff2=SUM(e1(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)*   &
+                  e2(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)*   &
+                  tabfine(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff))
+
+             cff3=e1parent(ipt,jpt)*e2parent(ipt,jpt)*tabcoarse(ipt,jpt)                        
+
+             tabfine(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)=  &
+                  tabfine(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)+(cff3-cff2)/cff1
+
+          END DO
+
+       ENDDO
+       !****      
+       DO ji=ind5,ind5+irafx,irafx
+          !       
+          ipt=i_min+(3-1)+(ji-ind1)/irafx
+
+          DO jj=ind3,ind4,irafy
+             jpt=j_min+(3-1)+(jj-ind3)/irafy
+
+             cff1=SUM(e1(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)* &
+                  e2(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff))
+
+             cff2=SUM(e1(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)*   &
+                  e2(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)*   &
+                  tabfine(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff))
+
+             cff3=e1parent(ipt,jpt)*e2parent(ipt,jpt)*tabcoarse(ipt,jpt)                        
+
+             tabfine(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)=  &
+                  tabfine(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)+(cff3-cff2)/cff1
+
+          END DO
+       ENDDO
+
+       DO jj=ind3,ind3+irafy,irafy
+          !       
+          jpt=j_min+(3-1)+(jj-ind3)/irafy
+          !
+          DO ji=ind1,ind2,irafx
+             !          
+             ipt=i_min+(3-1)+(ji-ind1)/irafx
+
+             cff1=SUM(e1(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)* &
+                  e2(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff))
+
+             cff2=SUM(e1(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)*   &
+                  e2(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)*   &
+                  tabfine(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff))
+
+             cff3=e1parent(ipt,jpt)*e2parent(ipt,jpt)*tabcoarse(ipt,jpt)                        
+
+             tabfine(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)=  &
+                  tabfine(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)+(cff3-cff2)/cff1
+
+          END DO
+       ENDDO
+       !****      
+       DO jj=ind6,ind6+irafy,irafy
+          !
+          jpt=j_min+(3-1)+(jj-ind3)/irafy
+          !
+          DO ji=ind1,ind2,irafx          
+             ipt=i_min+(3-1)+(ji-ind1)/irafx	
+
+             cff1=SUM(e1(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)* &
+                  e2(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff))
+
+             cff2=SUM(e1(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)*   &
+                  e2(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)*   &
+                  tabfine(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff))
+
+             cff3=e1parent(ipt,jpt)*e2parent(ipt,jpt)*tabcoarse(ipt,jpt)                        
+
+             tabfine(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)=  &
+                  tabfine(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)+(cff3-cff2)/cff1
+
+          END DO
+       ENDDO
+       !                                     
+       !       
+    ENDIF
+    RETURN
+  END SUBROUTINE Correctforconservation
+
+  !
+  !****************************************************************
+  !   subroutine Interp_Extrap_var				*
+  !								*
+  ! Interpolation and Extrapolation for temperature and salinity	*
+  !								*
+  ! -input : 							*
+  !       filename : file containing variable to interpolate	*
+  !								*
+  !****************************************************************          
+  !
+  SUBROUTINE Interp_Extrap_var(filename, cd_type)      
+    !
+    IMPLICIT NONE
+    !
+    ! variables declaration
+    !      
+    CHARACTER(len=80),INTENT(in) :: filename
+    CHARACTER(len=1 ), OPTIONAL, INTENT(in) :: cd_type
+
+    CHARACTER*100 :: interp_type
+    CHARACTER*100 :: Child_file,Childcoordinates
+    CHARACTER*100 :: varname,childbathy
+    CHARACTER*1  :: posvar
+    CHARACTER*20,DIMENSION(:),POINTER :: Ncdf_varname
+    CHARACTER(len=20),DIMENSION(4) :: dimnames
+    !
+    REAL*8, POINTER, DIMENSION(:,:) :: lonParent,latParent => NULL()
+    REAL*8, POINTER, DIMENSION(:,:) :: lonChild,latChild,latlon_temp => NULL()
+    REAL*8, POINTER, DIMENSION(:,:,:,:) :: tabinterp4d,tabvar1,tabvar2,tabvar3 => NULL()
+    REAL*8, POINTER, DIMENSION(:,:,:) :: tabinterp3d,tabvar3d => NULL()
+    REAL*8, POINTER, DIMENSION(:) :: timedepth_temp,depth => NULL()
+    REAL*8,DIMENSION(:,:),POINTER :: matrix => NULL()
+    INTEGER,DIMENSION(:),POINTER :: src_add,dst_add  => NULL()
+    INTEGER, POINTER, DIMENSION(:) :: tabtemp1DInt => NULL()
+    REAL*8, POINTER, DIMENSION(:) :: nav_lev => NULL()
+    !      
+    LOGICAL, DIMENSION(:,:,:), POINTER :: detected_pts => NULL()  
+    REAL*8,DIMENSION(:,:,:),POINTER :: mask => NULL()
+    LOGICAL,DIMENSION(:,:),POINTER :: masksrc => NULL()
+    LOGICAL :: Interpolation,conservation,Pacifique,Extrapolation,land_level
+    !      
+    INTEGER :: deptht,time,i,status,ncid,t,ii,j,nb,numlon,numlat
+
+    !        
+    TYPE(Coordinates) :: G0,G1      
+    !
+    !*****************
+    !If coarse grid is masked possibility to activate an extrapolation process
+    !
+    Extrapolation = .FALSE.
+    PRINT*,'DEBUT INTERP_EXTRAP_VAR'
+    !
+    !*****************
+    !
+    ! check grid position
+    !
+    IF( PRESENT(cd_type) ) THEN
+       posvar = cd_type
+    ELSE
+       posvar = 'T'
+    ENDIF     
+
+    !
+    ! read dimensions in netcdf file
+    !
+    CALL Read_Ncdf_dim('x',filename,numlon)
+    CALL Read_Ncdf_dim('y',filename,numlat)
+    CALL Read_Ncdf_dim('time_counter',filename,time)
+    IF ( Dims_Existence( 'deptht' , filename ) ) THEN
+       CALL Read_Ncdf_dim('deptht',filename,deptht)
+    ELSE IF ( Dims_Existence( 'depthu' , filename ) ) THEN
+       CALL Read_Ncdf_dim('depthu',filename,deptht)
+    ELSE IF ( Dims_Existence( 'depthv' , filename ) ) THEN
+       CALL Read_Ncdf_dim('depthv',filename,deptht)
+    ELSE IF ( Dims_Existence( 'depthw' , filename ) ) THEN
+       CALL Read_Ncdf_dim('depthw',filename,deptht)
+    ELSE IF ( Dims_Existence( 'z' , filename ) ) THEN
+       CALL Read_Ncdf_dim('z',filename,deptht)
+    ELSE
+       deptht = N
+    ENDIF
+
+    !
+    ! retrieve netcdf variable name
+    !
+    CALL Read_Ncdf_VarName(filename,Ncdf_varname)
+    !
+    ! define name of child grid file
+    !
+    CALL set_child_name(filename,Child_file) 
+    CALL set_child_name(parent_coordinate_file,Childcoordinates)
+    CALL set_child_name(parent_bathy_level,childbathy)
+    WRITE(*,*) 'Child grid file name = ',TRIM(Child_file)
+    !
+    ! create this file
+    !
+    status = nf90_create(Child_file,NF90_WRITE,ncid)
+    status = nf90_close(ncid)
+    !
+    ! read coordinates of both domains
+    !           
+    status = Read_Coordinates(parent_coordinate_file,G0)
+    status = Read_Coordinates(Childcoordinates,G1,Pacifique)
+    !
+    ! check consistency of informations read in namelist 
+    !      
+    IF( imax > SIZE(G0%glamt,1) .OR. jmax > SIZE(G0%glamt,2) .OR. &
+         imax <= imin .OR. jmax <= jmin ) THEN                    
+       WRITE(*,*) 'ERROR ***** bad child grid definition ...'
+       WRITE(*,*) 'please check imin,jmin,imax,jmax,jpizoom,jpjzoom values'       
+       WRITE(*,*) ' '
+       STOP
+    ENDIF
+    !
+    IF( SIZE(G1%nav_lon,1) .NE. nxfin .OR. SIZE(G1%nav_lon,2) .NE. nyfin ) THEN
+       WRITE(*,*) 'ERROR ***** bad child coordinates or bathy file ...'
+       WRITE(*,*) ' '
+       WRITE(*,*) 'please check that child coordinates file and child bathymetry file'
+       WRITE(*,*) 'has been created with the current namelist '
+       WRITE(*,*) ' '
+       STOP
+    ENDIF
+    !      
+
+    !
+    ! Initialization of T-mask thanks to bathymetry 
+    !
+    IF( Extrapolation ) THEN
+
+       WRITE(*,*) 'mask initialisation on coarse and fine grids'
+       ! 
+       ALLOCATE(mask(numlon,numlat,N))
+       CALL Init_mask(childbathy,G1,1,1)
+       CALL Init_mask(parent_bathy_level,G0,1,1)
+       !
+    ENDIF
+
+    !      
+    ! select coordinates to use according to variable position
+    !
+    ALLOCATE(lonParent(numlon,numlat),latParent(numlon,numlat))
+    ALLOCATE(lonChild(nxfin,nyfin),latChild(nxfin,nyfin))
+
+    SELECT CASE(posvar)
+    CASE('T')
+       lonParent = G0%glamt
+       latParent = G0%gphit
+       lonChild  = G1%glamt
+       latChild  = G1%gphit
+       mask      = G1%tmask
+    CASE('U')
+       lonParent = G0%glamu
+       latParent = G0%gphiu
+       lonChild  = G1%glamu
+       latChild  = G1%gphiu
+       mask      = G1%umask
+    CASE('V')
+       lonParent = G0%glamv
+       latParent = G0%gphiv
+       lonChild  = G1%glamv
+       latChild  = G1%gphiv
+       mask      = G1%vmask
+    END SELECT
+
+    DEALLOCATE(G0%glamu,G0%glamv,G0%gphiu,G0%gphiv)
+    DEALLOCATE(G1%glamu,G1%glamv,G1%gphiu,G1%gphiv) 
+    DEALLOCATE(G1%glamt,G1%gphit,G0%glamt,G0%gphit)
+
+    !
+    !longitude modification if child domain covers Pacific ocean area
+    ! 
+    IF( lonChild(1,1) > lonChild(nxfin,nyfin) ) THEN
+       Pacifique = .TRUE.
+       WHERE( lonChild < 0 )
+          lonChild = lonChild + 360.
+       END WHERE
+       WHERE( lonParent < 0 )
+          lonParent = lonParent + 360.
+       END WHERE
+    ENDIF
+
+    !    
+    !
+    ! dimensions initialization      
+    !
+    CALL Write_Ncdf_dim('x',Child_file,nxfin)
+    CALL Write_Ncdf_dim('y',Child_file,nyfin)
+    IF ( Dims_Existence( 'deptht' , filename ) ) CALL Write_Ncdf_dim('deptht',Child_file,deptht)
+    IF ( Dims_Existence( 'depthu' , filename ) ) CALL Write_Ncdf_dim('depthu',Child_file,deptht)
+    IF ( Dims_Existence( 'depthv' , filename ) ) CALL Write_Ncdf_dim('depthv',Child_file,deptht)
+    IF ( Dims_Existence( 'depthw' , filename ) ) CALL Write_Ncdf_dim('depthw',Child_file,deptht)
+    IF ( Dims_Existence( 'z' , filename ) ) CALL Write_Ncdf_dim('z',Child_file,deptht)
+    CALL Write_Ncdf_dim('time_counter',Child_file,0)
+
+    IF( deptht .NE. 1 .AND. deptht .NE. N ) THEN
+       WRITE(*,*) '***'
+       WRITE(*,*) 'Number of vertical levels doesn t match between namelist'
+       WRITE(*,*) 'and forcing file ',TRIM(filename)
+       WRITE(*,*) 'Please check the values in namelist file'
+       WRITE(*,*) 'N = ',N
+       WRITE(*,*) 'deptht = ',deptht
+       STOP     
+    ENDIF
+    !
+    !
+    DO i = 1,SIZE(Ncdf_varname)
+       !      
+       !
+       ! ******************************LOOP ON VARIABLE NAMES*******************************************
+       !
+       !      
+       SELECT CASE (TRIM(Ncdf_varname(i)))
+          !
+          !copy nav_lon from child coordinates to output file      
+       CASE('nav_lon')   
+          ALLOCATE(latlon_temp(nxfin,nyfin))
+          CALL Read_Ncdf_var('nav_lon',TRIM(Childcoordinates),latlon_temp) 
+          CALL Write_Ncdf_var('nav_lon',(/'x','y'/),Child_file,latlon_temp,'float')
+          CALL Copy_Ncdf_att('nav_lon',TRIM(filename),Child_file, &
+               MINVAL(latlon_temp),MAXVAL(latlon_temp))
+          DEALLOCATE(latlon_temp)
+          varname = TRIM(Ncdf_varname(i))
+          Interpolation = .FALSE.
+          !	     
+          !copy nav_lat from child coordinates to output file
+       CASE('nav_lat')             
+          ALLOCATE(latlon_temp(nxfin,nyfin))
+          CALL Read_Ncdf_var('nav_lat',TRIM(Childcoordinates),latlon_temp) 
+          CALL Write_Ncdf_var('nav_lat',(/'x','y'/),Child_file,latlon_temp,'float')
+          CALL Copy_Ncdf_att('nav_lat',TRIM(filename),Child_file, &
+               MINVAL(latlon_temp),MAXVAL(latlon_temp)) 
+          DEALLOCATE(latlon_temp)
+          varname = TRIM(Ncdf_varname(i))
+          Interpolation = .FALSE.
+          !
+          !copy nav_lev from restart_file to output file
+          !
+       CASE('nav_lev')
+
+          WRITE(*,*) 'copy nav_lev'
+          CALL Read_Ncdf_var('nav_lev',filename,nav_lev) 
+          IF(.NOT. dimg ) THEN
+             CALL Write_Ncdf_var('nav_lev','z',Child_file,nav_lev,'float')
+             CALL Copy_Ncdf_att('nav_lev',filename,Child_file)      
+          ENDIF
+          DEALLOCATE(nav_lev)
+          Interpolation = .FALSE.
+          !	    	
+          !copy time_counter from input file to output file
+       CASE('time_counter')
+          ALLOCATE(timedepth_temp(time))
+          CALL Read_Ncdf_var('time_counter',filename,timedepth_temp) 
+          CALL Write_Ncdf_var('time_counter','time_counter',  &
+               Child_file,timedepth_temp,'float')
+          CALL Copy_Ncdf_att('time_counter',TRIM(filename),Child_file)
+          DEALLOCATE(timedepth_temp)
+          varname = TRIM(Ncdf_varname(i))
+          Interpolation = .FALSE.
+          !
+          !copy deptht from input file to output file
+       CASE('deptht')
+          ALLOCATE(depth(deptht))
+          CALL Read_Ncdf_var('deptht',filename,depth) 
+          CALL Write_Ncdf_var('deptht','deptht',Child_file,depth,'float')
+          CALL Copy_Ncdf_att('deptht',TRIM(filename),Child_file)
+          varname = TRIM(Ncdf_varname(i))
+          Interpolation = .FALSE.     
+          !
+          !copy depthu from input file to output file
+       CASE('depthu')
+          ALLOCATE(depth(deptht))
+          CALL Read_Ncdf_var('depthu',filename,depth) 
+          CALL Write_Ncdf_var('depthu','depthu',Child_file,depth,'float')
+          CALL Copy_Ncdf_att('depthu',TRIM(filename),Child_file)
+          varname = TRIM(Ncdf_varname(i))
+          Interpolation = .FALSE.     
+          !
+          !copy depthv from input file to output file
+       CASE('depthv')
+          ALLOCATE(depth(deptht))
+          CALL Read_Ncdf_var('depthv',filename,depth) 
+          CALL Write_Ncdf_var('depthv','depthv',Child_file,depth,'float')
+          CALL Copy_Ncdf_att('depthv',TRIM(filename),Child_file)
+          varname = TRIM(Ncdf_varname(i))
+          Interpolation = .FALSE.     
+          !
+          !copy depthv from input file to output file
+       CASE('depthw')
+          ALLOCATE(depth(deptht))
+          CALL Read_Ncdf_var('depthw',filename,depth) 
+          CALL Write_Ncdf_var('depthw','depthw',Child_file,depth,'float')
+          CALL Copy_Ncdf_att('depthw',TRIM(filename),Child_file)
+          varname = TRIM(Ncdf_varname(i))
+          Interpolation = .FALSE.     
+          !
+          !copy time_steps from input file in case of restget use in NEMO in/out routines
+       CASE('time_steps')
+          !         print *,'avant time step'
+
+          CALL Read_Ncdf_var('time_steps',filename,tabtemp1DInt) 
+          !		   print *,'timedeph = ',tabtemp1DInt
+          CALL Write_Ncdf_var('time_steps','time_counter',Child_file,tabtemp1DInt,'integer')
+          CALL Copy_Ncdf_att('time_steps',filename,Child_file) 
+          DEALLOCATE(tabtemp1DInt)
+          Interpolation = .FALSE.  
+          !  
+          !store tmask in output file
+       CASE('tmask')
+          dimnames(1)='x'
+          dimnames(2)='y'
+          dimnames(3)='deptht' 
+          IF (.NOT.ASSOCIATED(G1%tmask)) THEN
+             ALLOCATE(G1%tmask(nxfin,nyfin,deptht))
+             G1%tmask = 1
+          ENDIF
+          CALL Write_Ncdf_var('tmask',dimnames(1:3),Child_file,G1%tmask,'float')
+          varname = TRIM(Ncdf_varname(i))
+          Interpolation = .FALSE.     
+          !      
+       CASE default
+          varname = Ncdf_varname(i)
+          conservation = .FALSE.
+          CALL get_interptype( varname,interp_type,conservation )
+          WRITE(*,*) '**********************************************'
+          WRITE(*,*) 'varname      = ',TRIM(varname), 'at ', posvar, ' point'
+          WRITE(*,*) 'interp_type  = ',TRIM(interp_type)
+          WRITE(*,*) 'conservation = ',conservation
+          WRITE(*,*) '***********************************************'
+          Interpolation = .TRUE.
+          !	         
+       END SELECT
+
+       ! //////////////// INTERPOLATION FOR 3D VARIABLES /////////////////////////////////////
+       ! 
+       IF( Interpolation .AND. Get_NbDims(TRIM(varname),TRIM(filename)) == 3 ) THEN
+          !      
+          ALLOCATE(detected_pts(numlon,numlat,N))
+          ALLOCATE(masksrc(numlon,numlat))                                           
+          !
+          ! ******************************LOOP ON TIME*******************************************
+          !loop on time
+          DO t = 1,time
+             !                   
+             IF(extrapolation) THEN
+                WRITE(*,*) 'interpolation/extrapolation ',TRIM(varname),' for time t = ',t
+             ELSE
+                WRITE(*,*) 'interpolation ',TRIM(varname),' for time t = ',t
+             ENDIF
+             !                            
+             ALLOCATE(tabvar3d(numlon,numlat,1))      
+             ALLOCATE(tabinterp3d(nxfin,nyfin,1))
+             !                    
+             CALL Read_Ncdf_var(varname,filename,tabvar3d,t)                                              
+             !
+             ! search points where extrapolation is required
+             ! 
+             IF(Extrapolation) THEN
+                 WHERE( tabvar3d .GE. 1.e+20 ) tabvar3d = 0.
+                IF (t .EQ. 1. ) CALL extrap_detect(G0,G1,detected_pts(:,:,1),1)
+                CALL correct_field_2d(detected_pts(:,:,1),tabvar3d,G0,masksrc,'posvar')
+             ELSE
+                masksrc = .TRUE.
+             ENDIF
+
+             IF (t.EQ.1 ) THEN 
+
+                SELECT CASE(TRIM(interp_type))
+                CASE('bilinear')
+                   CALL get_remap_matrix(latParent,latChild,   &
+                        lonParent,lonChild,                    &
+                        masksrc,matrix,src_add,dst_add)
+
+                CASE('bicubic')
+                   CALL get_remap_bicub(latParent,latChild,   &
+                        lonParent,lonChild,   &
+                        masksrc,matrix,src_add,dst_add)
+
+                END SELECT
+                !                                                        
+             ENDIF
+             !      
+             SELECT CASE(TRIM(interp_type))
+             CASE('bilinear')                                                       
+                CALL make_remap(tabvar3d(:,:,1),tabinterp3d(:,:,1),nxfin,nyfin, &
+                     matrix,src_add,dst_add)     
+             CASE('bicubic')                                   
+                CALL make_bicubic_remap(tabvar3d(:,:,1),masksrc,tabinterp3d(:,:,1),nxfin,nyfin, &
+                     matrix,src_add,dst_add)                        
+             END SELECT
+             !                     
+             IF( conservation ) CALL Correctforconservation(tabvar3d(:,:,1),tabinterp3d(:,:,1), &
+                  G0%e1t,G0%e2t,G1%e1t,G1%e2t,nxfin,nyfin,posvar,imin,jmin)  
+             !      
+             IF(Extrapolation) tabinterp3d(:,:,1) = tabinterp3d(:,:,1) * mask(:,:,1)     
+             !                     
+             dimnames(1)='x'
+             dimnames(2)='y'
+             dimnames(3)='time_counter'
+             !                                     
+             CALL Write_Ncdf_var(TRIM(varname),dimnames(1:3),&
+                  Child_file,tabinterp3d,t,'float')
+             !      
+             DEALLOCATE(tabinterp3d)
+             DEALLOCATE(tabvar3d)                     
+             !end loop on time
+          END DO
+          !                   
+          DEALLOCATE(detected_pts)
+          IF(ASSOCIATED(matrix)) DEALLOCATE(matrix,dst_add,src_add)
+          DEALLOCATE( masksrc)
+
+          CALL Copy_Ncdf_att(TRIM(varname),TRIM(filename),Child_file)                        
+          !
+       ELSE IF( Interpolation .AND. Get_NbDims(TRIM(varname),TRIM(filename)) == 4 ) THEN
+          !
+          !
+          ! //////////////// INTERPOLATION FOR 4D VARIABLES /////////////////////////////////////
+          ! 
+          dimnames(1)='x'
+          dimnames(2)='y'
+          IF ( Dims_Existence( 'deptht' , filename ) ) dimnames(3)='deptht'  
+          IF ( Dims_Existence( 'depthu' , filename ) ) dimnames(3)='depthu'
+          IF ( Dims_Existence( 'depthv' , filename ) ) dimnames(3)='depthv'
+          IF ( Dims_Existence( 'depthw' , filename ) ) dimnames(3)='depthw'
+          IF ( Dims_Existence( 'z' , filename ) ) dimnames(3)='z'
+          dimnames(4)='time_counter'  
+          !
+          ! loop on vertical levels
+          ! 
+          DO nb = 1,deptht
+             !        
+             ALLOCATE(masksrc(numlon,numlat))
+             ALLOCATE(detected_pts(numlon,numlat,N))          
+             !
+             ! point detection et level n                                     
+             !
+             land_level = .FALSE.
+             IF( Extrapolation ) THEN
+                IF(MAXVAL(mask(:,:,nb))==0.) land_level = .TRUE.
+             ENDIF
+
+
+             IF ( land_level ) THEN
+                !
+                WRITE(*,*) 'only land points on level ',nb
+                ALLOCATE(tabinterp4d(nxfin,nyfin,1,1)) 
+                tabinterp4d = 0.e0
+                !                              
+                DO ii = 1,time
+                   CALL Write_Ncdf_var(TRIM(varname),dimnames, &
+                        Child_file,tabinterp4d,ii,nb,'float')
+                END DO
+                DEALLOCATE(tabinterp4d)
+                !
+             ELSE
+                !                       
+                ! loop on time                       
+                !
+                DO t = 1,time
+                   !                   
+                   ALLOCATE(tabvar1(numlon,numlat,1,1))    ! level k
+                   IF(Extrapolation) ALLOCATE(tabvar2(numlon,numlat,1,1))    ! level k-1
+                   IF(Extrapolation) ALLOCATE(tabvar3(numlon,numlat,1,1))    ! level k-2                       
+                   ALLOCATE(tabinterp4d(nxfin,nyfin,1,1)) 
+                   !
+                   IF(Extrapolation) THEN                                  
+                      IF(nb==1) THEN
+                         CALL Read_Ncdf_var(varname,filename,tabvar1,t,nb)    
+                         WHERE( tabvar1 .GE. 1.e+20 ) tabvar1 = 0.
+                      ELSE IF (nb==2) THEN
+                         CALL Read_Ncdf_var(varname,filename,tabvar2,t,nb-1)
+                         CALL Read_Ncdf_var(varname,filename,tabvar1,t,nb)            
+                         WHERE( tabvar1 .GE. 1.e+20 ) tabvar1 = 0.
+                         WHERE( tabvar2 .GE. 1.e+20 ) tabvar2 = 0.
+                      ELSE 
+                         CALL Read_Ncdf_var(varname,filename,tabvar3,t,nb-2)
+                         CALL Read_Ncdf_var(varname,filename,tabvar2,t,nb-1)
+                         CALL Read_Ncdf_var(varname,filename,tabvar1,t,nb)
+                         WHERE( tabvar1 .GE. 1.e+20 ) tabvar1 = 0.
+                         WHERE( tabvar2 .GE. 1.e+20 ) tabvar2 = 0.
+                         WHERE( tabvar3 .GE. 1.e+20 ) tabvar3 = 0.
+                      ENDIF
+                      !                              
+                      IF (t.EQ.1 ) CALL extrap_detect(G0,G1,detected_pts(:,:,nb),nb)
+
+                      CALL correct_field(detected_pts(:,:,nb),tabvar1,tabvar2,&
+                           tabvar3,G0,depth,masksrc,nb,'posvar')                       
+                      DEALLOCATE(tabvar2,tabvar3)
+
+                   ELSE 
+                      CALL Read_Ncdf_var(varname,filename,tabvar1,t,nb)
+                      IF(MAXVAL(tabvar1(:,:,1,1))==0.) land_level = .TRUE.
+                      masksrc = .TRUE. 
+                   ENDIF
+
+                   IF( Extrapolation ) THEN
+                      WRITE(*,*) 'interpolation/extrapolation ',TRIM(varname),' for time t = ',t,'vertical level = ',nb   
+                   ELSE
+                      WRITE(*,*) 'interpolation ',TRIM(varname),' for time t = ',t,'vertical level = ',nb
+                   ENDIF
+
+                   !                          
+
+                   IF (t.EQ.1 ) THEN 
+
+                      SELECT CASE(TRIM(interp_type))
+                      CASE('bilinear')
+                         CALL get_remap_matrix(latParent,latChild,   &
+                              lonParent,lonChild,   &
+                              masksrc,matrix,src_add,dst_add)
+
+                      CASE('bicubic')
+                         CALL get_remap_bicub(latParent,latChild,   &
+                              lonParent,lonChild,   &
+                              masksrc,matrix,src_add,dst_add)
+                         !                             
+                      END SELECT
+                      !                                                        
+                   ENDIF
+                   !      
+                   SELECT CASE(TRIM(interp_type))
+                      !                             
+                   CASE('bilinear')                                                       
+                      CALL make_remap(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1),nxfin,nyfin, &
+                           matrix,src_add,dst_add)     
+                   CASE('bicubic')                                   
+                      CALL make_bicubic_remap(tabvar1(:,:,1,1),masksrc,tabinterp4d(:,:,1,1),nxfin,nyfin, &
+                           matrix,src_add,dst_add)                        
+                   END SELECT
+                   !                     
+                   IF( conservation ) CALL Correctforconservation(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1), &
+                        G0%e1t,G0%e2t,G1%e1t,G1%e2t,nxfin,nyfin,posvar,imin,jmin)  
+
+                   !
+                   IF(Extrapolation) CALL check_extrap(G1,tabinterp4d,nb)
+                   !      
+                   IF(Extrapolation) tabinterp4d(:,:,1,1) = tabinterp4d(:,:,1,1) * mask(:,:,nb)     
+                   !                     
+                   CALL Write_Ncdf_var(TRIM(varname),dimnames, &
+                        Child_file,tabinterp4d,t,nb,'float')
+                   !      
+                   DEALLOCATE(tabinterp4d)
+                   DEALLOCATE(tabvar1)                     
+                   !
+                   ! end loop on time
+                   !
+
+                END DO
+
+             ENDIF
+
+             !
+             IF(ASSOCIATED(matrix)) DEALLOCATE(matrix,dst_add,src_add)
+             DEALLOCATE( masksrc )
+             DEALLOCATE(detected_pts)       
+             !
+             ! end loop on vertical levels
+             !      
+          END DO
+          !   
+          CALL Copy_Ncdf_att(TRIM(varname),TRIM(filename),Child_file)
+          !
+          ! fin du if interpolation ...
+          !
+       ENDIF
+       ! 
+    END DO
+
+    PRINT *,'FIN DE INTERPEXTRAPVAR'
+    !    
+    IF(Extrapolation) DEALLOCATE(G1%tmask,G0%tmask)
+    DEALLOCATE(G0%e1t,G0%e2t,G1%e1t,G1%e2t)
+    IF(ASSOCIATED(depth)) DEALLOCATE(depth)   
+    !
+  END SUBROUTINE Interp_Extrap_var
+  !
+  ! 
+END MODULE agrif_interpolation
Index: /utils/tools_ticket2413/NESTING/src/agrif_modutil.f90
===================================================================
--- /utils/tools_ticket2413/NESTING/src/agrif_modutil.f90	(revision 12863)
+++ /utils/tools_ticket2413/NESTING/src/agrif_modutil.f90	(revision 12863)
@@ -0,0 +1,472 @@
+!
+MODULE agrif_modutil
+  !
+CONTAINS
+  !
+  !************************************************************************
+  ! 									*
+  ! MODULE  AGRIF_MODUTIL							*
+  !									*
+  ! module containing subroutine used for : 				*
+  !   - unrolling 2D arrays to 1D arrays (required for SCRIP package use)	*
+  !   - convert 1D arrays to 2D arrays (required for SCRIP package use)	*
+  !   - remapping process (use SCRIP remapping matrix)			*
+  !									*
+  !************************************************************************
+  ! 
+  !***********************************************************    
+  SUBROUTINE ssort (x, nb)
+    !***********************************************************
+    !
+    IMPLICIT NONE
+
+    INTEGER :: nb
+    REAL*8, DIMENSION(:) :: x
+    REAL*8 :: temp
+    INTEGER ji,jj,jmax,itemp
+    !      
+    jmax=nb-1
+    !
+    !
+    DO ji=1,nb-1
+       temp=HUGE(1)
+
+       DO jj=1,jmax
+
+          IF(X(jj).LE.X(jj+1)) THEN 
+             temp=X(jj)
+             X(jj)=X(jj+1)
+             X(jj+1)=temp
+          ENDIF
+
+       ENDDO
+
+       IF(temp.EQ.HUGE(1)) RETURN
+       jmax=jmax-1
+    ENDDO
+
+    RETURN
+  END SUBROUTINE ssort
+  !
+  !***********************************************************
+  !                    --- quicksort ---
+  ! Author: t-nissie
+  ! License: GPLv3
+  ! Gist: https://gist.github.com/t-nissie/479f0f16966925fa29ea
+  !***********************************************************
+  RECURSIVE SUBROUTINE quicksort(var, first, last)
+     IMPLICIT NONE
+
+     REAL*8, DIMENSION(:), INTENT(inout) :: var
+     INTEGER,              INTENT(in)    :: first, last
+     REAL*8  :: x, t
+     INTEGER :: ji, jj
+     
+     x = var( (first+last) / 2 )
+     ji = first
+     jj = last
+     DO
+        DO WHILE (var(ji) < x)
+           ji=ji+1
+        END DO
+        DO WHILE (x < var(jj))
+           jj=jj-1
+        END DO
+        IF (ji >= jj) EXIT
+        t = var(ji);  var(ji) = var(jj);  var(jj) = t
+        ji=ji+1
+        jj=jj-1
+     END DO
+     IF (first < ji-1) CALL quicksort(var, first, ji-1)
+     IF (jj+1 < last)  CALL quicksort(var, jj+1, last)
+  END SUBROUTINE quicksort
+  
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE 1Dto2D
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE tab1Dto2D(tab1D,tab2D,nx,ny)
+    !
+    IMPLICIT NONE   
+    !
+    REAL*8,DIMENSION(:) :: tab1D
+    REAL*8,DIMENSION(:,:) :: tab2D
+    !          
+    INTEGER :: xpos,ypos
+    INTEGER :: nx,ny   
+    INTEGER :: i      
+    !      
+    xpos=0
+    ypos=1
+    !      
+    DO i=1,nx*ny
+       xpos=xpos+1
+       IF(xpos.GT.nx) THEN
+          xpos=1
+          ypos=ypos+1
+       ENDIF
+       tab2D(ypos,xpos)=tab1D(i)
+    END DO
+    !
+  END SUBROUTINE tab1Dto2D
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE tab2Dto1D
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE tab2Dto1D(tab2D,tab1D)
+    !
+    IMPLICIT NONE 
+    !       
+    REAL*8,DIMENSION(:,:) :: tab2D
+    REAL*8,DIMENSION(:) :: tab1D
+    !          
+    INTEGER :: xpos,ypos
+    INTEGER :: nx,ny
+    INTEGER :: i
+    !
+    nx = SIZE(tab2D,2)
+    ny = SIZE(tab2D,1)
+    !      
+    xpos = 0
+    ypos = 1
+    DO i = 1,nx*ny
+       xpos = xpos + 1
+       IF(xpos.GT.nx) THEN
+          xpos = 1
+          ypos = ypos + 1
+       END IF
+       tab1D(i) = tab2D(ypos,xpos)
+    END DO
+    !
+  END SUBROUTINE tab2Dto1D
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE tab2Dto1D logical
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE logtab2Dto1D(tab2D,tab1D)
+    !
+    IMPLICIT NONE 
+    !       
+    LOGICAL,DIMENSION(:,:) :: tab2D
+    LOGICAL,DIMENSION(:) :: tab1D
+    !          
+    INTEGER :: xpos,ypos
+    INTEGER :: nx,ny
+    INTEGER :: i
+    !
+    nx = SIZE(tab2D,2)
+    ny = SIZE(tab2D,1)
+    !      
+    xpos = 0
+    ypos = 1
+    DO i = 1,nx*ny
+       xpos = xpos + 1
+       IF(xpos.GT.nx) THEN
+          xpos = 1
+          ypos = ypos + 1
+       END IF
+       tab1D(i) = tab2D(ypos,xpos)
+    END DO
+    !
+  END SUBROUTINE logtab2Dto1D
+  !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE 1Dto2D
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE logtab1Dto2D(tab1D,tab2D,nx,ny)
+    !
+    IMPLICIT NONE   
+    !
+    LOGICAL,DIMENSION(:) :: tab1D
+    LOGICAL,DIMENSION(:,:) :: tab2D
+    !          
+    INTEGER :: xpos,ypos
+    INTEGER :: nx,ny   
+    INTEGER :: i      
+    !      
+    xpos=0
+    ypos=1
+    !      
+    DO i=1,nx*ny
+       xpos=xpos+1
+       IF(xpos.GT.nx) THEN
+          xpos=1
+          ypos=ypos+1
+       ENDIF
+       tab2D(ypos,xpos)=tab1D(i)
+    END DO
+    !
+  END SUBROUTINE logtab1Dto2D
+
+  !**************************************************************
+  !   subroutine make_remap
+  !**************************************************************            
+  !
+  SUBROUTINE make_remap(tabin,tabout,nxfin,nyfin,matrix,src_add,dst_add) 
+    !      
+    IMPLICIT NONE
+    !      
+    REAL*8, DIMENSION(:,:)  :: tabin 
+    REAL*8, DIMENSION(:,:) :: tabout 
+    REAL*8, POINTER, DIMENSION(:,:) :: tabtemp    
+    INTEGER,DIMENSION(:) :: src_add,dst_add
+    INTEGER :: nxfin,nyfin      
+    REAL*8, POINTER, DIMENSION(:) :: var1D,var_interp1D
+    REAL*8,DIMENSION(:,:) :: matrix 
+    INTEGER :: num_links,i
+    ! 
+    ALLOCATE(var1D(SIZE(tabin,1)*SIZE(tabin,2)))     
+    CALL tab2Dto1D(tabin,var1D)
+    !      
+    ALLOCATE(var_interp1D(nxfin*nyfin))
+    var_interp1D = 0.0
+    num_links = SIZE(dst_add)
+    !
+    DO i = 1,num_links
+       var_interp1D(dst_add(i)) = var_interp1D(dst_add(i)) &
+            + matrix(1,i)*var1D(src_add(i))
+    END DO
+    !
+    ALLOCATE(tabtemp(SIZE(tabout,1),SIZE(tabout,2)))
+    !
+    CALL tab1Dto2D(var_interp1D,tabtemp,nyfin,nxfin)
+    !
+    tabout = tabtemp
+    !
+    DEALLOCATE(var_interp1D,var1D,tabtemp)  
+    ! 
+  END SUBROUTINE make_remap
+  !          
+  !
+  !**************************************************************
+  !   end subroutine make_remap
+  !**************************************************************          
+  !
+  !
+  !**************************************************************
+  !   subroutine make_bicubic_remap
+  !**************************************************************            
+  !
+  SUBROUTINE make_bicubic_remap(tabin,masksrc,tabout,nxfin,nyfin,matrix,src_add,dst_add) 
+    !      
+    IMPLICIT NONE
+    !      
+    REAL*8, DIMENSION(:,:)  :: tabin
+    LOGICAL, DIMENSION(:,:)  :: masksrc
+    LOGICAL, POINTER, DIMENSION(:)  :: grid1_mask
+    REAL*8, DIMENSION(:,:) :: tabout     
+    INTEGER,DIMENSION(:) :: src_add,dst_add
+    INTEGER :: nxfin,nyfin      
+    REAL*8, POINTER, DIMENSION(:) :: var1D,var_interp1D,gradi,gradj,gradij,deriv1,deriv2
+    REAL*8,DIMENSION(:,:) :: matrix 
+    INTEGER :: num_links,i,j,nx,ny,n,ip1,im1,jp1,jm1
+    INTEGER :: in,is,ie,iw,ine,inw,ise,isw
+    REAL*8 :: delew,delns
+    !
+    nx = SIZE(tabin,1)
+    ny = SIZE(tabin,2)
+    ALLOCATE(gradi(nx*ny),gradj(nx*ny),gradij(nx*ny),deriv1(nx*ny),deriv2(nx*ny))
+    ALLOCATE(var1D(nx*ny),grid1_mask(nx*ny))
+    !           
+    CALL tab2Dto1D(tabin,var1D)
+    CALL logtab2Dto1D(masksrc,grid1_mask)     
+    !
+    gradi  = 0.0
+    gradj  = 0.0
+    gradij = 0.0
+    !
+    DO n = 1,nx*ny
+
+       IF( grid1_mask(n) ) THEN                        
+          !                     
+          delew = 0.5      
+          delns = 0.5
+
+          j = (n-1)/ny + 1
+          i = n - (j-1)*ny
+          !
+          ip1 = i+1
+          im1 = i-1
+          jp1 = j+1
+          jm1 = j-1      
+          !
+          IF (ip1 > ny) ip1 = ip1 - ny
+
+          IF (im1 < 1 ) im1 = ny
+
+          IF (jp1 > nx) THEN
+             jp1 = j
+             delns = 1.
+          ENDIF
+
+          IF (jm1 < 1 ) THEN
+             jm1 = j
+             delns = 1.
+          ENDIF
+          !
+          in  = (jp1-1)*ny + i
+          is  = (jm1-1)*ny + i
+          ie  = (j  -1)*ny + ip1
+          iw  = (j  -1)*ny + im1
+          !
+          ine = (jp1-1)*ny + ip1
+          inw = (jp1-1)*ny + im1
+          ise = (jm1-1)*ny + ip1
+          isw = (jm1-1)*ny + im1
+          !
+          !*** compute i-gradient
+
+          IF (.NOT. grid1_mask(ie)) THEN
+             ie = n
+             delew = 1.
+          ENDIF
+          !            
+          IF (.NOT. grid1_mask(iw)) THEN
+             iw = n
+             delew = 1.
+          ENDIF
+          !
+          gradi(n) = delew*(var1D(ie) - var1D(iw))
+          !
+          !*** compute j-gradient
+
+          IF (.NOT. grid1_mask(in)) THEN
+             in = n
+             delns = 1.
+          ENDIF
+          !                      
+          IF (.NOT. grid1_mask(is)) THEN
+             is = n
+             delns = 1.
+          ENDIF
+          !
+          gradj(n) = delns*(var1D(in) - var1D(is))                    
+          !
+          !*** compute ij-gradient
+
+          delew = 0.5
+
+          IF (jp1 == j .OR. jm1 == j) THEN
+             delns = 1.
+          ELSE 
+             delns = 0.5
+          ENDIF
+          !
+          IF (.NOT. grid1_mask(ine)) THEN
+             IF (in /= n) THEN
+                ine = in
+                delew = 1.
+             ELSE IF (ie /= n) THEN
+                ine = ie
+                inw = iw
+                IF (inw == n) delew = 1.
+                delns = 1.
+             ELSE
+                ine = n
+                inw = iw
+                delew = 1
+                delns = 1
+             ENDIF
+          ENDIF
+          !
+          IF (.NOT. grid1_mask(inw)) THEN
+             IF (in /= n) THEN
+                inw = in
+                delew = 1.
+             ELSE IF (iw /= n) THEN
+                inw = iw
+                ine = ie
+                IF (ie == n) delew = 1.
+                delns = 1.
+             ELSE
+                inw = n
+                ine = ie
+                delew = 1.
+                delns = 1.
+             ENDIF
+          ENDIF
+          !
+          deriv1(n) = delew*(var1D(ine)-var1D(inw))                    
+          !
+          IF (.NOT. grid1_mask(ise)) THEN
+             IF (is /= n) THEN
+                ise = is
+                delew = 1.
+             ELSE IF (ie /= n) THEN
+                ise = ie
+                isw = iw
+                IF (isw == n) delew = 1.
+                delns = 1.
+             ELSE
+                ise = n
+                isw = iw
+                delew = 1.
+                delns = 1.
+             ENDIF
+          ENDIF
+          !
+          IF (.NOT. grid1_mask(isw)) THEN
+             IF (is /= n) THEN
+                isw = is
+                delew = 1.
+             ELSE IF (iw /= n) THEN
+                isw = iw
+                ise = ie
+                IF (ie == n) delew = 1.
+                delns = 1.
+             ELSE
+                isw = n
+                ise = ie
+                delew = 1.
+                delns = 1.
+             ENDIF
+          ENDIF
+
+          deriv2(n) = delew*(var1D(ise) - var1D(isw))
+          gradij(n) = delns*(deriv1(n) - deriv2(n))
+       ENDIF
+    END DO
+    !
+    DEALLOCATE(deriv1,deriv2,grid1_mask)
+
+    !       
+    ALLOCATE(var_interp1D(nxfin*nyfin))
+    var_interp1D = 0.0
+    num_links = SIZE(dst_add)
+    !      
+    DO i = 1,num_links
+       !        
+       var_interp1D(dst_add(i)) = var_interp1D(dst_add(i))        +      &
+            matrix(1,i)*var1D(src_add(i))   +      &
+            matrix(2,i)*gradi(src_add(i))   +      &
+            matrix(3,i)*gradj(src_add(i))   +      & 
+            matrix(4,i)*gradij(src_add(i))
+    END DO
+    !
+    DEALLOCATE(gradi,gradj,gradij,var1D)
+    !
+    CALL tab1Dto2D(var_interp1D,tabout,nyfin,nxfin)
+    !      
+    DEALLOCATE(var_interp1D)       
+    ! 
+  END SUBROUTINE make_bicubic_remap
+  !          
+  !
+  !**************************************************************
+  !   end subroutine make_bicubic_remap
+  !**************************************************************          
+  !
+  !
+END MODULE agrif_modutil
Index: /utils/tools_ticket2413/NESTING/src/agrif_partial_steps.f90
===================================================================
--- /utils/tools_ticket2413/NESTING/src/agrif_partial_steps.f90	(revision 12863)
+++ /utils/tools_ticket2413/NESTING/src/agrif_partial_steps.f90	(revision 12863)
@@ -0,0 +1,934 @@
+!************************************************************************
+! Fortran 95 OPA Nesting tools                                    	*
+!                                                      			*
+!     Copyright (C) 2005 Florian Lemarié (Florian.Lemarie@imag.fr)      *
+!                        Laurent Debreu (Laurent.Debreu@imag.fr)      	*
+!************************************************************************
+!
+MODULE agrif_partial_steps
+  !
+  USE agrif_types
+CONTAINS
+
+
+
+
+
+  !
+  !************************************************************************
+  !                                                       		*
+  ! MODULE  AGRIF_PARTIAL_STEPS                                    	*
+  !									*
+  !************************************************************************
+
+
+  !************************************************************************
+  !									*
+  ! Subroutine get_partial_steps						*
+  !									*
+  ! subroutine to compute gdepw_ps on the input grid (based on NEMO code) *
+  !                                                      			*
+  !************************************************************************
+  !       
+  SUBROUTINE get_partial_steps(Grid)
+    !
+    IMPLICIT NONE
+    !       
+    TYPE(Coordinates) :: Grid                     
+    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp
+    INTEGER :: i,j,jk,jj,ji,jpj,jpi,ik,ii,ipt,jpt
+    INTEGER, DIMENSION(1) :: k
+    INTEGER :: k1
+    REAL*8, POINTER, DIMENSION(:) :: gdepw,gdept,e3w,e3t
+    REAL*8, POINTER, DIMENSION(:,:)   :: hdepw,e3tp,e3wp
+    REAL*8, POINTER, DIMENSION(:,:,:) :: gdept_ps,gdepw_ps
+    REAL*8 e3t_ps
+
+    !
+    WRITE(*,*) 'convert bathymetry from etopo for partial step z-coordinate case'
+    WRITE(*,*) 'minimum thickness of partial step   e3zps_min = ', e3zps_min, ' (m)'
+    WRITE(*,*) '       step  level                  e3zps_rat = ', e3zps_rat       
+    !       
+    jpi = SIZE(Grid%bathy_meter,1)
+    jpj = SIZE(Grid%bathy_meter,2)       
+    !       
+    ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N))
+    ALLOCATE(gdepw_ps(jpi,jpj,N))                  
+    IF (.NOT.ASSOCIATED(Grid%bathy_level)) ALLOCATE(Grid%bathy_level(jpi,jpj))
+    !       
+    IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) &
+         .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN 
+       !    
+       WRITE(*,*) 'psur,pa0,pa1 computed'
+       za1=( ppdzmin - pphmax / (N-1) )          &
+            / ( TANH((1-ppkth)/ppacr) - ppacr/(N-1) &
+            *  (  LOG( COSH( (N - ppkth) / ppacr) )      &
+            - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
+
+       za0  = ppdzmin - za1 * TANH( (1-ppkth) / ppacr )
+       zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
+       !
+    ELSE IF ( (ppdzmin == 0 .OR. pphmax == 0) .AND. psur.NE.0 .AND. &
+         pa0.NE.0 .AND. pa1.NE.0 ) THEN
+       !       
+       WRITE(*,*) 'psur,pa0,pa1 given by namelist'
+       zsur = psur
+       za0  = pa0
+       za1  = pa1
+       za2  = pa2
+       !
+    ELSE
+       !       
+       WRITE(*,*) 'ERROR ***** bad vertical grid parameters ...' 
+       WRITE(*,*) ' '
+       WRITE(*,*) 'please check values of variables'
+       WRITE(*,*) 'in namelist vertical_grid section'
+       WRITE(*,*) ' '  
+       STOP    
+       !       
+    ENDIF
+
+    zacr  = ppacr
+    zkth  = ppkth     
+    zacr2 = ppacr2
+    zkth2 = ppkth2  
+    !
+    IF( ppkth == 0. ) THEN            !  uniform vertical grid 
+         za1 = pphmax / FLOAT(N-1) 
+         DO i = 1, N
+            gdepw(i) = ( i - 1   ) * za1
+            gdept(i) = ( i - 0.5 ) * za1
+            e3w  (i) =  za1
+            e3t  (i) =  za1
+         END DO
+    ELSE                            ! Madec & Imbard 1996 function
+       IF( .NOT. ldbletanh ) THEN
+          DO i = 1,N
+             ! 
+             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+             gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
+             e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
+             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+             !
+          END DO
+       ELSE
+            DO i = 1,N
+               ! Double tanh function
+               gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               &
+                  &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  )
+               gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr  ) )    &
+                  &                            + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) )  )
+               e3w  (i) =          za0         + za1        * TANH(       (i-zkth ) / zacr  )            &
+                  &                            + za2        * TANH(       (i-zkth2) / zacr2 )
+               e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      &
+                  &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 )
+            END DO
+       ENDIF
+    ENDIF
+    gdepw(1) = 0.0  
+    IF ( ln_e3_dep ) THEN      ! e3. = dk[gdep]   
+       !                     
+       DO i = 1, N-1
+          e3t(i) = gdepw(i+1)-gdepw(i)
+       END DO
+       e3t(N) = e3t(N-1)
+    
+       DO i = 2, N
+          e3w(i) = gdept(i) - gdept(i-1)
+       END DO
+       e3w(1  ) = 2. * (gdept(1) - gdepw(1))
+    END IF
+    !
+    ! Initialization of constant
+    !
+    zmax = gdepw(N) + e3t(N)
+    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level
+    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth
+    ENDIF
+    zmin = gdepw(i+1)
+    !
+    ! Initialize bathy_level to the maximum ocean level available
+    !
+    Grid%bathy_level = N-1
+    !
+    ! storage of land and island's number (zera and negative values) in mbathy
+    !
+    DO jj = 1, jpj
+       DO ji= 1, jpi
+          IF( Grid%bathy_meter(ji,jj) <= 0. )   &
+               Grid%bathy_level(ji,jj) = INT( Grid%bathy_meter(ji,jj) )
+       END DO
+    END DO
+    !
+    ! the last ocean level thickness cannot exceed e3t(jpkm1)+e3t(jpk)
+    !
+    DO jj = 1, jpj
+       DO ji= 1, jpi
+          IF( Grid%bathy_meter(ji,jj) <= 0. ) THEN
+             Grid%bathy_meter(ji,jj) = 0.e0
+          ELSE
+             Grid%bathy_meter(ji,jj) = MAX( Grid%bathy_meter(ji,jj), zmin )
+             Grid%bathy_meter(ji,jj) = MIN( Grid%bathy_meter(ji,jj), zmax )
+          ENDIF
+       END DO
+    END DO
+    !
+!!$    IF( partial_steps ) THEN
+    ! Compute bathy_level for ocean points (i.e. the number of ocean levels)
+    ! find the number of ocean levels such that the last level thickness
+    ! is larger than the minimum of e3zps_min and e3zps_rat * e3t (where
+    ! e3t is the reference level thickness   
+    DO jk = N-1, 1, -1
+       zdepth = gdepw(jk) + MIN( e3zps_min, e3t(jk)*e3zps_rat )
+       DO jj = 1, jpj
+          DO ji = 1, jpi
+             IF( 0. < Grid%bathy_meter(ji,jj) .AND. Grid%bathy_meter(ji,jj) <= zdepth ) &
+                Grid%bathy_level(ji,jj) = jk-1
+          END DO
+       END DO
+    END DO
+!!$    ELSE
+!!$       DO jj = 1,jpj
+!!$          DO ji = 1,jpi
+!!$             !
+!!$             IF (Grid%bathy_meter(ji,jj) .EQ. 0.0 ) THEN
+!!$                Grid%bathy_level(ji,jj)=0
+!!$             ELSE
+!!$                !	
+!!$                k1=2  ! clem: minimum levels = 2 ???
+!!$                DO WHILE (k1 .LT. (N-1))
+!!$                   IF ((Grid%bathy_meter(ji,jj).GE.gdepw(k1)) &
+!!$                      .AND.(Grid%bathy_meter(ji,jj).LE.gdepw(k1+1))) EXIT
+!!$                   k1=k1+1
+!!$                END DO
+!!$                Grid%bathy_level(ji,jj)=k1
+!!$                !
+!!$             ENDIF
+!!$             !
+!!$          END DO
+!!$       END DO
+!!$
+!!$    ENDIF
+
+    CALL bathymetry_control(grid%bathy_level)
+    !
+    ! initialization to the reference z-coordinate
+    ! 
+    WRITE(*,*) ' initialization to the reference z-coordinate '
+    !     
+    DO jk = 1, N
+       !        Write(*,*) 'k = ',jk
+       gdepw_ps(1:jpi,1:jpj,jk) = gdepw(jk)
+    END DO
+    !      
+    Grid%gdepw_ps(:,:) = gdepw_ps(:,:,3)           
+    !
+    DO jj = 1, jpj
+       DO ji = 1, jpi
+          ik = Grid%bathy_level(ji,jj)
+          ! ocean point only
+          IF( ik > 0 ) THEN
+             ! max ocean level case
+             IF( ik == N-1 ) THEN
+                zdepwp = Grid%bathy_meter(ji,jj)
+                ze3tp  = Grid%bathy_meter(ji,jj) - gdepw(ik)
+                ze3wp = 0.5 * e3w(ik) * ( 1. + ( ze3tp/e3t(ik) ) )
+                gdepw_ps(ji,jj,ik+1) = zdepwp
+                ! standard case
+             ELSE
+                !
+                IF( Grid%bathy_meter(ji,jj) <= gdepw(ik+1) ) THEN
+                   gdepw_ps(ji,jj,ik+1) = Grid%bathy_meter(ji,jj)
+                ELSE
+                   !
+                   gdepw_ps(ji,jj,ik+1) = gdepw(ik+1)
+                ENDIF
+                !
+             ENDIF
+             !           
+          ENDIF
+       END DO
+    END DO
+    !
+    DO jj = 1, jpj
+       DO ji = 1, jpi
+          ik = Grid%bathy_level(ji,jj)
+          ! ocean point only
+          IF( ik > 0 ) THEN
+             ! bathymetry output
+             !
+             Grid%gdepw_ps(ji,jj) = gdepw_ps(ji,jj,ik+1)
+             !
+             !AJOUT-----------------------------------------------------------------------
+             !
+          ELSE
+             !           
+             Grid%gdepw_ps(ji,jj) = 0
+             !
+             !AJOUT------------------------------------------------------------------------
+             !           
+          ENDIF
+          !                     
+       END DO
+    END DO
+    !     
+    !
+    DEALLOCATE(gdepw,gdept,e3w,e3t)
+    DEALLOCATE(gdepw_ps)                  
+  END SUBROUTINE get_partial_steps
+  !
+  !
+  !*************************************************************************
+  !									*
+  ! Subroutine check interp						*
+  !									*
+  ! subroutine to compute gdepw_ps on the input grid (based on NEMO code) *
+  !                                                      			*
+  !************************************************************************
+  !
+  !
+  SUBROUTINE check_interp( ParentGrid , gdepwChild )
+    !
+    IMPLICIT NONE
+    !                   
+    TYPE(Coordinates) :: ParentGrid
+    REAL*8,DIMENSION(:,:) :: gdepwChild 
+    INTEGER :: i,j,ji,ij,ii,jj,jpt,ipt
+    REAL,DIMENSION(N) :: gdepw,e3t
+    REAL :: za0,za1,za2,zsur,zacr,zacr2,zkth,zkth2,zmin,zmax,zdepth
+    INTEGER :: kbathy,jk
+    !
+    IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) &
+         .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN 
+       !    
+       WRITE(*,*) 'psur,pa0,pa1 computed'
+       za1=( ppdzmin - pphmax / (N-1) )          &
+            / ( TANH((1-ppkth)/ppacr) - ppacr/(N-1) &
+            *  (  LOG( COSH( (N - ppkth) / ppacr) )      &
+            - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
+
+       za0  = ppdzmin - za1 * TANH( (1-ppkth) / ppacr )
+       zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
+       !
+    ELSE IF ( (ppdzmin == 0 .OR. pphmax == 0) .AND. psur.NE.0 .AND. &
+         pa0.NE.0 .AND. pa1.NE.0 ) THEN
+       !       
+       WRITE(*,*) 'psur,pa0,pa1 given by namelist'
+       zsur = psur
+       za0  = pa0
+       za1  = pa1
+       za2  = pa2
+       !
+    ELSE
+       !       
+       WRITE(*,*) 'ERROR ***** bad vertical grid parameters ...' 
+       WRITE(*,*) ' '
+       WRITE(*,*) 'please check values of variables'
+       WRITE(*,*) 'in namelist vertical_grid section'
+       WRITE(*,*) ' '  
+       STOP    
+       !       
+    ENDIF
+
+    zacr  = ppacr
+    zkth  = ppkth     
+    zacr2 = ppacr2
+    zkth2 = ppkth2  
+    !
+    IF( ppkth == 0. ) THEN            !  uniform vertical grid 
+         za1 = pphmax / FLOAT(N-1) 
+         DO i = 1, N
+            gdepw(i) = ( i - 1   ) * za1
+            e3t  (i) =  za1
+         END DO
+    ELSE                            ! Madec & Imbard 1996 function
+       IF( .NOT. ldbletanh ) THEN
+          DO i = 1,N
+             ! 
+             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+             !
+          END DO
+       ELSE
+            DO i = 1,N
+               ! Double tanh function
+               gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               &
+                  &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  )
+               e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      &
+                  &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 )
+            END DO
+       ENDIF
+    ENDIF
+    gdepw(1) = 0.0
+    IF ( ln_e3_dep ) THEN      ! e3. = dk[gdep]   
+       !                     
+       DO i = 1, N-1
+          e3t(i) = gdepw(i+1)-gdepw(i)
+       END DO
+       e3t(N) = e3t(N-1)
+    END IF
+    !              
+    !
+    ! west boundary
+    IF( ln_agrif_domain ) THEN
+       CALL correct_level( gdepwchild,ParentGrid,gdepw,e3t,1,2+nbghostcellsfine+(npt_copy+npt_connect)*irafx-1,1,nyfin)
+    ELSE
+       CALL correct_level( gdepwchild,ParentGrid,gdepw,e3t,1,(npt_copy+npt_connect)*irafx,1,nyfin)
+    ENDIF
+    !
+    ! east boundary
+    IF( ln_agrif_domain ) THEN
+       CALL correct_level( gdepwchild,ParentGrid,gdepw,e3t,nxfin-1-nbghostcellsfine-((npt_copy+npt_connect)*irafx-1),nxfin,1,nyfin)
+    ELSE
+       CALL correct_level( gdepwchild,ParentGrid,gdepw,e3t,nxfin-((npt_copy+npt_connect)*irafx+1),nxfin,1,nyfin)
+    ENDIF
+    !
+    ! north boundary
+    IF( ln_agrif_domain ) THEN
+       CALL correct_level( gdepwchild,ParentGrid,gdepw,e3t,1,nxfin,nyfin-1-nbghostcellsfine-((npt_copy+npt_connect)*irafy-1),nyfin)
+    ELSE
+       CALL correct_level( gdepwchild,ParentGrid,gdepw,e3t,1,nxfin,nyfin-((npt_copy+npt_connect)*irafy+1),nyfin)
+    ENDIF
+    !
+    ! south boundary
+    IF( ln_agrif_domain ) THEN
+       CALL correct_level( gdepwchild,ParentGrid,gdepw,e3t,1,nxfin,1,2+nbghostcellsfine+(npt_copy+npt_connect)*irafy-1)
+    ELSE
+       CALL correct_level( gdepwchild,ParentGrid,gdepw,e3t,1,nxfin,1,(npt_copy+npt_connect)*irafy)
+    ENDIF
+    !       
+    !
+    !
+  END SUBROUTINE check_interp
+  !
+  SUBROUTINE correct_level( gdepwchild,ParentGrid,gdepw,e3t,minboundx,maxboundx,minboundy,maxboundy )
+    !
+    IMPLICIT NONE
+    TYPE(Coordinates) :: ParentGrid
+    REAL*8,DIMENSION(:,:) :: gdepwChild
+    REAL*8,DIMENSION(N) :: gdepw,e3t
+    INTEGER :: minboundx,maxboundx,minboundy,maxboundy
+    INTEGER :: kbathy,jk,indx,indy,diff
+    REAL :: xdiff
+    INTEGER :: i,j,ji,ij,ii,jj,jpt,ipt,i1,i2,j1,j2,ii1,ii2,jj1,jj2
+    REAL*8 :: slopex, slopey,val,tmp1,tmp2,tmp3,tmp4
+    INTEGER :: parentbathy
+    REAL :: mindepth, maxdepth
+    REAL :: xmin,ymin,dxfin,dyfin,dsparent
+    INTEGER ipbegin,ipend,jpbegin,jpend
+    INTEGER ibegin,iend,jbegin,jend
+    REAL x,y,zmin,zmax
+    INTEGER ptx,pty
+    REAL,DIMENSION(:,:),ALLOCATABLE :: gdepwtemp
+    INTEGER,DIMENSION(:,:),ALLOCATABLE :: parentbathytab
+    !
+    !
+    ! Initialization of constant
+    !
+    zmax = gdepw(N) + e3t(N)
+    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level
+    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth
+    ENDIF
+    zmin = gdepw(i+1)
+    !
+    ! check that interpolated value stays at the same level         
+    ! 
+    !
+    diff = 0      
+    IF ( MOD(irafx,2) .EQ. 0 ) diff = 1
+
+    xdiff = REAL(diff)/2.
+
+    dxfin = 1./irafx
+    dyfin = 1./irafy
+
+    ptx = 1 + nbghostcellsfine + 1
+    pty = 1 + nbghostcellsfine + 1
+
+    xmin = (imin-1) * 1
+    ymin = (jmin-1) * 1
+
+
+    ! compute x and y the locations of the indices minbounx and minboundy 
+
+    x = xmin + (minboundx-ptx)*dxfin  + dxfin/2.
+    y = ymin + (minboundy-pty)*dyfin  + dyfin/2.
+
+    ! compute the indices of the nearest coarse grid points      
+    ipbegin = ptx + agrif_int((x-0.-1./2.) / 1.) - 1
+    jpbegin = pty + agrif_int((y-0.-1./2.) / 1.) - 1
+
+    ! compute indices of the fine grid points nearest to the preceeding coarse grid points       
+    ! (inferior values)
+
+    x = (ipbegin - ptx) + 1./2.
+    y = (jpbegin - pty) + 1./2.
+
+    ibegin = ptx + agrif_int((x-xmin-dxfin/2.)/dxfin) 
+    jbegin = pty + agrif_int((y-ymin-dyfin/2.)/dyfin) 
+
+    ! compute x and y the locations of the indices maxbounx and maxboundy        
+    x = xmin + (maxboundx-ptx)*dxfin + dxfin/2.
+    y = ymin + (maxboundy-pty)*dyfin + dyfin/2.
+
+    ! compute the indices of the nearest coarse grid points         
+    ipend = ptx + CEILING((x-0.-1./2) / 1.) + 1
+    jpend = pty + CEILING((y-0.-1./2) / 1.) + 1
+
+    ! compute indices of the fine grid points nearest to the preceeding coarse grid points       
+    ! (inferior values)
+
+    x = (ipend - ptx) + 1./2.
+    y = (jpend - pty) + 1./2.
+    iend = ptx + agrif_int((x-xmin-dxfin/2.)/dxfin) 
+    jend = pty + agrif_int((y-ymin-dyfin/2.)/dyfin)               
+
+    IF( ln_agrif_domain ) THEN
+       ALLOCATE(gdepwtemp(ibegin-irafx:iend+irafx,jbegin-irafy:jend+irafy))
+       ALLOCATE(parentbathytab(ibegin-irafx:iend+irafx,jbegin-irafy:jend+irafy))
+
+       i1 = ibegin
+       i2 = iend
+       j1 = jbegin
+       j2 = jend
+       
+       ii1 = -FLOOR(irafx/2.0)+diff
+       ii2 =  FLOOR(irafx/2.0)
+       jj1 = -FLOOR(irafy/2.0)+diff
+       jj2 =  FLOOR(irafy/2.0)
+    ELSE
+       ibegin = minboundx
+       jbegin = minboundy
+       iend   = maxboundx ! (npt_copy+npt_connect)*irafx
+       jend   = maxboundy ! (npt_copy+npt_connect)*irafy
+       !
+       ipbegin = imin + (ibegin-1)/irafx
+       jpbegin = jmin + (jbegin-1)/irafy
+       ipend   = ipbegin + (npt_copy+npt_connect) - 1
+       jpend   = jpbegin + (npt_copy+npt_connect) - 1
+       !
+       i1 = ibegin
+       i2 = iend
+       j1 = jbegin
+       j2 = jend
+       
+       ii1 = 0
+       ii2 = irafx - 1
+       jj1 = 0
+       jj2 = irafy - 1
+       !
+       ALLOCATE(gdepwtemp(ibegin:iend,jbegin:jend))
+       ALLOCATE(parentbathytab(ibegin:iend,jbegin:jend))
+
+    ENDIF
+    
+
+    jpt=jpbegin
+    DO j=jbegin,jend,irafy
+
+       ipt=ipbegin
+
+
+       DO i=i1,i2,irafx
+
+
+          !            
+          parentbathy = ParentGrid%bathy_level(ipt,jpt)
+          IF (parentbathy == 0) THEN
+             mindepth = 0.
+             maxdepth = 0.
+          ELSE
+             mindepth = MAX(gdepw(parentbathy) + MIN( e3zps_min, e3t(parentbathy)*e3zps_rat ),zmin)
+             !                  maxdepth = min(gdepw(parentbathy + 1),zmax)
+             IF (parentbathy < (N-1)) THEN
+                maxdepth = gdepw(parentbathy + 1)
+             ELSE
+                maxdepth = HUGE(1.)
+             ENDIF
+          ENDIF
+
+          slopex = vanleer(parentgrid%gdepw_ps(ipt-1:ipt+1,jpt))/REAL(irafx)
+
+
+          tmp1 = (maxdepth - parentgrid%gdepw_ps(ipt,jpt)) / REAL(irafx)
+          tmp2 = (parentgrid%gdepw_ps(ipt,jpt) - mindepth) / REAL(irafx)
+
+          IF (ABS(slopex) > tmp1) THEN
+             IF (slopex > 0) THEN
+                slopex = tmp1
+             ELSE
+                slopex = -tmp1
+             ENDIF
+          ENDIF
+
+          IF (ABS(slopex) > tmp2) THEN
+             IF (slopex > 0) THEN
+                slopex = tmp2
+             ELSE
+                slopex = -tmp2
+             ENDIF
+          ENDIF
+          !                  
+          ! interpolation on fine grid points (connection zone)
+          !
+          DO ii = i+ii1,i+ii2
+!!             x = ii-i - xdiff/2.
+!!             val = parentgrid%gdepw_ps(ipt,jpt)+slopex * x
+!! chanut: uncomment this to get nearest neighbor interpolation
+             val = parentgrid%gdepw_ps(ipt,jpt)          
+             gdepwtemp(ii,j) = val
+             IF (gdepwtemp(ii,j) < mindepth) THEN
+                gdepwtemp(ii,j) = mindepth
+             ENDIF
+             IF (gdepwtemp(ii,j) > maxdepth) THEN
+                gdepwtemp(ii,j) = maxdepth
+             ENDIF
+             parentbathytab(ii,j) = parentbathy
+          ENDDO
+          ipt =ipt + 1
+       ENDDO
+
+       jpt = jpt + 1                
+    ENDDO
+
+    DO j=jbegin+irafy,jend-irafy,irafy
+
+       DO i=ibegin,iend
+
+          parentbathy = parentbathytab(i,j)
+          IF (parentbathy == 0) THEN
+             mindepth = 0.
+             maxdepth = 0.
+          ELSE
+             mindepth = MAX(gdepw(parentbathy) + MIN( e3zps_min, e3t(parentbathy)*e3zps_rat ),zmin)
+             !                  maxdepth = min(gdepw(parentbathy + 1),zmax)
+             IF (parentbathy < (N-1)) THEN
+                maxdepth = gdepw(parentbathy + 1)
+             ELSE
+                maxdepth = HUGE(1.)
+             ENDIF
+          ENDIF
+
+          slopey = vanleer(gdepwtemp(i,j-irafy:j+irafy:irafy))/REAL(irafy)
+          
+          tmp1 = (maxdepth - gdepwtemp(i,j)) / REAL(irafy)
+          tmp2 = (gdepwtemp(i,j) - mindepth) / REAL(irafy)
+
+          IF (ABS(slopey) > tmp1) THEN
+             IF (slopey > 0) THEN
+                slopey = tmp1
+             ELSE
+                slopey = -tmp1
+             ENDIF
+          ENDIF
+          IF (ABS(slopey) > tmp2) THEN
+             IF (slopey > 0) THEN
+                slopey = tmp2
+             ELSE
+                slopey = -tmp2
+             ENDIF
+          ENDIF
+
+
+          DO jj = j+jj1,j+jj2
+!!             y = jj-j - xdiff/2.
+!!             val = gdepwtemp(i,j) + slopey*y
+!! chanut: uncomment this to get nearest neighbor interpolation
+             val = gdepwtemp(i,j)
+             gdepwtemp(i,jj) = val     
+          ENDDO
+       ENDDO
+    ENDDO
+
+
+    gdepwchild(minboundx:maxboundx,minboundy:maxboundy) = gdepwtemp(minboundx:maxboundx,minboundy:maxboundy)
+    DEALLOCATE(gdepwtemp,parentbathytab)
+
+  END SUBROUTINE correct_level
+  !
+  !
+  !***************************************************
+  ! function van leer to compute the corresponding 
+  ! Van Leer slopes
+  !***************************************************
+  !      
+  REAL FUNCTION vanleer(tab)
+    REAL, DIMENSION(3) :: tab
+    REAL res,res1
+    REAL p1,p2,p3
+
+    p1=(tab(3)-tab(1))/2.
+    p2=(tab(2)-tab(1))
+    p3=(tab(3)-tab(2))
+
+    IF ((p1>0.).AND.(p2>0.).AND.(p3>0)) THEN
+       res1=MINVAL((/p1,p2,p3/))
+    ELSEIF ((p1<0.).AND.(p2<0.).AND.(p3<0)) THEN
+       res1=MAXVAL((/p1,p2,p3/))
+    ELSE
+       res1=0.
+    ENDIF
+
+    vanleer = res1   
+
+
+  END FUNCTION vanleer
+  !
+  !
+  !********************************************************************************
+  !   subroutine bathymetry_control                        			*
+  !                                                				*
+  !  - Purpose :   check the bathymetry in levels                  		*
+  !										*
+  !  - Method  :   The array mbathy is checked to verified its consistency	*
+  !      with the model options. in particular:					*
+  !            mbathy must have at least 1 land grid-points (mbathy<=0)		*
+  !                  along closed boundary.					*
+  !            mbathy must be cyclic IF jperio=1.					*
+  !            mbathy must be lower or equal to jpk-1.				*
+  !            isolated ocean grid points are suppressed from mbathy		*
+  !                  since they are only connected to remaining			*
+  !                  ocean through vertical diffusion.				*
+  !										*
+  !										*
+  !********************************************************************************
+
+  SUBROUTINE bathymetry_control(mbathy)
+
+    INTEGER ::   ji, jj, jl           
+    INTEGER ::   icompt, ibtest, ikmax          
+    REAL*8, DIMENSION(:,:) :: mbathy     
+
+    ! ================
+    ! Bathymetry check
+    ! ================
+
+    ! Suppress isolated ocean grid points
+
+    WRITE(*,*)'                   suppress isolated ocean grid points'
+    WRITE(*,*)'                   -----------------------------------'
+
+    icompt = 0
+
+    DO jl = 1, 2
+       !
+       DO jj = 2, SIZE(mbathy,2)-1
+          DO ji = 2, SIZE(mbathy,1)-1
+
+             ibtest = MAX( mbathy(ji-1,jj), mbathy(ji+1,jj),mbathy(ji,jj-1),mbathy(ji,jj+1) )
+             !               
+             IF( ibtest < mbathy(ji,jj) ) THEN
+                !                  
+                WRITE(*,*) 'grid-point(i,j)= ',ji,jj,'is changed from',mbathy(ji,jj),' to ', ibtest
+                mbathy(ji,jj) = ibtest
+                icompt = icompt + 1
+                !
+             ENDIF
+             !           
+          END DO
+       END DO
+       !
+    END DO
+    !      
+    IF( icompt == 0 ) THEN
+       WRITE(*,*)'     no isolated ocean grid points'
+    ELSE
+       WRITE(*,*)'    ',icompt,' ocean grid points suppressed'
+    ENDIF
+    !
+
+    ! Number of ocean level inferior or equal to jpkm1
+
+    ikmax = 0
+    DO jj = 1, SIZE(mbathy,2)
+       DO ji = 1, SIZE(mbathy,1)
+          ikmax = MAX( ikmax, NINT(mbathy(ji,jj)) )
+       END DO
+    END DO
+    !
+    IF( ikmax > N-1 ) THEN
+       WRITE(*,*) ' maximum number of ocean level = ', ikmax,' >  jpk-1'
+       WRITE(*,*) ' change jpk to ',ikmax+1,' to use the exact ead bathymetry'
+    ELSE IF( ikmax < N-1 ) THEN
+       WRITE(*,*) ' maximum number of ocean level = ', ikmax,' < jpk-1' 
+       WRITE(*,*) ' you can decrease jpk to ', ikmax+1
+    ENDIF
+
+  END SUBROUTINE bathymetry_control
+  !
+  !
+  !**********************************************************************************
+  !
+  !subroutine get_scale_factors
+  !
+  !**********************************************************************************
+  !
+  SUBROUTINE get_scale_factors(Grid,fse3t,fse3u,fse3v)
+    !
+    IMPLICIT NONE
+    !       
+    TYPE(Coordinates) :: Grid 
+    REAL*8, DIMENSION(:,:,:) :: fse3u,fse3t,fse3v
+    !                                  
+    REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp
+    INTEGER :: i,j,jk,jj,ji,jpj,jpi,ik,ii,ipt,jpt,jpk
+    INTEGER, DIMENSION(1) :: k
+    INTEGER :: k1
+    REAL*8, POINTER, DIMENSION(:) :: gdepw,gdept,e3w,e3t
+    REAL*8, POINTER, DIMENSION(:,:)   :: hdepw,e3tp,e3wp
+    REAL*8, POINTER, DIMENSION(:,:,:) :: gdept_ps,gdepw_ps   
+    !       
+    jpi = SIZE(fse3t,1)
+    jpj = SIZE(fse3t,2) 
+    jpk = SIZE(fse3t,3)      
+    !       
+    ALLOCATE(gdepw(jpk),e3t(jpk))
+    ALLOCATE(gdepw_ps(jpi,jpj,jpk))                  
+    !  
+    IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) &
+         .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN 
+       !    
+       WRITE(*,*) 'psur,pa0,pa1 computed'
+       za1=( ppdzmin - pphmax / (jpk-1) )          &
+            / ( TANH((1-ppkth)/ppacr) - ppacr/(jpk-1) &
+            *  (  LOG( COSH( (jpk - ppkth) / ppacr) )      &
+            - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
+
+       za0  = ppdzmin - za1 * TANH( (1-ppkth) / ppacr )
+       zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
+       !
+    ELSE IF ( (ppdzmin == 0 .OR. pphmax == 0) .AND. psur.NE.0 .AND. &
+         pa0.NE.0 .AND. pa1.NE.0 ) THEN
+       !       
+       WRITE(*,*) 'psur,pa0,pa1 given by namelist'
+       zsur = psur
+       za0  = pa0
+       za1  = pa1
+       za2  = pa2
+       !
+    ELSE
+       !       
+       WRITE(*,*) 'ERROR ***** bad vertical grid parameters ...' 
+       WRITE(*,*) ' '
+       WRITE(*,*) 'please check values of variables'
+       WRITE(*,*) 'in namelist vertical_grid section'
+       WRITE(*,*) ' '  
+       STOP    
+       !       
+    ENDIF
+
+    zacr  = ppacr
+    zkth  = ppkth     
+    zacr2 = ppacr2
+    zkth2 = ppkth2  
+    !
+    IF( ppkth == 0. ) THEN            !  uniform vertical grid 
+         za1 = pphmax / FLOAT(jpk-1) 
+         DO i = 1, jpk
+            gdepw(i) = ( i - 1   ) * za1
+            e3t  (i) =  za1
+         END DO
+    ELSE                            ! Madec & Imbard 1996 function
+       IF( .NOT. ldbletanh ) THEN
+          DO i = 1,jpk
+             ! 
+             gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+             e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+             !
+          END DO
+       ELSE
+            DO i = 1,jpk
+               ! Double tanh function
+               gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               &
+                  &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  )
+               e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      &
+                  &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 )
+            END DO
+       ENDIF
+    ENDIF         
+    !         
+    gdepw(1)=0.
+    IF ( ln_e3_dep ) THEN      ! e3. = dk[gdep]   
+       !                     
+       DO i = 1, jpk-1
+          e3t(i) = gdepw(i+1)-gdepw(i)
+       END DO
+       e3t(jpk) = e3t(jpk-1)
+    END IF
+    !                
+    DO i = 1,jpk
+       !       
+       fse3t(:,:,i) = e3t(i)
+       gdepw_ps(:,:,i) = gdepw(i)
+       !
+    END DO
+    !                                 
+    gdepw(1) = 0.0 
+    gdepw_ps(:,:,1) = 0.0 
+    !
+    zmax = gdepw(jpk) + e3t(jpk)
+    IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level
+    ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth
+    ENDIF
+    zmin = gdepw(i+1)
+    !
+    DO jj = 1, jpj
+       DO ji= 1, jpi
+          IF( Grid%bathy_meter(ji,jj) <= 0. ) THEN
+             Grid%bathy_meter(ji,jj) = 0.e0
+          ELSE
+             Grid%bathy_meter(ji,jj) = MAX( Grid%bathy_meter(ji,jj), zmin )
+             Grid%bathy_meter(ji,jj) = MIN( Grid%bathy_meter(ji,jj), zmax )
+          ENDIF
+       END DO
+    END DO
+    !
+    DO jj = 1, jpj
+       DO ji = 1, jpi
+          ik = Grid%bathy_level(ji,jj) 
+          IF( ik > 0 ) THEN
+             ! max ocean level case
+             IF( ik == jpk-1 ) THEN
+                zdepwp = Grid%bathy_meter(ji,jj)
+                ze3tp  = Grid%bathy_meter(ji,jj) - gdepw(ik)
+                fse3t(ji,jj,ik  ) = ze3tp
+                fse3t(ji,jj,ik+1) = ze3tp
+                gdepw_ps(ji,jj,ik+1) = zdepwp
+             ELSE
+                IF( Grid%bathy_meter(ji,jj) <= gdepw(ik+1) ) THEN
+                   gdepw_ps(ji,jj,ik+1) = Grid%bathy_meter(ji,jj)
+                ELSE
+                   gdepw_ps(ji,jj,ik+1) = gdepw(ik+1)
+                ENDIF
+                fse3t(ji,jj,ik) = e3t(ik) * ( gdepw_ps(ji,jj,ik+1) - gdepw(ik))   & 
+                     /( gdepw(ik+1) - gdepw(ik)) 
+                fse3t(ji,jj,ik+1) = fse3t(ji,jj,ik)
+
+             ENDIF
+          ENDIF
+       END DO
+    END DO
+    !
+    DO i = 1, jpk
+       fse3u (:,:,i)  = e3t(i)
+       fse3v (:,:,i)  = e3t(i)
+    END DO
+    !
+    DO jk = 1,jpk
+       DO jj = 1, jpj-1
+          DO ji = 1, jpi-1
+             fse3u (ji,jj,jk) = MIN( fse3t(ji,jj,jk), fse3t(ji+1,jj,jk))
+             fse3v (ji,jj,jk) = MIN( fse3t(ji,jj,jk), fse3t(ji,jj+1,jk))      
+          ENDDO
+       ENDDO
+    ENDDO
+    !           
+    DEALLOCATE(gdepw,e3t)
+    DEALLOCATE(gdepw_ps)
+    DEALLOCATE(Grid%bathy_meter,Grid%bathy_level) 
+    !
+  END SUBROUTINE get_scale_factors
+  !       
+END MODULE agrif_partial_steps
+
+
Index: /utils/tools_ticket2413/NESTING/src/agrif_readwrite.f90
===================================================================
--- /utils/tools_ticket2413/NESTING/src/agrif_readwrite.f90	(revision 12863)
+++ /utils/tools_ticket2413/NESTING/src/agrif_readwrite.f90	(revision 12863)
@@ -0,0 +1,1396 @@
+!************************************************************************
+! Fortran 95 OPA Nesting tools						*
+!									*
+!     Copyright (C) 2005 Florian Lemarié (Florian.Lemarie@imag.fr)	*
+!									*
+!************************************************************************
+!
+MODULE agrif_readwrite
+  !
+  USE agrif_types
+  !
+  IMPLICIT NONE
+  !
+CONTAINS
+  !
+  !************************************************************************
+  ! 									*
+  ! MODULE  AGRIF_READWRITE						*
+  !									*
+  ! module containing subroutine used for : 				*
+  !   - Coordinates files reading/writing				*
+  !   - Bathymetry files reading/writing (meter and levels)		*
+  !   - Naming of child grid files					*
+  !									*
+  !************************************************************************
+  !       
+  !*****************************************************
+  !   function Read_Coordinates(name,Grid)
+  !*****************************************************
+
+  INTEGER FUNCTION Read_Coordinates(name,Grid,Pacifique)
+    !
+    USE io_netcdf
+    !    
+    !  file name to open
+    ! 
+    CHARACTER(*) name
+    LOGICAL,OPTIONAL :: Pacifique
+    ! 
+    TYPE(Coordinates) :: Grid
+    !      
+    CALL read_ncdf_var('glamt',name,Grid%glamt)
+    CALL read_ncdf_var('glamu',name,Grid%glamu)
+    CALL read_ncdf_var('glamv',name,Grid%glamv)
+    CALL read_ncdf_var('glamf',name,Grid%glamf)
+    CALL read_ncdf_var('gphit',name,Grid%gphit)
+    CALL read_ncdf_var('gphiu',name,Grid%gphiu)
+    CALL read_ncdf_var('gphiv',name,Grid%gphiv)
+    CALL read_ncdf_var('gphif',name,Grid%gphif)
+    CALL read_ncdf_var('e1t',name,Grid%e1t)
+    CALL read_ncdf_var('e1u',name,Grid%e1u)
+    CALL read_ncdf_var('e1v',name,Grid%e1v)
+    CALL read_ncdf_var('e1f',name,Grid%e1f)
+    CALL read_ncdf_var('e2t',name,Grid%e2t)
+    CALL read_ncdf_var('e2u',name,Grid%e2u)
+    CALL read_ncdf_var('e2v',name,Grid%e2v)
+    CALL read_ncdf_var('e2f',name,Grid%e2f)
+    CALL read_ncdf_var('nav_lon',name,Grid%nav_lon)
+    CALL read_ncdf_var('nav_lat',name,Grid%nav_lat)       
+    ! 
+    IF( PRESENT(Pacifique) )THEN
+       IF ( Grid%glamt(1,1) > Grid%glamt(nxfin,nyfin) ) THEN           
+       Pacifique = .TRUE.
+       WHERE ( Grid%glamt < 0 )
+          Grid%glamt = Grid%glamt + 360.
+       END WHERE
+       WHERE ( Grid%glamf < 0 )
+          Grid%glamf = Grid%glamf + 360.
+       END WHERE
+       WHERE ( Grid%glamu < 0 )
+          Grid%glamu = Grid%glamu + 360.
+       END WHERE
+       WHERE ( Grid%glamv < 0 )
+          Grid%glamv = Grid%glamv + 360.
+       END WHERE
+       WHERE ( Grid%nav_lon < 0 )
+          Grid%nav_lon = Grid%nav_lon + 360.
+       END WHERE
+       ENDIF
+    ENDIF
+    !            
+    WRITE(*,*) ' '
+    WRITE(*,*) 'Reading coordinates file: ',name
+    WRITE(*,*) ' '
+    !      
+    Read_Coordinates = 1
+    !      
+  END FUNCTION Read_Coordinates
+
+  !*****************************************************
+  !   function Read_Coordinates(name,Grid)
+  !*****************************************************
+
+  INTEGER FUNCTION Read_Local_Coordinates(name,Grid,strt,cnt)
+    !
+    USE io_netcdf
+    !    
+    !  file name to open
+    ! 
+    CHARACTER(*) name
+    INTEGER, DIMENSION(2) :: strt,cnt
+    ! 
+    TYPE(Coordinates) :: Grid
+    !      
+    CALL read_ncdf_var('glamt',name,Grid%glamt,strt,cnt)
+    CALL read_ncdf_var('glamu',name,Grid%glamu,strt,cnt)
+    CALL read_ncdf_var('glamv',name,Grid%glamv,strt,cnt)
+    CALL read_ncdf_var('glamf',name,Grid%glamf,strt,cnt)
+    CALL read_ncdf_var('gphit',name,Grid%gphit,strt,cnt)
+    CALL read_ncdf_var('gphiu',name,Grid%gphiu,strt,cnt)
+    CALL read_ncdf_var('gphiv',name,Grid%gphiv,strt,cnt)
+    CALL read_ncdf_var('gphif',name,Grid%gphif,strt,cnt)
+    CALL read_ncdf_var('e1t',name,Grid%e1t,strt,cnt)
+    CALL read_ncdf_var('e1u',name,Grid%e1u,strt,cnt)
+    CALL read_ncdf_var('e1v',name,Grid%e1v,strt,cnt)
+    CALL read_ncdf_var('e1f',name,Grid%e1f,strt,cnt)
+    CALL read_ncdf_var('e2t',name,Grid%e2t,strt,cnt)
+    CALL read_ncdf_var('e2u',name,Grid%e2u,strt,cnt)
+    CALL read_ncdf_var('e2v',name,Grid%e2v,strt,cnt)
+    CALL read_ncdf_var('e2f',name,Grid%e2f,strt,cnt)
+    CALL read_ncdf_var('nav_lon',name,Grid%nav_lon,strt,cnt)
+    CALL read_ncdf_var('nav_lat',name,Grid%nav_lat,strt,cnt)       
+    !
+    WRITE(*,*) ' '
+    WRITE(*,*) 'Reading coordinates file: ',name
+    WRITE(*,*) ' '
+    !      
+    Read_Local_Coordinates = 1
+    !      
+  END FUNCTION Read_Local_Coordinates
+
+  !*****************************************************
+  !   function Write_Coordinates(name,Grid)
+  !*****************************************************
+
+  INTEGER FUNCTION Write_Coordinates(name,Grid)
+    !
+    USE io_netcdf
+    CHARACTER(*) name
+    TYPE(Coordinates) :: Grid
+    INTEGER :: status,ncid
+    CHARACTER(len=1),DIMENSION(2) :: dimnames
+    !
+    status = nf90_create(name,NF90_WRITE,ncid)
+    status = nf90_close(ncid)
+    !           
+    dimnames = (/ 'x','y' /)
+    CALL write_ncdf_dim(dimnames(1),name,nxfin)
+    CALL write_ncdf_dim(dimnames(2),name,nyfin)
+    !      
+    CALL write_ncdf_var('nav_lon',dimnames,name,Grid%nav_lon,'float')      
+    CALL write_ncdf_var('nav_lat',dimnames,name,Grid%nav_lat,'float')
+    !
+    CALL write_ncdf_var('glamt',dimnames,name,Grid%glamt,'double')
+    CALL write_ncdf_var('glamu',dimnames,name,Grid%glamu,'double')
+    CALL write_ncdf_var('glamv',dimnames,name,Grid%glamv,'double')
+    CALL write_ncdf_var('glamf',dimnames,name,Grid%glamf,'double')
+    CALL write_ncdf_var('gphit',dimnames,name,Grid%gphit,'double')
+    CALL write_ncdf_var('gphiu',dimnames,name,Grid%gphiu,'double')
+    CALL write_ncdf_var('gphiv',dimnames,name,Grid%gphiv,'double')
+    CALL write_ncdf_var('gphif',dimnames,name,Grid%gphif,'double')      
+    CALL write_ncdf_var('e1t',dimnames,name,Grid%e1t,'double')      
+    CALL write_ncdf_var('e1u',dimnames,name,Grid%e1u,'double')     
+    CALL write_ncdf_var('e1v',dimnames,name,Grid%e1v,'double')      
+    CALL write_ncdf_var('e1f',dimnames,name,Grid%e1f,'double')
+    CALL write_ncdf_var('e2t',dimnames,name,Grid%e2t,'double')
+    CALL write_ncdf_var('e2u',dimnames,name,Grid%e2u,'double')
+    CALL write_ncdf_var('e2v',dimnames,name,Grid%e2v,'double')
+    CALL write_ncdf_var('e2f',dimnames,name,Grid%e2f,'double')
+    !      
+    CALL copy_ncdf_att('nav_lon',TRIM(parent_coordinate_file),name,MINVAL(Grid%nav_lon),MAXVAL(Grid%nav_lon))
+    CALL copy_ncdf_att('nav_lat',TRIM(parent_coordinate_file),name,MINVAL(Grid%nav_lat),MAXVAL(Grid%nav_lat))
+    CALL copy_ncdf_att('glamt',TRIM(parent_coordinate_file),name)
+    CALL copy_ncdf_att('glamu',TRIM(parent_coordinate_file),name)
+    CALL copy_ncdf_att('glamv',TRIM(parent_coordinate_file),name)
+    CALL copy_ncdf_att('glamf',TRIM(parent_coordinate_file),name)
+    CALL copy_ncdf_att('gphit',TRIM(parent_coordinate_file),name)
+    CALL copy_ncdf_att('gphiu',TRIM(parent_coordinate_file),name)
+    CALL copy_ncdf_att('gphiv',TRIM(parent_coordinate_file),name)
+    CALL copy_ncdf_att('gphif',TRIM(parent_coordinate_file),name)
+    CALL copy_ncdf_att('e1t',TRIM(parent_coordinate_file),name)
+    CALL copy_ncdf_att('e1u',TRIM(parent_coordinate_file),name)
+    CALL copy_ncdf_att('e1v',TRIM(parent_coordinate_file),name)
+    CALL copy_ncdf_att('e1f',TRIM(parent_coordinate_file),name)
+    CALL copy_ncdf_att('e2t',TRIM(parent_coordinate_file),name)
+    CALL copy_ncdf_att('e2u',TRIM(parent_coordinate_file),name)
+    CALL copy_ncdf_att('e2v',TRIM(parent_coordinate_file),name)
+    CALL copy_ncdf_att('e2f',TRIM(parent_coordinate_file),name)            
+    !
+    WRITE(*,*) ' '
+    WRITE(*,*) 'Writing coordinates file: ',name
+    WRITE(*,*) ' '
+    !
+    Write_Coordinates = 1
+    !      
+  END FUNCTION Write_Coordinates
+  !
+  !
+  !
+  !*****************************************************
+  !   function Read_Bathy_level(name,Grid)
+  !*****************************************************
+  !
+  INTEGER FUNCTION Read_Bathy_level(name,Grid)
+    !
+    USE io_netcdf
+    !      
+    CHARACTER(*) name
+    TYPE(Coordinates) :: Grid
+    !
+    CALL read_ncdf_var(parent_level_name,name,Grid%Bathy_level)    
+    !
+    WRITE(*,*) ' '
+    WRITE(*,*) 'Reading bathymetry file: ',name
+    WRITE(*,*) ' '      
+    !
+    Read_Bathy_level = 1
+    !      
+  END FUNCTION Read_Bathy_level
+  !
+  !*****************************************************
+  !   function Write_Bathy_level(name,Grid)
+  !*****************************************************
+  !
+  INTEGER FUNCTION Write_Bathy_level(name,Grid)
+    !
+    USE io_netcdf
+    !      
+    CHARACTER(*) name
+    TYPE(Coordinates) :: Grid
+    INTEGER :: status,ncid
+    CHARACTER(len=1),DIMENSION(2) :: dimnames
+    !
+    status = nf90_create(name,NF90_WRITE,ncid)
+    status = nf90_close(ncid)          
+    !
+    dimnames = (/ 'x','y' /)
+    CALL write_ncdf_dim(dimnames(1),name,nxfin)
+    CALL write_ncdf_dim(dimnames(2),name,nyfin)
+    !      
+    CALL write_ncdf_var('nav_lon'        ,dimnames,name,Grid%nav_lon    ,'float')
+    CALL write_ncdf_var('nav_lat'        ,dimnames,name,Grid%nav_lat    ,'float')
+    CALL write_ncdf_var(parent_level_name,dimnames,name,NINT(Grid%bathy_level),'integer')
+    !
+    CALL copy_ncdf_att('nav_lon'        ,TRIM(parent_bathy_level),name,MINVAL(Grid%nav_lon),MAXVAL(Grid%nav_lon))
+    CALL copy_ncdf_att('nav_lat'        ,TRIM(parent_bathy_level),name,MINVAL(Grid%nav_lat),MAXVAL(Grid%nav_lat))
+    CALL copy_ncdf_att(parent_level_name,TRIM(parent_bathy_level),name)       
+    !
+    WRITE(*,*) ' '
+    WRITE(*,*) 'Writing bathymetry (levels) in: ',name
+    WRITE(*,*) ' '
+    !
+    Write_Bathy_level = 1
+    !
+  END FUNCTION Write_Bathy_level
+  !
+  !*****************************************************
+  !   function read_bathy_coord(name,CoarseGrid,ChildGrid)
+  !*****************************************************
+  !
+  INTEGER FUNCTION read_bathy_coord(name,CoarseGrid,ChildGrid,Pacifique)
+    !
+    USE io_netcdf
+    CHARACTER(*) name
+    INTEGER :: i,j,tabdim1,tabdim2
+    INTEGER, DIMENSION(1) :: i_min,i_max,j_min,j_max
+    REAL*8,POINTER,DIMENSION(:) :: topo_lon,topo_lat
+    INTEGER :: status,ncid,varid 
+    LOGICAL,OPTIONAL :: Pacifique
+    TYPE(Coordinates) :: CoarseGrid,ChildGrid
+    REAL*8 :: zdel
+    zdel = 0.5 ! Offset in degrees to extend extraction of bathymetry data
+    !
+    IF( Dims_Existence('lon',name) .AND. Dims_Existence('lat',name) ) THEN
+       WRITE(*,*) '****'
+       WRITE(*,*) ' etopo format for external high resolution database  '
+       WRITE(*,*) '****'
+       CALL read_ncdf_var('lon',name,topo_lon)
+       CALL read_ncdf_var('lat',name,topo_lat)
+    ELSE IF( Dims_Existence('x',name) .AND. Dims_Existence('y',name) ) THEN
+       WRITE(*,*) '****'
+       WRITE(*,*) ' OPA format for external high resolution database  '
+       WRITE(*,*) '****'
+       CALL read_ncdf_var('nav_lon',name,CoarseGrid%nav_lon)
+       CALL read_ncdf_var('nav_lat',name,CoarseGrid%nav_lat)
+       CALL read_ncdf_var(parent_meter_name,name,CoarseGrid%Bathy_meter)
+       !            
+       IF ( PRESENT(Pacifique) ) THEN
+          IF(Pacifique) THEN
+             WHERE(CoarseGrid%nav_lon < 0.001) 
+                CoarseGrid%nav_lon = CoarseGrid%nav_lon + 360.
+             END WHERE
+          ENDIF
+       ENDIF
+       !      
+       read_bathy_coord = 1
+       RETURN      
+    ELSE
+       WRITE(*,*) '****'
+       WRITE(*,*) '*** ERROR Bad format for external high resolution database'
+       WRITE(*,*) '****'
+       STOP  
+    ENDIF
+    !
+    IF( MAXVAL(ChildGrid%glamt) > 180. ) THEN                 
+       !          
+       WHERE( topo_lon < 0. )   topo_lon = topo_lon + 360.
+       !          
+       i_min = MAXLOC(topo_lon,mask = topo_lon < MINVAL(ChildGrid%nav_lon)-zdel)
+       i_max = MINLOC(topo_lon,mask = topo_lon > MAXVAL(ChildGrid%nav_lon)+zdel)                    
+       j_min = MAXLOC(topo_lat,mask = topo_lat < MINVAL(ChildGrid%nav_lat)-zdel)
+       j_max = MINLOC(topo_lat,mask = topo_lat > MAXVAL(ChildGrid%nav_lat)+zdel)
+       !          
+       tabdim1 = ( SIZE(topo_lon) - i_min(1) + 1 ) + i_max(1)                    
+       !          
+       IF( ln_agrif_domain ) THEN
+          IF(j_min(1)-2 >= 1 .AND. j_max(1)+3 <= SIZE(topo_lat,1) ) THEN
+             j_min(1) = j_min(1)-2
+             j_max(1) = j_max(1)+3
+          ENDIF
+       ENDIF
+       tabdim2 = j_max(1) - j_min(1) + 1
+       !
+       ALLOCATE(CoarseGrid%nav_lon(tabdim1,tabdim2))
+       ALLOCATE(CoarseGrid%nav_lat(tabdim1,tabdim2))
+       ALLOCATE(CoarseGrid%Bathy_meter(tabdim1,tabdim2))          
+       !
+       DO i = 1,tabdim1
+          CoarseGrid%nav_lat(i,:) = topo_lat(j_min(1):j_max(1))
+       END DO
+       !
+       DO j = 1, tabdim2
+          !                     
+          CoarseGrid%nav_lon(1:SIZE(topo_lon)-i_min(1)+1      ,j) = topo_lon(i_min(1):SIZE(topo_lon))
+          CoarseGrid%nav_lon(2+SIZE(topo_lon)-i_min(1):tabdim1,j) = topo_lon(1:i_max(1))
+          !    
+       END DO
+       status = nf90_open(name,NF90_NOWRITE,ncid)
+       status = nf90_inq_varid(ncid,elevation_name,varid)
+       !
+       IF (status/=nf90_noerr) THEN
+          WRITE(*,*)"Can't find variable: ", elevation_name
+          STOP
+       ENDIF
+       !          
+       status=nf90_get_var(ncid,varid,CoarseGrid%Bathy_meter(1:SIZE(topo_lon)-i_min(1)+1,:), &
+            start=(/i_min(1),j_min(1)/),count=(/SIZE(topo_lon)-i_min(1),tabdim2/))
+
+       status=nf90_get_var(ncid,varid,CoarseGrid%Bathy_meter(2+SIZE(topo_lon)-i_min(1):tabdim1,:), &
+            start=(/1,j_min(1)/),count=(/i_max(1),tabdim2/))                
+       !
+    ELSE
+       !
+       WHERE( topo_lon > 180. )   topo_lon = topo_lon - 360.
+       !
+       i_min = MAXLOC(topo_lon,mask = topo_lon < MINVAL(ChildGrid%nav_lon)-zdel)
+       i_max = MINLOC(topo_lon,mask = topo_lon > MAXVAL(ChildGrid%nav_lon)+zdel)
+       j_min = MAXLOC(topo_lat,mask = topo_lat < MINVAL(ChildGrid%nav_lat)-zdel)
+       j_max = MINLOC(topo_lat,mask = topo_lat > MAXVAL(ChildGrid%nav_lat)+zdel)
+       !      
+       IF( ln_agrif_domain ) THEN
+          IF(i_min(1)-2 >= 1 .AND. i_max(1)+3 <= SIZE(topo_lon,1) ) THEN
+             i_min(1) = i_min(1)-2
+             i_max(1) = i_max(1)+3
+          ENDIF
+       ENDIF
+       tabdim1 = i_max(1) - i_min(1) + 1
+       !
+       IF( ln_agrif_domain ) THEN
+          IF(j_min(1)-2 >= 1 .AND. j_max(1)+3 <= SIZE(topo_lat,1) ) THEN
+             j_min(1) = j_min(1)-2
+             j_max(1) = j_max(1)+3
+          ENDIF
+       ENDIF
+       tabdim2 = j_max(1) - j_min(1) + 1
+       !
+       WRITE(*,*) ' '
+       WRITE(*,*) 'Reading bathymetry file: ',name
+       WRITE(*,*) ' '
+       !
+       ALLOCATE(CoarseGrid%nav_lon(tabdim1,tabdim2))
+       ALLOCATE(CoarseGrid%nav_lat(tabdim1,tabdim2))
+       ALLOCATE(CoarseGrid%Bathy_meter(tabdim1,tabdim2))
+       !
+       DO j = 1,tabdim2
+          CoarseGrid%nav_lon(:,j) = topo_lon(i_min(1):i_max(1))
+       END DO
+       !      
+       DO i = 1,tabdim1
+          CoarseGrid%nav_lat(i,:) = topo_lat(j_min(1):j_max(1)) 
+       END DO
+       !
+       status = nf90_open(name,NF90_NOWRITE,ncid)
+       status = nf90_inq_varid(ncid,elevation_name,varid)
+       IF (status/=nf90_noerr) THEN
+          WRITE(*,*)"Can't find variable: ", elevation_name
+          STOP
+       ENDIF
+
+       status = nf90_get_var(ncid,varid,CoarseGrid%Bathy_meter, &
+          &                  start=(/i_min(1),j_min(1)/),count=(/tabdim1,tabdim2/))
+       !
+    ENDIF
+    !
+    status = nf90_close(ncid)     
+    !
+    WHERE(CoarseGrid%Bathy_meter.GE.0)
+       CoarseGrid%Bathy_meter = 0.0
+    END WHERE
+    !      
+    CoarseGrid%Bathy_meter(:,:) = -1.0 * CoarseGrid%Bathy_meter(:,:)
+    !      
+    read_bathy_coord = 1
+    RETURN
+    !      
+  END FUNCTION read_bathy_coord
+  ! 
+  !
+  !*****************************************************
+  !   function read_bathy_meter(name,CoarseGrid,ChildGrid)
+  !*****************************************************
+  !
+  INTEGER FUNCTION read_bathy_meter(name,Grid)
+    !
+    !
+    USE io_netcdf
+    !      
+    CHARACTER(*) name
+    TYPE(Coordinates) :: Grid
+    !
+    CALL read_ncdf_var(parent_meter_name,name,Grid%Bathy_meter)    
+    !
+    WRITE(*,*) ' '
+    WRITE(*,*) 'Reading bathymetry file: ',name
+    WRITE(*,*) ' '      
+    !
+    read_bathy_meter = 1
+    !      
+  END FUNCTION read_bathy_meter
+  !     
+  !*****************************************************
+  !   function Write_Bathy_meter(name,Grid)
+  !*****************************************************
+  !
+  INTEGER FUNCTION Write_Bathy_meter(name,Grid)
+    !
+    USE io_netcdf
+    !
+    CHARACTER(*) name
+    TYPE(Coordinates) :: Grid
+    INTEGER :: status,ncid
+    CHARACTER(len=1),DIMENSION(2) :: dimnames
+    INTEGER :: nx,ny
+    !
+    status = nf90_create(name,NF90_WRITE,ncid)
+    status = nf90_close(ncid)     
+    !
+    nx = SIZE(Grid%bathy_meter,1)
+    ny = SIZE(Grid%bathy_meter,2)
+    dimnames = (/ 'x','y' /)
+
+    CALL write_ncdf_dim(dimnames(1),name,nx)
+    CALL write_ncdf_dim(dimnames(2),name,ny)
+    !     
+    CALL write_ncdf_var('nav_lon'        ,dimnames,name,Grid%nav_lon    ,'float')
+    CALL write_ncdf_var('nav_lat'        ,dimnames,name,Grid%nav_lat    ,'float')
+    CALL write_ncdf_var(parent_meter_name,dimnames,name,Grid%bathy_meter,'float')
+    CALL write_ncdf_var('weight'         ,dimnames,name,Grid%wgt        ,'float')
+    !
+    CALL copy_ncdf_att('nav_lon'        ,TRIM(parent_bathy_meter),name,MINVAL(Grid%nav_lon),MAXVAL(Grid%nav_lon))
+    CALL copy_ncdf_att('nav_lat'        ,TRIM(parent_bathy_meter),name,MINVAL(Grid%nav_lat),MAXVAL(Grid%nav_lat))  
+    CALL copy_ncdf_att(parent_meter_name,TRIM(parent_bathy_meter),name)
+    !
+    WRITE(*,*) ' '
+    WRITE(*,*) 'Writing bathymetry (meters) in: ',name
+    WRITE(*,*) ' '
+    !
+    Write_Bathy_meter = 1
+    !      
+  END FUNCTION Write_Bathy_meter
+  !
+  !*****************************************************
+  !   function write_domcfg(name,Grid)
+  !*****************************************************
+
+  INTEGER FUNCTION write_domcfg(name,Grid)
+     !-----------------------------------------
+     ! It creates a domain_cfg.nc used in NEMO4
+     !-----------------------------------------    
+     !
+     USE io_netcdf
+     !
+     CHARACTER(*) name
+     TYPE(Coordinates) :: Grid
+     !
+     INTEGER :: status, ncid
+     INTEGER :: nx, ny, jk
+     INTEGER :: ln_sco, ln_isfcav, ln_zco, ln_zps, jperio
+     REAL*8  :: rpi, rad, rday, rsiyea, rsiday, omega
+     !
+     CHARACTER(len=1),     DIMENSION(3)     ::   dimnames
+     REAL*8 ,              DIMENSION(N)     ::   e3t_1d, e3w_1d, gdept_1d, gdepw_1d
+     REAL*8 , ALLOCATABLE, DIMENSION(:,:)   ::   ff_t, ff_f, zbathy
+     INTEGER, ALLOCATABLE, DIMENSION(:,:)   ::   bottom_level, top_level, mbathy
+     REAL*8 , ALLOCATABLE, DIMENSION(:,:,:) ::   e3t_0, e3u_0, e3v_0, e3f_0, e3w_0, e3uw_0, e3vw_0
+     !
+     ! size of the Grid
+     nx = SIZE(Grid%bathy_meter,1)
+     ny = SIZE(Grid%bathy_meter,2)
+
+     ! allocate needed arrays for domain_cfg
+     ALLOCATE( ff_t(nx,ny), ff_f(nx,ny), zbathy(nx,ny) )
+     ALLOCATE( bottom_level(nx,ny), top_level(nx,ny), mbathy(nx,ny) )
+     ALLOCATE( e3t_0(nx,ny,N), e3u_0 (nx,ny,N), e3v_0 (nx,ny,N), e3f_0(nx,ny,N),  &
+        &      e3w_0(nx,ny,N), e3uw_0(nx,ny,N), e3vw_0(nx,ny,N) )
+
+     ! some physical parameters
+     rpi    = 3.141592653589793
+     rad    = 3.141592653589793 / 180.
+     rday   = 24.*60.*60.
+     rsiyea = 365.25 * rday * 2. * rpi / 6.283076
+     rsiday = rday / ( 1. + rday / rsiyea )
+     omega  = 2. * rpi / rsiday
+
+     ! Coriolis
+     ff_f(:,:) = 2. * omega * SIN( rad * Grid%gphif(:,:) )     ! compute it on the sphere at f-point
+     ff_t(:,:) = 2. * omega * SIN( rad * Grid%gphit(:,:) )     !    -        -       -    at t-point
+
+     ! bathy in meters
+     zbathy(:,:) = Grid%bathy_meter
+
+     ! vertical scale factors
+     CALL zgr_z( e3t_1d, e3w_1d, gdept_1d, gdepw_1d )    
+!     DO jk = 1, N
+!        e3t_0  (:,:,jk) = e3t_1d  (jk)
+!        e3u_0  (:,:,jk) = e3t_1d  (jk)
+!        e3v_0  (:,:,jk) = e3t_1d  (jk)
+!        e3f_0  (:,:,jk) = e3t_1d  (jk)
+!        e3w_0  (:,:,jk) = e3w_1d  (jk)
+!        e3uw_0 (:,:,jk) = e3w_1d  (jk)
+!        e3vw_0 (:,:,jk) = e3w_1d  (jk)
+!     END DO
+
+     ! logicals and others
+     ln_sco = 0
+     ln_isfcav = 0
+!!$     IF( partial_steps ) THEN
+        ln_zps = 1
+        ln_zco = 0
+!!$     ELSE
+!!$        ln_zps = 0
+!!$        ln_zco = 1
+!!$     ENDIF
+
+     CALL zgr_zps( nx, ny, gdept_1d, gdepw_1d, e3t_1d, e3w_1d, zbathy, &        ! input
+        &          mbathy, e3t_0, e3u_0, e3v_0, e3f_0, e3w_0, e3uw_0, e3vw_0 )  ! output
+
+     ! top/bottom levels
+     bottom_level(:,:) = mbathy(:,:)
+     top_level(:,:)    = MIN( 1, mbathy(:,:) )
+
+     ! closed domain for child grid and namelist defined domain for parent grid
+     IF( TRIM(name) == TRIM(parent_domcfg_updated) .OR. TRIM(name) == TRIM(parent_domcfg_out) ) THEN
+        jperio = parent_jperio
+     ELSE
+        jperio = 0
+     ENDIF
+
+     !IF( .NOT.ln_agrif_domain ) THEN
+     !   bottom_level(1:nx,1   ) = 0
+     !   bottom_level(1:nx,  ny) = 0
+     !   bottom_level(1   ,1:ny) = 0
+     !   bottom_level(  nx,1:ny) = 0
+
+     !   top_level(1:nx,1   ) = 0
+     !   top_level(1:nx,  ny) = 0
+     !   top_level(1   ,1:ny) = 0
+     !   top_level(  nx,1:ny) = 0
+
+     !   zbathy(1:nx,1   ) = 0.
+     !   zbathy(1:nx,  ny) = 0.
+     !   zbathy(1   ,1:ny) = 0.
+     !   zbathy(  nx,1:ny) = 0.     
+     !ENDIF
+     
+     ! -------------------
+     ! write domain_cfg.nc
+     ! -------------------
+     status = nf90_create(name,IOR(NF90_64BIT_OFFSET,NF90_WRITE),ncid)
+     status = nf90_close(ncid)
+     !
+     ! dimensions
+     dimnames = (/'x','y','z'/)
+     CALL write_ncdf_dim(dimnames(1),name,nx)
+     CALL write_ncdf_dim(dimnames(2),name,ny)
+     CALL write_ncdf_dim(dimnames(3),name,N)
+     !      
+     ! variables
+     CALL write_ncdf_var('nav_lon',dimnames(1:2),name,Grid%nav_lon,'float')      
+     CALL write_ncdf_var('nav_lat',dimnames(1:2),name,Grid%nav_lat,'float')
+     CALL write_ncdf_var('nav_lev',dimnames(3)  ,name,gdept_1d    ,'float')
+     !
+     CALL write_ncdf_var('jpiglo',name,nx    ,'integer')
+     CALL write_ncdf_var('jpjglo',name,ny    ,'integer')
+     CALL write_ncdf_var('jpkglo',name,N     ,'integer')
+     CALL write_ncdf_var('jperio',name,jperio,'integer')
+     !
+     CALL write_ncdf_var('ln_zco'   ,name,ln_zco   ,'integer')
+     CALL write_ncdf_var('ln_zps'   ,name,ln_zps   ,'integer')
+     CALL write_ncdf_var('ln_sco'   ,name,ln_sco   ,'integer')
+     CALL write_ncdf_var('ln_isfcav',name,ln_isfcav,'integer')
+
+     CALL write_ncdf_var('glamt',dimnames(1:2),name,Grid%glamt,'double')
+     CALL write_ncdf_var('glamu',dimnames(1:2),name,Grid%glamu,'double')
+     CALL write_ncdf_var('glamv',dimnames(1:2),name,Grid%glamv,'double')
+     CALL write_ncdf_var('glamf',dimnames(1:2),name,Grid%glamf,'double')
+     CALL write_ncdf_var('gphit',dimnames(1:2),name,Grid%gphit,'double')
+     CALL write_ncdf_var('gphiu',dimnames(1:2),name,Grid%gphiu,'double')
+     CALL write_ncdf_var('gphiv',dimnames(1:2),name,Grid%gphiv,'double')
+     CALL write_ncdf_var('gphif',dimnames(1:2),name,Grid%gphif,'double')      
+
+     CALL write_ncdf_var('e1t',dimnames(1:2),name,Grid%e1t,'double')      
+     CALL write_ncdf_var('e1u',dimnames(1:2),name,Grid%e1u,'double')     
+     CALL write_ncdf_var('e1v',dimnames(1:2),name,Grid%e1v,'double')      
+     CALL write_ncdf_var('e1f',dimnames(1:2),name,Grid%e1f,'double')
+     CALL write_ncdf_var('e2t',dimnames(1:2),name,Grid%e2t,'double')
+     CALL write_ncdf_var('e2u',dimnames(1:2),name,Grid%e2u,'double')
+     CALL write_ncdf_var('e2v',dimnames(1:2),name,Grid%e2v,'double')
+     CALL write_ncdf_var('e2f',dimnames(1:2),name,Grid%e2f,'double')
+
+     CALL write_ncdf_var('ff_f',dimnames(1:2),name,ff_f,'double')
+     CALL write_ncdf_var('ff_t',dimnames(1:2),name,ff_t,'double')
+
+     CALL write_ncdf_var('e3t_1d',dimnames(3),name,e3t_1d,'double')
+     CALL write_ncdf_var('e3w_1d',dimnames(3),name,e3w_1d,'double')
+
+     CALL write_ncdf_var('e3t_0' ,dimnames(:),name,e3t_0 ,'double')
+     CALL write_ncdf_var('e3w_0' ,dimnames(:),name,e3w_0 ,'double')
+     CALL write_ncdf_var('e3u_0' ,dimnames(:),name,e3u_0 ,'double')
+     CALL write_ncdf_var('e3v_0' ,dimnames(:),name,e3v_0 ,'double')
+     CALL write_ncdf_var('e3f_0' ,dimnames(:),name,e3f_0 ,'double')
+     CALL write_ncdf_var('e3w_0' ,dimnames(:),name,e3w_0 ,'double')
+     CALL write_ncdf_var('e3uw_0',dimnames(:),name,e3uw_0,'double')
+     CALL write_ncdf_var('e3vw_0',dimnames(:),name,e3vw_0,'double')
+
+     CALL write_ncdf_var('bottom_level',dimnames(1:2),name,bottom_level,'integer')
+     CALL write_ncdf_var('top_level'   ,dimnames(1:2),name,top_level   ,'integer')
+     CALL write_ncdf_var('bathy_meter' ,dimnames(1:2),name,zbathy      ,'float')
+
+     ! some attributes      
+     CALL copy_ncdf_att('nav_lon',TRIM(parent_coordinate_file),name,MINVAL(Grid%nav_lon),MAXVAL(Grid%nav_lon))
+     CALL copy_ncdf_att('nav_lat',TRIM(parent_coordinate_file),name,MINVAL(Grid%nav_lat),MAXVAL(Grid%nav_lat))
+
+     CALL copy_ncdf_att('glamt',TRIM(parent_coordinate_file),name)
+     CALL copy_ncdf_att('glamu',TRIM(parent_coordinate_file),name)
+     CALL copy_ncdf_att('glamv',TRIM(parent_coordinate_file),name)
+     CALL copy_ncdf_att('glamf',TRIM(parent_coordinate_file),name)
+     CALL copy_ncdf_att('gphit',TRIM(parent_coordinate_file),name)
+     CALL copy_ncdf_att('gphiu',TRIM(parent_coordinate_file),name)
+     CALL copy_ncdf_att('gphiv',TRIM(parent_coordinate_file),name)
+     CALL copy_ncdf_att('gphif',TRIM(parent_coordinate_file),name)
+
+     CALL copy_ncdf_att('e1t',TRIM(parent_coordinate_file),name)
+     CALL copy_ncdf_att('e1u',TRIM(parent_coordinate_file),name)
+     CALL copy_ncdf_att('e1v',TRIM(parent_coordinate_file),name)
+     CALL copy_ncdf_att('e1f',TRIM(parent_coordinate_file),name)
+     CALL copy_ncdf_att('e2t',TRIM(parent_coordinate_file),name)
+     CALL copy_ncdf_att('e2u',TRIM(parent_coordinate_file),name)
+     CALL copy_ncdf_att('e2v',TRIM(parent_coordinate_file),name)
+     CALL copy_ncdf_att('e2f',TRIM(parent_coordinate_file),name)            
+     !
+     ! control print
+     WRITE(*,*) ' '
+     WRITE(*,*) 'Writing domcfg file: ',name
+     WRITE(*,*) ' '
+     !
+     DEALLOCATE( ff_t, ff_f, zbathy )
+     DEALLOCATE( bottom_level, top_level, mbathy )
+     DEALLOCATE( e3t_0, e3u_0, e3v_0, e3f_0, e3w_0, e3uw_0, e3vw_0 )
+     !      
+     write_domcfg = 1
+
+  END FUNCTION write_domcfg
+  !
+  SUBROUTINE zgr_z(e3t_1d, e3w_1d, gdept_1d, gdepw_1d )
+     !!----------------------------------------------------------------------
+     !!                   ***  ROUTINE zgr_z (from NEMO4) ***
+     !!                   
+     !! ** Purpose :   set the depth of model levels and the resulting 
+     !!      vertical scale factors.
+     !!
+     !! ** Method  :   z-coordinate system (use in all type of coordinate)
+     !!        The depth of model levels is defined from an analytical
+     !!      function the derivative of which gives the scale factors.
+     !!        both depth and scale factors only depend on k (1d arrays).
+     !!              w-level: gdepw_1d  = gdep(k)
+     !!                       e3w_1d(k) = dk(gdep)(k)     = e3(k)
+     !!              t-level: gdept_1d  = gdep(k+0.5)
+     !!                       e3t_1d(k) = dk(gdep)(k+0.5) = e3(k+0.5)
+     !!
+     !! ** Action  : - gdept_1d, gdepw_1d : depth of T- and W-point (m)
+     !!              - e3t_1d  , e3w_1d   : scale factors at T- and W-levels (m)
+     !!
+     !! Reference : Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766.
+     !!----------------------------------------------------------------------
+     INTEGER  ::   jk                   ! dummy loop indices
+     REAL*8 ::   zt, zw                 ! temporary scalars
+     REAL*8 ::   zsur, za0, za1, zkth   ! Values set from parameters in
+     REAL*8 ::   zacr, zdzmin, zhmax    ! par_CONFIG_Rxx.h90
+     REAL*8 ::   za2, zkth2, zacr2      ! Values for optional double tanh function set from parameters 
+
+     REAL*8, DIMENSION(:), INTENT(out) ::  e3t_1d, e3w_1d, gdept_1d, gdepw_1d
+     !!----------------------------------------------------------------------
+     !
+     !
+     ! Set variables from parameters
+     ! ------------------------------
+     zkth = ppkth       ;   zacr = ppacr
+     zdzmin = ppdzmin   ;   zhmax = pphmax
+     zkth2 = ppkth2     ;   zacr2 = ppacr2   ! optional (ldbletanh=T) double tanh parameters
+
+     ! If pa1 and pa0 and psur are et to pp_to_be_computed
+     !  za0, za1, zsur are computed from ppdzmin , pphmax, ppkth, ppacr
+    IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) &
+         .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN
+        !
+        za1  = (  ppdzmin - pphmax / FLOAT(N-1)  )                                                      &
+           & / ( TANH((1-ppkth)/ppacr) - ppacr/FLOAT(N-1) * (  LOG( COSH( (N - ppkth) / ppacr) )      &
+           &                                                   - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
+        za0  = ppdzmin - za1 *              TANH( (1-ppkth) / ppacr )
+        zsur =   - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
+     ELSE
+        za1 = pa1 ;       za0 = pa0 ;          zsur = psur
+        za2 = pa2                            ! optional (ldbletanh=T) double tanh parameter
+     ENDIF
+
+     ! Reference z-coordinate (depth - scale factor at T- and W-points)
+     ! ======================
+     IF( ppkth == 0. ) THEN            !  uniform vertical grid 
+
+        za1 = zhmax / FLOAT(N-1)
+
+        DO jk = 1, N
+           zw = FLOAT( jk )
+           zt = FLOAT( jk ) + 0.5
+           gdepw_1d(jk) = ( zw - 1 ) * za1
+           gdept_1d(jk) = ( zt - 1 ) * za1
+           e3w_1d  (jk) =  za1
+           e3t_1d  (jk) =  za1
+        END DO
+     ELSE                                ! Madec & Imbard 1996 function
+        IF( .NOT. ldbletanh ) THEN
+           DO jk = 1, N
+              zw = REAL( jk )
+              zt = REAL( jk ) + 0.5
+              gdepw_1d(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth) / zacr ) )  )
+              gdept_1d(jk) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth) / zacr ) )  )
+              e3w_1d  (jk) =          za0      + za1        * TANH(       (zw-zkth) / zacr   )
+              e3t_1d  (jk) =          za0      + za1        * TANH(       (zt-zkth) / zacr   )
+           END DO
+        ELSE
+           DO jk = 1, N
+              zw = FLOAT( jk )
+              zt = FLOAT( jk ) + 0.5
+              ! Double tanh function
+              gdepw_1d(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth ) / zacr  ) )    &
+                 &                             + za2 * zacr2* LOG ( COSH( (zw-zkth2) / zacr2 ) )  )
+              gdept_1d(jk) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth ) / zacr  ) )    &
+                 &                             + za2 * zacr2* LOG ( COSH( (zt-zkth2) / zacr2 ) )  )
+              e3w_1d  (jk) =          za0      + za1        * TANH(       (zw-zkth ) / zacr  )      &
+                 &                             + za2        * TANH(       (zw-zkth2) / zacr2 )
+              e3t_1d  (jk) =          za0      + za1        * TANH(       (zt-zkth ) / zacr  )      &
+                 &                             + za2        * TANH(       (zt-zkth2) / zacr2 )
+           END DO
+        ENDIF
+        gdepw_1d(1) = 0.                    ! force first w-level to be exactly at zero
+     ENDIF
+
+     IF ( ln_e3_dep ) THEN      ! e3. = dk[gdep]   
+        !
+        !==>>>   need to be like this to compute the pressure gradient with ISF. 
+        !        If not, level beneath the ISF are not aligned (sum(e3t) /= depth)
+        !        define e3t_0 and e3w_0 as the differences between gdept and gdepw respectively
+        !
+        DO jk = 1, N-1
+           e3t_1d(jk) = gdepw_1d(jk+1)-gdepw_1d(jk)
+        END DO
+        e3t_1d(N) = e3t_1d(N-1)   ! we don't care because this level is masked in NEMO
+
+        DO jk = 2, N
+           e3w_1d(jk) = gdept_1d(jk) - gdept_1d(jk-1)
+        END DO
+        e3w_1d(1  ) = 2. * (gdept_1d(1) - gdepw_1d(1))
+     END IF
+
+     !
+  END SUBROUTINE zgr_z
+
+  SUBROUTINE zgr_zps( nx, ny, gdept_1d, gdepw_1d, e3t_1d, e3w_1d, zbathy, &
+     &                mbathy, e3t_0, e3u_0, e3v_0, e3f_0, e3w_0, e3uw_0, e3vw_0 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zgr_zps (from NEMO4)  ***
+      !!                     
+      !! ** Purpose :   the depth and vertical scale factor in partial step
+      !!              reference z-coordinate case
+      !!
+      !! ** Method  :   Partial steps : computes the 3D vertical scale factors
+      !!      of T-, U-, V-, W-, UW-, VW and F-points that are associated with
+      !!      a partial step representation of bottom topography.
+      !!
+      !!        The reference depth of model levels is defined from an analytical
+      !!      function the derivative of which gives the reference vertical
+      !!      scale factors.
+      !!        From  depth and scale factors reference, we compute there new value
+      !!      with partial steps  on 3d arrays ( i, j, k ).
+      !!
+      !!              w-level: gdepw_0(i,j,k)  = gdep(k)
+      !!                       e3w_0(i,j,k) = dk(gdep)(k)     = e3(i,j,k)
+      !!              t-level: gdept_0(i,j,k)  = gdep(k+0.5)
+      !!                       e3t_0(i,j,k) = dk(gdep)(k+0.5) = e3(i,j,k+0.5)
+      !!
+      !!        With the help of the bathymetric file ( bathymetry_depth_ORCA_R2.nc),
+      !!      we find the mbathy index of the depth at each grid point.
+      !!      This leads us to three cases:
+      !!
+      !!              - bathy = 0 => mbathy = 0
+      !!              - 1 < mbathy < jpkm1    
+      !!              - bathy > gdepw_0(jpk) => mbathy = jpkm1  
+      !!
+      !!        Then, for each case, we find the new depth at t- and w- levels
+      !!      and the new vertical scale factors at t-, u-, v-, w-, uw-, vw- 
+      !!      and f-points.
+      !! 
+      !!        This routine is given as an example, it must be modified
+      !!      following the user s desiderata. nevertheless, the output as
+      !!      well as the way to compute the model levels and scale factors
+      !!      must be respected in order to insure second order accuracy
+      !!      schemes.
+      !!
+      !!         c a u t i o n : gdept_1d, gdepw_1d and e3._1d are positives
+      !!         - - - - - - -   gdept_0, gdepw_0 and e3. are positives
+      !!      
+      !!  Reference :   Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270.
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk       ! dummy loop indices
+      INTEGER  ::   ik
+      INTEGER  ::   ikb, ikt       ! temporary integers
+      REAL*8 ::   ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points
+      REAL*8 ::   zdepwp, zdepth   ! Ajusted ocean depth to avoid too small e3t
+      REAL*8 ::   zmax             ! temporary scalar
+      !
+      REAL*8, ALLOCATABLE, DIMENSION(:,:,:) ::  gdept_0, gdepw_0, zprt
+      !
+      INTEGER,                   INTENT(in   ) ::  nx, ny
+      REAL*8 , DIMENSION(:)    , INTENT(in   ) ::  gdept_1d, gdepw_1d, e3t_1d, e3w_1d
+      REAL*8 , DIMENSION(:,:)  , INTENT(inout) ::  zbathy
+      INTEGER, DIMENSION(:,:)  , INTENT(  out) ::  mbathy
+      REAL*8 , DIMENSION(:,:,:), INTENT(  out) ::  e3t_0, e3u_0, e3v_0, e3f_0, e3w_0, e3uw_0, e3vw_0
+      !
+      !!---------------------------------------------------------------------
+      
+      ALLOCATE( zprt(nx,ny,N), gdept_0(nx,ny,N), gdepw_0(nx,ny,N) )
+      !
+      ! bathymetry in level (from bathy_meter)
+      ! ===================
+      zmax = gdepw_1d(N) + e3t_1d(N)        ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_1d(N-1) )
+      zbathy(:,:) = MIN( zmax ,  zbathy(:,:) )    ! bounded value of bathy (min already set at the end of zgr_bat)
+      WHERE( zbathy(:,:) == 0. )   ;   mbathy(:,:) = 0     ! land  : set mbathy to 0
+      ELSEWHERE                    ;   mbathy(:,:) = N-1   ! ocean : initialize mbathy to the max ocean level
+      END WHERE
+
+!!$      IF( partial_steps ) THEN
+         ! Compute mbathy for ocean points (i.e. the number of ocean levels)
+         ! find the number of ocean levels such that the last level thickness
+         ! is larger than the minimum of e3zps_min and e3zps_rat * e3t_1d (where
+         ! e3t_1d is the reference level thickness
+         DO jk = N-1, 1, -1
+            zdepth = gdepw_1d(jk) + MIN( e3zps_min, e3t_1d(jk)*e3zps_rat )
+            WHERE( 0. < zbathy(:,:) .AND. zbathy(:,:) <= zdepth )   mbathy(:,:) = jk-1
+         END DO
+!!$      ELSE
+!!$         DO jk = 1, N
+!!$            WHERE( 0. < zbathy(:,:) .AND. zbathy(:,:) >= gdepw_1d(jk) )   mbathy(:,:) = jk-1
+!!$         END DO        
+!!$      ENDIF
+      
+      ! Scale factors and depth at T- and W-points
+      DO jk = 1, N                        ! intitialization to the reference z-coordinate
+         gdept_0(:,:,jk) = gdept_1d(jk)
+         gdepw_0(:,:,jk) = gdepw_1d(jk)
+         e3t_0  (:,:,jk) = e3t_1d  (jk)
+         e3w_0  (:,:,jk) = e3w_1d  (jk)
+      END DO
+      
+      ! Bathy, iceshelf draft, scale factor and depth at T- and W- points in case of isf
+      !!clem: not implemented yet
+      !!      IF ( ln_isfcav == 1 ) CALL zgr_isf
+      !
+      ! Scale factors and depth at T- and W-points
+      ! IF ( ln_isfcav == 0 ) THEN
+      DO jj = 1, ny
+         DO ji = 1, nx
+            ik = mbathy(ji,jj)
+            IF( ik > 0 ) THEN               ! ocean point only
+               ! max ocean level case
+               IF( ik == N-1 ) THEN
+                  zdepwp = zbathy(ji,jj)
+                  ze3tp  = zbathy(ji,jj) - gdepw_1d(ik)
+                  ze3wp = 0.5 * e3w_1d(ik) * ( 1. + ( ze3tp/e3t_1d(ik) ) )
+                  e3t_0(ji,jj,ik  ) = ze3tp
+                  e3t_0(ji,jj,ik+1) = ze3tp
+                  e3w_0(ji,jj,ik  ) = ze3wp
+                  e3w_0(ji,jj,ik+1) = ze3tp
+                  gdepw_0(ji,jj,ik+1) = zdepwp
+                  gdept_0(ji,jj,ik  ) = gdept_1d(ik-1) + ze3wp
+                  gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + ze3tp
+                  !
+               ELSE                         ! standard case
+                  IF( zbathy(ji,jj) <= gdepw_1d(ik+1) ) THEN  ;   gdepw_0(ji,jj,ik+1) = zbathy(ji,jj)
+                  ELSE                                        ;   gdepw_0(ji,jj,ik+1) = gdepw_1d(ik+1)
+                  ENDIF
+                  !gm Bug?  check the gdepw_1d
+                  !       ... on ik
+                  gdept_0(ji,jj,ik) = gdepw_1d(ik) + ( gdepw_0(ji,jj,ik+1) - gdepw_1d(ik) )   &
+                     &                             * ((gdept_1d(     ik  ) - gdepw_1d(ik) )   &
+                     &                             / ( gdepw_1d(     ik+1) - gdepw_1d(ik) ))
+                  e3t_0  (ji,jj,ik) = e3t_1d  (ik) * ( gdepw_0 (ji,jj,ik+1) - gdepw_1d(ik) )   & 
+                     &                             / ( gdepw_1d(      ik+1) - gdepw_1d(ik) ) 
+                  e3w_0(ji,jj,ik) = 0.5 * ( gdepw_0(ji,jj,ik+1) + gdepw_1d(ik+1) - 2. * gdepw_1d(ik) )   &
+                     &                     * ( e3w_1d(ik) / ( gdepw_1d(ik+1) - gdepw_1d(ik) ) )
+                  !       ... on ik+1
+                  e3w_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik)
+                  e3t_0  (ji,jj,ik+1) = e3t_0  (ji,jj,ik)
+                  gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + e3t_0(ji,jj,ik)
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      !
+      ! DO jj = 1, ny
+      !    DO ji = 1, nx
+      !       ik = mbathy(ji,jj)
+      !       IF( ik > 0 ) THEN               ! ocean point only
+      !          e3tp (ji,jj) = e3t_0(ji,jj,ik)
+      !          e3wp (ji,jj) = e3w_0(ji,jj,ik)
+      !       ENDIF
+      !    END DO
+      ! END DO
+      ! END IF
+      !
+      ! Scale factors and depth at U-, V-, UW and VW-points
+      DO jk = 1, N                        ! initialisation to z-scale factors
+         e3u_0 (:,:,jk) = e3t_1d(jk)
+         e3v_0 (:,:,jk) = e3t_1d(jk)
+         e3uw_0(:,:,jk) = e3w_1d(jk)
+         e3vw_0(:,:,jk) = e3w_1d(jk)
+      END DO
+
+      DO jk = 1,N                         ! Computed as the minimum of neighbooring scale factors
+         DO jj = 1, ny-1
+            DO ji = 1, nx-1   ! vector opt.
+               e3u_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji+1,jj,jk) )
+               e3v_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji,jj+1,jk) )
+               e3uw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji+1,jj,jk) )
+               e3vw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji,jj+1,jk) )
+            END DO
+         END DO
+      END DO
+      
+!      IF ( ln_isfcav == 1 ) THEN
+!      ! (ISF) define e3uw (adapted for 2 cells in the water column)
+!         DO jj = 2, ny-1 
+!            DO ji = 2, nx-1   ! vector opt. 
+!               ikb = MAX(mbathy (ji,jj),mbathy (ji+1,jj))
+!               ikt = MAX(misfdep(ji,jj),misfdep(ji+1,jj))
+!               IF (ikb == ikt+1) e3uw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji+1,jj  ,ikb  ) ) &
+!                                       &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji+1,jj  ,ikb-1) )
+!               ikb = MAX(mbathy (ji,jj),mbathy (ji,jj+1))
+!               ikt = MAX(misfdep(ji,jj),misfdep(ji,jj+1))
+!               IF (ikb == ikt+1) e3vw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji  ,jj+1,ikb  ) ) &
+!                                       &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji  ,jj+1,ikb-1) )
+!            END DO
+!         END DO
+!      END IF
+      !
+
+      DO jk = 1, N                        ! set to z-scale factor if zero (i.e. along closed boundaries)
+         WHERE( e3u_0 (:,:,jk) == 0. )   e3u_0 (:,:,jk) = e3t_1d(jk)
+         WHERE( e3v_0 (:,:,jk) == 0. )   e3v_0 (:,:,jk) = e3t_1d(jk)
+         WHERE( e3uw_0(:,:,jk) == 0. )   e3uw_0(:,:,jk) = e3w_1d(jk)
+         WHERE( e3vw_0(:,:,jk) == 0. )   e3vw_0(:,:,jk) = e3w_1d(jk)
+      END DO
+      
+      ! Scale factor at F-point
+      DO jk = 1, N                        ! initialisation to z-scale factors
+         e3f_0(:,:,jk) = e3t_1d(jk)
+      END DO
+      DO jk = 1, N                        ! Computed as the minimum of neighbooring V-scale factors
+         DO jj = 1, ny-1
+            DO ji = 1, nx-1   ! vector opt.
+               e3f_0(ji,jj,jk) = MIN( e3v_0(ji,jj,jk), e3v_0(ji+1,jj,jk) )
+            END DO
+         END DO
+      END DO
+      !
+      DO jk = 1, N                        ! set to z-scale factor if zero (i.e. along closed boundaries)
+         WHERE( e3f_0(:,:,jk) == 0. )   e3f_0(:,:,jk) = e3t_1d(jk)
+      END DO
+
+      ! Control of the sign
+      IF( MINVAL( e3t_0  (:,:,:) ) <= 0. )   STOP '    zgr_zps :   e r r o r   e3t_0 <= 0' 
+      IF( MINVAL( e3w_0  (:,:,:) ) <= 0. )   STOP '    zgr_zps :   e r r o r   e3w_0 <= 0' 
+      IF( MINVAL( gdept_0(:,:,:) ) <  0. )   STOP '    zgr_zps :   e r r o r   gdept_0 <  0' 
+      IF( MINVAL( gdepw_0(:,:,:) ) <  0. )   STOP '    zgr_zps :   e r r o r   gdepw_0 <  0' 
+     
+      ! Compute gde3w_0 (vertical sum of e3w)
+!      IF ( ln_isfcav ==1 ) THEN ! if cavity
+!         WHERE( misfdep == 0 )   misfdep = 1
+!         DO jj = 1,ny
+!            DO ji = 1,nx
+!               gde3w_0(ji,jj,1) = 0.5 * e3w_0(ji,jj,1)
+!               DO jk = 2, misfdep(ji,jj)
+!                  gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk) 
+!               END DO
+!               IF( misfdep(ji,jj) >= 2 )   gde3w_0(ji,jj,misfdep(ji,jj)) = risfdep(ji,jj) + 0.5 * e3w_0(ji,jj,misfdep(ji,jj))
+!               DO jk = misfdep(ji,jj) + 1, N
+!                  gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk) 
+!               END DO
+!            END DO
+!         END DO
+!      ELSE ! no cavity
+!         gde3w_0(:,:,1) = 0.5 * e3w_0(:,:,1)
+!         DO jk = 2, N
+!            gde3w_0(:,:,jk) = gde3w_0(:,:,jk-1) + e3w_0(:,:,jk)
+!         END DO
+!      END IF
+      !
+      DEALLOCATE( zprt, gdept_0, gdepw_0 )
+      !
+   END SUBROUTINE zgr_zps
+
+  !*****************************************************
+  !   function set_child_name(Parentname,Childname)
+  !*****************************************************
+  !
+  SUBROUTINE set_child_name(Parentname,Childname)
+    !
+    CHARACTER(*),INTENT(in) :: Parentname
+    CHARACTER(*),INTENT(out) :: Childname
+    CHARACTER(2) :: prefix
+    INTEGER :: pos
+    !   
+    pos  = INDEX(TRIM(Parentname),'/',back=.TRUE.)
+    !
+    prefix=Parentname(pos+1:pos+2)
+    IF (prefix == '1_') THEN
+       Childname = '2_'//Parentname(pos+3:LEN(Parentname)) 
+    ELSEIF (prefix == '2_') THEN
+       Childname = '3_'//Parentname(pos+3:LEN(Parentname)) 
+    ELSEIF (prefix == '3_') THEN
+       Childname = '4_'//Parentname(pos+3:LEN(Parentname)) 
+    ELSEIF (prefix == '4_') THEN
+       Childname = '5_'//Parentname(pos+3:LEN(Parentname)) 
+    ELSE
+       Childname = '1_'//Parentname(pos+1:LEN(Parentname)) 
+    ENDIF
+    !   
+  END SUBROUTINE set_child_name
+  !
+  !*****************************************************
+  !   subroutine get_interptype(varname,interp_type,conservation)
+  !*****************************************************
+  !
+  SUBROUTINE get_interptype( varname,interp_type,conservation )
+    !
+    LOGICAL,OPTIONAL :: conservation
+    CHARACTER(*) :: interp_type,varname
+    INTEGER :: pos,pos1,pos2,pos3,i,k 
+    LOGICAL :: find        
+    i=1
+    DO WHILE ( TRIM(VAR_INTERP(i)) /= '' )     
+       pos = INDEX( TRIM(VAR_INTERP(i)) , TRIM(varname) )
+       IF ( pos .NE. 0 ) THEN      
+          pos1 = INDEX( TRIM(VAR_INTERP(i)) , 'bicubic' )
+          pos2 = INDEX( TRIM(VAR_INTERP(i)) , 'bilinear' )
+          pos3 = INDEX( TRIM(VAR_INTERP(i)) , 'conservative' )
+          ! initialize interp_type
+          IF( pos1 .NE. 0 ) interp_type = 'bicubic'
+          IF( pos2 .NE. 0 ) interp_type = 'bilinear'
+          IF( pos1 .EQ. 0 .AND. pos2 .EQ. 0) interp_type = 'bicubic'
+          ! initialize conservation                                           
+          IF( pos3 .NE. 0 .AND. PRESENT(conservation) ) THEN
+             conservation = .TRUE.
+             RETURN
+          ELSE 
+             conservation = .FALSE.
+          ENDIF
+          find = .FALSE.
+          IF( PRESENT(conservation) ) THEN
+             k=0
+             conservation = .FALSE.         
+             DO WHILE( k < SIZE(flxtab) .AND. .NOT.find ) 
+                k = k+1
+                IF( TRIM(varname) .EQ. TRIM(flxtab(k)) ) THEN       
+                   conservation = .TRUE.
+                   find = .TRUE.
+                ENDIF
+             END DO
+          ENDIF
+          RETURN
+       ENDIF
+       i = i+1
+    END DO
+    !default values interp_type = bicubic // conservation = false      
+    interp_type = 'bicubic'      
+    IF( PRESENT(conservation) ) conservation = .FALSE.
+
+    RETURN
+    !   
+  END SUBROUTINE get_interptype
+  !      
+  !*****************************************************
+  !   subroutine Init_mask(name,Grid)
+  !*****************************************************
+  !
+  SUBROUTINE Init_mask(name,Grid,jpiglo,jpjglo)
+    !
+    USE io_netcdf
+    !      
+    CHARACTER(*) name
+    INTEGER :: nx,ny,k,i,j,jpiglo,jpjglo
+    TYPE(Coordinates) :: Grid
+    REAL*8, POINTER, DIMENSION(:,:) ::zwf => NULL()
+    !
+    IF(jpiglo == 1 .AND. jpjglo == 1) THEN
+       CALL read_ncdf_var('Bathy_level',name,Grid%Bathy_level)
+    ELSE
+       CALL read_ncdf_var('Bathy_level',name,Grid%Bathy_level,(/jpizoom,jpjzoom/),(/jpiglo,jpjglo/) )
+    ENDIF
+
+
+    !
+    WRITE(*,*) 'Init masks in T,U,V,F points'    
+    !
+    nx = SIZE(Grid%Bathy_level,1)
+    ny = SIZE(Grid%Bathy_level,2)
+    !
+    !      
+    ALLOCATE(Grid%tmask(nx,ny,N), &
+         Grid%umask(nx,ny,N), &
+         Grid%vmask(nx,ny,N), &
+         Grid%fmask(nx,ny,N))
+    !
+    DO k = 1,N
+       !      
+       WHERE(Grid%Bathy_level(:,:) <= k-1 )    
+          Grid%tmask(:,:,k) = 0
+       ELSEWHERE
+          Grid%tmask(:,:,k) = 1
+       END WHERE
+       !
+    END DO
+    !
+    Grid%umask(1:nx-1,:,:) = Grid%tmask(1:nx-1,:,:)*Grid%tmask(2:nx,:,:)
+    Grid%vmask(:,1:ny-1,:) = Grid%tmask(:,1:ny-1,:)*Grid%tmask(:,2:ny,:)
+    !
+    Grid%umask(nx,:,:) = Grid%tmask(nx,:,:)
+    Grid%vmask(:,ny,:) = Grid%tmask(:,ny,:)
+    !      
+    Grid%fmask(1:nx-1,1:ny-1,:) = Grid%tmask(1:nx-1,1:ny-1,:)*Grid%tmask(2:nx,1:ny-1,:)* &
+         Grid%tmask(1:nx-1,2:ny,:)*Grid%tmask(2:nx,2:ny,:) 
+    !
+    Grid%fmask(nx,:,:) = Grid%tmask(nx,:,:)
+    Grid%fmask(:,ny,:) = Grid%tmask(:,ny,:)
+    !
+    ALLOCATE(zwf(nx,ny))
+    !     
+    DO k = 1,N
+       !
+       zwf(:,:) = Grid%fmask(:,:,k)
+       !         
+       DO j = 2, ny-1
+          DO i = 2,nx-1            
+             IF( Grid%fmask(i,j,k) == 0. ) THEN               
+                Grid%fmask(i,j,k) = shlat * MIN(1.,MAX( zwf(i+1,j),zwf(i,j+1),zwf(i-1,j),zwf(i,j-1)))
+             END IF
+          END DO
+       END DO
+       !
+       DO j = 2, ny-1
+          IF( Grid%fmask(1,j,k) == 0. ) THEN
+             Grid%fmask(1,j,k) = shlat * MIN(1.,MAX(zwf(2,j),zwf(1,j+1),zwf(1,j-1)))
+          ENDIF
+
+          IF( Grid%fmask(nx,j,k) == 0. ) THEN
+             Grid%fmask(nx,j,k) = shlat * MIN(1.,MAX(zwf(nx,j+1),zwf(nx-1,j),zwf(nx,j-1)))
+          ENDIF
+       END DO
+       !         
+       DO i = 2, nx-1         
+          IF( Grid%fmask(i,1,k) == 0. ) THEN
+             Grid%fmask(i, 1 ,k) = shlat*MIN( 1.,MAX(zwf(i+1,1),zwf(i,2),zwf(i-1,1)))
+          ENDIF
+          !            
+          IF( Grid%fmask(i,ny,k) == 0. ) THEN
+             Grid%fmask(i,ny,k) = shlat * MIN(1.,MAX(zwf(i+1,ny),zwf(i-1,ny),zwf(i,ny-1)))
+          ENDIF
+       END DO
+       !!
+    END DO
+    !!      
+  END SUBROUTINE Init_mask
+  !
+  !*****************************************************
+  !   subroutine Init_Tmask(name,Grid)
+  !*****************************************************
+  !
+  SUBROUTINE Init_Tmask(name,Grid,jpiglo,jpjglo)
+    !
+    USE io_netcdf
+    !      
+    CHARACTER(*) name
+    INTEGER :: nx,ny,k,i,j,jpiglo,jpjglo
+    TYPE(Coordinates) :: Grid
+    REAL*8, POINTER, DIMENSION(:,:) ::zwf => NULL()
+    !
+    IF(jpiglo == 1 .AND. jpjglo == 1) THEN
+       CALL read_ncdf_var('Bathy_level',name,Grid%Bathy_level)
+    ELSE
+       CALL read_ncdf_var('Bathy_level',name,Grid%Bathy_level,(/jpizoom,jpjzoom/),(/jpiglo,jpjglo/) )
+    ENDIF
+    !
+    nx = SIZE(Grid%Bathy_level,1)
+    ny = SIZE(Grid%Bathy_level,2) 
+    !
+    WRITE(*,*) 'Init masks in T points'    
+    !     
+    ALLOCATE( Grid%tmask(nx,ny,N) )
+    !
+    DO k = 1,N
+       !      
+       WHERE(Grid%Bathy_level(:,:) <= k-1 )    
+          Grid%tmask(:,:,k) = 0.
+       ELSEWHERE
+          Grid%tmask(:,:,k) = 1.
+       END WHERE
+       !
+    END DO
+    !      
+  END SUBROUTINE Init_Tmask
+  !
+  !*****************************************************
+  !   subroutine Init_ssmask(name,Grid)
+  !*****************************************************
+  !
+!  SUBROUTINE Init_ssmask(varname,filename,Grid,jpiglo,jpjglo)
+!    !
+!    USE io_netcdf
+!    !      
+!    CHARACTER(*) varname,filename
+!    INTEGER :: nx,ny,k,i,j,jpiglo,jpjglo
+!    TYPE(Coordinates) :: Grid
+!    REAL*8, POINTER, DIMENSION(:,:) ::zwf => NULL()
+!    !
+!    IF(jpiglo == 1 .AND. jpjglo == 1) THEN
+!       CALL read_ncdf_var(varname,filename,Grid%bathy_level)
+!    ELSE
+!       CALL read_ncdf_var(varname,filename,Grid%bathy_level,(/jpizoom,jpjzoom/),(/jpiglo,jpjglo/) )
+!    ENDIF
+!    !
+!    nx = SIZE(Grid%bathy_level,1)
+!    ny = SIZE(Grid%bathy_level,2) 
+!    !
+!    WRITE(*,*) 'Init surface masks in T points'    
+!    !     
+!    ALLOCATE( Grid%ssmask(nx,ny), Grid%ssumask(nx,ny), Grid%ssvmask(nx,ny) )
+!    !
+!    WHERE(Grid%bathy_level(:,:) <= 0. )    
+!       Grid%ssmask(:,:) = 0.
+!    ELSEWHERE
+!       Grid%ssmask(:,:) = 1.
+!    END WHERE
+!    !
+!    Grid%ssumask(1:nx-1,:) = Grid%ssmask(1:nx-1,:)*Grid%ssmask(2:nx,:)
+!    Grid%ssvmask(:,1:ny-1) = Grid%ssmask(:,1:ny-1)*Grid%ssmask(:,2:ny)
+!    !
+!    Grid%ssumask(nx,:) = Grid%ssmask(nx,:)
+!    Grid%ssvmask(:,ny) = Grid%ssmask(:,ny)
+!    !      
+!  END SUBROUTINE Init_ssmask
+  !
+  !*****************************************************
+  !   subroutine get_mask(name,Grid)
+  !*****************************************************
+  !
+  SUBROUTINE get_mask(level,posvar,mask,filename)
+    !
+    USE io_netcdf
+    !      
+    CHARACTER(*) filename
+    CHARACTER(*) posvar
+    INTEGER :: level, nx, ny
+    LOGICAL,DIMENSION(:,:),POINTER :: mask
+    INTEGER,DIMENSION(:,:),POINTER :: maskT,maskU,maskV
+    !      
+    TYPE(Coordinates) :: Grid
+    !
+    CALL read_ncdf_var('Bathy_level',filename,Grid%Bathy_level)
+    ! 
+    nx = SIZE(Grid%Bathy_level,1)
+    ny = SIZE(Grid%Bathy_level,2)
+    ALLOCATE(maskT(nx,ny),mask(nx,ny))
+    mask = .TRUE.
+    !
+    WHERE(Grid%Bathy_level(:,:) <= level-1 )    
+       maskT(:,:) = 0
+    ELSEWHERE
+       maskT(:,:) = 1
+    END WHERE
+    !
+    SELECT CASE(posvar)
+       !
+    CASE('T')
+       !
+       WHERE(maskT > 0)
+          mask = .TRUE.
+       ELSEWHERE
+          mask = .FALSE.
+       END WHERE
+       DEALLOCATE(maskT)
+       !
+    CASE('U')
+       !
+       ALLOCATE(maskU(nx,ny))
+       maskU(1:nx-1,:) = maskT(1:nx-1,:)*maskT(2:nx,:)
+       maskU(nx,:) = maskT(nx,:)
+       WHERE(maskU > 0)
+          mask = .TRUE.
+       ELSEWHERE
+          mask = .FALSE.
+       END WHERE
+       DEALLOCATE(maskU,maskT)
+       !
+    CASE('V')
+       !
+       ALLOCATE(maskV(nx,ny))
+       maskV(:,1:ny-1) = maskT(:,1:ny-1)*maskT(:,2:ny)
+       maskV(:,ny) = maskT(:,ny)
+       WHERE(maskT > 0)
+          mask = .TRUE.
+       ELSEWHERE
+          mask = .FALSE.
+       END WHERE
+       DEALLOCATE(maskV,maskT)
+       !
+    END SELECT
+    !      
+  END SUBROUTINE get_mask
+  !
+  !
+  !*****************************************************
+  !   subroutine read_dimg_var(unit,irec,field)
+  !*****************************************************
+  !
+  SUBROUTINE read_dimg_var(unit,irec,field,jpk)
+    !      
+    INTEGER :: unit,irec,jpk
+    REAL*8,DIMENSION(:,:,:,:),POINTER :: field
+    INTEGER :: k
+    !      
+    DO k = 1,jpk
+       READ(unit,REC=irec) field(:,:,k,1)
+       irec = irec + 1
+    ENDDO
+    !
+  END SUBROUTINE read_dimg_var
+  ! 
+  !
+  !*****************************************************
+  !   subroutine read_dimg_var(unit,irec,field)
+  !*****************************************************
+  !
+  SUBROUTINE write_dimg_var(unit,irec,field,jpk)
+    !      
+    INTEGER :: unit,irec,jpk
+    REAL*8,DIMENSION(:,:,:,:),POINTER :: field
+    INTEGER :: k
+    !      
+    DO k = 1,jpk
+       WRITE(unit,REC=irec) field(:,:,k,1)
+       irec = irec + 1
+    ENDDO
+    !
+  END SUBROUTINE write_dimg_var
+
+END MODULE agrif_readwrite
Index: /utils/tools_ticket2413/NESTING/src/agrif_types.f90
===================================================================
--- /utils/tools_ticket2413/NESTING/src/agrif_types.f90	(revision 12863)
+++ /utils/tools_ticket2413/NESTING/src/agrif_types.f90	(revision 12863)
@@ -0,0 +1,249 @@
+!************************************************************************
+! Fortran 95 OPA Nesting tools						*
+!									*
+!     Copyright (C) 2005 Florian Lemarié (Florian.Lemarie@imag.fr)	*
+!									*
+!************************************************************************
+!      
+MODULE agrif_types
+  !
+  PUBLIC
+  !   
+  !*****************************
+  ! Coordinates type definition 
+  !*****************************
+  TYPE Coordinates
+     !
+     REAL*8,  DIMENSION(:,:),  POINTER :: nav_lon, nav_lat => NULL()
+     REAL*8,  DIMENSION(:,:),  POINTER :: glamv, glamu, glamt, glamf => NULL()
+     REAL*8,  DIMENSION(:,:),  POINTER :: gphit, gphiu, gphiv, gphif => NULL()
+     REAL*8,  DIMENSION(:,:),  POINTER :: e1t, e1u, e1v, e1f => NULL()
+     REAL*8,  DIMENSION(:,:),  POINTER :: e2t, e2u, e2v, e2f => NULL()
+     REAL*8,  DIMENSION(:,:),  POINTER :: bathy_level => NULL()
+     REAL*8,  DIMENSION(:,:),  POINTER :: bathy_meter => NULL()
+     REAL*8,  DIMENSION(:,:),  POINTER :: wgt => NULL()
+     REAL*8,  DIMENSION(:,:,:),POINTER :: fmask, umask, vmask, tmask => NULL()
+     REAL*8,  DIMENSION(:,:,:),POINTER :: e3t_ps, e3w_ps, gdept_ps, gdepwps => NULL()
+     REAL*8,  DIMENSION(:,:),  POINTER :: gdepw_ps => NULL()
+     REAL*8,  DIMENSION(:),    POINTER :: gdeptht => NULL()
+     INTEGER, DIMENSION(:) ,   POINTER :: time_steps => NULL()
+     !     
+  END TYPE Coordinates
+  !
+  !
+  !
+  CHARACTER*8,DIMENSION(10) :: flxtab = (/'socliot1','socliot2','socliopl', &
+       'socliocl','socliohu','socliowi','soshfldo','sohefldo','sowaflup','sofbt   '/)
+  !
+  !
+  !**************************************************************
+  ! Declaration of various input file variables (namelist.input) 
+  !**************************************************************
+  !
+  INTEGER ::   irafx, irafy
+  INTEGER ::   nxfin, nyfin
+  !      
+  INTEGER ::   nbghostcellsfine, imin, jmin, imax, jmax, rho, rhot
+  INTEGER ::   shlat
+  INTEGER ::   N, type_bathy_interp
+  ! 
+  INTEGER ::   jpizoom, jpjzoom, npt_connect, npt_copy
+  INTEGER ::   parent_jperio
+  !      
+  REAL*8 ::   rn_hmin
+  REAL*8 ::   ppkth2, ppacr2, ppkth, ppacr, ppdzmin, pphmax, smoothing_factor, e3zps_min, e3zps_rat
+  REAL*8 ::   psur, pa0, pa1, pa2, adatrj
+  !       
+  LOGICAL ::   ldbletanh, ln_e3_dep
+  LOGICAL ::   partial_steps, smoothing, bathy_update
+  LOGICAL ::   new_topo, removeclosedseas, dimg, iom_activated
+  LOGICAL ::   ln_agrif_domain
+  !       
+  CHARACTER*100 ::   parent_bathy_level, parent_level_name, parent_bathy_meter, parent_meter_name, parent_domcfg_out
+  CHARACTER*100 ::   elevation_name, elevation_database
+  CHARACTER*100 ::   parent_coordinate_file, parent_bathy_meter_updated, parent_domcfg_updated, &
+     &               restart_file, restart_trc_file, restart_ice_file
+  CHARACTER*100 ::   dimg_output_file, interp_type
+  !      
+  CHARACTER(len=80) , DIMENSION(20) :: flx_Files, u_files, v_files
+  CHARACTER(len=255), DIMENSION(20) :: VAR_INTERP
+  !
+  NAMELIST /input_output/iom_activated
+  !
+  NAMELIST /coarse_grid_files/parent_coordinate_file, parent_bathy_level, parent_level_name, &
+     &                                                parent_bathy_meter, parent_meter_name, parent_domcfg_out, &
+     &                                                parent_jperio
+  !      
+  NAMELIST /bathymetry/new_topo, elevation_database, elevation_name, smoothing, smoothing_factor,  &
+                       ln_agrif_domain, npt_connect, npt_copy, removeclosedseas, type_bathy_interp, rn_hmin      
+  !      
+  NAMELIST /nesting/nbghostcellsfine, imin, imax, jmin, jmax, rho, rhot, &
+     &              bathy_update, parent_bathy_meter_updated, parent_domcfg_updated      
+  !
+  NAMELIST /vertical_grid/ppkth, ppacr, ppdzmin, pphmax, psur, pa0, pa1, N, ldbletanh, ln_e3_dep, pa2, ppkth2, ppacr2
+  ! 
+  NAMELIST /partial_cells/partial_steps, e3zps_min, e3zps_rat      
+  !
+  NAMELIST /nemo_coarse_grid/ jpizoom, jpjzoom 
+  !          
+  NAMELIST /forcing_files/ flx_files,  u_files,  v_files 
+  !           
+  NAMELIST /interp/ VAR_INTERP
+  !      
+  NAMELIST /restart/ restart_file, shlat, dimg, dimg_output_file, adatrj, interp_type 
+  !
+  NAMELIST /restart_trc/ restart_trc_file, interp_type 
+  !
+  NAMELIST /restart_ice/ restart_ice_file, interp_type 
+  !
+CONTAINS
+  !
+  !********************************************************
+  !subroutine agrif_grid_allocate				*
+  !							*
+  !allocation of grid type elements 			*
+  !      according to nx and ny				*
+  !							*
+  !							*
+  !********************************************************
+  !       
+  SUBROUTINE agrif_grid_allocate(Grid, nx, ny)
+    !
+    TYPE(Coordinates) :: Grid
+    INTEGER :: nx, ny
+    !
+    ALLOCATE(Grid%nav_lon(nx,ny),Grid%nav_lat(nx,ny))
+    !
+    ALLOCATE(Grid%glamt(nx,ny),Grid%glamu(nx,ny),Grid%glamv(nx,ny),Grid%glamf(nx,ny))
+    ALLOCATE(Grid%gphit(nx,ny),Grid%gphiu(nx,ny),Grid%gphiv(nx,ny),Grid%gphif(nx,ny))
+    !
+    ALLOCATE(Grid%e1t(nx,ny),Grid%e1u(nx,ny),Grid%e1v(nx,ny),Grid%e1f(nx,ny))
+    ALLOCATE(Grid%e2t(nx,ny),Grid%e2u(nx,ny),Grid%e2v(nx,ny),Grid%e2f(nx,ny))
+    !
+    ALLOCATE(Grid%bathy_level(nx,ny))
+    !
+  END SUBROUTINE agrif_grid_allocate
+  !
+  !
+  !************************************************************************
+  !									*
+  !   subroutine read_namelist						*
+  !									*
+  !   read variables contained in namelist.input file   			*
+  !   filled in by user 							*
+  !									*
+  !************************************************************************
+  !
+  SUBROUTINE read_namelist(namelistname)
+    !
+    IMPLICIT NONE
+    CHARACTER(len=80) :: namelistname
+    CHARACTER*255 :: output
+    LOGICAL :: is_it_there
+    INTEGER unit_nml
+    !      
+    FLX_FILES  = ''
+    U_FILES    = ''
+    V_FILES    = ''
+    VAR_INTERP = ''
+    unit_nml = Agrif_Get_Unit()
+    !      
+    INQUIRE ( FILE = namelistname , EXIST = is_it_there )      
+    !
+    IF ( is_it_there ) THEN 
+       !
+       OPEN ( FILE   = namelistname , &
+            UNIT   =  unit_nml        , &
+            STATUS = 'OLD'            , &
+            FORM   = 'FORMATTED'      , &
+            ACTION = 'READ'           , &
+            ACCESS = 'SEQUENTIAL'     )
+       !
+       REWIND(unit_nml)
+       READ (unit_nml , NML = input_output)
+       READ (unit_nml , NML = coarse_grid_files)
+       READ (unit_nml , NML = bathymetry)
+       READ (unit_nml , NML = nesting) 
+       READ (unit_nml , NML = vertical_grid)
+       READ (unit_nml , NML = partial_cells)                    
+       READ (unit_nml , NML = nemo_coarse_grid ) 
+       READ (unit_nml , NML = forcing_files )  
+       READ (unit_nml , NML = interp )   
+       READ (unit_nml , NML = restart )
+       READ (unit_nml , NML = restart_trc )
+       READ (unit_nml , NML = restart_ice )
+       CLOSE(unit_nml)
+       !	
+       irafx = rho
+       irafy = rho
+       imin = imin + jpizoom - 1
+       imax = imax + jpizoom - 1
+       jmin = jmin + jpjzoom - 1
+       jmax = jmax + jpjzoom - 1
+       !
+       IF( ln_agrif_domain ) THEN
+          nxfin = (imax-imin)*irafx+2*nbghostcellsfine+2
+          nyfin = (jmax-jmin)*irafy+2*nbghostcellsfine+2
+       ELSE
+          bathy_update = .FALSE.
+          nbghostcellsfine = 0
+          nxfin = (imax-imin+1)*irafx
+          nyfin = (jmax-jmin+1)*irafy
+       ENDIF
+       !
+       IF( .NOT.partial_steps ) THEN
+          WRITE(*,*) 'E R R O R: partial_steps must be set to true otherwise very thin bottom layers can be created'
+          STOP
+       ENDIF
+       !
+    ELSE
+       !
+       PRINT *,'namelist file ''',TRIM(namelistname),''' not found'
+       STOP 
+       !
+    END IF
+    !
+    !
+  END SUBROUTINE read_namelist
+
+  INTEGER FUNCTION agrif_int(x)
+
+    REAL :: x
+    INTEGER ::i
+
+    i = FLOOR(x) + 1
+
+    IF( ABS(x - i).LE.0.0001 )THEN
+       agrif_int = i
+    ELSE
+       agrif_int = i-1
+    ENDIF
+
+  END FUNCTION agrif_int
+  !
+  !*************************************************
+  !   function Agrif_Get_Unit                             
+  !*************************************************
+  !
+
+  INTEGER FUNCTION Agrif_Get_Unit()
+    !
+    INTEGER n
+    LOGICAL op
+    INTEGER :: nunit
+    INTEGER :: iii,out,iiimax 
+    ! 
+    DO n = 7,1000
+       ! 
+       INQUIRE(Unit=n,Opened=op)
+       !
+       IF (.NOT.op) EXIT
+       !      
+    ENDDO
+    !
+    Agrif_Get_Unit=n
+    !
+    !
+  END FUNCTION Agrif_Get_Unit
+  !
+END MODULE agrif_types
Index: /utils/tools_ticket2413/NESTING/src/bicubic_interp.f90
===================================================================
--- /utils/tools_ticket2413/NESTING/src/bicubic_interp.f90	(revision 12863)
+++ /utils/tools_ticket2413/NESTING/src/bicubic_interp.f90	(revision 12863)
@@ -0,0 +1,1091 @@
+!
+MODULE bicubic_interp
+  !
+  USE agrif_modutil
+  !
+  !************************************************************************
+  ! 									*
+  ! MODULE  BICUBIC INTERP						*
+  ! 									*
+  ! bicubic interpolation routines from SCRIP package			*		
+  !									*
+  !http://climate.lanl.gov/Software/SCRIP/				*
+  !									*
+  !Bicubic remapping							*
+  !									*
+  !************************************************************************
+  !                 
+  IMPLICIT NONE
+  !
+  INTEGER :: grid1_size,grid2_size,grid1_rank, grid2_rank      
+  INTEGER, DIMENSION(:), POINTER :: grid1_dims, grid2_dims  
+  LOGICAL, DIMENSION(:), POINTER :: grid1_mask,grid2_mask        
+  REAL*8,DIMENSION(:),POINTER :: &
+       grid1_center_lat,  &
+       grid1_center_lon,  & 
+       grid2_center_lat,  &
+       grid2_center_lon,  &
+       grid1_frac,        & 
+       grid2_frac           
+  REAL*8,DIMENSION(:,:), POINTER :: grid1_bound_box,grid2_bound_box   
+  INTEGER, PARAMETER :: num_srch_bins = 90  
+  INTEGER,DIMENSION(:,:),POINTER :: bin_addr1,bin_addr2 
+  REAL*8, DIMENSION(:,:),POINTER :: bin_lats,bin_lons       
+  REAL*8, PARAMETER :: zero   = 0.0,  &
+       one    = 1.0,  &
+       two    = 2.0,  &
+       three  = 3.0,  &
+       four   = 4.0,  &
+       five   = 5.0,  & 
+       half   = 0.5,  &
+       quart  = 0.25, &
+       bignum = 1.e+20, &
+       tiny   = 1.e-14, &
+       pi     = 3.14159265359, &
+       pi2    = two*pi, &
+       pih    = half*pi        
+
+  REAL*8, PARAMETER :: deg2rad = pi/180.   
+  INTEGER , PARAMETER :: max_iter = 100   
+  REAL*8, PARAMETER :: converge = 1.e-10 
+  INTEGER, PARAMETER :: norm_opt_none    = 1 &
+       ,norm_opt_dstarea = 2 &
+       ,norm_opt_frcarea = 3
+  !
+  INTEGER, PARAMETER :: map_type_conserv  = 1 &
+       ,map_type_bilinear = 2 &
+       ,map_type_bicubic  = 3 &
+       ,map_type_distwgt  = 4
+  !
+  INTEGER :: max_links_map1  &  ! current size of link arrays
+       ,num_links_map1  &  ! actual number of links for remapping
+       ,max_links_map2  &  ! current size of link arrays
+       ,num_links_map2  &  ! actual number of links for remapping
+       ,num_maps        &  ! num of remappings for this grid pair
+       ,num_wts         &  ! num of weights used in remapping
+       ,map_type        &  ! identifier for remapping method
+       ,norm_opt        &  ! option for normalization (conserv only)
+       ,resize_increment ! default amount to increase array size
+
+  INTEGER , DIMENSION(:), POINTER :: &
+       bicubic_grid1_add_map1, &  ! grid1 address for each link in mapping 1
+       bicubic_grid2_add_map1, &  ! grid2 address for each link in mapping 1
+       grid1_add_map2, &  ! grid1 address for each link in mapping 2
+       grid2_add_map2   ! grid2 address for each link in mapping 2
+
+  REAL*8, DIMENSION(:,:), POINTER ::   &
+       bicubic_wts_map1, &   ! map weights for each link (num_wts,max_links)
+       wts_map2 => NULL()    ! map weights for each link (num_wts,max_links)
+
+
+
+
+
+
+CONTAINS
+
+
+
+
+
+
+
+  !***********************************************************************
+  SUBROUTINE get_remap_bicub(grid1_lat,grid2_lat,grid1_lon,grid2_lon,mask, &
+       remap_matrix,source_add,destination_add)
+
+    !-----------------------------------------------------------------------
+    !
+    !     this routine computes the weights for a bicubic interpolation.
+    !
+    !-----------------------------------------------------------------------
+    REAL*8,DIMENSION(:,:),POINTER :: grid1_lat,grid2_lat,grid1_lon,grid2_lon
+    LOGICAL,DIMENSION(:,:) :: mask
+    !      
+    INTEGER,DIMENSION(:),POINTER :: source_add,destination_add
+    REAL*8,DIMENSION(:,:),POINTER :: remap_matrix 
+    !-----------------------------------------------------------------------
+    !
+    !     local variables
+    !
+    !-----------------------------------------------------------------------
+
+    INTEGER :: n,icount,dst_add,iter,nx,ny,i,j,ip1,e_add,jp1,n_add,ne_add,nele
+    REAL*8, DIMENSION(4) :: tmp_lats, tmp_lons
+    INTEGER, DIMENSION(4) :: src_add
+
+    REAL*8, DIMENSION(4)  :: src_lats,src_lons
+    INTEGER lastsrc_add
+    REAL*8, DIMENSION(4,4)  :: wgts
+    REAL*8 :: dlat,dlon
+    REAL*8 :: plat, plon,iguess, jguess,thguess, phguess,deli, delj, &
+         dth1, dth2, dth3,dph1, dph2, dph3,dthp, dphp,          &
+         mat1, mat2, mat3, mat4,determinant,sum_wgts,           &
+         w1,w2,w3,w4,w5,w6,w7,w8,w9,w10,w11,w12,w13,w14,w15,w16
+
+
+    !-----------------------------------------------------------------------
+    !
+    !     compute mappings from grid1 to grid2
+    !
+    !-----------------------------------------------------------------------
+    !
+    ALLOCATE(grid1_dims(2),grid2_dims(2))
+    grid1_dims(1) = SIZE(grid1_lat,2)
+    grid1_dims(2) = SIZE(grid1_lat,1)
+    grid2_dims(1) = SIZE(grid2_lat,2)
+    grid2_dims(2) = SIZE(grid2_lat,1)
+    grid1_size = SIZE(grid1_lat,2) * SIZE(grid1_lat,1)
+    grid2_size = SIZE(grid2_lat,2) * SIZE(grid2_lat,1) 
+    !      
+    ALLOCATE( grid2_mask(grid2_size),         &
+         grid1_bound_box (4,grid1_size), &
+         grid2_bound_box (4,grid2_size), &
+         grid1_frac      (grid1_size),   &
+         grid2_frac      (grid2_size))
+
+    grid1_frac = zero
+    grid2_frac = zero
+
+    !
+    ! 2D array -> 1D array
+    !
+    ALLOCATE(grid1_center_lat(SIZE(grid1_lat,1)*SIZE(grid1_lat,2)))
+    CALL tab2Dto1D(grid1_lat,grid1_center_lat)
+
+    ALLOCATE(grid1_center_lon(SIZE(grid1_lon,1)*SIZE(grid1_lon,2)))
+    CALL tab2Dto1D(grid1_lon,grid1_center_lon)
+
+    ALLOCATE(grid2_center_lat(SIZE(grid2_lat,1)*SIZE(grid2_lat,2)))
+    CALL tab2Dto1D(grid2_lat,grid2_center_lat)
+
+    ALLOCATE(grid2_center_lon(SIZE(grid2_lon,1)*SIZE(grid2_lon,2)))      
+    CALL tab2Dto1D(grid2_lon,grid2_center_lon) 
+
+    ALLOCATE(grid1_mask(SIZE(grid1_lat,1)*SIZE(grid1_lat,2)))
+    CALL logtab2Dto1D(mask,grid1_mask)
+    !      
+    !      Write(*,*) ,'grid1_mask = ',grid1_mask 
+    !              
+    !
+    ! degrees to radian
+    !
+    grid1_center_lat = grid1_center_lat*deg2rad
+    grid1_center_lon = grid1_center_lon*deg2rad
+    grid2_center_lat = grid2_center_lat*deg2rad
+    grid2_center_lon = grid2_center_lon*deg2rad
+
+    !-----------------------------------------------------------------------
+    !     convert longitudes to 0,2pi interval
+    !-----------------------------------------------------------------------
+
+    WHERE (grid1_center_lon .GT. pi2)  grid1_center_lon =       &
+         grid1_center_lon - pi2
+    WHERE (grid1_center_lon .LT. zero) grid1_center_lon =       &
+         grid1_center_lon + pi2
+    WHERE (grid2_center_lon .GT. pi2)  grid2_center_lon =       &
+         grid2_center_lon - pi2
+    WHERE (grid2_center_lon .LT. zero) grid2_center_lon =       &
+         grid2_center_lon + pi2
+
+    !-----------------------------------------------------------------------
+    !
+    !     make sure input latitude range is within the machine values
+    !     for +/- pi/2 
+    !
+    !-----------------------------------------------------------------------
+
+    WHERE (grid1_center_lat >  pih) grid1_center_lat =  pih
+    WHERE (grid1_center_lat < -pih) grid1_center_lat = -pih
+    WHERE (grid2_center_lat >  pih) grid2_center_lat =  pih
+    WHERE (grid2_center_lat < -pih) grid2_center_lat = -pih
+    !
+
+    !
+    !-----------------------------------------------------------------------
+    !
+    !     compute bounding boxes for restricting future grid searches
+    !
+    !-----------------------------------------------------------------------
+    !
+    nx = grid1_dims(1)
+    ny = grid1_dims(2)
+
+    DO n=1,grid1_size
+
+       !*** find N,S and NE points to this grid point
+
+       j = (n - 1)/nx +1
+       i = n - (j-1)*nx
+
+       IF (i < nx) THEN
+          ip1 = i + 1
+       ELSE
+          !*** assume cyclic
+          ip1 = 1
+          !*** but if it is not, correct
+          e_add = (j - 1)*nx + ip1
+          IF (ABS(grid1_center_lat(e_add) -     &
+               grid1_center_lat(n   )) > pih) THEN
+             ip1 = i
+          ENDIF
+          ip1=nx
+       ENDIF
+
+       IF (j < ny) THEN
+          jp1 = j+1
+       ELSE
+          !*** assume cyclic
+          jp1 = 1
+          !*** but if it is not, correct
+          n_add = (jp1 - 1)*nx + i
+          IF (ABS(grid1_center_lat(n_add) -             &
+               grid1_center_lat(n   )) > pih) THEN
+             jp1 = j
+          ENDIF
+          jp1=ny
+       ENDIF
+
+       n_add = (jp1 - 1)*nx + i
+       e_add = (j - 1)*nx + ip1
+       ne_add = (jp1 - 1)*nx + ip1
+
+       !*** find N,S and NE lat/lon coords and check bounding box
+
+       tmp_lats(1) = grid1_center_lat(n)
+       tmp_lats(2) = grid1_center_lat(e_add)
+       tmp_lats(3) = grid1_center_lat(ne_add)
+       tmp_lats(4) = grid1_center_lat(n_add)
+
+       tmp_lons(1) = grid1_center_lon(n)
+       tmp_lons(2) = grid1_center_lon(e_add)
+       tmp_lons(3) = grid1_center_lon(ne_add)
+       tmp_lons(4) = grid1_center_lon(n_add)
+
+       grid1_bound_box(1,n) = MINVAL(tmp_lats)
+       grid1_bound_box(2,n) = MAXVAL(tmp_lats)
+
+       grid1_bound_box(3,n) = MINVAL(tmp_lons)
+       grid1_bound_box(4,n) = MAXVAL(tmp_lons)
+    END DO
+
+    nx = grid2_dims(1)
+    ny = grid2_dims(2)
+
+    DO n=1,grid2_size
+
+       !*** find N,S and NE points to this grid point
+
+       j = (n - 1)/nx +1
+       i = n - (j-1)*nx
+
+       IF (i < nx) THEN
+          ip1 = i + 1
+       ELSE
+          !*** assume cyclic
+          ip1 = 1
+          !*** but if it is not, correct
+          e_add = (j - 1)*nx + ip1
+          IF (ABS(grid2_center_lat(e_add) -  &
+               grid2_center_lat(n   )) > pih) THEN
+             ip1 = i
+          ENDIF
+       ENDIF
+
+       IF (j < ny) THEN
+          jp1 = j+1
+       ELSE
+          !*** assume cyclic
+          jp1 = 1
+          !*** but if it is not, correct
+          n_add = (jp1 - 1)*nx + i
+          IF (ABS(grid2_center_lat(n_add) -  &
+               grid2_center_lat(n   )) > pih) THEN
+             jp1 = j
+          ENDIF
+       ENDIF
+
+       n_add = (jp1 - 1)*nx + i
+       e_add = (j - 1)*nx + ip1
+       ne_add = (jp1 - 1)*nx + ip1
+
+       !*** find N,S and NE lat/lon coords and check bounding box
+
+       tmp_lats(1) = grid2_center_lat(n)
+       tmp_lats(2) = grid2_center_lat(e_add)
+       tmp_lats(3) = grid2_center_lat(ne_add)
+       tmp_lats(4) = grid2_center_lat(n_add)
+
+       tmp_lons(1) = grid2_center_lon(n)
+       tmp_lons(2) = grid2_center_lon(e_add)
+       tmp_lons(3) = grid2_center_lon(ne_add)
+       tmp_lons(4) = grid2_center_lon(n_add)
+
+       grid2_bound_box(1,n) = MINVAL(tmp_lats)
+       grid2_bound_box(2,n) = MAXVAL(tmp_lats)
+       grid2_bound_box(3,n) = MINVAL(tmp_lons)
+       grid2_bound_box(4,n) = MAXVAL(tmp_lons)
+    END DO
+    !
+    !
+    !
+    WHERE (ABS(grid1_bound_box(4,:) - grid1_bound_box(3,:)) > pi)
+       grid1_bound_box(3,:) = zero
+       grid1_bound_box(4,:) = pi2
+    END WHERE
+
+    WHERE (ABS(grid2_bound_box(4,:) - grid2_bound_box(3,:)) > pi)
+       grid2_bound_box(3,:) = zero
+       grid2_bound_box(4,:) = pi2
+    END WHERE
+
+    !***
+    !*** try to check for cells that overlap poles
+    !***
+
+    WHERE (grid1_center_lat > grid1_bound_box(2,:)) &
+         grid1_bound_box(2,:) = pih
+
+    WHERE (grid1_center_lat < grid1_bound_box(1,:)) &
+         grid1_bound_box(1,:) = -pih
+
+    WHERE (grid2_center_lat > grid2_bound_box(2,:)) &
+         grid2_bound_box(2,:) = pih
+
+    WHERE (grid2_center_lat < grid2_bound_box(1,:)) &
+         grid2_bound_box(1,:) = -pih
+
+    !-----------------------------------------------------------------------
+    !     set up and assign address ranges to search bins in order to 
+    !     further restrict later searches
+    !-----------------------------------------------------------------------
+
+    ALLOCATE(bin_addr1(2,num_srch_bins))
+    ALLOCATE(bin_addr2(2,num_srch_bins))
+    ALLOCATE(bin_lats (2,num_srch_bins))
+    ALLOCATE(bin_lons (2,num_srch_bins))
+
+    dlat = pi/num_srch_bins
+
+    DO n=1,num_srch_bins
+       bin_lats(1,n) = (n-1)*dlat - pih
+       bin_lats(2,n) =     n*dlat - pih
+       bin_lons(1,n) = zero
+       bin_lons(2,n) = pi2
+       bin_addr1(1,n) = grid1_size + 1
+       bin_addr1(2,n) = 0
+       bin_addr2(1,n) = grid2_size + 1
+       bin_addr2(2,n) = 0
+    END DO
+
+    DO nele=1,grid1_size
+       DO n=1,num_srch_bins
+          IF (grid1_bound_box(1,nele) <= bin_lats(2,n) .AND.   &
+               grid1_bound_box(2,nele) >= bin_lats(1,n)) THEN
+             bin_addr1(1,n) = MIN(nele,bin_addr1(1,n))
+             bin_addr1(2,n) = MAX(nele,bin_addr1(2,n))
+          ENDIF
+       END DO
+    END DO
+
+    DO nele=1,grid2_size
+       DO n=1,num_srch_bins
+          IF (grid2_bound_box(1,nele) <= bin_lats(2,n) .AND.    &
+               grid2_bound_box(2,nele) >= bin_lats(1,n)) THEN
+             bin_addr2(1,n) = MIN(nele,bin_addr2(1,n))
+             bin_addr2(2,n) = MAX(nele,bin_addr2(2,n))
+          ENDIF
+       END DO
+    END DO
+
+    CALL init_remap_vars    
+    !
+    !***
+    !*** loop over destination grid 
+    !***
+    !      
+    grid2_mask = .TRUE.
+    !
+    lastsrc_add=1
+    !         
+    WRITE(*,*) 'Bicubic remapping weights computation'
+    !      
+    DO dst_add = 1, grid2_size
+
+       plat = grid2_center_lat(dst_add)
+       plon = grid2_center_lon(dst_add)         
+       !           
+       !           
+       CALL grid_search_bicub(src_add, src_lats, src_lons,     &
+            plat, plon, grid1_dims,              &
+            grid1_center_lat, grid1_center_lon,  &
+            grid1_bound_box, bin_addr1, bin_addr2,lastsrc_add)
+       !        
+       !           
+       IF (src_add(1) > 0) THEN
+          DO n=1,4
+             IF (.NOT. grid1_mask(src_add(n))) src_add(1) = 0
+          END DO
+       ENDIF
+
+       !-----------------------------------------------------------------------
+       !
+       !       if point found, find local i,j coordinates for weights
+       !
+       !-----------------------------------------------------------------------
+
+       IF (src_add(1) > 0) THEN
+
+          grid2_frac(dst_add) = one
+          !
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          IF (dph1 >  three*pih) dph1 = dph1 - pi2
+          IF (dph2 >  three*pih) dph2 = dph2 - pi2
+          IF (dph3 >  three*pih) dph3 = dph3 - pi2
+          IF (dph1 < -three*pih) dph1 = dph1 + pi2
+          IF (dph2 < -three*pih) dph2 = dph2 + pi2
+          IF (dph3 < -three*pih) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+          iguess = half
+          jguess = half
+
+          DO iter=1,max_iter
+
+             dthp = plat-src_lats(1)-dth1*iguess- &
+                  dth2*jguess-dth3*iguess*jguess
+             dphp = plon - src_lons(1)
+
+             IF (dphp >  three*pih) dphp = dphp - pi2
+             IF (dphp < -three*pih) dphp = dphp + pi2
+
+             dphp = dphp - dph1*iguess - dph2*jguess - & 
+                  dph3*iguess*jguess
+             !
+             mat1 = dth1 + dth3*jguess
+             mat2 = dth2 + dth3*iguess
+             mat3 = dph1 + dph3*jguess
+             mat4 = dph2 + dph3*iguess
+             !
+             determinant = mat1*mat4 - mat2*mat3
+             !
+             deli = (dthp*mat4 - mat2*dphp)/determinant
+             delj = (mat1*dphp - dthp*mat3)/determinant
+             !
+             IF (ABS(deli) < converge .AND.            & 
+                  ABS(delj) < converge) EXIT
+             !
+             iguess = iguess + deli
+             jguess = jguess + delj
+
+          END DO
+
+          IF (iter <= max_iter) THEN
+             !
+             wgts(1,1) = (one - jguess**2*(three-two*jguess))*   &
+                  (one - iguess**2*(three-two*iguess))
+
+             wgts(1,2) = (one - jguess**2*(three-two*jguess))*   &
+                  iguess**2*(three-two*iguess)
+
+             wgts(1,3) = jguess**2*(three-two*jguess)*           &
+                  iguess**2*(three-two*iguess)
+
+             wgts(1,4) = jguess**2*(three-two*jguess)*           &
+                  (one - iguess**2*(three-two*iguess))
+
+             wgts(2,1) = (one - jguess**2*(three-two*jguess))*   &
+                  iguess*(iguess-one)**2
+
+             wgts(2,2) = (one - jguess**2*(three-two*jguess))*   &
+                  iguess**2*(iguess-one)
+
+             wgts(2,3) = jguess**2*(three-two*jguess)*           &
+                  iguess**2*(iguess-one)
+
+             wgts(2,4) =  jguess**2*(three-two*jguess)*          &
+                  iguess*(iguess-one)**2
+
+             wgts(3,1) =  jguess*(jguess-one)**2*                &
+                  (one - iguess**2*(three-two*iguess))
+
+             wgts(3,2) =  jguess*(jguess-one)**2*                &
+                  iguess**2*(three-two*iguess)                            
+
+             wgts(3,3) =  jguess**2*(jguess-one)*                &
+                  iguess**2*(three-two*iguess)
+
+             wgts(3,4) =  jguess**2*(jguess-one)*                &
+                  (one - iguess**2*(three-two*iguess))
+
+             wgts(4,1) =  iguess*(iguess-one)**2*                &
+                  jguess*(jguess-one)**2
+
+             wgts(4,2) =  iguess**2*(iguess-one)*                &
+                  jguess*(jguess-one)**2
+
+             wgts(4,3) =  iguess**2*(iguess-one)*                &
+                  jguess**2*(jguess-one)
+
+             wgts(4,4) =  iguess*(iguess-one)**2*                &
+                  jguess**2*(jguess-one)
+
+             CALL store_link_bicub(dst_add, src_add, wgts)
+
+          ELSE
+             STOP 'Iteration for i,j exceed max iteration count'
+          ENDIF
+          !
+       ELSE IF (src_add(1) < 0) THEN
+
+          src_add = ABS(src_add)
+          !
+          icount = 0
+          !          
+          DO n=1,4
+             IF (grid1_mask(src_add(n))) THEN
+                icount = icount + 1
+             ELSE
+                src_lats(n) = zero
+             ENDIF
+          END DO
+
+          IF (icount > 0) THEN
+
+             sum_wgts = SUM(src_lats)
+             wgts(1,1) = src_lats(1)/sum_wgts
+             wgts(1,2) = src_lats(2)/sum_wgts
+             wgts(1,3) = src_lats(3)/sum_wgts
+             wgts(1,4) = src_lats(4)/sum_wgts
+             wgts(2:4,:) = zero
+
+             CALL store_link_bicub(dst_add, src_add, wgts)
+
+          ENDIF
+
+       ENDIF
+       !
+    END DO
+    !              
+    ALLOCATE(remap_matrix(SIZE(bicubic_wts_map1,1),SIZE(bicubic_wts_map1,2)), &
+         source_add(num_links_map1),       &
+         destination_add(num_links_map1))
+
+    DO j = 1,SIZE(bicubic_wts_map1,2)
+       DO i = 1,SIZE(bicubic_wts_map1,1)
+
+          remap_matrix(i,j) = bicubic_wts_map1(i,j)
+
+       END DO
+    END DO
+    !        
+    source_add(:) = bicubic_grid1_add_map1(1:num_links_map1)
+    destination_add(:) = bicubic_grid2_add_map1(1:num_links_map1)
+    !                
+    !
+    WHERE(destination_add == 0)
+       destination_add = 1
+    END WHERE
+
+    WHERE(source_add == 0)
+       source_add = 1
+    END WHERE
+    !               
+    DEALLOCATE(grid1_bound_box,grid2_bound_box,grid1_center_lat,grid1_center_lon)
+    DEALLOCATE(grid2_center_lat,grid2_center_lon,bicubic_grid1_add_map1,bicubic_wts_map1)
+    DEALLOCATE(grid1_frac,grid2_frac,grid1_dims,grid2_dims,grid2_mask)
+    DEALLOCATE(bin_addr1,bin_addr2,bin_lats,bin_lons)
+    DEALLOCATE(grid1_mask,bicubic_grid2_add_map1)	
+    !
+    !-----------------------------------------------------------------------
+
+  END SUBROUTINE get_remap_bicub
+
+  !
+  !***********************************************************************
+
+  !***********************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE GRID_SEARCH_BILIN
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  SUBROUTINE grid_search_bicub(src_add, src_lats, src_lons,   &
+       plat, plon, src_grid_dims,      &
+       src_center_lat, src_center_lon, & 
+       src_grid_bound_box,             &
+       src_bin_add, dst_bin_add,lastsrc_add)
+
+    !-----------------------------------------------------------------------
+    !
+    !     this routine finds the location of the search point plat, plon
+    !     in the source grid and returns the corners needed for a bilinear
+    !     interpolation.
+    !
+    !-----------------------------------------------------------------------
+
+    !-----------------------------------------------------------------------
+    !     output variables
+    !-----------------------------------------------------------------------
+    !
+    ! address of each corner point enclosing P
+    !
+    INTEGER,DIMENSION(4) :: src_add  
+    REAL*8,DIMENSION(4) :: src_lats,src_lons  
+    !      
+    !-----------------------------------------------------------------------
+    !     input variables
+    !-----------------------------------------------------------------------
+    ! 
+    ! latitude, longitude of the search point
+    !
+    REAL*8, INTENT(in) :: plat,plon   
+    !
+    ! size of each src grid dimension
+    !
+    INTEGER, DIMENSION(2), INTENT(in) :: src_grid_dims  
+    !
+    ! latitude, longitude of each src grid center
+    !
+    REAL*8, DIMENSION(:), INTENT(in) :: src_center_lat,src_center_lon  
+    !
+    ! bound box for source grid
+    !
+    REAL*8, DIMENSION(:,:), INTENT(in) :: src_grid_bound_box 
+    !
+    ! latitude bins for restricting searches
+    !
+    INTEGER, DIMENSION(:,:), INTENT(in) ::src_bin_add,dst_bin_add 
+
+    INTEGER,OPTIONAL :: lastsrc_add
+    INTEGER :: loopsrc,l1,l2
+    !      
+    !-----------------------------------------------------------------------
+    !     local variables
+    !-----------------------------------------------------------------------
+    !
+    INTEGER :: n,next_n,srch_add,nx, ny,min_add, max_add,  &
+         i, j, jp1, ip1, n_add, e_add, ne_add
+
+
+    REAL*8 ::  vec1_lat, vec1_lon,vec2_lat, vec2_lon, cross_product,  &
+         cross_product_last,coslat_dst, sinlat_dst, coslon_dst, &
+         sinlon_dst,dist_min, distance 
+
+    !-----------------------------------------------------------------------
+    !     restrict search first using bins
+    !-----------------------------------------------------------------------
+
+    src_add = 0
+    min_add = SIZE(src_center_lat)
+    max_add = 1
+    DO n=1,num_srch_bins
+       IF (plat >= bin_lats(1,n) .AND. plat <= bin_lats(2,n) .AND. &
+            plon >= bin_lons(1,n) .AND. plon <= bin_lons(2,n)) THEN
+          min_add = MIN(min_add, src_bin_add(1,n))
+          max_add = MAX(max_add, src_bin_add(2,n))
+       ENDIF
+    END DO
+
+    !-----------------------------------------------------------------------
+    !     now perform a more detailed search 
+    !-----------------------------------------------------------------------
+
+    nx = src_grid_dims(1)
+    ny = src_grid_dims(2)
+
+    loopsrc=0
+    DO WHILE (loopsrc <= max_add)
+
+
+       l1=MAX(min_add,lastsrc_add-loopsrc)
+       l2=MIN(max_add,lastsrc_add+loopsrc)      
+
+       loopsrc = loopsrc+1
+
+       srch_loop: DO srch_add = l1,l2,MAX(l2-l1,1)
+
+          !*** first check bounding box
+
+          IF (plat <= src_grid_bound_box(2,srch_add) .AND. & 
+               plat >= src_grid_bound_box(1,srch_add) .AND.  &
+               plon <= src_grid_bound_box(4,srch_add) .AND.  &
+               plon >= src_grid_bound_box(3,srch_add)) THEN
+
+
+             !***
+             !*** we are within bounding box so get really serious
+             !***
+             !*** determine neighbor addresses
+             !
+             j = (srch_add - 1)/nx +1
+             i = srch_add - (j-1)*nx
+             !
+             IF (i < nx) THEN
+                ip1 = i + 1
+             ELSE
+                ip1 = 1
+             ENDIF
+             !
+             IF (j < ny) THEN
+                jp1 = j+1
+             ELSE
+                jp1 = 1
+             ENDIF
+             !
+             n_add = (jp1 - 1)*nx + i
+             e_add = (j - 1)*nx + ip1
+             ne_add = (jp1 - 1)*nx + ip1
+             !
+             src_lats(1) = src_center_lat(srch_add)
+             src_lats(2) = src_center_lat(e_add)
+             src_lats(3) = src_center_lat(ne_add)
+             src_lats(4) = src_center_lat(n_add)
+             !
+             src_lons(1) = src_center_lon(srch_add)
+             src_lons(2) = src_center_lon(e_add)
+             src_lons(3) = src_center_lon(ne_add)
+             src_lons(4) = src_center_lon(n_add)
+             !
+             !***
+             !*** for consistency, we must make sure all lons are in
+             !*** same 2pi interval
+             !***
+             !
+             vec1_lon = src_lons(1) - plon
+             IF (vec1_lon >  pi) THEN
+                src_lons(1) = src_lons(1) - pi2
+             ELSE IF (vec1_lon < -pi) THEN
+                src_lons(1) = src_lons(1) + pi2
+             ENDIF
+             DO n=2,4
+                vec1_lon = src_lons(n) - src_lons(1)
+                IF (vec1_lon >  pi) THEN
+                   src_lons(n) = src_lons(n) - pi2
+                ELSE IF (vec1_lon < -pi) THEN
+                   src_lons(n) = src_lons(n) + pi2
+                ENDIF
+             END DO
+             !
+             corner_loop: DO n=1,4
+                next_n = MOD(n,4) + 1
+                !***
+                !*** here we take the cross product of the vector making 
+                !*** up each box side with the vector formed by the vertex
+                !*** and search point.  if all the cross products are 
+                !*** positive, the point is contained in the box.
+                !***
+                vec1_lat = src_lats(next_n) - src_lats(n)
+                vec1_lon = src_lons(next_n) - src_lons(n)
+                vec2_lat = plat - src_lats(n)
+                vec2_lon = plon - src_lons(n)
+                !***
+                !*** check for 0,2pi crossings
+                !***
+                IF (vec1_lon >  three*pih) THEN
+                   vec1_lon = vec1_lon - pi2
+                ELSE IF (vec1_lon < -three*pih) THEN
+                   vec1_lon = vec1_lon + pi2
+                ENDIF
+                IF (vec2_lon >  three*pih) THEN
+                   vec2_lon = vec2_lon - pi2
+                ELSE IF (vec2_lon < -three*pih) THEN
+                   vec2_lon = vec2_lon + pi2
+                ENDIF
+                !
+                cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+                !
+                !***
+                !*** if cross product is less than zero, this cell
+                !*** doesn't work
+                !***
+                IF (n == 1) cross_product_last = cross_product
+                IF (cross_product*cross_product_last < zero) &
+                     EXIT corner_loop
+                cross_product_last = cross_product
+                !
+             END DO corner_loop
+             !***
+             !*** if cross products all same sign, we found the location
+             !***
+             IF (n > 4) THEN
+                src_add(1) = srch_add
+                src_add(2) = e_add
+                src_add(3) = ne_add
+                src_add(4) = n_add
+                !
+                lastsrc_add = srch_add
+                RETURN
+             ENDIF
+             !***
+             !*** otherwise move on to next cell
+             !***
+          ENDIF !bounding box check
+       END DO srch_loop
+
+
+    ENDDO
+
+    !***
+    !*** if no cell found, point is likely either in a box that
+    !*** straddles either pole or is outside the grid.  fall back
+    !*** to a distance-weighted average of the four closest
+    !*** points.  go ahead and compute weights here, but store
+    !*** in src_lats and return -add to prevent the parent
+    !*** routine from computing bilinear weights
+    !***
+    !print *,'Could not find location for ',plat,plon
+    !print *,'Using nearest-neighbor average for this point'
+    !
+    coslat_dst = COS(plat)
+    sinlat_dst = SIN(plat)
+    coslon_dst = COS(plon)
+    sinlon_dst = SIN(plon)
+    !
+    dist_min = bignum
+    src_lats = bignum
+    DO srch_add = min_add,max_add
+       distance = ACOS(coslat_dst*COS(src_center_lat(srch_add))*   &
+            (coslon_dst*COS(src_center_lon(srch_add)) +   &
+            sinlon_dst*SIN(src_center_lon(srch_add)))+   &
+            sinlat_dst*SIN(src_center_lat(srch_add)))
+
+       IF (distance < dist_min) THEN
+          sort_loop: DO n=1,4
+             IF (distance < src_lats(n)) THEN
+                DO i=4,n+1,-1
+                   src_add (i) = src_add (i-1)
+                   src_lats(i) = src_lats(i-1)
+                END DO
+                src_add (n) = -srch_add
+                src_lats(n) = distance
+                dist_min = src_lats(4)
+                EXIT sort_loop
+             ENDIF
+          END DO sort_loop
+       ENDIF
+    END DO
+    !
+    src_lons = one/(src_lats + tiny)
+    distance = SUM(src_lons)
+    src_lats = src_lons/distance
+
+    !-----------------------------------------------------------------------
+
+  END SUBROUTINE grid_search_bicub
+
+
+
+
+
+
+
+
+
+
+
+
+
+  !-----------------------------------------------------------------------
+
+  SUBROUTINE store_link_bicub(dst_add, src_add, weights)
+
+    !-----------------------------------------------------------------------
+    !
+    !     this routine stores the address and weight for four links 
+    !     associated with one destination point in the appropriate address 
+    !     and weight arrays and resizes those arrays if necessary.
+    !
+    !-----------------------------------------------------------------------
+
+    !-----------------------------------------------------------------------
+    !
+    !     input variables
+    !
+    !-----------------------------------------------------------------------
+
+    INTEGER :: dst_add
+    INTEGER, DIMENSION(4) :: src_add
+    REAL*8, DIMENSION(4,4) :: weights 
+
+    !-----------------------------------------------------------------------
+    !
+    !     local variables
+    !
+    !-----------------------------------------------------------------------
+
+    INTEGER :: n,num_links_old
+
+    !-----------------------------------------------------------------------
+    !
+    !     increment number of links and check to see if remap arrays need
+    !     to be increased to accomodate the new link.  then store the
+    !     link.
+    !
+    !-----------------------------------------------------------------------
+
+
+    num_links_old  = num_links_map1
+    num_links_map1 = num_links_old + 4
+
+    IF (num_links_map1 > max_links_map1)    & 
+         CALL resize_remap_vars(resize_increment)
+
+    DO n=1,4
+       bicubic_grid1_add_map1(num_links_old+n) = src_add(n)
+       bicubic_grid2_add_map1(num_links_old+n) = dst_add
+       bicubic_wts_map1    (:,num_links_old+n) = weights(:,n)
+    END DO
+
+
+
+
+
+    !-----------------------------------------------------------------------
+
+  END SUBROUTINE store_link_bicub
+
+  !***********************************************************************
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+  !
+  !************************************************************************
+  !   SUBROUTINE INIT_REMAP_VAR
+  !************************************************************************
+  !
+  SUBROUTINE init_remap_vars
+    !
+    num_wts = 4
+    !
+    num_links_map1 = 0
+    max_links_map1 = 4*grid2_size
+    IF (num_maps > 1) THEN
+       num_links_map2 = 0
+       max_links_map1 = MAX(4*grid1_size,4*grid2_size)
+       max_links_map2 = max_links_map1
+    ENDIF
+
+    resize_increment = 0.1*MAX(grid1_size,grid2_size)
+    !
+    !-----------------------------------------------------------------------
+    !
+    !     allocate address and weight arrays for mapping 1
+    !   
+    !-----------------------------------------------------------------------
+    !
+    ALLOCATE (bicubic_grid1_add_map1(max_links_map1),  &
+         bicubic_grid2_add_map1(max_links_map1),  &
+         bicubic_wts_map1(num_wts, max_links_map1))
+
+    !-----------------------------------------------------------------------
+    !
+    !     allocate address and weight arrays for mapping 2 if necessary 
+    !   
+    !-----------------------------------------------------------------------
+
+    IF (num_maps > 1) THEN
+       ALLOCATE (grid1_add_map2(max_links_map2),    &
+            grid2_add_map2(max_links_map2),    &
+            wts_map2(num_wts, max_links_map2))
+    ENDIF
+
+    !-----------------------------------------------------------------------
+
+  END SUBROUTINE init_remap_vars
+
+  !***********************************************************************
+  !************************************************************************
+  !   SUBROUTINE RESIZE_REMAP_VAR
+  !************************************************************************
+
+  SUBROUTINE resize_remap_vars(increment)
+
+    !-----------------------------------------------------------------------
+    !     this routine resizes remapping arrays by increasing(decreasing)
+    !     the max_links by increment
+    !-----------------------------------------------------------------------
+
+    !-----------------------------------------------------------------------
+    !     input variables
+    !-----------------------------------------------------------------------
+
+    INTEGER :: increment
+
+    !-----------------------------------------------------------------------
+    !     local variables
+    !-----------------------------------------------------------------------
+
+    INTEGER ::    &
+         ierr,    &  ! error flag
+         mxlinks   ! size of link arrays
+
+    INTEGER, DIMENSION(:), POINTER ::    &
+         add1_tmp,   & ! temp array for resizing address arrays
+         add2_tmp  ! temp array for resizing address arrays
+    !
+    ! temp array for resizing weight arrays
+    !
+    REAL*8, DIMENSION(:,:), POINTER :: wts_tmp   
+    !
+    !-----------------------------------------------------------------------
+    !***
+    !*** allocate temporaries to hold original values
+    !***
+    mxlinks = SIZE(bicubic_grid1_add_map1)
+    ALLOCATE (add1_tmp(mxlinks), add2_tmp(mxlinks), &
+         wts_tmp(num_wts,mxlinks))
+
+    add1_tmp = bicubic_grid1_add_map1
+    add2_tmp = bicubic_grid2_add_map1
+    wts_tmp  = bicubic_wts_map1
+
+    !***
+    !*** deallocate originals and increment max_links then
+    !*** reallocate arrays at new size
+    !***
+
+    DEALLOCATE (bicubic_grid1_add_map1, bicubic_grid2_add_map1, bicubic_wts_map1)
+    max_links_map1 = mxlinks + increment
+    ALLOCATE (bicubic_grid1_add_map1(max_links_map1),    &
+         bicubic_grid2_add_map1(max_links_map1),    &
+         bicubic_wts_map1(num_wts,max_links_map1))
+    !***
+    !*** restore original values from temp arrays and
+    !*** deallocate temps
+    !***
+    mxlinks = MIN(mxlinks, max_links_map1)
+    bicubic_grid1_add_map1(1:mxlinks) = add1_tmp (1:mxlinks)
+    bicubic_grid2_add_map1(1:mxlinks) = add2_tmp (1:mxlinks)
+    bicubic_wts_map1    (:,1:mxlinks) = wts_tmp(:,1:mxlinks)
+    DEALLOCATE(add1_tmp, add2_tmp, wts_tmp)
+
+    !-----------------------------------------------------------------------
+    !
+  END SUBROUTINE resize_remap_vars
+  !
+  !************************************************************************
+  !
+
+END MODULE bicubic_interp
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/NESTING/src/bilinear_interp.f90
===================================================================
--- /utils/tools_ticket2413/NESTING/src/bilinear_interp.f90	(revision 12863)
+++ /utils/tools_ticket2413/NESTING/src/bilinear_interp.f90	(revision 12863)
@@ -0,0 +1,1207 @@
+!
+MODULE bilinear_interp
+  !
+  USE agrif_modutil
+  !
+  !************************************************************************
+  ! 									*
+  ! MODULE  BILINEAR INTERP						*
+  ! 									*
+  ! bilinear interpolation routines from SCRIP package			*		
+  !									*
+  !http://climate.lanl.gov/Software/SCRIP/				*
+  !									*
+  !Bilinear remapping							*
+  !									*
+  !************************************************************************
+  !     
+  !-----------------------------------------------------------------------
+  IMPLICIT NONE
+
+  !-----------------------------------------------------------------------
+  !     variables that describe each grid
+  !-----------------------------------------------------------------------
+  !
+  INTEGER :: grid1_size,grid2_size,grid1_rank, grid2_rank
+  !      
+  INTEGER, DIMENSION(:), POINTER :: grid1_dims, grid2_dims  
+  !  
+
+  !-----------------------------------------------------------------------
+  !     grid coordinates and masks
+  !-----------------------------------------------------------------------
+  !
+  LOGICAL, DIMENSION(:), POINTER :: grid1_mask,grid2_mask        
+  ! each grid center in radians
+  REAL*8,DIMENSION(:),POINTER :: &
+       grid1_center_lat,  &
+       grid1_center_lon,  & 
+       grid2_center_lat,  &
+       grid2_center_lon,  &
+       grid1_frac,        & ! fractional area of grid cells
+       grid2_frac           ! participating in remapping
+  !
+  ! lat/lon bounding box for use in restricting grid searches
+  !
+  REAL*8,DIMENSION(:,:), POINTER :: grid1_bound_box,grid2_bound_box   
+  !
+  !-----------------------------------------------------------------------
+  !     bins for restricting searches
+  !-----------------------------------------------------------------------
+  !
+  ! num of bins for restricted srch
+  INTEGER, PARAMETER :: num_srch_bins = 90  
+  !
+  ! min,max adds for grid cells in this lat bin
+  !
+  INTEGER,DIMENSION(:,:),POINTER :: bin_addr1,bin_addr2 
+  !
+  ! min,max longitude for each search bin
+  !
+  REAL*8, DIMENSION(:,:),POINTER :: bin_lats,bin_lons 
+
+  REAL*8, PARAMETER :: zero   = 0.0,  &
+       one    = 1.0,  &
+       two    = 2.0,  &
+       three  = 3.0,  &
+       four   = 4.0,  &
+       five   = 5.0,  & 
+       half   = 0.5,  &
+       quart  = 0.25, &
+       bignum = 1.e+20, &
+       tiny   = 1.e-14, &
+       pi     = 3.14159265359, &
+       pi2    = two*pi, &
+       pih    = half*pi        
+
+  REAL*8, PARAMETER :: deg2rad = pi/180.
+  ! 
+  ! max iteration count for i,j iteration 
+  !    
+  INTEGER , PARAMETER :: max_iter = 100   
+  !
+  ! convergence criterion
+  !
+  REAL*8, PARAMETER :: converge = 1.e-10
+
+
+  !  
+  INTEGER, PARAMETER :: norm_opt_none    = 1 &
+       ,norm_opt_dstarea = 2 &
+       ,norm_opt_frcarea = 3
+  !
+  INTEGER, PARAMETER :: map_type_conserv  = 1 &
+       ,map_type_bilinear = 2 &
+       ,map_type_bicubic  = 3 &
+       ,map_type_distwgt  = 4
+  !
+  INTEGER :: max_links_map1  &  ! current size of link arrays
+       ,num_links_map1  &  ! actual number of links for remapping
+       ,max_links_map2  &  ! current size of link arrays
+       ,num_links_map2  &  ! actual number of links for remapping
+       ,num_maps        &  ! num of remappings for this grid pair
+       ,num_wts         &  ! num of weights used in remapping
+       ,map_type        &  ! identifier for remapping method
+       ,norm_opt        &  ! option for normalization (conserv only)
+       ,resize_increment ! default amount to increase array size
+
+  INTEGER , DIMENSION(:), POINTER :: &
+       grid1_add_map1, &  ! grid1 address for each link in mapping 1
+       grid2_add_map1, &  ! grid2 address for each link in mapping 1
+       grid1_add_map2, &  ! grid1 address for each link in mapping 2
+       grid2_add_map2    ! grid2 address for each link in mapping 2
+
+  REAL*8, DIMENSION(:,:), POINTER ::   &
+       wts_map1, &   ! map weights for each link (num_wts,max_links)
+       wts_map2     ! map weights for each link (num_wts,max_links)
+  !
+CONTAINS 
+  !     
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE GRID_INIT
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  SUBROUTINE get_remap_matrix(grid1_lat,grid2_lat,grid1_lon,grid2_lon,mask, &
+       remap_matrix,source_add,destination_add)
+    !
+    !-----------------------------------------------------------------------
+    !this routine makes any necessary changes (e.g. for 0,2pi longitude range)
+    !-----------------------------------------------------------------------
+    !
+    REAL*8,DIMENSION(:,:),POINTER :: grid1_lat,grid2_lat,grid1_lon,grid2_lon
+    LOGICAL,DIMENSION(:,:) :: mask
+    !      
+    INTEGER,DIMENSION(:),POINTER :: source_add,destination_add  
+    REAL*8,DIMENSION(:,:),POINTER :: remap_matrix       
+    !
+    !-----------------------------------------------------------------------
+    ! local variables
+    !-----------------------------------------------------------------------
+    !
+    INTEGER :: n,nele,i,j,ip1,jp1,n_add,e_add,ne_add,nx,ny
+    INTEGER :: xpos,ypos
+    !          
+    ! integer mask
+    ! 
+    INTEGER, DIMENSION(:), POINTER :: imask 
+    !
+    ! lat/lon intervals for search bins
+    !
+    REAL*8 :: dlat,dlon           
+    !      
+    ! temps for computing bounding boxes
+    !
+    REAL*8, DIMENSION(4) :: tmp_lats, tmp_lons  
+    !
+    !      write(*,*)'proceed to Bilinear interpolation ...'
+    !
+    IF(ASSOCIATED(wts_map1)) DEALLOCATE(wts_map1)
+    IF(ASSOCIATED(grid1_add_map1)) DEALLOCATE(grid1_add_map1)
+    IF(ASSOCIATED(grid2_add_map1)) DEALLOCATE(grid2_add_map1)
+
+
+    !
+    ALLOCATE(grid1_dims(2),grid2_dims(2))
+    !      
+    grid1_dims(1) = SIZE(grid1_lat,2)
+    grid1_dims(2) = SIZE(grid1_lat,1)
+    grid2_dims(1) = SIZE(grid2_lat,2)
+    grid2_dims(2) = SIZE(grid2_lat,1)
+    grid1_size = SIZE(grid1_lat,2) * SIZE(grid1_lat,1)
+    grid2_size = SIZE(grid2_lat,2) * SIZE(grid2_lat,1)  
+    !      
+    !-----------------------------------------------------------------------
+    !     allocate grid coordinates/masks and read data
+    !-----------------------------------------------------------------------
+    !     
+    ALLOCATE( grid2_mask(grid2_size),         &
+         grid1_bound_box (4,grid1_size), &
+         grid2_bound_box (4,grid2_size), &
+         grid1_frac      (grid1_size),   &
+         grid2_frac      (grid2_size))
+    ALLOCATE(imask(grid1_size))
+    !                 
+    !      
+    grid1_frac = zero
+    grid2_frac = zero
+
+    !
+    ! 2D array -> 1D array
+    !
+    ALLOCATE(grid1_center_lat(SIZE(grid1_lat,1)*SIZE(grid1_lat,2)))
+    CALL tab2Dto1D(grid1_lat,grid1_center_lat)
+
+    ALLOCATE(grid1_center_lon(SIZE(grid1_lon,1)*SIZE(grid1_lon,2)))
+    CALL tab2Dto1D(grid1_lon,grid1_center_lon)
+
+    ALLOCATE(grid2_center_lat(SIZE(grid2_lat,1)*SIZE(grid2_lat,2)))
+    CALL tab2Dto1D(grid2_lat,grid2_center_lat)
+
+    ALLOCATE(grid2_center_lon(SIZE(grid2_lon,1)*SIZE(grid2_lon,2)))      
+    CALL tab2Dto1D(grid2_lon,grid2_center_lon) 
+
+    ALLOCATE(grid1_mask(SIZE(grid1_lat,1)*SIZE(grid1_lat,2)))
+    CALL logtab2Dto1D(mask,grid1_mask)
+    !      
+    !      Write(*,*) ,'grid1_mask = ',grid1_mask                 
+    !
+    ! degrees to radian
+    !
+    grid1_center_lat = grid1_center_lat*deg2rad
+    grid1_center_lon = grid1_center_lon*deg2rad
+    grid2_center_lat = grid2_center_lat*deg2rad
+    grid2_center_lon = grid2_center_lon*deg2rad
+
+    !-----------------------------------------------------------------------
+    !     convert longitudes to 0,2pi interval
+    !-----------------------------------------------------------------------
+
+    WHERE (grid1_center_lon .GT. pi2)  grid1_center_lon =       &
+         grid1_center_lon - pi2
+    WHERE (grid1_center_lon .LT. zero) grid1_center_lon =       &
+         grid1_center_lon + pi2
+    WHERE (grid2_center_lon .GT. pi2)  grid2_center_lon =       &
+         grid2_center_lon - pi2
+    WHERE (grid2_center_lon .LT. zero) grid2_center_lon =       &
+         grid2_center_lon + pi2
+
+    !-----------------------------------------------------------------------
+    !
+    !     make sure input latitude range is within the machine values
+    !     for +/- pi/2 
+    !
+    !-----------------------------------------------------------------------
+
+    WHERE (grid1_center_lat >  pih) grid1_center_lat =  pih
+    WHERE (grid1_center_lat < -pih) grid1_center_lat = -pih
+    WHERE (grid2_center_lat >  pih) grid2_center_lat =  pih
+    WHERE (grid2_center_lat < -pih) grid2_center_lat = -pih
+
+    !-----------------------------------------------------------------------
+    !
+    !     compute bounding boxes for restricting future grid searches
+    !
+    !-----------------------------------------------------------------------
+    !
+    nx = grid1_dims(1)
+    ny = grid1_dims(2)
+
+    DO n=1,grid1_size
+
+       !*** find N,S and NE points to this grid point
+
+       j = (n - 1)/nx +1
+       i = n - (j-1)*nx
+
+       IF (i < nx) THEN
+          ip1 = i + 1
+       ELSE
+          !*** assume cyclic
+          ip1 = 1
+          !*** but if it is not, correct
+          e_add = (j - 1)*nx + ip1
+          IF (ABS(grid1_center_lat(e_add) -     &
+               grid1_center_lat(n   )) > pih) THEN
+             ip1 = i
+          ENDIF
+          ip1=nx
+       ENDIF
+
+       IF (j < ny) THEN
+          jp1 = j+1
+       ELSE
+          !*** assume cyclic
+          jp1 = 1
+          !*** but if it is not, correct
+          n_add = (jp1 - 1)*nx + i
+          IF (ABS(grid1_center_lat(n_add) -             &
+               grid1_center_lat(n   )) > pih) THEN
+             jp1 = j
+          ENDIF
+          jp1=ny
+       ENDIF
+
+       n_add = (jp1 - 1)*nx + i
+       e_add = (j - 1)*nx + ip1
+       ne_add = (jp1 - 1)*nx + ip1
+
+       !*** find N,S and NE lat/lon coords and check bounding box
+
+       tmp_lats(1) = grid1_center_lat(n)
+       tmp_lats(2) = grid1_center_lat(e_add)
+       tmp_lats(3) = grid1_center_lat(ne_add)
+       tmp_lats(4) = grid1_center_lat(n_add)
+
+       tmp_lons(1) = grid1_center_lon(n)
+       tmp_lons(2) = grid1_center_lon(e_add)
+       tmp_lons(3) = grid1_center_lon(ne_add)
+       tmp_lons(4) = grid1_center_lon(n_add)
+
+       grid1_bound_box(1,n) = MINVAL(tmp_lats)
+       grid1_bound_box(2,n) = MAXVAL(tmp_lats)
+
+       grid1_bound_box(3,n) = MINVAL(tmp_lons)
+       grid1_bound_box(4,n) = MAXVAL(tmp_lons)
+    END DO
+
+    nx = grid2_dims(1)
+    ny = grid2_dims(2)
+
+    DO n=1,grid2_size
+
+       !*** find N,S and NE points to this grid point
+
+       j = (n - 1)/nx +1
+       i = n - (j-1)*nx
+
+       IF (i < nx) THEN
+          ip1 = i + 1
+       ELSE
+          !*** assume cyclic
+          ip1 = 1
+          !*** but if it is not, correct
+          e_add = (j - 1)*nx + ip1
+          IF (ABS(grid2_center_lat(e_add) -  &
+               grid2_center_lat(n   )) > pih) THEN
+             ip1 = i
+          ENDIF
+       ENDIF
+
+       IF (j < ny) THEN
+          jp1 = j+1
+       ELSE
+          !*** assume cyclic
+          jp1 = 1
+          !*** but if it is not, correct
+          n_add = (jp1 - 1)*nx + i
+          IF (ABS(grid2_center_lat(n_add) -  &
+               grid2_center_lat(n   )) > pih) THEN
+             jp1 = j
+          ENDIF
+       ENDIF
+
+       n_add = (jp1 - 1)*nx + i
+       e_add = (j - 1)*nx + ip1
+       ne_add = (jp1 - 1)*nx + ip1
+
+       !*** find N,S and NE lat/lon coords and check bounding box
+
+       tmp_lats(1) = grid2_center_lat(n)
+       tmp_lats(2) = grid2_center_lat(e_add)
+       tmp_lats(3) = grid2_center_lat(ne_add)
+       tmp_lats(4) = grid2_center_lat(n_add)
+
+       tmp_lons(1) = grid2_center_lon(n)
+       tmp_lons(2) = grid2_center_lon(e_add)
+       tmp_lons(3) = grid2_center_lon(ne_add)
+       tmp_lons(4) = grid2_center_lon(n_add)
+
+       grid2_bound_box(1,n) = MINVAL(tmp_lats)
+       grid2_bound_box(2,n) = MAXVAL(tmp_lats)
+       grid2_bound_box(3,n) = MINVAL(tmp_lons)
+       grid2_bound_box(4,n) = MAXVAL(tmp_lons)
+    END DO
+    !
+    !
+    !
+    WHERE (ABS(grid1_bound_box(4,:) - grid1_bound_box(3,:)) > pi)
+       grid1_bound_box(3,:) = zero
+       grid1_bound_box(4,:) = pi2
+    END WHERE
+
+    WHERE (ABS(grid2_bound_box(4,:) - grid2_bound_box(3,:)) > pi)
+       grid2_bound_box(3,:) = zero
+       grid2_bound_box(4,:) = pi2
+    END WHERE
+
+    !***
+    !*** try to check for cells that overlap poles
+    !***
+
+    WHERE (grid1_center_lat > grid1_bound_box(2,:)) &
+         grid1_bound_box(2,:) = pih
+
+    WHERE (grid1_center_lat < grid1_bound_box(1,:)) &
+         grid1_bound_box(1,:) = -pih
+
+    WHERE (grid2_center_lat > grid2_bound_box(2,:)) &
+         grid2_bound_box(2,:) = pih
+
+    WHERE (grid2_center_lat < grid2_bound_box(1,:)) &
+         grid2_bound_box(1,:) = -pih
+
+    !-----------------------------------------------------------------------
+    !     set up and assign address ranges to search bins in order to 
+    !     further restrict later searches
+    !-----------------------------------------------------------------------
+
+    ALLOCATE(bin_addr1(2,num_srch_bins))
+    ALLOCATE(bin_addr2(2,num_srch_bins))
+    ALLOCATE(bin_lats (2,num_srch_bins))
+    ALLOCATE(bin_lons (2,num_srch_bins))
+
+    dlat = pi/num_srch_bins
+
+    DO n=1,num_srch_bins
+       bin_lats(1,n) = (n-1)*dlat - pih
+       bin_lats(2,n) =     n*dlat - pih
+       bin_lons(1,n) = zero
+       bin_lons(2,n) = pi2
+       bin_addr1(1,n) = grid1_size + 1
+       bin_addr1(2,n) = 0
+       bin_addr2(1,n) = grid2_size + 1
+       bin_addr2(2,n) = 0
+    END DO
+
+    DO nele=1,grid1_size
+       DO n=1,num_srch_bins
+          IF (grid1_bound_box(1,nele) <= bin_lats(2,n) .AND.   &
+               grid1_bound_box(2,nele) >= bin_lats(1,n)) THEN
+             bin_addr1(1,n) = MIN(nele,bin_addr1(1,n))
+             bin_addr1(2,n) = MAX(nele,bin_addr1(2,n))
+          ENDIF
+       END DO
+    END DO
+
+    DO nele=1,grid2_size
+       DO n=1,num_srch_bins
+          IF (grid2_bound_box(1,nele) <= bin_lats(2,n) .AND.    &
+               grid2_bound_box(2,nele) >= bin_lats(1,n)) THEN
+             bin_addr2(1,n) = MIN(nele,bin_addr2(1,n))
+             bin_addr2(2,n) = MAX(nele,bin_addr2(2,n))
+          ENDIF
+       END DO
+    END DO
+    !	
+    CALL init_remap_vars 
+    CALL remap_bilin
+
+    ALLOCATE(remap_matrix(SIZE(wts_map1,1),SIZE(wts_map1,2)), &
+         source_add(SIZE(grid1_add_map1)),       &
+         destination_add(SIZE(grid2_add_map1)))
+
+    DO j = 1,SIZE(wts_map1,2)
+       DO i = 1,SIZE(wts_map1,1)
+
+          remap_matrix(i,j) = wts_map1(i,j)
+
+       END DO
+    END DO
+
+
+    source_add(:) = grid1_add_map1(:)
+    destination_add(:) = grid2_add_map1(:)               
+    !
+    WHERE(destination_add == 0)
+       destination_add = 1
+    END WHERE
+
+    WHERE(source_add == 0)
+       source_add = 1
+    END WHERE
+    !               
+    DEALLOCATE(grid1_bound_box,grid2_bound_box,grid1_center_lat,grid1_center_lon)
+    DEALLOCATE(grid2_center_lat,grid2_center_lon,grid2_add_map1,grid1_add_map1,wts_map1)
+    DEALLOCATE(grid1_frac,grid2_frac,grid1_dims,grid2_dims,grid2_mask,imask)
+    DEALLOCATE(bin_addr1,bin_addr2,bin_lats,bin_lons)
+    DEALLOCATE(grid1_mask)	
+    !	
+    !-----------------------------------------------------------------------
+
+  END SUBROUTINE get_remap_matrix
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+  !***********************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE REMAP_BILINEAR
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE remap_bilin
+
+    !-----------------------------------------------------------------------
+    !     this routine computes the weights for a bilinear interpolation.
+    !-----------------------------------------------------------------------
+
+    !-----------------------------------------------------------------------
+    !     local variables
+    !-----------------------------------------------------------------------
+
+    INTEGER :: n,icount,dst_add,iter,nmap,nbmasked    
+    !        
+    ! address for the four source points
+    !
+    INTEGER, DIMENSION(4) :: src_add,involved_pts
+    INTEGER, DIMENSION(1) :: minlon
+    INTEGER, DIMENSION(1) :: minlat
+    REAL*8, DIMENSION(4) :: distx,disty
+    REAL*8 :: normalize
+    !               
+    ! latitudes longitudes of four bilinear corners
+    !
+    REAL*8, DIMENSION(4) :: src_lats,src_lons
+    !
+    ! bilinear weights for four corners
+    !      
+    REAL*8, DIMENSION(4) :: wgts            
+    !
+    REAL*8 :: &
+         plat, plon,       &  ! lat/lon coords of destination point
+         iguess, jguess,   &  ! current guess for bilinear coordinate
+         thguess, phguess, &  ! current guess for lat/lon coordinate
+         deli, delj,       &  ! corrections to i,j
+         dth1, dth2, dth3, &  ! some latitude  differences
+         dph1, dph2, dph3, &  ! some longitude differences
+         dthp, dphp,       &  ! difference between point and sw corner
+         mat1, mat2, mat3, mat4, &  ! matrix elements
+         determinant, &     ! matrix determinant
+         sum_wgts          ! sum of weights for normalization
+
+    INTEGER lastsrc_add     
+    !      
+    grid2_mask = .TRUE.     
+    !      
+    !      
+    nmap = 1
+    !
+    !***
+    !*** loop over destination grid 
+    !***
+    !      print*,'grid2_size =',grid2_size
+    !      
+    lastsrc_add=1
+    !
+    grid_loop1: DO dst_add = 1, grid2_size
+
+       IF (.NOT. grid2_mask(dst_add)) CYCLE grid_loop1
+       !        
+       plat = grid2_center_lat(dst_add)
+       plon = grid2_center_lon(dst_add)
+       !***
+       !*** find nearest square of grid points on source grid
+       !***
+       CALL grid_search_bilin(src_add, src_lats, src_lons,          &
+            plat, plon, grid1_dims,               &
+            grid1_center_lat, grid1_center_lon,   & 
+            grid1_bound_box, bin_addr1, bin_addr2,lastsrc_add)		       
+       !***
+       !*** check to see if points are land points
+       !*** 
+       !   
+       IF (src_add(1) > 0) THEN
+          !	    
+          DO n=1,4
+             !           if(.not. grid1_mask(src_add(n))) nbmasked = nbmasked + 1
+             IF(.NOT. grid1_mask(src_add(n))) src_add(1) = 0
+          END DO
+          !
+       ENDIF
+       !
+       !
+
+       !***
+       !*** if point found, find local i,j coordinates for weights
+       !***
+       IF (src_add(1) > 0) THEN
+          grid2_frac(dst_add) = one
+          !***
+          !*** iterate to find i,j for bilinear approximation
+          !***
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          IF (dph1 >  three*pih) dph1 = dph1 - pi2
+          IF (dph2 >  three*pih) dph2 = dph2 - pi2
+          IF (dph3 >  three*pih) dph3 = dph3 - pi2
+          IF (dph1 < -three*pih) dph1 = dph1 + pi2
+          IF (dph2 < -three*pih) dph2 = dph2 + pi2
+          IF (dph3 < -three*pih) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+
+          iguess = half
+          jguess = half
+
+          iter_loop1: DO iter=1,max_iter
+
+             dthp = plat - src_lats(1) - dth1*iguess -        &
+                  dth2*jguess - dth3*iguess*jguess
+             dphp = plon - src_lons(1)
+
+             IF (dphp >  three*pih) dphp = dphp - pi2
+             IF (dphp < -three*pih) dphp = dphp + pi2
+
+             dphp = dphp - dph1*iguess - dph2*jguess -        &
+                  dph3*iguess*jguess
+
+             mat1 = dth1 + dth3*jguess
+             mat2 = dth2 + dth3*iguess
+             mat3 = dph1 + dph3*jguess
+             mat4 = dph2 + dph3*iguess
+
+             determinant = mat1*mat4 - mat2*mat3
+
+             deli = (dthp*mat4 - mat2*dphp)/determinant
+             delj = (mat1*dphp - dthp*mat3)/determinant
+
+             IF (ABS(deli) < converge .AND.                   &
+                  ABS(delj) < converge) EXIT iter_loop1
+
+             iguess = iguess + deli
+             jguess = jguess + delj
+
+          END DO iter_loop1
+
+          IF (iter <= max_iter) THEN
+
+             !***
+             !*** successfully found i,j - compute weights
+             !***
+
+             wgts(1) = (one-iguess)*(one-jguess)
+             wgts(2) = iguess*(one-jguess)
+             wgts(3) = iguess*jguess
+             wgts(4) = (one-iguess)*jguess
+             !	    	        
+             !
+             CALL store_link_bilin(dst_add, src_add, wgts, nmap)
+
+          ELSE
+             PRINT *,'Point coords: ',plat,plon
+             PRINT *,'Dest grid lats: ',src_lats
+             PRINT *,'Dest grid lons: ',src_lons
+             PRINT *,'Dest grid addresses: ',src_add
+             PRINT *,'Current i,j : ',iguess, jguess
+             STOP 'Iteration for i,j exceed max iteration count'
+          ENDIF
+          !
+          !***
+          !*** search for bilinear failed - use a distance-weighted
+          !*** average instead (this is typically near the pole)
+          !***
+       ELSE IF (src_add(1) < 0) THEN
+
+          src_add = ABS(src_add)
+          icount = 0
+          DO n=1,4
+             !           
+             IF (grid1_mask(src_add(n))) THEN
+                icount = icount + 1
+             ELSE
+                src_lats(n) = zero
+             ENDIF
+             !	    
+          END DO
+
+          IF (icount > 0) THEN
+             !	  
+             !*** renormalize weights
+             !
+             sum_wgts = SUM(src_lats)
+             wgts(1) = src_lats(1)/sum_wgts
+             wgts(2) = src_lats(2)/sum_wgts
+             wgts(3) = src_lats(3)/sum_wgts
+             wgts(4) = src_lats(4)/sum_wgts
+             !
+             grid2_frac(dst_add) = one
+             CALL store_link_bilin(dst_add, src_add, wgts, nmap)
+          ENDIF
+
+          !
+       ENDIF
+    END DO grid_loop1
+    !      
+    !      Call sort_add(grid2_add_map1, grid1_add_map1, wts_map1)	
+    !               
+    !
+    !-----------------------------------------------------------------------
+
+  END SUBROUTINE remap_bilin
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+  !***********************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE GRID_SEARCH_BILIN
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  SUBROUTINE grid_search_bilin(src_add, src_lats, src_lons,   &
+       plat, plon, src_grid_dims,      &
+       src_center_lat, src_center_lon, & 
+       src_grid_bound_box,             &
+       src_bin_add, dst_bin_add,lastsrc_add)
+
+    !-----------------------------------------------------------------------
+    !
+    !     this routine finds the location of the search point plat, plon
+    !     in the source grid and returns the corners needed for a bilinear
+    !     interpolation.
+    !
+    !-----------------------------------------------------------------------
+
+    !-----------------------------------------------------------------------
+    !     output variables
+    !-----------------------------------------------------------------------
+    !
+    ! address of each corner point enclosing P
+    !
+    INTEGER,DIMENSION(4) :: src_add  
+    REAL*8,DIMENSION(4) :: src_lats,src_lons  
+    !      
+    !-----------------------------------------------------------------------
+    !     input variables
+    !-----------------------------------------------------------------------
+    ! 
+    ! latitude, longitude of the search point
+    !
+    REAL*8, INTENT(in) :: plat,plon   
+    !
+    ! size of each src grid dimension
+    !
+    INTEGER, DIMENSION(2), INTENT(in) :: src_grid_dims  
+    !
+    ! latitude, longitude of each src grid center
+    !
+    REAL*8, DIMENSION(:), INTENT(in) :: src_center_lat,src_center_lon  
+    !
+    ! bound box for source grid
+    !
+    REAL*8, DIMENSION(:,:), INTENT(in) :: src_grid_bound_box 
+    !
+    ! latitude bins for restricting searches
+    !
+    INTEGER, DIMENSION(:,:), INTENT(in) ::src_bin_add,dst_bin_add 
+
+    INTEGER,OPTIONAL :: lastsrc_add
+    INTEGER :: loopsrc,l1,l2
+    !      
+    !-----------------------------------------------------------------------
+    !     local variables
+    !-----------------------------------------------------------------------
+    !
+    INTEGER :: n,next_n,srch_add,nx, ny,min_add, max_add,  &
+         i, j, jp1, ip1, n_add, e_add, ne_add
+
+
+    REAL*8 ::  vec1_lat, vec1_lon,vec2_lat, vec2_lon, cross_product,  &
+         cross_product_last,coslat_dst, sinlat_dst, coslon_dst, &
+         sinlon_dst,dist_min, distance 
+
+    !-----------------------------------------------------------------------
+    !     restrict search first using bins
+    !-----------------------------------------------------------------------
+
+    src_add = 0
+
+    min_add = SIZE(src_center_lat)
+    max_add = 1
+    DO n=1,num_srch_bins
+       IF (plat >= bin_lats(1,n) .AND. plat <= bin_lats(2,n) .AND. &
+            plon >= bin_lons(1,n) .AND. plon <= bin_lons(2,n)) THEN
+          min_add = MIN(min_add, src_bin_add(1,n))
+          max_add = MAX(max_add, src_bin_add(2,n))
+       ENDIF
+    END DO
+
+    !-----------------------------------------------------------------------
+    !     now perform a more detailed search 
+    !-----------------------------------------------------------------------
+
+    nx = src_grid_dims(1)
+    ny = src_grid_dims(2)
+
+    loopsrc=0
+    DO WHILE (loopsrc <= max_add)
+
+
+       l1=MAX(min_add,lastsrc_add-loopsrc)
+       l2=MIN(max_add,lastsrc_add+loopsrc)      
+
+       loopsrc = loopsrc+1
+
+       srch_loop: DO srch_add = l1,l2,MAX(l2-l1,1)
+
+          !*** first check bounding box
+
+          IF (plat <= src_grid_bound_box(2,srch_add) .AND. & 
+               plat >= src_grid_bound_box(1,srch_add) .AND.  &
+               plon <= src_grid_bound_box(4,srch_add) .AND.  &
+               plon >= src_grid_bound_box(3,srch_add)) THEN
+             !***
+             !*** we are within bounding box so get really serious
+             !***
+             !*** determine neighbor addresses
+             !
+             j = (srch_add - 1)/nx +1
+             i = srch_add - (j-1)*nx
+             !
+             IF (i < nx) THEN
+                ip1 = i + 1
+             ELSE
+                ip1 = 1
+             ENDIF
+             !
+             IF (j < ny) THEN
+                jp1 = j+1
+             ELSE
+                jp1 = 1
+             ENDIF
+             !
+             n_add = (jp1 - 1)*nx + i
+             e_add = (j - 1)*nx + ip1
+             ne_add = (jp1 - 1)*nx + ip1
+             !
+             src_lats(1) = src_center_lat(srch_add)
+             src_lats(2) = src_center_lat(e_add)
+             src_lats(3) = src_center_lat(ne_add)
+             src_lats(4) = src_center_lat(n_add)
+             !
+             src_lons(1) = src_center_lon(srch_add)
+             src_lons(2) = src_center_lon(e_add)
+             src_lons(3) = src_center_lon(ne_add)
+             src_lons(4) = src_center_lon(n_add)
+             !
+             !***
+             !*** for consistency, we must make sure all lons are in
+             !*** same 2pi interval
+             !***
+             !
+             vec1_lon = src_lons(1) - plon
+             IF (vec1_lon >  pi) THEN
+                src_lons(1) = src_lons(1) - pi2
+             ELSE IF (vec1_lon < -pi) THEN
+                src_lons(1) = src_lons(1) + pi2
+             ENDIF
+             DO n=2,4
+                vec1_lon = src_lons(n) - src_lons(1)
+                IF (vec1_lon >  pi) THEN
+                   src_lons(n) = src_lons(n) - pi2
+                ELSE IF (vec1_lon < -pi) THEN
+                   src_lons(n) = src_lons(n) + pi2
+                ENDIF
+             END DO
+             !
+             corner_loop: DO n=1,4
+                next_n = MOD(n,4) + 1
+                !***
+                !*** here we take the cross product of the vector making 
+                !*** up each box side with the vector formed by the vertex
+                !*** and search point.  if all the cross products are 
+                !*** positive, the point is contained in the box.
+                !***
+                vec1_lat = src_lats(next_n) - src_lats(n)
+                vec1_lon = src_lons(next_n) - src_lons(n)
+                vec2_lat = plat - src_lats(n)
+                vec2_lon = plon - src_lons(n)
+                !***
+                !*** check for 0,2pi crossings
+                !***
+                IF (vec1_lon >  three*pih) THEN
+                   vec1_lon = vec1_lon - pi2
+                ELSE IF (vec1_lon < -three*pih) THEN
+                   vec1_lon = vec1_lon + pi2
+                ENDIF
+                IF (vec2_lon >  three*pih) THEN
+                   vec2_lon = vec2_lon - pi2
+                ELSE IF (vec2_lon < -three*pih) THEN
+                   vec2_lon = vec2_lon + pi2
+                ENDIF
+                !
+                cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+                !
+                !***
+                !*** if cross product is less than zero, this cell
+                !*** doesn't work
+                !***
+                IF (n == 1) cross_product_last = cross_product
+                IF (cross_product*cross_product_last < zero) &
+                     EXIT corner_loop
+                cross_product_last = cross_product
+                !
+             END DO corner_loop
+             !***
+             !*** if cross products all same sign, we found the location
+             !***
+             IF (n > 4) THEN
+                src_add(1) = srch_add
+                src_add(2) = e_add
+                src_add(3) = ne_add
+                src_add(4) = n_add
+                !
+                lastsrc_add = srch_add
+                RETURN
+             ENDIF
+             !***
+             !*** otherwise move on to next cell
+             !***
+          ENDIF !bounding box check
+       END DO srch_loop
+
+
+    ENDDO
+
+
+    !***
+    !*** if no cell found, point is likely either in a box that
+    !*** straddles either pole or is outside the grid.  fall back
+    !*** to a distance-weighted average of the four closest
+    !*** points.  go ahead and compute weights here, but store
+    !*** in src_lats and return -add to prevent the parent
+    !*** routine from computing bilinear weights
+    !***
+    !print *,'Could not find location for ',plat,plon
+    !print *,'Using nearest-neighbor average for this point'
+    !
+    coslat_dst = COS(plat)
+    sinlat_dst = SIN(plat)
+    coslon_dst = COS(plon)
+    sinlon_dst = SIN(plon)
+    !
+    dist_min = bignum
+    src_lats = bignum
+    DO srch_add = min_add,max_add
+       distance = ACOS(coslat_dst*COS(src_center_lat(srch_add))*   &
+            (coslon_dst*COS(src_center_lon(srch_add)) +   &
+            sinlon_dst*SIN(src_center_lon(srch_add)))+   &
+            sinlat_dst*SIN(src_center_lat(srch_add)))
+
+       IF (distance < dist_min) THEN
+          sort_loop: DO n=1,4
+             IF (distance < src_lats(n)) THEN
+                DO i=4,n+1,-1
+                   src_add (i) = src_add (i-1)
+                   src_lats(i) = src_lats(i-1)
+                END DO
+                src_add (n) = -srch_add
+                src_lats(n) = distance
+                dist_min = src_lats(4)
+                EXIT sort_loop
+             ENDIF
+          END DO sort_loop
+       ENDIF
+    END DO
+    !
+    src_lons = one/(src_lats + tiny)
+    distance = SUM(src_lons)
+    src_lats = src_lons/distance
+
+    !-----------------------------------------------------------------------
+
+  END SUBROUTINE grid_search_bilin
+
+
+  !***********************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE STORE_LINK_BILIN
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE store_link_bilin(dst_add, src_add, weights, nmap)
+
+    !-----------------------------------------------------------------------
+    !     this routine stores the address and weight for four links 
+    !     associated with one destination point in the appropriate address 
+    !     and weight arrays and resizes those arrays if necessary.
+    !-----------------------------------------------------------------------
+
+    !-----------------------------------------------------------------------
+    !     input variables
+    !-----------------------------------------------------------------------
+    !
+    INTEGER :: dst_add,nmap
+    !
+    INTEGER, DIMENSION(4) :: src_add
+    !
+    REAL*8, DIMENSION(4) :: weights 
+
+    !-----------------------------------------------------------------------
+    !
+    !     local variables
+    !
+    !-----------------------------------------------------------------------
+
+    INTEGER :: n,num_links_old   
+
+    !-----------------------------------------------------------------------
+    !     increment number of links and check to see if remap arrays need
+    !     to be increased to accomodate the new link.  then store the
+    !     link.
+    !-----------------------------------------------------------------------
+
+    num_links_old  = num_links_map1
+    num_links_map1 = num_links_old + 4
+
+    IF (num_links_map1 > max_links_map1) &
+         CALL resize_remap_vars(1,resize_increment)
+
+    DO n=1,4
+       grid1_add_map1(num_links_old+n) = src_add(n)
+       grid2_add_map1(num_links_old+n) = dst_add
+       wts_map1    (1,num_links_old+n) = weights(n)
+    END DO
+
+    !-----------------------------------------------------------------------
+
+  END SUBROUTINE store_link_bilin
+
+
+
+
+
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE INIT_REMAP_VARS
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  SUBROUTINE init_remap_vars
+
+    !-----------------------------------------------------------------------
+    !
+    !     this routine initializes some variables and provides an initial
+    !     allocation of arrays (fairly large so frequent resizing 
+    !     unnecessary).
+    !
+    !-----------------------------------------------------------------------
+
+    !-----------------------------------------------------------------------
+    !     determine the number of weights
+    !-----------------------------------------------------------------------
+    num_wts = 1     ! bilinear interpolation
+    !-----------------------------------------------------------------------
+    !     initialize num_links and set max_links to four times the largest 
+    !     of the destination grid sizes initially (can be changed later).
+    !     set a default resize increment to increase the size of link
+    !     arrays if the number of links exceeds the initial size  
+    !-----------------------------------------------------------------------
+
+    num_links_map1 = 0
+    max_links_map1 = 4*grid2_size
+    IF (num_maps > 1) THEN
+       num_links_map2 = 0
+       max_links_map1 = MAX(4*grid1_size,4*grid2_size)
+       max_links_map2 = max_links_map1
+    ENDIF
+
+    resize_increment = 0.1*MAX(grid1_size,grid2_size)
+
+    !-----------------------------------------------------------------------
+    !     allocate address and weight arrays for mapping 1  
+    !-----------------------------------------------------------------------
+
+    ALLOCATE (grid1_add_map1(max_links_map1),    &
+         grid2_add_map1(max_links_map1),    &
+         wts_map1(num_wts, max_links_map1))
+
+    grid1_add_map1 = 0.	
+    grid2_add_map1 = 0.
+    wts_map1 = 0.
+
+    !-----------------------------------------------------------------------
+
+  END SUBROUTINE init_remap_vars
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+  !***********************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE RESIZE_REMAP_VAR
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE resize_remap_vars(nmap, increment)
+
+    !-----------------------------------------------------------------------
+    !     this routine resizes remapping arrays by increasing(decreasing)
+    !     the max_links by increment
+    !-----------------------------------------------------------------------
+
+    !-----------------------------------------------------------------------
+    !     input variables
+    !-----------------------------------------------------------------------
+
+    INTEGER ::     &
+         nmap,      &     ! identifies which mapping array to resize
+         increment       ! the number of links to add(subtract) to arrays
+
+    !-----------------------------------------------------------------------
+    !     local variables
+    !-----------------------------------------------------------------------
+
+    INTEGER ::    &
+         ierr,    &  ! error flag
+         mxlinks   ! size of link arrays
+
+    INTEGER, DIMENSION(:), POINTER ::    &
+         add1_tmp,   & ! temp array for resizing address arrays
+         add2_tmp  ! temp array for resizing address arrays
+    !
+    ! temp array for resizing weight arrays
+    !
+    REAL*8, DIMENSION(:,:), POINTER :: wts_tmp   
+    !
+    !-----------------------------------------------------------------------
+    !***
+    !*** allocate temporaries to hold original values
+    !***
+    mxlinks = SIZE(grid1_add_map1)
+    ALLOCATE (add1_tmp(mxlinks), add2_tmp(mxlinks), &
+         wts_tmp(num_wts,mxlinks))
+
+    add1_tmp = grid1_add_map1
+    add2_tmp = grid2_add_map1
+    wts_tmp  = wts_map1
+
+    !***
+    !*** deallocate originals and increment max_links then
+    !*** reallocate arrays at new size
+    !***
+
+    DEALLOCATE (grid1_add_map1, grid2_add_map1, wts_map1)
+    max_links_map1 = mxlinks + increment
+    ALLOCATE (grid1_add_map1(max_links_map1),    &
+         grid2_add_map1(max_links_map1),    &
+         wts_map1(num_wts,max_links_map1))
+    !***
+    !*** restore original values from temp arrays and
+    !*** deallocate temps
+    !***
+    mxlinks = MIN(mxlinks, max_links_map1)
+    grid1_add_map1(1:mxlinks) = add1_tmp (1:mxlinks)
+    grid2_add_map1(1:mxlinks) = add2_tmp (1:mxlinks)
+    wts_map1    (:,1:mxlinks) = wts_tmp(:,1:mxlinks)
+    DEALLOCATE(add1_tmp, add2_tmp, wts_tmp)
+
+    !-----------------------------------------------------------------------
+    !
+  END SUBROUTINE resize_remap_vars
+  !
+  !************************************************************************
+  !
+END MODULE bilinear_interp
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
Index: /utils/tools_ticket2413/NESTING/src/io_netcdf.f90
===================================================================
--- /utils/tools_ticket2413/NESTING/src/io_netcdf.f90	(revision 12863)
+++ /utils/tools_ticket2413/NESTING/src/io_netcdf.f90	(revision 12863)
@@ -0,0 +1,1606 @@
+!************************************************************************
+! Fortran 95 OPA Nesting tools						*
+!									*
+!     Copyright (C) 2005 Florian Lemari�(Florian.Lemarie@imag.fr)	*
+!									*
+!************************************************************************
+!
+!********************************************************************************
+!										*
+! module io_netcdf								*
+!										*
+! NetCDF Fortran 90 read/write interface					*
+! using input/output functions provided						*
+! by unidata									*
+!										*
+!http://my.unidata.ucar.edu/content/software/netcdf/docs/netcdf-f90/index.html	*
+!										*
+!********************************************************************************
+!
+!
+!
+MODULE io_netcdf
+  !      
+  USE netcdf
+  USE agrif_types
+  !      
+  INTERFACE read_ncdf_var
+     MODULE PROCEDURE  &
+        read_ncdf_var0d_real, read_ncdf_var1d_real, read_ncdf_var2d_real  , read_ncdf_var2d_real_bis,                        &
+        read_ncdf_var3d_real, read_ncdf_var4d_real, read_ncdf_var3d_real_t, read_ncdf_var4d_real_t, read_ncdf_var4d_real_nt, &
+        read_ncdf_var0d_int,  read_ncdf_var1d_int , read_ncdf_var2d_int   , read_ncdf_var3d_int   , read_ncdf_var4d_int
+  END INTERFACE
+  !
+  INTERFACE write_ncdf_var
+     MODULE PROCEDURE &
+        write_ncdf_var0d_real, write_ncdf_var1d_real  , write_ncdf_var2d_real  , write_ncdf_var3d_real,    &
+        write_ncdf_var4d_real, write_ncdf_var3d_real_t, write_ncdf_var4d_real_t, write_ncdf_var4d_real_nt, &                           
+        write_ncdf_var2d_real_bis ,                                                                        &			   
+        write_ncdf_var0d_int, write_ncdf_var1d_int, write_ncdf_var2d_int, write_ncdf_var3d_int, write_ncdf_var4d_int
+  END INTERFACE
+  ! 
+  INTERFACE copy_ncdf_att
+     MODULE PROCEDURE copy_ncdf_att_latlon,copy_ncdf_att_var
+  END INTERFACE
+  !
+CONTAINS
+  !
+  !****************************************************************
+  !   subroutine read_ncdf_dim					*
+  !								*
+  ! subroutine to retrieve value of a given dimension 		*
+  !								*
+  !     dimname : name of dimension to retrieve			*
+  !     file    : netcdf file name				*
+  !     dimval  : value of the required dimension			*
+  !								*
+  !****************************************************************
+  !
+  SUBROUTINE read_ncdf_dim(dimname,file,dimval)   
+    !      
+    IMPLICIT NONE
+    !           
+    CHARACTER(*),INTENT(in) :: dimname,file    
+    INTEGER    :: dimval
+    !            
+    ! local variables
+    !
+    INTEGER ncid,status,dimid
+    !     
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname,dimid)
+    status = nf90_inquire_dimension(ncid,dimid,len=dimval)						                
+    !      
+    status = nf90_close(ncid)
+    !      
+  END SUBROUTINE read_ncdf_dim
+  !
+  !**************************************************************
+  ! end subroutine read_ncdf_dim
+  !**************************************************************      
+  !
+  !****************************************************************
+  !   subroutine write_ncdf_dim					*
+  !								*
+  ! subroutine to write a dimension in a given file 		*
+  !								*
+  !     dimname : name of dimension to initialize			*
+  !     file    : netcdf file name				*
+  !     dimval  : value of the dimension to write			*
+  !								*
+  !****************************************************************
+  !
+  SUBROUTINE write_ncdf_dim(dimname,file,dimval)   
+    !      
+    IMPLICIT NONE
+    !           
+    CHARACTER(*),INTENT(in) :: dimname,file    
+    INTEGER    :: dimval
+    !      
+    ! local variables
+    !
+    INTEGER ncid,status,dimid
+    !     
+    status = nf90_open(file,NF90_WRITE,ncid)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_redef(ncid)
+    IF(dimval.EQ.0) THEN
+       status = nf90_def_dim(ncid,dimname,nf90_unlimited,dimid)       
+    ELSE
+       status = nf90_def_dim(ncid,dimname,dimval,dimid)  
+    END IF
+
+    status = nf90_enddef(ncid)
+    !      
+
+    status = nf90_close(ncid)
+    !      
+  END SUBROUTINE write_ncdf_dim
+  !
+  !**************************************************************
+  ! end subroutine write_ncdf_dim
+  !**************************************************************            
+  ! 
+  !****************************************************************
+  !   subroutine read_ncdf_var					*
+  !								*
+  ! subroutine to retrieve values of a given variable 		*
+  !								*
+  !     varname : name of variable to retrieve			*
+  !     file    : netcdf file name				*
+  !     tabvar  : array containing values of the required variable*
+  !								*
+  !****************************************************************
+  !      
+  SUBROUTINE read_ncdf_var1d_real(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8, DIMENSION(:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(1) :: dimID
+    INTEGER :: dim1
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimID)
+    status=nf90_inquire_dimension(ncid,dimID(1),len=dim1)
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1))  
+    ELSE
+       IF( ANY(SHAPE(tabvar)/=(/dim1/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1))      
+       ENDIF
+    ENDIF
+    !        
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE read_ncdf_var1d_real
+  !           
+  !      
+  SUBROUTINE read_ncdf_var2d_real(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8, DIMENSION(:,:), POINTER :: tabvar
+    !local variables
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2))  
+    ELSE
+       IF( ANY(SHAPE(tabvar)/=(/dim1,dim2/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2))      
+       ENDIF
+    ENDIF
+    !       
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE read_ncdf_var2d_real
+  !           
+  !      
+  SUBROUTINE read_ncdf_var2d_real_bis(varname,file,tabvar,strt,cnt)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8, DIMENSION(:,:), POINTER :: tabvar
+    !local variables
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER, DIMENSION(2) :: strt,cnt
+    INTEGER :: dim1,dim2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    dim1 = cnt(1) 
+    dim2 = cnt(2)
+    !      
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2))  
+    ELSE
+       IF( ANY(SHAPE(tabvar)/=(/dim1,dim2/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2))      
+       ENDIF
+    ENDIF
+    !       
+    status=nf90_get_var(ncid,varid,tabvar,start = strt,count = cnt)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE read_ncdf_var2d_real_bis
+  !           
+  !      
+  SUBROUTINE read_ncdf_var3d_real(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8, DIMENSION(:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2,dim3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)  
+    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)
+    !    
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,dim3))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,dim3/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2,dim3))      
+       ENDIF
+    ENDIF
+    !      
+    status=nf90_get_var(ncid,varid,tabvar) 
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to retrieve netcdf variable : ",TRIM(varname)
+       STOP
+    ENDIF
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE read_ncdf_var3d_real
+  !           
+  !      
+  SUBROUTINE read_ncdf_var4d_real(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2,dim3,dim4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)  
+    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)   
+    status=nf90_inquire_dimension(ncid,dimIDS(4),len=dim4)       
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,dim3,dim4))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,dim3,dim4/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2,dim3,dim4))      
+       ENDIF
+    ENDIF
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE read_ncdf_var4d_real
+
+  SUBROUTINE read_ncdf_var0d_real(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8 :: tabvar
+    !
+    !local variables
+    !
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    !
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE read_ncdf_var0d_real
+
+  SUBROUTINE read_ncdf_var0d_int(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    !
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE read_ncdf_var0d_int
+  !           
+  !      
+  SUBROUTINE read_ncdf_var1d_int(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER, DIMENSION(:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER,DIMENSION(10) :: dimID
+    INTEGER :: dim1
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimID)
+    status=nf90_inquire_dimension(ncid,dimID(1),len=dim1)          
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1))      
+       ENDIF
+    ENDIF
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !      
+  END SUBROUTINE read_ncdf_var1d_int
+  !           
+  !      
+  SUBROUTINE read_ncdf_var2d_int(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER, DIMENSION(:,:), POINTER :: tabvar
+    !local variables
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)      
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2))      
+       ENDIF
+    ENDIF
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !      
+  END SUBROUTINE read_ncdf_var2d_int
+  !           
+  !      
+  SUBROUTINE read_ncdf_var3d_int(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER, DIMENSION(:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2,dim3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)  
+    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)          
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,dim3))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,dim3/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2,dim3))      
+       ENDIF
+    ENDIF
+    ! 
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !      
+  END SUBROUTINE read_ncdf_var3d_int
+  !           
+  !      
+  SUBROUTINE read_ncdf_var4d_int(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2,dim3,dim4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)  
+    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)   
+    status=nf90_inquire_dimension(ncid,dimIDS(4),len=dim4)       
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,dim3,dim4))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,dim3,dim4/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2,dim3,dim4))      
+       ENDIF
+    ENDIF
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE read_ncdf_var4d_int
+  !           
+  !
+  !****************************************************************
+  !   subroutine write_ncdf_var					*
+  !								*
+  ! subroutine to write a variable in a given file 		*
+  !								*
+  !     varname : name of variable to store			*     
+  !     dimname : name of dimensions of the given variable	*
+  !     file    : netcdf file name				*
+  !     tabvar  : values of the variable to write			*
+  !								*
+  !****************************************************************
+  !    
+  !      
+  SUBROUTINE write_ncdf_var1d_real(varname,dimname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,dimname,typevar
+    REAL*8, DIMENSION(:), INTENT(in) :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname,dimid)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    SELECT CASE(TRIM(typevar))
+    CASE('double')
+       status = nf90_def_var(ncid,varname,nf90_double,(/dimid/),varid)
+    CASE('float')
+       status = nf90_def_var(ncid,varname,nf90_float,(/dimid/),varid)      
+    END SELECT
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var1d_real
+  !      
+  !      
+  SUBROUTINE write_ncdf_var2d_real_bis(varname,dimname,file,tabvar,nbdim,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    INTEGER,INTENT(in) :: nbdim
+    CHARACTER(*), DIMENSION(4) :: dimname
+    REAL*8, DIMENSION(:,:) :: tabvar
+    REAL*8, ALLOCATABLE, DIMENSION(:,:,:) :: tabtemp3d
+    REAL*8, ALLOCATABLE, DIMENSION(:,:,:,:) :: tabtemp4d
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3,dimid4
+    INTEGER :: status,ncid,ncid2
+    INTEGER :: varid,varid2             
+    ! 
+    IF(nbdim==4) THEN      
+       ALLOCATE(tabtemp4d(SIZE(tabvar,1),SIZE(tabvar,2),1,1))
+       tabtemp4d(:,:,1,1) = tabvar(:,:)
+    ELSE IF(nbdim==3) THEN
+       ALLOCATE(tabtemp3d(SIZE(tabvar,1),SIZE(tabvar,2),1))
+       tabtemp3d(:,:,1) = tabvar(:,:)
+    END IF
+    !      
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+    !      
+    IF(nbdim==4) status = nf90_inq_dimid(ncid,dimname(4), dimid4)
+    !      
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    IF(nbdim==4 .AND. typevar == 'double') THEN
+       status = nf90_def_var(ncid,varname,nf90_double,     &
+            (/dimid1,dimid2,dimid3,dimid4/),varid)
+       !                              
+    ELSE IF(nbdim==4 .AND. typevar == 'float') THEN
+       status = nf90_def_var(ncid,varname,nf90_float,     &
+            (/dimid1,dimid2,dimid3,dimid4/),varid)                        
+       !          
+    ELSE IF(nbdim==3 .AND. typevar == 'float') THEN
+       status = nf90_def_var(ncid,varname,nf90_float,     &
+            (/dimid1,dimid2,dimid3/),varid)
+       !
+    ELSE IF(nbdim==3 .AND. typevar == 'double') THEN
+       status = nf90_def_var(ncid,varname,nf90_double,     &
+            (/dimid1,dimid2,dimid3/),varid)
+       !     			      			      
+    ENDIF
+    !      			      
+    status = nf90_enddef(ncid)
+    IF(nbdim==4) status = nf90_put_var(ncid,varid,tabtemp4d)
+    IF(nbdim==3) status = nf90_put_var(ncid,varid,tabtemp3d)
+    !      
+    IF(ALLOCATED( tabtemp3d ) ) DEALLOCATE( tabtemp3d )   
+    IF(ALLOCATED( tabtemp4d ) ) DEALLOCATE( tabtemp4d )     
+    !
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var2d_real_bis
+  !      
+  !      
+  SUBROUTINE write_ncdf_var2d_real(varname,dimname,file,tabvar,typevar)
+    !      
+    !      implicit none
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*), DIMENSION(2) :: dimname
+    REAL*8, DIMENSION(:,:), INTENT(in) :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+
+    SELECT CASE(TRIM(typevar))
+    CASE('double')
+       status = nf90_def_var(ncid,varname,nf90_double,     &
+            (/dimid1,dimid2/),varid)
+    CASE('float')
+       status = nf90_def_var(ncid,varname,nf90_float,     &
+            (/dimid1,dimid2/),varid)     
+    END SELECT
+    !
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var2d_real
+  !      
+  !      
+  SUBROUTINE write_ncdf_var3d_real(varname,dimname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(3),INTENT(in) :: dimname
+    REAL*8, DIMENSION(:,:,:), INTENT(in) :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+
+    SELECT CASE(TRIM(typevar))
+    CASE('double')
+       status = nf90_def_var(ncid,varname,nf90_double,     &
+            (/dimid1,dimid2,dimid3/),varid)
+    CASE('float')
+       status = nf90_def_var(ncid,varname,nf90_float,     &
+            (/dimid1,dimid2,dimid3/),varid)    
+    END SELECT
+    !
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var3d_real
+  !      
+  !      
+  SUBROUTINE write_ncdf_var4d_real(varname,dimname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(4),INTENT(in) :: dimname
+    REAL*8, DIMENSION(:,:,:,:), INTENT(in) :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3,dimid4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !
+    status = nf90_inq_varid(ncid,varname,varid)
+    !      
+    IF(status/=nf90_noerr) THEN
+       !     
+       status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+       status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+       status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+       status = nf90_inq_dimid(ncid,dimname(4), dimid4)
+       status = nf90_redef(ncid)
+       !      
+       SELECT CASE(TRIM(typevar))
+       CASE('double')
+          status = nf90_def_var(ncid,varname,nf90_double,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)
+       CASE('float')
+          status = nf90_def_var(ncid,varname,nf90_float,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)   
+       END SELECT
+       !
+       status = nf90_enddef(ncid)
+    ENDIF
+    !         
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var4d_real
+  !      
+  !      
+  SUBROUTINE write_ncdf_var1d_int(varname,dimname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,dimname,typevar
+    INTEGER, DIMENSION(:), INTENT(in) :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    !           print *,'ici tabvar = ',tabvar,varname,dimname
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname, dimid)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    status = nf90_def_var(ncid,varname,nf90_int,(/dimid/),varid)
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var1d_int
+  !      
+  !      
+  SUBROUTINE write_ncdf_var2d_int(varname,dimname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*), INTENT(in) :: varname,file,typevar
+    CHARACTER(*), DIMENSION(2), INTENT(in) :: dimname
+    INTEGER, DIMENSION(:,:), INTENT(in) :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1),dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2),dimid2)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    status = nf90_def_var(ncid,varname,nf90_int,(/dimid1,dimid2/),varid)
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var2d_int
+  !      
+  !      
+  SUBROUTINE write_ncdf_var3d_int(varname,dimname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(3),INTENT(in) :: dimname
+    INTEGER, DIMENSION(:,:,:), INTENT(in) :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    status = nf90_def_var(ncid,varname,nf90_int,     &
+         (/dimid1,dimid2,dimid3/),varid)
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var3d_int
+  !      
+  !      
+  SUBROUTINE write_ncdf_var4d_int(varname,dimname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(4),INTENT(in) :: dimname
+    INTEGER, DIMENSION(:,:,:,:), INTENT(in) :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3,dimid4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+    status = nf90_inq_dimid(ncid,dimname(4), dimid4)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    status = nf90_def_var(ncid,varname,nf90_int,     &
+         (/dimid1,dimid2,dimid3,dimid4/),varid)
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var4d_int
+  !      
+  !
+  !****************************************************************
+  !   subroutine read_ncdf_var_t					*
+  !								*
+  ! subroutine to read a variable in a given file for time t	*
+  !								*
+  !     varname : name of variable to read			*     
+  !     file    : netcdf file name				*
+  !     tabvar  : values of the read variable			*
+  !     time    : time corresponding to the values to read	*	
+  !								*
+  !****************************************************************
+  !
+  !      
+  SUBROUTINE read_ncdf_var3d_real_t(varname,file,tabvar,time)
+    !      
+    USE agrif_types     
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER,INTENT(in) :: time
+    REAL*8, DIMENSION(:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(3) :: dimIDS
+    INTEGER :: dim1,dim2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    !        
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)
+    !
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,1))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,1/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2,1))      
+       ENDIF
+    ENDIF
+
+    status=nf90_get_var(ncid,varid,tabvar,start=(/1,1,time/))
+
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to retrieve netcdf variable : ",TRIM(varname)
+       STOP
+    ENDIF
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE read_ncdf_var3d_real_t
+  !           
+  !
+  !****************************************************************
+  !   subroutine write_ncdf_var_t					*
+  !								*
+  ! subroutine to write a variable in a given file for time t	*
+  !								*
+  !     varname : name of variable to store			*     
+  !     dimname : name of dimensions of the given variable	*
+  !     file    : netcdf file name				*
+  !     tabvar  : values of the variable to write			*
+  !     time    : time corresponding to the values to store	*	
+  !								*
+  !****************************************************************
+  !
+  !      
+  SUBROUTINE write_ncdf_var3d_real_t(varname,dimname,file,tabvar,time,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(3),INTENT(in) :: dimname
+    INTEGER :: time
+    REAL*8, DIMENSION(:,:,:), INTENT(in) :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    IF(time==1) THEN
+       !      
+       status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+       status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+       status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+       status = nf90_redef(ncid)
+
+       !      
+       SELECT CASE(TRIM(typevar))
+       CASE('double')
+          status = nf90_def_var(ncid,varname,nf90_double,     &
+               (/dimid1,dimid2,dimid3/),varid) 
+       CASE('float')
+          status = nf90_def_var(ncid,varname,nf90_float,     &
+               (/dimid1,dimid2,dimid3/),varid)    
+       END SELECT
+       !
+       status = nf90_enddef(ncid)
+
+    ELSE
+       status = nf90_inq_varid(ncid, varname, varid)
+    ENDIF
+    !      
+    status = nf90_put_var(ncid,varid,tabvar,start=(/1,1,time/))
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to store variable ",varname, &
+	    " in file ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var3d_real_t
+  !      
+  !
+  !****************************************************************
+  !   subroutine read_ncdf_var_t					*
+  !								*
+  ! subroutine to read a variable in a given file for time t	*
+  !						at level n	*
+  !     varname : name of variable to read			*     
+  !     file    : netcdf file name				*
+  !     tabvar  : values of the read variable			*
+  !     time    : time corresponding to the values to read	*	
+  !     level   : level corresponding to the values to read	*
+  !								*
+  !****************************************************************
+  !
+  !      
+  SUBROUTINE read_ncdf_var4d_real_nt(varname,file,tabvar,time,level)
+    !      
+    USE agrif_types     
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER,INTENT(in) :: time,level
+    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(4) :: dimIDS
+    INTEGER :: dim1,dim2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    !        
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)
+    !
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,1,1))  
+    ELSE
+       IF ((SIZE(tabvar,1) /= dim1) .OR. (SIZE(tabvar,2) /= dim2)) THEN
+          DEALLOCATE(tabvar)
+          ALLOCATE(tabvar(dim1,dim2,1,1))
+       ENDIF
+    ENDIF
+    !
+    status=nf90_get_var(ncid,varid,tabvar,start=(/1,1,level,time/),count=(/dim1,dim2,1,1/))
+    !                                             
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to retrieve netcdf variable : ",TRIM(varname)
+       STOP
+    ENDIF
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE read_ncdf_var4d_real_nt
+  !           
+  !      
+  SUBROUTINE read_ncdf_var4d_real_t(varname,file,tabvar,time)
+    !      
+    USE agrif_types     
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER,INTENT(in) :: time
+    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(4) :: dimIDS
+    INTEGER :: dim1,dim2,dim3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    !        
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)
+    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)
+    !
+    IF(.NOT. ASSOCIATED(tabvar)) ALLOCATE(tabvar(dim1,dim2,dim3,1))  
+    status=nf90_get_var(ncid,varid,tabvar,start=(/1,1,1,time/))
+
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to retrieve netcdf variable : ",TRIM(varname)
+       STOP
+    ENDIF
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE read_ncdf_var4d_real_t
+  !           
+  !****************************************************************
+  !   subroutine write_ncdf_var_t					*
+  !								*
+  ! subroutine to write a variable in a given file for time t	*
+  !						at level n	*
+  !     varname : name of variable to store			*     
+  !     dimname : name of dimensions of the given variable	*
+  !     file    : netcdf file name				*
+  !     tabvar  : values of the variable to write			*
+  !     time    : time corresponding to the values to store	*	
+  !     level   : level corresponding to the values to store	*
+  !								*
+  !****************************************************************
+  !
+  !      
+  SUBROUTINE write_ncdf_var4d_real_t(varname,dimname,file,tabvar,time,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(4),INTENT(in) :: dimname
+    INTEGER :: time,level
+    REAL*8, DIMENSION(:,:,:,:), INTENT(in) :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3,dimid4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !      
+    IF(time==1) THEN
+       !      
+       status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+       status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+       status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+       status = nf90_inq_dimid(ncid,dimname(4), dimid4)
+       status = nf90_redef(ncid)
+       !      
+       SELECT CASE(TRIM(typevar))
+       CASE('double')
+          status = nf90_def_var(ncid,TRIM(varname),nf90_double,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)  
+       CASE('float')
+          status = nf90_def_var(ncid,TRIM(varname),nf90_float,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)    
+       END SELECT
+       !
+       status = nf90_enddef(ncid)
+
+    ELSE
+       status = nf90_inq_varid(ncid, varname, varid)
+    ENDIF
+    !    
+    status = nf90_put_var(ncid,varid,tabvar,start=(/1,1,1,time/))
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to store variable ",varname, &
+	    " in file ",file
+       STOP
+    ENDIF
+    !    
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var4d_real_t
+  !      
+  !      
+  SUBROUTINE write_ncdf_var4d_real_nt(varname,dimname,file,tabvar,time,level,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(4),INTENT(in) :: dimname
+    INTEGER :: time,level
+    REAL*8, DIMENSION(:,:,:,:), INTENT(in) :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3,dimid4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !      
+    IF(time==1.AND.level==1) THEN
+       !      
+       status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+       status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+       status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+       status = nf90_inq_dimid(ncid,dimname(4), dimid4)
+       status = nf90_redef(ncid)
+       !      
+       SELECT CASE(TRIM(typevar))
+       CASE('double')
+          status = nf90_def_var(ncid,TRIM(varname),nf90_double,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)  
+       CASE('float')
+          status = nf90_def_var(ncid,TRIM(varname),nf90_float,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)    
+       END SELECT
+       !
+       status = nf90_enddef(ncid)
+
+    ELSE
+       status = nf90_inq_varid(ncid, varname, varid)
+    ENDIF
+    !    
+    status = nf90_put_var(ncid,varid,tabvar,start=(/1,1,level,time/))
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to store variable ",varname, &
+	    " in file ",file
+       STOP
+    ENDIF
+    !    
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var4d_real_nt
+
+  SUBROUTINE write_ncdf_var0d_real(varname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    INTEGER :: time,level
+    REAL*8 :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !      
+
+    status = nf90_redef(ncid)
+    !      
+    SELECT CASE(TRIM(typevar))
+    CASE('double')
+       status = nf90_def_var(ncid,TRIM(varname),nf90_double,     &
+            varid=varid)  
+    CASE('float')
+       status = nf90_def_var(ncid,TRIM(varname),nf90_float,     &
+            varid=varid)    
+    END SELECT
+    !
+    status = nf90_enddef(ncid)
+
+    !    
+    status = nf90_put_var(ncid,varid,tabvar)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to store variable ",varname, &
+	    " in file ",file
+       STOP
+    ENDIF
+    !    
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var0d_real
+
+  SUBROUTINE write_ncdf_var0d_int(varname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    INTEGER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: status,ncid
+    INTEGER :: varid
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)
+    IF (status/=nf90_noerr) THEN
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_redef(ncid)
+    status = nf90_def_var(ncid,TRIM(varname),nf90_int,varid)
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)
+    !     
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to store variable ",varname, &
+	    " in file ",file
+       STOP
+    ENDIF
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var0d_int
+
+  !
+  !****************************************************************
+  !   subroutine read_ncdf_VarName				*
+  !								*
+  ! subroutine to retrieve of all variables 			*
+  ! included in a given file					*
+  !								*
+  !     filename    : netcdf file name				*
+  !     tabvarname  : array containing various variables names	*
+  !								*
+  !****************************************************************
+  !
+  !
+  SUBROUTINE read_ncdf_VarName(filename,tabvarname)
+    !      
+    CHARACTER(*),INTENT(in) :: filename
+    CHARACTER*20,DIMENSION(:),POINTER :: tabvarname
+    INTEGER :: nDimensions,nVariables
+    INTEGER :: nAttributes,unlimitedDimId,i
+    INTEGER :: ncid,status,dimid
+    !     
+    status = nf90_open(filename,NF90_NOWRITE,ncid)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",filename
+       STOP
+    ENDIF
+    !      
+    status = nf90_inquire(ncid,nDimensions,nVariables,nAttributes, &                                                      
+         unlimitedDimId) 
+    !
+    ALLOCATE(tabvarname(nVariables))
+    !
+    DO i=1,nVariables
+       status = nf90_inquire_variable(ncid,i,tabvarname(i))
+    END DO
+
+  END SUBROUTINE read_ncdf_Varname
+  !
+  !
+  SUBROUTINE copy_ncdf_att_var(varname,filein,fileout)
+    !      
+    CHARACTER(*),INTENT(in) :: filein,fileout
+    CHARACTER(*),INTENT(in) :: varname
+    INTEGER :: ncid_in,ncid_out,status,varid_in,varid_out
+    !     
+    !      print *,'filein = ',filein,fileout
+    status = nf90_open(filein,NF90_NOWRITE,ncid_in)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open input netcdf file : ",filein
+       STOP
+    ENDIF
+    !     							     	   
+    status = nf90_open(fileout,NF90_WRITE,ncid_out)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open output netcdf file : ",fileout
+       STOP
+    ENDIF
+    !  
+    !      print *,'ici1'
+    status = nf90_inq_varid(ncid_in,varname,varid_in)
+    status = nf90_inq_varid(ncid_out,varname,varid_out)
+    !
+    status = nf90_redef(ncid_out)
+    !      
+    status = nf90_copy_att(ncid_in,varid_in,'units',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'valid_min',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'valid_max',ncid_out,varid_out) 
+    status = nf90_copy_att(ncid_in,varid_in,'long_name',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'calendar',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'title',ncid_out,varid_out)     
+    status = nf90_copy_att(ncid_in,varid_in,'time_origin',ncid_out,varid_out) 
+    status = nf90_copy_att(ncid_in,varid_in,'positive',ncid_out,varid_out)                 
+    status = nf90_copy_att(ncid_in,varid_in,'tstep_sec',ncid_out,varid_out)          
+    status = nf90_copy_att(ncid_in,varid_in,'nav_model',ncid_out,varid_out)   
+    status = nf90_copy_att(ncid_in,varid_in,'Minvalue=',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'Maxvalue=',ncid_out,varid_out)  
+    status = nf90_copy_att(ncid_in,varid_in,'short_name',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'online_operation',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'axis',ncid_out,varid_out)            
+    status = nf90_copy_att(ncid_in,varid_in,'interval_operation',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'interval_write',ncid_out,varid_out) 
+    status = nf90_copy_att(ncid_in,varid_in,'associate',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'actual_range',ncid_out,varid_out) 
+    status = nf90_copy_att(ncid_in,varid_in,'longitude',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'latitude',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'scale_factor',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'add_offset',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'missing_value',ncid_out,varid_out) 
+    !      
+    status = nf90_enddef(ncid_out)  
+    !
+    status = nf90_close(ncid_in)
+    status = nf90_close(ncid_out)
+    !      print *,'ici2'
+    ! 
+  END SUBROUTINE copy_ncdf_att_var
+  !
+  !
+  SUBROUTINE copy_ncdf_att_latlon(varname,filein,fileout,min,max)
+    !      
+    CHARACTER(*),INTENT(in) :: filein,fileout
+    CHARACTER(*),INTENT(in) :: varname
+    REAL*8 :: min,max
+    INTEGER :: ncid_in,ncid_out,status,varid_in,varid_out
+    !     
+    status = nf90_open(filein,NF90_NOWRITE,ncid_in)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",filein
+       STOP
+    ENDIF
+    !     							     	   
+    status = nf90_open(fileout,NF90_WRITE,ncid_out)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",fileout
+       STOP
+    ENDIF
+    !  
+    status = nf90_inq_varid(ncid_in,varname,varid_in)
+    status = nf90_inq_varid(ncid_out,varname,varid_out)
+    !
+    status = nf90_redef(ncid_out)
+    !      
+    SELECT CASE (varname)
+       !      
+    CASE('nav_lon')     
+       status = nf90_copy_att(ncid_in,varid_in,'units',ncid_out,varid_out) 
+       status = nf90_put_att(ncid_out,varid_out,'valid_min',REAL(min,4))
+       status = nf90_put_att(ncid_out,varid_out,'valid_max',REAL(max,4))
+       status = nf90_copy_att(ncid_in,varid_in,'long_name',ncid_out,varid_out)
+       status = nf90_copy_att(ncid_in,varid_in,'nav_model',ncid_out,varid_out)
+       status = nf90_copy_att(ncid_in,varid_in,'title',ncid_out,varid_out)
+       !
+    CASE('nav_lat')
+       status = nf90_copy_att(ncid_in,varid_in,'units',ncid_out,varid_out) 
+       status = nf90_put_att(ncid_out,varid_out,'valid_min',REAL(min,4))
+       status = nf90_put_att(ncid_out,varid_out,'valid_max',REAL(max,4))
+       status = nf90_copy_att(ncid_in,varid_in,'long_name',ncid_out,varid_out)
+       status = nf90_copy_att(ncid_in,varid_in,'nav_model',ncid_out,varid_out)
+       status = nf90_copy_att(ncid_in,varid_in,'title',ncid_out,varid_out) 
+       !
+    END SELECT
+    !      
+    status = nf90_enddef(ncid_out)  
+    !
+    status = nf90_close(ncid_in)
+    status = nf90_close(ncid_out)
+  END SUBROUTINE copy_ncdf_att_latlon
+
+  !*************************************************************
+  !**************************************************************
+  !
+  INTEGER FUNCTION Get_NbDims( varname , filename )
+    !
+    CHARACTER(*),INTENT(in) :: varname,filename
+    INTEGER :: status,ncid,varid    
+    !      
+    status = nf90_open(TRIM(filename),NF90_NOWRITE,ncid)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",TRIM(filename)
+       STOP
+    ENDIF
+    status = nf90_inq_varid(ncid,TRIM(varname),varid)     
+    status = nf90_inquire_variable(ncid, varid , ndims = Get_NbDims)
+    !
+    RETURN
+    !
+  END FUNCTION Get_NbDims
+  !
+  !
+  LOGICAL FUNCTION Dims_Existence( dimname , filename )
+    !
+    CHARACTER(*),INTENT(in) :: dimname,filename
+    INTEGER :: status,ncid,dimid    
+    !      
+    status = nf90_open(TRIM(filename),NF90_NOWRITE,ncid)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",TRIM(filename)
+       STOP
+    ENDIF
+    status = nf90_inq_dimid(ncid,dimname,dimid)
+    !      
+    IF (status/=nf90_noerr) THEN
+       Dims_Existence = .FALSE.
+    ELSE
+       Dims_Existence = .TRUE.
+    ENDIF
+    !
+    RETURN
+    !
+  END FUNCTION Dims_Existence
+  !
+END MODULE io_netcdf
Index: /utils/tools_ticket2413/NESTING_AGRIF/AGRIF_FixedGrids.in
===================================================================
--- /utils/tools_ticket2413/NESTING_AGRIF/AGRIF_FixedGrids.in	(revision 12863)
+++ /utils/tools_ticket2413/NESTING_AGRIF/AGRIF_FixedGrids.in	(revision 12863)
@@ -0,0 +1,2 @@
+1 
+1 181 50 100 1 1 1
Index: /utils/tools_ticket2413/NESTING_AGRIF/MODEL.CPP
===================================================================
--- /utils/tools_ticket2413/NESTING_AGRIF/MODEL.CPP	(revision 12863)
+++ /utils/tools_ticket2413/NESTING_AGRIF/MODEL.CPP	(revision 12863)
@@ -0,0 +1,1 @@
+#define key_agrif
Index: /utils/tools_ticket2413/NESTING_AGRIF/Makefile
===================================================================
--- /utils/tools_ticket2413/NESTING_AGRIF/Makefile	(revision 12863)
+++ /utils/tools_ticket2413/NESTING_AGRIF/Makefile	(revision 12863)
@@ -0,0 +1,136 @@
+SHELL = /bin/bash
+MPI = NO
+
+include make.inc
+
+PROGS = create_coordinate
+SFMAKEDEPEND := ./sfmakedepend
+DIR_LIB=lib
+DIR_FILES=src
+DIR_PPSRC=NEMOFILES
+DIR_PPSRC_2=ppsrc
+DIR_DOC=doc
+DIR_OBJS=obj
+DIR_LIB=lib
+
+FILENAMES =$(notdir $(basename $(wildcard src/*.F90))) $(notdir $(basename $(wildcard src/*.F))) $(notdir $(basename $(wildcard src/*.c))) $(notdir $(basename $(wildcard src/*.f))) $(notdir $(basename $(wildcard src/*.f90)))
+FILES=src/*
+OBJS=$(addsuffix .o,$(addprefix $(DIR_OBJS)/,$(FILENAMES)))
+OBJS := $(filter-out obj/agrif2model.o, $(OBJS))
+
+PROG=create_coordinate
+
+all: depend conv prepagrif AGRIF_LIB $(OBJS) $(PROGS)
+		@echo
+		@echo ===================================================
+		@echo   Nesting is ok
+		@echo ===================================================
+		@echo
+
+
+create_coordinate: $(DIR_LIB)/libnesting.a $(DIR_PPSRC)/create_coordinate.f90
+		$(FC) $(LINKFLAGS) $(FFLAGS) -o create_coordinate -L$(DIR_LIB) -lnesting $(LIBS) -I$(DIR_OBJS) $(FFLAGS_SPEC) -I../../ext/AGRIF  -L../../ext/AGRIF -lagrif
+
+prepagrif:
+		@echo
+		@echo ===================================================
+		@echo   Create working directories for AGRIF ...
+		@echo ===================================================
+		mkdir -p obj
+		mkdir -p $(DIR_PPSRC_2)
+		mkdir -p $(DIR_LIB)
+		mkdir -p $(DIR_OBJS)
+		mkdir -p $(DIR_PPSRC)
+		mkdir -p $(DIR_PPSRC)/AGRIF_MODELFILES
+		mkdir -p $(DIR_PPSRC)/AGRIF_INC
+		\cp ../../ext/AGRIF/LIB/conv $(DIR_PPSRC)
+		\cp ../../ext/AGRIF/agrif_oce.in $(DIR_PPSRC)
+		@echo
+
+conv:
+		$(MAKE) -C ../../ext/AGRIF/LIB
+
+AGRIF_LIB: 
+		$(MAKE) -C ../../ext/AGRIF FC=$(FC) CPP=$(CPP) FFLAGS="$(FFLAGS)"
+
+$(DIR_LIB)/libnesting.a: $(OBJS) $(DIR_OBJS)/agrif2model.o
+		@echo
+		@echo ===================================================
+		@echo   Compile Nesting library...
+		@echo ===================================================
+		$(AR) -r $@ $(OBJS) $(DIR_OBJS)/agrif2model.o
+		ranlib $@
+		@echo
+
+
+$(DIR_OBJS)/agrif2model.o: $(DIR_FILES)/agrif2model.F90 Makefile  MODEL.CPP 
+		$(CPP) -I$(DIR_PPSRC)/AGRIF_INC -include MODEL.CPP $(CPPFLAGS) $(DIR_FILES)/$(*F).F90 > $(DIR_PPSRC_2)/$(*F).f90
+		$(FC) $(FFLAGS) -c $(DIR_PPSRC_2)/$(*F).f90 -o $(DIR_OBJS)/$(*F).o -I../../ext/AGRIF -I$(DIR_OBJS)  
+
+$(DIR_OBJS)/%.o: $(DIR_FILES)/%.F90 Makefile  MODEL.CPP 
+		$(CPP) -include MODEL.CPP $(CPPFLAGS) $(DIR_FILES)/$(*F).F90 > $(DIR_PPSRC)/$(*F).f90
+			@(cd NEMOFILES ; ./conv ./agrif_oce.in -rm \
+		-comdirin ./ -comdirout AGRIF_MODELFILES/. -convfile $(*F).f90)
+		$(CPP) -I$(DIR_PPSRC)/AGRIF_INC -include MODEL.CPP $(CPPFLAGS)  $(DIR_PPSRC)/AGRIF_MODELFILES/$(*F).f90 >$(DIR_PPSRC_2)/$(*F).f90	
+		$(FC) $(FFLAGS) -c $(DIR_PPSRC_2)/$(*F).f90 -o $(DIR_OBJS)/$(*F).o -I../../ext/AGRIF -I$(DIR_OBJS)  -J$(DIR_OBJS)
+
+$(DIR_OBJS)/%.o: $(DIR_FILES)/%.f90 Makefile MODEL.CPP 
+		$(CPP) -include MODEL.CPP $(CPPFLAGS) $(DIR_FILES)/$(*F).f90 > $(DIR_PPSRC)/$(*F).f90
+			@(cd NEMOFILES ; ./conv agrif_oce.in -rm \
+		-comdirin ./ -comdirout AGRIF_MODELFILES/. -convfile $(*F).f90)
+		$(CPP) -I$(DIR_PPSRC)/AGRIF_INC -include MODEL.CPP $(CPPFLAGS)  $(DIR_PPSRC)/AGRIF_MODELFILES/$(*F).f90 >$(DIR_PPSRC_2)/$(*F).f90	
+		$(FC) $(FFLAGS) -c $(DIR_PPSRC_2)/$(*F).f90 -o $(DIR_OBJS)/$(*F).o -I../../ext/AGRIF -I$(DIR_OBJS)  -J$(DIR_OBJS) 
+
+#$(DIR_OBJS)/%.o: $(DIR_FILES)/%.F Makefile MODEL.CPP
+#		$(CPP) -include MODEL.CPP $(CPPFLAGS) $(DIR_FILES)/$(*F).F > $(DIR_PPSRC)/$(*F).f
+#		$(FC) $(FFLAGS) $(F77FLG) -c $(DIR_PPSRC)/$(*F).f -o $(DIR_OBJS)/$(*F).o
+
+#$(DIR_OBJS)/%.o: $(DIR_FILES)/%.f90 Makefile MODEL.CPP
+#		$(FC) $(FFLAGS) -c $(DIR_PPSRC)/$(*F).f90 -o $(DIR_OBJS)/$(*F).o
+
+#$(DIR_OBJS)/par_oce.o: $(DIR_FILES)/par_oce.f90
+#		echo $(OBJS) $(DIR_FILES)/
+
+#$(DIR_OBJS)/%.o: $(DIR_FILES)/%.c Makefile MODEL.CPP
+#	$(CC) -c $(CFLAGS) -c $(DIR_FILES)/$(*F).c -o $(DIR_OBJS)/$(*F).o
+
+#--------------------------------------------------------------------------
+#  Target to create dependeanies.
+#--------------------------------------------------------------------------
+
+MakeDepend: $(DIR_FILES)
+		$(SFMAKEDEPEND) --silent --fext=f90 --fext=f --fext=F90 --fext=F --fext=c --file=- --moddir=$(DIR_OBJS) --objdir=$(DIR_OBJS)  $(FILES) > MakeDepend
+
+depend: $(DIR_FILES)
+		@echo
+		@echo ===================================================
+		@echo   Create dependancies for Nesting ...
+		@echo ===================================================
+		$(SFMAKEDEPEND) --fext=f90 --fext=f  --silent --fext=F90 --fext=F --fext=c --file=- --moddir=$(DIR_OBJS) --objdir=$(DIR_OBJS)  $(FILES) > MakeDepend
+
+#ifneq "$(MAKECMDGOALS)" "clean"
+-include ./MakeDepend
+#endif
+
+#--------------------------------------------------------------------------
+#  Target to clean
+#--------------------------------------------------------------------------
+
+clean:
+		@echo
+		@echo ===================================================
+		@echo   Clean ...
+		@echo ===================================================
+		$(RM) -rf $(DIR_PPSRC) $(DIR_PPSRC_2) $(DIR_LIB) $(DIR_OBJS) $(PROGS) 
+
+cleangrif:	
+		@echo
+		@echo ===================================================
+		@echo   Clean agrif and conv ...
+		@echo ===================================================
+		$(MAKE) clean -C ../../ext/AGRIF/LIB 
+		$(MAKE) clean -C ../../ext/AGRIF 
+
+cleanall: clean cleangrif
+	
+# DO NOT DELETE THIS LINE - used by make depend	
Index: /utils/tools_ticket2413/NESTING_AGRIF/make.inc
===================================================================
--- /utils/tools_ticket2413/NESTING_AGRIF/make.inc	(revision 12863)
+++ /utils/tools_ticket2413/NESTING_AGRIF/make.inc	(revision 12863)
@@ -0,0 +1,26 @@
+FC=gfortran
+FFLAGS=  -O0 -fdefault-real-8  -ffree-line-length-none -I$(NCDF_ROOT)/include
+FFLAGS_SPEC=  -J$(DIR_OBJS)
+#-fbounds-check  -fbacktrace -g -fcheck=all -Wall
+CPP=cpp
+CPPFLAGS=-P -traditional 
+CPPARCH = 
+CPPFLAGS += $(CPPARCH) 
+
+CC=mpicc
+CFLAGS = -Df2cFortran 
+
+NCDF_ROOT=/usr/local
+INC_NETCDF = -I$(NCDF_ROOT)/include
+LIB_NETCDF= -L$(NCDF_ROOT)/lib/ -lnetcdf -lnetcdff
+
+INCS = $(INC_NETCDF) 
+LIBS =$(LIB_NETCDF)  
+
+# language-specific flags
+#
+F77FLG =  -ffixed-form # -Mfixed
+F90FLG =  -ffree-form -ffree-line-length-0 # -Mfree
+
+MPI = NO
+
Index: /utils/tools_ticket2413/NESTING_AGRIF/sfmakedepend
===================================================================
--- /utils/tools_ticket2413/NESTING_AGRIF/sfmakedepend	(revision 12863)
+++ /utils/tools_ticket2413/NESTING_AGRIF/sfmakedepend	(revision 12863)
@@ -0,0 +1,787 @@
+#!/usr/bin/env perl
+#
+# svn $Id: sfmakedepend 751 2015-01-07 22:56:36Z arango $
+#######################################################################
+# Copyright (c) 2002-2015 The ROMS/TOMS Group                         #
+#   Licensed under a MIT/X style license                              #
+#   See License_ROMS.txt                                              #
+##################################################### Kate Hedstrom ###
+#                                                                     #
+# Fortran 90/77 dependency checker, version 2007b.                    #
+#                                                                     #
+#######################################################################
+
+use 5.6.0;
+use strict;
+use File::Basename;
+use Getopt::Long;
+use Pod::Usage;
+use Getopt::Long;
+use File::Copy;
+
+my ($opt_help, $opt_man, $opt_file, @incdirs, @srcdirs, @defines,
+    $opt_modext, $opt_case, $compiler, $opt_depend, $drop_circ);
+our ($cpp, $add_ext, $mod_dir, $libdeps, $longpath, $obj_dir, %defines,
+    $silent);
+our $obj_ext = 'o';
+our $ext = 'f';
+
+# Parse the arguments, do the right thing for --help, --man.
+Getopt::Long::Configure( "bundling" );
+GetOptions("help" => \$opt_help,    "man" => \$opt_man,
+        "file=s" => \$opt_file,     "I=s@" => \@incdirs,
+	"srcdir=s@" => \@srcdirs,   "moddir=s" => \$mod_dir,
+        "fext=s" => \$ext,          "objext=s" => \$obj_ext,
+	"modext=s" => \$opt_modext, "addext=s" => \$add_ext,
+	"case=s" => \$opt_case,     "compiler=s" => \$compiler,
+	"depend=s" => \$opt_depend, "cpp" => \$cpp,
+	"libdeps" => \$libdeps,     "drop" => \$drop_circ,
+	"longpath" => \$longpath,   "objdir=s" => \$obj_dir,
+	"D=s@" => \@defines,        "silent" => \$silent )
+  or pod2usage("Try '$0 --help' for more information");
+pod2usage(-verbose => 1) if $opt_help;
+pod2usage(-verbose => 2) if $opt_man;
+
+our @suffixes = qw( .c .C .cc .cxx .cpp .f .F .f90 .F90 .f95 .F95 .for);
+our @mod_files = ();
+
+my $mf = 'Makefile';
+if ($opt_file) {
+    $mf = $opt_file;
+} elsif (-f "makefile") {
+    $mf = 'makefile';
+}
+if ( !(-f $mf) && ($mf ne '-')) {
+    system "touch $mf";
+}
+
+if (@defines) {
+    my $foo;
+    foreach $foo (@defines) {
+        my($before, $after) = split /=/, $foo;
+	$defines{$before} = $after;
+    }
+}
+
+# extension used for compiler's private module information
+our $mod_ext = "mod";
+our $depend = "obj";
+our $case = "lower";
+our $obj_dep_flag;
+my $ll = 79;             # maximum line length in Makefile
+my $cray;
+my $parasoft;
+my $nothing = "\n";
+
+# Check the compiler first, then override the compiler-specific defaults
+if ($compiler) {
+    if ($compiler eq "crayold") {
+        $cray = 1;
+        $case = "lower";
+        $depend = "obj";
+        $obj_dep_flag = "-p";
+    } elsif ($compiler eq "cray") {
+        $case = "upper";
+    } elsif ($compiler eq "parasoft") {
+        $parasoft = 1;
+        $case = "lower";
+        $depend = "obj";
+        $obj_dep_flag = "-module";
+    } elsif ($compiler eq "sgiold") {
+        $mod_ext = "kmo";
+        $case = "upper";
+    } elsif ($compiler eq "sgi" or $compiler eq "hp" or
+	     $compiler eq "absoft") {
+        $case = "upper";
+    } elsif ($compiler eq "nag" or $compiler eq "ibm" or
+	     $compiler eq "sun") {
+        $case = "lower";
+    } else {
+        warn "Unknown compiler: $compiler\n";
+    }
+}
+
+$depend = $opt_depend if defined($opt_depend);
+if ($depend eq "obj") {
+    $drop_circ = 1;
+}
+
+$case = $opt_case if defined($opt_case);
+
+# extension used for compiler's private module information
+if ($opt_modext) {
+    $mod_ext = $opt_modext;
+}
+
+# need to add some more dependencies so the .f file gets created
+our $need_f;
+if ($cpp and $depend eq "obj") {
+    $need_f = 1;
+}
+
+my $mystring = '# DO NOT DELETE THIS LINE - used by make depend';
+
+# Search for the includes in all the files
+my $file;
+my %sources;
+foreach $file (@ARGV) {
+    my $filesrc = findsrc($file);
+    $sources{$file} = new Source_File($file, $filesrc, $filesrc);
+    $sources{$file}->find_includes();
+}
+
+# Create new Makefile with new dependencies.
+
+if ($mf ne "-") {
+    copy( "$mf", "$mf.old");
+    open(MFILE, "$mf.old") || die "can't read Makefile $mf.old: $!\n";
+    open(NMFILE, "> $mf") || die "can't write $mf: $!\n";
+    select(NMFILE);
+
+    while (<MFILE>) {
+        if (!/$mystring/) {
+            print;
+        } else {
+            last;
+        }
+    }
+    print $mystring, "\n";
+}
+
+# Now print out include and use dependencies in sorted order.
+my $target;
+foreach $target (sort keys(%sources)) {
+    $sources{$target}->print();
+# Hernan hack
+    print $nothing;
+}
+
+# print out module dependencies
+if ( !( $cray || $parasoft) ) {
+    my $modname;
+    foreach $modname (sort keys(%main::mod_files)) {
+        my ($name, $path, $suffix) = fileparse(
+	    $sources{$main::mod_files{$modname}}->{'filepath'}, @suffixes);
+        my $object = $name . "." . $obj_ext;
+        if (!( $drop_circ && lc($modname) eq lc($name)) ) {
+            $object =~ s#^\./##;
+            my $modfile = "$modname.$mod_ext";
+            my $objfile = $object;
+            $modfile = $mod_dir . '/' . $modfile if $mod_dir;
+            $objfile = $obj_dir . '/' . $objfile if $obj_dir;
+            print "$modfile: $objfile\n";
+        }
+    }
+}
+
+#
+# End of main
+#
+
+sub findfile {
+# Let's see if we can find the included file. Look in current
+# directory first, then in directories from -I arguments.
+    my $file = shift;
+    my ($found, $i, $filepath);
+
+    $found = 0;
+
+    if ( -f $file ) {
+        $found = 1;
+        $file =~ s#^\./##;          # convert ./foo.h to foo.h
+        return $file;
+    }
+    foreach $i (0 .. $#incdirs) {
+        $filepath = $incdirs[$i]."/".$file;
+        if ( -f $filepath ) {
+	    $found = 1;
+            $filepath =~ s#^\./##;          # convert ./foo.h to foo.h
+            return $filepath;
+        }
+    }
+    if ( ! $found ) {
+	$filepath = "";
+    }
+    $filepath;
+}
+#-----------------------------------------------------------------------
+sub findsrc {
+# Let's see if we can find the source-file.  Look in current
+# directory first, then in directories from --srcdir arguments.
+    my $src = shift;
+    my($found, $i, $srcpath);
+
+    $found = 0;
+
+    if ( -f $src ) {
+        $found = 1;
+        $src =~ s#^\./##;          # convert ./foo.h to foo.h
+        return $src;
+    }
+    foreach $i (0 .. $#srcdirs) {
+        $srcpath = $srcdirs[$i]."/".$src;
+        if ( -f $srcpath ) {
+	    $found = 1;
+            $srcpath =~ s#^\./##;          # convert ./foo.h to foo.h
+            return $srcpath;
+        }
+    }
+    if ( ! $found ) {
+	$srcpath = "";
+    }
+    $srcpath;
+}
+
+#################################################################
+package Source_File;
+
+# hash containing names of included files
+my %inc_files = ();
+my %flist;
+
+# Constructor
+sub new {
+    my $type = shift;
+    my $filename = shift;
+    my $path = shift;
+    my $parent = shift;
+    my $self = {};
+    $self->{'Source_File'} = $filename;
+    $self->{'filepath'} = $path;
+    $self->{'parent'} = $parent;
+    $self->{'includes'} = {};
+    $self->{'uses'} = {};
+    $self->{'modules'} = {};
+    bless $self;
+}
+
+sub find_includes {
+    my $self = shift;
+    my $file = $self->{'filepath'};
+    my $parent = $self->{'parent'};
+    my($after, $filepath, $ref, $included, $use, $modname);
+    local(*FILE);
+    local($_);
+
+    if (-f $file) {
+        open(FILE, $file) || $silent || warn "Can't open $file: $!\n";
+    } else {
+	return;
+    }
+    while (<FILE>) {
+	$included = "";
+	$use = "";
+        # look for Fortran style includes
+        if (/^\s*include\s*['"]([^"']*)["']/i) {
+            $included = $1;
+	    $after = $';
+	# C preprocessor style includes
+        } elsif (/^#\s*include\s*["<]([^">]*)[">]/) {
+            $included = $1;
+	    $after = $';
+        # Fortran 90 "use"
+        } elsif (/^\s*use\s+(\w+)/i) {
+	    # Gavin Salam attempt at dealing with multiple uses on one line
+	    # remove trailing comments (do not take uses after a comment!)
+	    s/\!.*//;
+	    # try and get multiple use commands
+	    my @commands = split(';',$_);
+	    while (my $command = shift @commands) {
+	      if ($command =~ /^\s*use\s+(\w+)/i) {
+		$use = $1;
+		# Change the case as needed - compiler dependent.
+		if ($main::case eq "upper") {
+		  $use = uc($use);
+		} elsif ($main::case eq "lower") {
+		  $use = lc($use);
+		}
+		$self->{'uses'}{$use} = 1;
+	      }
+	    }
+	# Fortran 90 module
+	} elsif (/^\s*module\s+(\w+)/i) {
+	    $modname = $1;
+	    if ($main::case eq "upper") {
+		$modname = uc($modname);
+	    } elsif ($main::case eq "lower") {
+		$modname = lc($modname);
+	    }
+	    # Skip "module procedure" in interface blocks
+	    next if (lc($modname) eq "procedure");
+
+	    $main::mod_files{$modname} = $parent;
+	    $self->{'modules'}{$modname} = 1;
+	}
+	# C preprocessor style includes of a -DROMS_HEADER sort
+        my $key;
+        foreach $key (keys(%defines)) {
+	    if (/^#\s*include\s*($key)/) {
+	        $included = $defines{$key};
+	        $after = $';
+	    }
+	}
+	if ($included) {
+	    # See if we've already searched this file
+	    if ( $inc_files{$included} ) {
+		$filepath = $inc_files{$included}{'filepath'};
+	    } else {
+                $filepath = main::findfile($included);
+		$ref = new Source_File($included, $filepath, $parent);
+                $inc_files{$included} = $ref;
+# Search included file for includes
+		$ref->find_includes();
+	    }
+            if ( $filepath ) {
+		$self->{'includes'}{$included} = 1;
+	    } else {
+                if ($after !~ /bogus/i) {
+		    $silent || warn "Can't find file: $included\n";
+		}
+	    }
+	}
+    }
+    close FILE;
+}
+
+sub print_includes {
+    my $self = shift;
+    my $target = shift;
+    my $len_sum = shift;
+    my $file;
+    my $len;
+
+    foreach $file (keys %{$self->{'includes'}}) {
+	if (!$flist{$file}) {
+	    $flist{$file} = 1;
+	    my $ref = $inc_files{$file};
+	    if ($longpath) {
+                $len = length($ref->{'filepath'}) + 1;
+            } else {
+                $len = length($ref->{'Source_File'}) + 1;
+            }
+	    if (($len_sum + $len > $ll) &&
+	           (length($target) + 1 < $len_sum)) {
+	        print "\n$target:";
+	        $len_sum = length($target) + 1;
+	    }
+	    if ($longpath) {
+	        print " " . $ref->{'filepath'};
+	    } else {
+	        print " " . $ref->{'Source_File'};
+	    }
+    	    $len_sum += $len;
+	    $len_sum = $ref->print_includes($target, $len_sum);
+        }
+    }
+    $len_sum;
+}
+
+# return list of modules used by included files
+sub inc_mods {
+    my $self = shift;
+    my($file, $ref, $mod, @sub_list);
+    my @list = ();
+
+    foreach $mod (keys %{$self->{'uses'}}) {
+	push(@list, $mod);
+    }
+
+    foreach $file (keys %{$self->{'includes'}}) {
+	$ref = $inc_files{$file};
+	@sub_list = $ref->inc_mods();
+	@list = (@list, @sub_list);
+    }
+    @list;
+}
+
+# filenames containing the modules used by file and all its includes
+sub find_mods {
+    my $self = shift;
+    my($modname, $file);
+    my @module_files = ();
+    my @mod_list = ();
+
+# find modules used by include files
+    if (%{$self->{'includes'}}) {
+	foreach $file (keys %{$self->{'includes'}}) {
+	    my $ref = $inc_files{$file};
+	    my @list = $ref->inc_mods();
+	    @mod_list = (@mod_list, @list);
+	}
+    }
+
+# add them to the uses list (hash ensures uniqueness)
+    foreach $modname (@mod_list) {
+	$self->{'uses'}{$modname} = 1;
+    }
+
+# now find the filename that contains the module information
+    foreach $modname (keys %{$self->{'uses'}}) {
+	if ($main::depend eq "obj") {
+	    if ($file = $main::mod_files{$modname}) {
+                my $base = main::basename($file, @main::suffixes);
+		$file = $base . "." . $main::obj_ext;
+		push(@module_files, $file);
+	    } elsif ( !$silent ) {
+		warn "Don't know where module $modname lives.\n";
+	    }
+	} else {
+	    if ($main::libdeps or defined($main::mod_files{$modname})) {
+		$modname .= "." . $main::mod_ext;
+		push(@module_files, $modname);
+	    } elsif ( !$silent ) {
+		warn "Couldn't locate source for module $modname\n";
+	    }
+	}
+    }
+    sort(@module_files);
+}
+
+sub print {
+    my $self = shift;
+    my $source = $self->{'Source_File'};
+    my $compile_string = "\t" . '$(F90) $(F90FLAGS) -c';
+    my($len_sum, $len);
+    my($base, $object, $modname, $flag, $target, $ftarget);
+
+    $base = main::basename($source, @main::suffixes);
+    $base = $main::obj_dir . '/' . $base if $main::obj_dir;
+    $target = $base . "." . $main::obj_ext;
+    if ($main::cpp) {
+	$ftarget = $base . "." . $main::ext;
+    }
+
+    $flag = $main::obj_dep_flag;
+
+# print out "include" dependencies
+    %flist = ();
+    if (%{$self->{'includes'}}) {
+	$len_sum = length($target) + 1;
+	if ($main::add_ext) {
+	    print "$base.$main::add_ext ";
+	    $len_sum += length($base) + length($main::add_ext) + 2;
+	}
+        print "$target:";
+        $self->print_includes($target, $len_sum);
+        print "\n";
+        if ($main::cpp) {
+            %flist = ();
+	    $len_sum = length($ftarget) + 1;
+            print "$ftarget:";
+            $self->print_includes($ftarget, $len_sum);
+            print "\n";
+        }
+    }
+
+# clean out "use" of modules in own file
+    my $mod;
+    foreach $mod ( keys %{$self->{'uses'}} ) {
+	if ( ${$self->{'modules'}}{$mod} ) {
+	    delete ${$self->{'uses'}}{$mod};
+	}
+    }
+
+# print out "use" dependencies
+    if (%{$self->{'uses'}} || %{$self->{'includes'}}) {
+	my @module_files = $self->find_mods();
+        $len_sum = 0;
+	my $file;
+	foreach $file (@module_files) {
+	    $file = $main::mod_dir . '/' . $file if $main::mod_dir;
+            if( $len_sum < 1 ) {
+ 	        $len_sum = length($target) + 1;
+ 	        print "$target:";
+            }
+	    $len = length($file) + 1;
+	    if (($len_sum + $len > $ll) &&
+		     (length($target) + 1 < $len_sum)) {
+		print "\n$target:";
+		$len_sum = length($target) + 1;
+	    }
+	    $len_sum += $len;
+	    print " " . $file;
+	}
+	if ($main::need_f) {
+	    $len = length($ftarget) + 1;
+	    if (($len_sum + $len > $ll) &&
+		     (length($target) + 1 < $len_sum)) {
+		print "\n$target:";
+		$len_sum = length($target) + 1;
+	    }
+	    print " " . $ftarget if $len_sum;
+	}
+        print "\n" if $len_sum;
+# extra Cray / Parasoft stuff
+        if ($flag) {
+	    print $compile_string;
+	    foreach $file (@module_files) {
+		print $flag . $file;
+	    }
+	    if ($main::cpp) {
+	        print " " . $ftarget . "\n";
+	    } else {
+	        print " " . $source . "\n";
+	    }
+	}
+    }
+}
+
+__END__
+
+sfmakedepend - Fortran Dependency Checker
+
+=head1 SYNOPSIS
+
+sfmakedepend [--help] [--man] [--file=file] [-I dir]
+             [--srcdir dir] [--objdir dir] [--moddir dir]
+             [--fext ext] [--objext ext] [--modext ext]
+             [-D TAG=file] [--addext ext] [--case=up|down|asis]
+             [--compiler=crayold|cray|sgiold|sgi|nag|ibm|
+                                 parasoft|hp|absoft|sun]
+             [--depend=mod|obj] [--cpp] [--libdeps] [--drop]
+             [--silent] file ...
+
+=head1 DESCRIPTION
+
+This is a makedepend script for Fortran, including Fortran 90.
+It searches for Fortran style includes, C preprocessor includes,
+and module dependencies to the extent that I understand them.
+
+Your files must have an extension listed in the @suffixes list
+in the code. You might also want to modify $compile_string;
+the compiler is called $(F90).
+
+=head1 OPTIONS AND ARGUMENTS
+
+=over 4
+
+=item I<--help>
+
+Print more details about the arguments.
+
+=item I<--man>
+
+Print a full man page.
+
+=item I<--file file>
+
+Change the name of the current Makefile (default is Makefile).
+Use "--file -" to write to stdout.
+
+=item I<-I dir>
+
+Look in alternate directories for the include files. There can be
+several "-I dir" options used at once. The current directory is
+still searched first.
+
+=item I<--srcdir dir>
+
+Look in alternate directories for the source files, much like VPATH.
+It can be used multiple times to search in more than one directory.
+
+=item I<--objdir dir>
+
+Tells sfmakedepend to prepend objdir to all object references (and
+cpp output files if used). This is required if you use a build
+directory that isn't your current directory.
+
+=item I<--moddir dir>
+
+Tells sfmakedepend to prepend moddir to all module references. This
+is required if you use a common module library directory for a
+multi-directory project (+moddir= .. option on HP, eg.).
+
+=item I<--fext>
+
+This is used with the --cpp switch for compilers
+which expect an extension other than .f on source files.  For
+instance, one might choose to use "--fext f90".
+
+=item I<--objext ext>
+
+Tells sfmakedepend what extension to use for object files. The
+default is "o", but "obj", for instance, is
+appropriate on MS-DOG etc.
+
+=item I<--modext ext>
+
+Specifies the extension to use for Fortran 90 module files. The default
+extension is "mod" since this seems to be an emerging standard. Let
+me know if other compilers use a different filename for the module
+information (keep that --compiler option up to date).
+
+=item I<--D tag=file>
+
+Tells sfmakedepend to search the source files for lines such as:
+
+   #include MY_CHEESE
+
+Where MY_CHEESE is set with a -DMY_CHEESE="wensleydale.h".
+
+=item I<--addext ext>
+
+Tells sfmakedepend to add targets with extension add_ext to the rules
+for object files. For instance, to operate with (f77) ftnchek .prj
+files, you could use
+
+`--addext prj' to get rules like:
+foo.prj foo.o: ...
+
+=item I<--case up|down|asis>
+
+Controls case of module names when generating module file names. Only
+relevant where the module file name is named after the module rather
+than after the source file.
+
+=item I<--compiler=crayold|cray|sgiold|sgi|nag|ibm|parasoft|hp|absoft|sun>
+
+Controls the type of target compiler, setting the module name and other
+options appropriately. The cray option assumes that FFLAGS includes
+-e m for creating the .mod file, while crayold refers to the default of
+including that information in the object file.
+
+=item I<--depend=mod|obj>
+
+Whether to use the module information file or the module object file
+in dependencies.
+
+=item I<--cpp>
+
+There are times when one might choose to run .F files through cpp and
+to keep the .f files (for the debugger or for a custom preprocessor).
+In that case, make must be told about the cpp include dependencies of
+the .f files. This option will provide those dependencies.
+
+=item I<--libdeps>
+
+Generate dependencies on modules for which source code is not
+available. Otherwise a warning is issued, but the dependency is not
+listed.
+
+=item I<--longpath>
+
+Keep the full path to the include files in the dependency. Otherwise,
+just print the filename and use VPATH to provide the directory
+information.
+
+=item I<--drop>
+
+Drop module dependencies (my_mod.mod: my_mod.o). This is also done when
+--depend=obj.
+
+=item I<--silent>
+
+The default is to warn about unfound files. This option causes those
+warnings to not be printed.
+
+=item I<[file ...]>
+
+The list of source files to search for dependencies.
+
+=back
+
+=head1 EXAMPLE
+
+Search for include files in /usr/local/include:
+
+   sfmakedepend --cpp --fext=f90 -I /usr/local/include *.F
+
+Example usage in gnuMakefile:
+
+   SRCDIRS= srcdir1 srcdir2 srcdir3 ...
+   FSRCS0 := $(foreach DIR, . $(SRCDIRSH),$(wildcard $(DIR)/*.f))
+   FSRCS  := $(sort $(notdir $(FSRCS0)))
+
+   F_makedepend=sfmakedepend  --file - $(addprefix --srcdir ,$(SRCDIRSH)) \
+                                      $(subst -I,-I ,$(Includes))
+   depend $(MAKEFILE_INC):
+             $(F_makedepend) $(FSRCS) >> $(MAKEFILE_INC)
+
+   include $(MAKEFILE_INC)
+
+=head1 AUTHOR
+
+Kate Hedstrom (kate@arsc.edu)
+   First Perl 5 Fortran 90 version November 1994.
+
+=head1 CONTRIBUTORS
+
+   Dave Love         (d.love@dl.ac.uk)
+       Added the --objext and --addext options (1996).
+
+   Patrick Jessee
+       Added hp support (1997, now in --compiler option).
+
+   Sergio Gelato     (gelato@tac.dk)
+       Added the --compiler, --depend, --case options, and
+       --(no)libdeps (1998).
+
+   Tobias Buchal     (buchal@ifh.bau-verm.uni-karlsruhe.de)
+       Added the --srcdir and --file - options (1999).
+
+   Klaus Ramstock    (klaus@tdm234.el.utwente.nl)
+       Added the --moddir option (1999).
+
+   Sandra Schroedter (sandra@fsg-ship.de)
+       Fix to preserve Makefile links (1999).
+
+   Holger Bauer      (bauer@itsm.uni-stuttgart.de)
+       Added the --drop option (2000).
+
+   Gavin Salam       (salam@lpthe.jussieu.fr)
+       Made it recognize multiple "use"s on one line (2005).
+
+Others I've doubtless forgotten.
+
+=cut
+#
+# NOTES
+#	This makedepend script is my first attempt at using perl 5
+#	objects.  Therefore, it may not be the best example of how
+#	to do this.  Also, it requires perl 5 and will die if you
+#	to use it with an older perl.  The latest version is
+#	available from:
+#
+#		http://www.arsc.edu/~kate/Perl/
+#		ftp://ahab.rutgers.edu/pub/perl/sfmakedepend
+#
+#	Fortran 90 introduces some interesting dependencies.  Two
+#	compilers I have access to (NAG f90 and IBM xlf) produce a
+#	private "mod_name.mod" file if you define "module mod_name"
+#	in your code.  This file is used by the compiler when you
+#	use the module as a consistency check (type-safe).  On the
+#	other hand, the Cray and Parasoft compilers store the module
+#	information in the object file and then files which use the
+#	modules need to be compiled with extra flags pointing to the
+#	module object files.
+#
+#	This script assumes that all the files using and defining
+#	modules are in the same directory and are all in the list of
+#	files to be searched.  It seems that the industry has not
+#	settled on a practical way to deal with a separate modules
+#	directory, anyway.
+#
+#	I sometimes include non-existent files as a compile time
+#	consistency check:
+#
+#	   #ifndef PLOTS
+#	   #include "must_define_PLOTS"       /* bogus include */
+#	   #endif
+#
+#	This program warns about include files it can't find, but
+#	not if there is a "bogus" on the same line.
+#
+#     *	The f90 module dependencies can confuse some versions of
+#	make, especially of the System V variety.  We use gnu
+#	make because it has no problems with these dependencies.
+#
+# BUGS
+#	It can sometimes produce duplicate dependencies.
+#
+#	It treats C preprocessor includes the same as Fortran
+#	includes.  This can add unnecessary dependencies if you
+#	use the -s flag and both kinds of includes.
+#
+#       Please let me know if you find any others.
+#	Kate Hedstrom
+#	kate@arsc.edu
Index: /utils/tools_ticket2413/NESTING_AGRIF/src/agrif2model.F90
===================================================================
--- /utils/tools_ticket2413/NESTING_AGRIF/src/agrif2model.F90	(revision 12863)
+++ /utils/tools_ticket2413/NESTING_AGRIF/src/agrif2model.F90	(revision 12863)
@@ -0,0 +1,89 @@
+#if defined key_agrif
+   !!----------------------------------------------------------------------
+   !! NEMO/NST 4.0 , NEMO Consortium (2018)
+   !! $Id: agrif2model.F90 10068 2018-08-28 14:09:04Z nicolasmartin $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+SUBROUTINE Agrif2Model
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif2Model ***
+      !!--------------------------------------------- 
+END SUBROUTINE Agrif2model
+
+SUBROUTINE Agrif_Set_numberofcells(Agrif_Gr)
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Set_numberofcells ***
+      !!--------------------------------------------- 
+   USE Agrif_Grids
+   IMPLICIT NONE
+
+   TYPE(Agrif_Grid), POINTER :: Agrif_Gr
+
+   IF ( ASSOCIATED(Agrif_Curgrid) )THEN
+#include "SetNumberofcells.h"
+   ENDIF
+
+END SUBROUTINE Agrif_Set_numberofcells
+
+SUBROUTINE Agrif_Get_numberofcells(Agrif_Gr)
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Get_numberofcells ***
+      !!--------------------------------------------- 
+   USE Agrif_Grids
+   IMPLICIT NONE
+
+   TYPE(Agrif_Grid), POINTER :: Agrif_Gr
+
+   IF ( ASSOCIATED(Agrif_Curgrid) ) THEN
+#include "GetNumberofcells.h"
+   ENDIF
+
+END SUBROUTINE Agrif_Get_numberofcells
+
+SUBROUTINE Agrif_Allocationcalls(Agrif_Gr)
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Allocationscalls ***
+      !!--------------------------------------------- 
+   USE Agrif_Grids 
+#include "include_use_Alloc_agrif.h"
+   IMPLICIT NONE
+
+   TYPE(Agrif_Grid), POINTER :: Agrif_Gr
+
+#include "allocations_calls_agrif.h"
+
+END SUBROUTINE Agrif_Allocationcalls
+
+SUBROUTINE Agrif_probdim_modtype_def()
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_probdim_modtype_def ***
+      !!--------------------------------------------- 
+   USE Agrif_Types
+   IMPLICIT NONE
+
+#include "modtype_agrif.h"
+#include "probdim_agrif.h"
+#include "keys_agrif.h"
+
+   RETURN
+
+END SUBROUTINE Agrif_probdim_modtype_def
+
+SUBROUTINE Agrif_clustering_def()
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_clustering_def ***
+      !!--------------------------------------------- 
+   IMPLICIT NONE
+
+   RETURN
+
+END SUBROUTINE Agrif_clustering_def
+
+#else
+SUBROUTINE Agrif2Model
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif2Model ***
+      !!--------------------------------------------- 
+   WRITE(*,*) 'Impossible to bet here'
+END SUBROUTINE Agrif2model
+#endif
Index: /utils/tools_ticket2413/NESTING_AGRIF/src/agrif_create_coordinates.f90
===================================================================
--- /utils/tools_ticket2413/NESTING_AGRIF/src/agrif_create_coordinates.f90	(revision 12863)
+++ /utils/tools_ticket2413/NESTING_AGRIF/src/agrif_create_coordinates.f90	(revision 12863)
@@ -0,0 +1,28 @@
+program create_coordinates
+use agrif_util
+use par_oce
+use user_allocate
+use variables
+use io_netcdf
+
+  INTEGER :: narg,iargc
+  CHARACTER(len=80) :: namelistname
+  
+call agrif_init_grids()
+
+  narg = iargc()
+
+  IF (narg == 0) THEN
+     namelistname = 'namelist.input'
+  ELSE
+     CALL getarg(1,namelistname)
+  ENDIF
+
+  ! read input file (namelist.input)
+  CALL read_namelist(namelistname)
+  
+CALL read_ncdf_var('glamt',TRIM(parent_coordinate_file),glamt)
+
+call allocate_arrays()
+stop
+end
Index: /utils/tools_ticket2413/NESTING_AGRIF/src/agrif_user.f90
===================================================================
--- /utils/tools_ticket2413/NESTING_AGRIF/src/agrif_user.f90	(revision 12863)
+++ /utils/tools_ticket2413/NESTING_AGRIF/src/agrif_user.f90	(revision 12863)
@@ -0,0 +1,26 @@
+subroutine agrif_user
+
+end subroutine agrif_user
+
+subroutine agrif_initworkspace
+
+end subroutine agrif_initworkspace
+
+subroutine agrif_initvalues
+
+end subroutine agrif_initvalues
+
+SUBROUTINE Agrif_detect( kg, ksizex )
+      !!----------------------------------------------------------------------
+      !!                      *** ROUTINE Agrif_detect ***
+      !!----------------------------------------------------------------------
+   INTEGER, DIMENSION(2) :: ksizex
+   INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
+      !!----------------------------------------------------------------------
+   !
+   RETURN
+   !
+END SUBROUTINE Agrif_detect
+
+SUBROUTINE agrif_before_regridding
+END SUBROUTINE agrif_before_regridding
Index: /utils/tools_ticket2413/NESTING_AGRIF/src/allocate_arrays.f90
===================================================================
--- /utils/tools_ticket2413/NESTING_AGRIF/src/allocate_arrays.f90	(revision 12863)
+++ /utils/tools_ticket2413/NESTING_AGRIF/src/allocate_arrays.f90	(revision 12863)
@@ -0,0 +1,8 @@
+module user_allocate
+contains
+subroutine allocate_arrays
+use variables
+glamt=-2.
+end subroutine allocate_arrays
+
+end module user_allocate
Index: /utils/tools_ticket2413/NESTING_AGRIF/src/create_coordinate.f90
===================================================================
--- /utils/tools_ticket2413/NESTING_AGRIF/src/create_coordinate.f90	(revision 12863)
+++ /utils/tools_ticket2413/NESTING_AGRIF/src/create_coordinate.f90	(revision 12863)
@@ -0,0 +1,4 @@
+program create_coordinate
+use par_oce
+
+end
Index: /utils/tools_ticket2413/NESTING_AGRIF/src/io_netcdf.f90
===================================================================
--- /utils/tools_ticket2413/NESTING_AGRIF/src/io_netcdf.f90	(revision 12863)
+++ /utils/tools_ticket2413/NESTING_AGRIF/src/io_netcdf.f90	(revision 12863)
@@ -0,0 +1,1606 @@
+!************************************************************************
+! Fortran 95 OPA Nesting tools						*
+!									*
+!     Copyright (C) 2005 Florian Lemari�(Florian.Lemarie@imag.fr)	*
+!									*
+!************************************************************************
+!
+!********************************************************************************
+!										*
+! module io_netcdf								*
+!										*
+! NetCDF Fortran 90 read/write interface					*
+! using input/output functions provided						*
+! by unidata									*
+!										*
+!http://my.unidata.ucar.edu/content/software/netcdf/docs/netcdf-f90/index.html	*
+!										*
+!********************************************************************************
+!
+!
+!
+MODULE io_netcdf
+  !      
+  USE netcdf
+  USE agrif_types
+  !      
+  INTERFACE read_ncdf_var
+     MODULE PROCEDURE  &
+        read_ncdf_var0d_real, read_ncdf_var1d_real, read_ncdf_var2d_real  , read_ncdf_var2d_real_bis,                        &
+        read_ncdf_var3d_real, read_ncdf_var4d_real, read_ncdf_var3d_real_t, read_ncdf_var4d_real_t, read_ncdf_var4d_real_nt, &
+        read_ncdf_var0d_int,  read_ncdf_var1d_int , read_ncdf_var2d_int   , read_ncdf_var3d_int   , read_ncdf_var4d_int
+  END INTERFACE
+  !
+  INTERFACE write_ncdf_var
+     MODULE PROCEDURE &
+        write_ncdf_var0d_real, write_ncdf_var1d_real  , write_ncdf_var2d_real  , write_ncdf_var3d_real,    &
+        write_ncdf_var4d_real, write_ncdf_var3d_real_t, write_ncdf_var4d_real_t, write_ncdf_var4d_real_nt, &                           
+        write_ncdf_var2d_real_bis ,                                                                        &			   
+        write_ncdf_var0d_int, write_ncdf_var1d_int, write_ncdf_var2d_int, write_ncdf_var3d_int, write_ncdf_var4d_int
+  END INTERFACE
+  ! 
+  INTERFACE copy_ncdf_att
+     MODULE PROCEDURE copy_ncdf_att_latlon,copy_ncdf_att_var
+  END INTERFACE
+  !
+CONTAINS
+  !
+  !****************************************************************
+  !   subroutine read_ncdf_dim					*
+  !								*
+  ! subroutine to retrieve value of a given dimension 		*
+  !								*
+  !     dimname : name of dimension to retrieve			*
+  !     file    : netcdf file name				*
+  !     dimval  : value of the required dimension			*
+  !								*
+  !****************************************************************
+  !
+  SUBROUTINE read_ncdf_dim(dimname,file,dimval)   
+    !      
+    IMPLICIT NONE
+    !           
+    CHARACTER(*),INTENT(in) :: dimname,file    
+    INTEGER    :: dimval
+    !            
+    ! local variables
+    !
+    INTEGER ncid,status,dimid
+    !     
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname,dimid)
+    status = nf90_inquire_dimension(ncid,dimid,len=dimval)						                
+    !      
+    status = nf90_close(ncid)
+    !      
+  END SUBROUTINE read_ncdf_dim
+  !
+  !**************************************************************
+  ! end subroutine read_ncdf_dim
+  !**************************************************************      
+  !
+  !****************************************************************
+  !   subroutine write_ncdf_dim					*
+  !								*
+  ! subroutine to write a dimension in a given file 		*
+  !								*
+  !     dimname : name of dimension to initialize			*
+  !     file    : netcdf file name				*
+  !     dimval  : value of the dimension to write			*
+  !								*
+  !****************************************************************
+  !
+  SUBROUTINE write_ncdf_dim(dimname,file,dimval)   
+    !      
+    IMPLICIT NONE
+    !           
+    CHARACTER(*),INTENT(in) :: dimname,file    
+    INTEGER    :: dimval
+    !      
+    ! local variables
+    !
+    INTEGER ncid,status,dimid
+    !     
+    status = nf90_open(file,NF90_WRITE,ncid)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_redef(ncid)
+    IF(dimval.EQ.0) THEN
+       status = nf90_def_dim(ncid,dimname,nf90_unlimited,dimid)       
+    ELSE
+       status = nf90_def_dim(ncid,dimname,dimval,dimid)  
+    END IF
+
+    status = nf90_enddef(ncid)
+    !      
+
+    status = nf90_close(ncid)
+    !      
+  END SUBROUTINE write_ncdf_dim
+  !
+  !**************************************************************
+  ! end subroutine write_ncdf_dim
+  !**************************************************************            
+  ! 
+  !****************************************************************
+  !   subroutine read_ncdf_var					*
+  !								*
+  ! subroutine to retrieve values of a given variable 		*
+  !								*
+  !     varname : name of variable to retrieve			*
+  !     file    : netcdf file name				*
+  !     tabvar  : array containing values of the required variable*
+  !								*
+  !****************************************************************
+  !      
+  SUBROUTINE read_ncdf_var1d_real(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8, DIMENSION(:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(1) :: dimID
+    INTEGER :: dim1
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimID)
+    status=nf90_inquire_dimension(ncid,dimID(1),len=dim1)
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1))  
+    ELSE
+       IF( ANY(SHAPE(tabvar)/=(/dim1/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1))      
+       ENDIF
+    ENDIF
+    !        
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE read_ncdf_var1d_real
+  !           
+  !      
+  SUBROUTINE read_ncdf_var2d_real(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8, DIMENSION(:,:), POINTER :: tabvar
+    !local variables
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2))  
+    ELSE
+       IF( ANY(SHAPE(tabvar)/=(/dim1,dim2/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2))      
+       ENDIF
+    ENDIF
+    !       
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE read_ncdf_var2d_real
+  !           
+  !      
+  SUBROUTINE read_ncdf_var2d_real_bis(varname,file,tabvar,strt,cnt)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8, DIMENSION(:,:), POINTER :: tabvar
+    !local variables
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER, DIMENSION(2) :: strt,cnt
+    INTEGER :: dim1,dim2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    dim1 = cnt(1) 
+    dim2 = cnt(2)
+    !      
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2))  
+    ELSE
+       IF( ANY(SHAPE(tabvar)/=(/dim1,dim2/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2))      
+       ENDIF
+    ENDIF
+    !       
+    status=nf90_get_var(ncid,varid,tabvar,start = strt,count = cnt)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE read_ncdf_var2d_real_bis
+  !           
+  !      
+  SUBROUTINE read_ncdf_var3d_real(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8, DIMENSION(:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2,dim3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)  
+    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,dim3))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,dim3/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2,dim3))      
+       ENDIF
+    ENDIF
+    !      
+    status=nf90_get_var(ncid,varid,tabvar) 
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to retrieve netcdf variable : ",TRIM(varname)
+       STOP
+    ENDIF
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE read_ncdf_var3d_real
+  !           
+  !      
+  SUBROUTINE read_ncdf_var4d_real(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2,dim3,dim4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)  
+    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)   
+    status=nf90_inquire_dimension(ncid,dimIDS(4),len=dim4)       
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,dim3,dim4))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,dim3,dim4/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2,dim3,dim4))      
+       ENDIF
+    ENDIF
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE read_ncdf_var4d_real
+
+  SUBROUTINE read_ncdf_var0d_real(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8 :: tabvar
+    !
+    !local variables
+    !
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    !
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE read_ncdf_var0d_real
+
+  SUBROUTINE read_ncdf_var0d_int(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    !
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE read_ncdf_var0d_int
+  !           
+  !      
+  SUBROUTINE read_ncdf_var1d_int(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER, DIMENSION(:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER,DIMENSION(10) :: dimID
+    INTEGER :: dim1
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimID)
+    status=nf90_inquire_dimension(ncid,dimID(1),len=dim1)          
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1))      
+       ENDIF
+    ENDIF
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !      
+  END SUBROUTINE read_ncdf_var1d_int
+  !           
+  !      
+  SUBROUTINE read_ncdf_var2d_int(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER, DIMENSION(:,:), POINTER :: tabvar
+    !local variables
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)      
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2))      
+       ENDIF
+    ENDIF
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !      
+  END SUBROUTINE read_ncdf_var2d_int
+  !           
+  !      
+  SUBROUTINE read_ncdf_var3d_int(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER, DIMENSION(:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2,dim3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)  
+    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)          
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,dim3))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,dim3/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2,dim3))      
+       ENDIF
+    ENDIF
+    ! 
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !      
+  END SUBROUTINE read_ncdf_var3d_int
+  !           
+  !      
+  SUBROUTINE read_ncdf_var4d_int(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2,dim3,dim4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)  
+    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)   
+    status=nf90_inquire_dimension(ncid,dimIDS(4),len=dim4)       
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,dim3,dim4))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,dim3,dim4/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2,dim3,dim4))      
+       ENDIF
+    ENDIF
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE read_ncdf_var4d_int
+  !           
+  !
+  !****************************************************************
+  !   subroutine write_ncdf_var					*
+  !								*
+  ! subroutine to write a variable in a given file 		*
+  !								*
+  !     varname : name of variable to store			*     
+  !     dimname : name of dimensions of the given variable	*
+  !     file    : netcdf file name				*
+  !     tabvar  : values of the variable to write			*
+  !								*
+  !****************************************************************
+  !    
+  !      
+  SUBROUTINE write_ncdf_var1d_real(varname,dimname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,dimname,typevar
+    REAL*8, DIMENSION(:), INTENT(in) :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname,dimid)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    SELECT CASE(TRIM(typevar))
+    CASE('double')
+       status = nf90_def_var(ncid,varname,nf90_double,(/dimid/),varid)
+    CASE('float')
+       status = nf90_def_var(ncid,varname,nf90_float,(/dimid/),varid)      
+    END SELECT
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var1d_real
+  !      
+  !      
+  SUBROUTINE write_ncdf_var2d_real_bis(varname,dimname,file,tabvar,nbdim,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    INTEGER,INTENT(in) :: nbdim
+    CHARACTER(*), DIMENSION(4) :: dimname
+    REAL*8, DIMENSION(:,:) :: tabvar
+    REAL*8, ALLOCATABLE, DIMENSION(:,:,:) :: tabtemp3d
+    REAL*8, ALLOCATABLE, DIMENSION(:,:,:,:) :: tabtemp4d
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3,dimid4
+    INTEGER :: status,ncid,ncid2
+    INTEGER :: varid,varid2             
+    ! 
+    IF(nbdim==4) THEN      
+       ALLOCATE(tabtemp4d(SIZE(tabvar,1),SIZE(tabvar,2),1,1))
+       tabtemp4d(:,:,1,1) = tabvar(:,:)
+    ELSE IF(nbdim==3) THEN
+       ALLOCATE(tabtemp3d(SIZE(tabvar,1),SIZE(tabvar,2),1))
+       tabtemp3d(:,:,1) = tabvar(:,:)
+    END IF
+    !      
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+    !      
+    IF(nbdim==4) status = nf90_inq_dimid(ncid,dimname(4), dimid4)
+    !      
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    IF(nbdim==4 .AND. typevar == 'double') THEN
+       status = nf90_def_var(ncid,varname,nf90_double,     &
+            (/dimid1,dimid2,dimid3,dimid4/),varid)
+       !                              
+    ELSE IF(nbdim==4 .AND. typevar == 'float') THEN
+       status = nf90_def_var(ncid,varname,nf90_float,     &
+            (/dimid1,dimid2,dimid3,dimid4/),varid)                        
+       !          
+    ELSE IF(nbdim==3 .AND. typevar == 'float') THEN
+       status = nf90_def_var(ncid,varname,nf90_float,     &
+            (/dimid1,dimid2,dimid3/),varid)
+       !
+    ELSE IF(nbdim==3 .AND. typevar == 'double') THEN
+       status = nf90_def_var(ncid,varname,nf90_double,     &
+            (/dimid1,dimid2,dimid3/),varid)
+       !     			      			      
+    ENDIF
+    !      			      
+    status = nf90_enddef(ncid)
+    IF(nbdim==4) status = nf90_put_var(ncid,varid,tabtemp4d)
+    IF(nbdim==3) status = nf90_put_var(ncid,varid,tabtemp3d)
+    !      
+    IF(ALLOCATED( tabtemp3d ) ) DEALLOCATE( tabtemp3d )   
+    IF(ALLOCATED( tabtemp4d ) ) DEALLOCATE( tabtemp4d )     
+    !
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var2d_real_bis
+  !      
+  !      
+  SUBROUTINE write_ncdf_var2d_real(varname,dimname,file,tabvar,typevar)
+    !      
+    !      implicit none
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*), DIMENSION(2) :: dimname
+    REAL*8, DIMENSION(:,:), INTENT(in) :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+
+    SELECT CASE(TRIM(typevar))
+    CASE('double')
+       status = nf90_def_var(ncid,varname,nf90_double,     &
+            (/dimid1,dimid2/),varid)
+    CASE('float')
+       status = nf90_def_var(ncid,varname,nf90_float,     &
+            (/dimid1,dimid2/),varid)     
+    END SELECT
+    !
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var2d_real
+  !      
+  !      
+  SUBROUTINE write_ncdf_var3d_real(varname,dimname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(3),INTENT(in) :: dimname
+    REAL*8, DIMENSION(:,:,:), INTENT(in) :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+
+    SELECT CASE(TRIM(typevar))
+    CASE('double')
+       status = nf90_def_var(ncid,varname,nf90_double,     &
+            (/dimid1,dimid2,dimid3/),varid)
+    CASE('float')
+       status = nf90_def_var(ncid,varname,nf90_float,     &
+            (/dimid1,dimid2,dimid3/),varid)    
+    END SELECT
+    !
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var3d_real
+  !      
+  !      
+  SUBROUTINE write_ncdf_var4d_real(varname,dimname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(4),INTENT(in) :: dimname
+    REAL*8, DIMENSION(:,:,:,:), INTENT(in) :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3,dimid4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !
+    status = nf90_inq_varid(ncid,varname,varid)
+    !      
+    IF(status/=nf90_noerr) THEN
+       !     
+       status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+       status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+       status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+       status = nf90_inq_dimid(ncid,dimname(4), dimid4)
+       status = nf90_redef(ncid)
+       !      
+       SELECT CASE(TRIM(typevar))
+       CASE('double')
+          status = nf90_def_var(ncid,varname,nf90_double,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)
+       CASE('float')
+          status = nf90_def_var(ncid,varname,nf90_float,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)   
+       END SELECT
+       !
+       status = nf90_enddef(ncid)
+    ENDIF
+    !         
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var4d_real
+  !      
+  !      
+  SUBROUTINE write_ncdf_var1d_int(varname,dimname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,dimname,typevar
+    INTEGER, DIMENSION(:), INTENT(in) :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    !           print *,'ici tabvar = ',tabvar,varname,dimname
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname, dimid)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    status = nf90_def_var(ncid,varname,nf90_int,(/dimid/),varid)
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var1d_int
+  !      
+  !      
+  SUBROUTINE write_ncdf_var2d_int(varname,dimname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*), INTENT(in) :: varname,file,typevar
+    CHARACTER(*), DIMENSION(2), INTENT(in) :: dimname
+    INTEGER, DIMENSION(:,:), INTENT(in) :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1),dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2),dimid2)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    status = nf90_def_var(ncid,varname,nf90_int,(/dimid1,dimid2/),varid)
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var2d_int
+  !      
+  !      
+  SUBROUTINE write_ncdf_var3d_int(varname,dimname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(3),INTENT(in) :: dimname
+    INTEGER, DIMENSION(:,:,:), INTENT(in) :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    status = nf90_def_var(ncid,varname,nf90_int,     &
+         (/dimid1,dimid2,dimid3/),varid)
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var3d_int
+  !      
+  !      
+  SUBROUTINE write_ncdf_var4d_int(varname,dimname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(4),INTENT(in) :: dimname
+    INTEGER, DIMENSION(:,:,:,:), INTENT(in) :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3,dimid4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+    status = nf90_inq_dimid(ncid,dimname(4), dimid4)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    status = nf90_def_var(ncid,varname,nf90_int,     &
+         (/dimid1,dimid2,dimid3,dimid4/),varid)
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var4d_int
+  !      
+  !
+  !****************************************************************
+  !   subroutine read_ncdf_var_t					*
+  !								*
+  ! subroutine to read a variable in a given file for time t	*
+  !								*
+  !     varname : name of variable to read			*     
+  !     file    : netcdf file name				*
+  !     tabvar  : values of the read variable			*
+  !     time    : time corresponding to the values to read	*	
+  !								*
+  !****************************************************************
+  !
+  !      
+  SUBROUTINE read_ncdf_var3d_real_t(varname,file,tabvar,time)
+    !      
+    USE agrif_types     
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER,INTENT(in) :: time
+    REAL*8, DIMENSION(:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(3) :: dimIDS
+    INTEGER :: dim1,dim2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    !        
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)
+    !
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,1))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,1/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2,1))      
+       ENDIF
+    ENDIF
+
+    status=nf90_get_var(ncid,varid,tabvar,start=(/1,1,time/))
+
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to retrieve netcdf variable : ",TRIM(varname)
+       STOP
+    ENDIF
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE read_ncdf_var3d_real_t
+  !           
+  !
+  !****************************************************************
+  !   subroutine write_ncdf_var_t					*
+  !								*
+  ! subroutine to write a variable in a given file for time t	*
+  !								*
+  !     varname : name of variable to store			*     
+  !     dimname : name of dimensions of the given variable	*
+  !     file    : netcdf file name				*
+  !     tabvar  : values of the variable to write			*
+  !     time    : time corresponding to the values to store	*	
+  !								*
+  !****************************************************************
+  !
+  !      
+  SUBROUTINE write_ncdf_var3d_real_t(varname,dimname,file,tabvar,time,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(3),INTENT(in) :: dimname
+    INTEGER :: time
+    REAL*8, DIMENSION(:,:,:), INTENT(in) :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    IF(time==1) THEN
+       !      
+       status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+       status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+       status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+       status = nf90_redef(ncid)
+
+       !      
+       SELECT CASE(TRIM(typevar))
+       CASE('double')
+          status = nf90_def_var(ncid,varname,nf90_double,     &
+               (/dimid1,dimid2,dimid3/),varid) 
+       CASE('float')
+          status = nf90_def_var(ncid,varname,nf90_float,     &
+               (/dimid1,dimid2,dimid3/),varid)    
+       END SELECT
+       !
+       status = nf90_enddef(ncid)
+
+    ELSE
+       status = nf90_inq_varid(ncid, varname, varid)
+    ENDIF
+    !      
+    status = nf90_put_var(ncid,varid,tabvar,start=(/1,1,time/))
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to store variable ",varname, &
+	    " in file ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var3d_real_t
+  !      
+  !
+  !****************************************************************
+  !   subroutine read_ncdf_var_t					*
+  !								*
+  ! subroutine to read a variable in a given file for time t	*
+  !						at level n	*
+  !     varname : name of variable to read			*     
+  !     file    : netcdf file name				*
+  !     tabvar  : values of the read variable			*
+  !     time    : time corresponding to the values to read	*	
+  !     level   : level corresponding to the values to read	*
+  !								*
+  !****************************************************************
+  !
+  !      
+  SUBROUTINE read_ncdf_var4d_real_nt(varname,file,tabvar,time,level)
+    !      
+    USE agrif_types     
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER,INTENT(in) :: time,level
+    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(4) :: dimIDS
+    INTEGER :: dim1,dim2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    !        
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)
+    !
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,1,1))  
+    ELSE
+       IF ((SIZE(tabvar,1) /= dim1) .OR. (SIZE(tabvar,2) /= dim2)) THEN
+          DEALLOCATE(tabvar)
+          ALLOCATE(tabvar(dim1,dim2,1,1))
+       ENDIF
+    ENDIF
+    !
+    status=nf90_get_var(ncid,varid,tabvar,start=(/1,1,level,time/),count=(/dim1,dim2,1,1/))
+    !                                             
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to retrieve netcdf variable : ",TRIM(varname)
+       STOP
+    ENDIF
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE read_ncdf_var4d_real_nt
+  !           
+  !      
+  SUBROUTINE read_ncdf_var4d_real_t(varname,file,tabvar,time)
+    !      
+    USE agrif_types     
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER,INTENT(in) :: time
+    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(4) :: dimIDS
+    INTEGER :: dim1,dim2,dim3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    !        
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)
+    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)
+    !
+    IF(.NOT. ASSOCIATED(tabvar)) ALLOCATE(tabvar(dim1,dim2,dim3,1))  
+    status=nf90_get_var(ncid,varid,tabvar,start=(/1,1,1,time/))
+
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to retrieve netcdf variable : ",TRIM(varname)
+       STOP
+    ENDIF
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE read_ncdf_var4d_real_t
+  !           
+  !****************************************************************
+  !   subroutine write_ncdf_var_t					*
+  !								*
+  ! subroutine to write a variable in a given file for time t	*
+  !						at level n	*
+  !     varname : name of variable to store			*     
+  !     dimname : name of dimensions of the given variable	*
+  !     file    : netcdf file name				*
+  !     tabvar  : values of the variable to write			*
+  !     time    : time corresponding to the values to store	*	
+  !     level   : level corresponding to the values to store	*
+  !								*
+  !****************************************************************
+  !
+  !      
+  SUBROUTINE write_ncdf_var4d_real_t(varname,dimname,file,tabvar,time,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(4),INTENT(in) :: dimname
+    INTEGER :: time,level
+    REAL*8, DIMENSION(:,:,:,:), INTENT(in) :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3,dimid4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !      
+    IF(time==1) THEN
+       !      
+       status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+       status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+       status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+       status = nf90_inq_dimid(ncid,dimname(4), dimid4)
+       status = nf90_redef(ncid)
+       !      
+       SELECT CASE(TRIM(typevar))
+       CASE('double')
+          status = nf90_def_var(ncid,TRIM(varname),nf90_double,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)  
+       CASE('float')
+          status = nf90_def_var(ncid,TRIM(varname),nf90_float,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)    
+       END SELECT
+       !
+       status = nf90_enddef(ncid)
+
+    ELSE
+       status = nf90_inq_varid(ncid, varname, varid)
+    ENDIF
+    !    
+    status = nf90_put_var(ncid,varid,tabvar,start=(/1,1,1,time/))
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to store variable ",varname, &
+	    " in file ",file
+       STOP
+    ENDIF
+    !    
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var4d_real_t
+  !      
+  !      
+  SUBROUTINE write_ncdf_var4d_real_nt(varname,dimname,file,tabvar,time,level,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(4),INTENT(in) :: dimname
+    INTEGER :: time,level
+    REAL*8, DIMENSION(:,:,:,:), INTENT(in) :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3,dimid4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !      
+    IF(time==1.AND.level==1) THEN
+       !      
+       status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+       status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+       status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+       status = nf90_inq_dimid(ncid,dimname(4), dimid4)
+       status = nf90_redef(ncid)
+       !      
+       SELECT CASE(TRIM(typevar))
+       CASE('double')
+          status = nf90_def_var(ncid,TRIM(varname),nf90_double,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)  
+       CASE('float')
+          status = nf90_def_var(ncid,TRIM(varname),nf90_float,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)    
+       END SELECT
+       !
+       status = nf90_enddef(ncid)
+
+    ELSE
+       status = nf90_inq_varid(ncid, varname, varid)
+    ENDIF
+    !    
+    status = nf90_put_var(ncid,varid,tabvar,start=(/1,1,level,time/))
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to store variable ",varname, &
+	    " in file ",file
+       STOP
+    ENDIF
+    !    
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var4d_real_nt
+
+  SUBROUTINE write_ncdf_var0d_real(varname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    INTEGER :: time,level
+    REAL*8 :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !      
+
+    status = nf90_redef(ncid)
+    !      
+    SELECT CASE(TRIM(typevar))
+    CASE('double')
+       status = nf90_def_var(ncid,TRIM(varname),nf90_double,     &
+            varid=varid)  
+    CASE('float')
+       status = nf90_def_var(ncid,TRIM(varname),nf90_float,     &
+            varid=varid)    
+    END SELECT
+    !
+    status = nf90_enddef(ncid)
+
+    !    
+    status = nf90_put_var(ncid,varid,tabvar)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to store variable ",varname, &
+	    " in file ",file
+       STOP
+    ENDIF
+    !    
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var0d_real
+
+  SUBROUTINE write_ncdf_var0d_int(varname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    INTEGER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: status,ncid
+    INTEGER :: varid
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)
+    IF (status/=nf90_noerr) THEN
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_redef(ncid)
+    status = nf90_def_var(ncid,TRIM(varname),nf90_int,varid)
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)
+    !     
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to store variable ",varname, &
+	    " in file ",file
+       STOP
+    ENDIF
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE write_ncdf_var0d_int
+
+  !
+  !****************************************************************
+  !   subroutine read_ncdf_VarName				*
+  !								*
+  ! subroutine to retrieve of all variables 			*
+  ! included in a given file					*
+  !								*
+  !     filename    : netcdf file name				*
+  !     tabvarname  : array containing various variables names	*
+  !								*
+  !****************************************************************
+  !
+  !
+  SUBROUTINE read_ncdf_VarName(filename,tabvarname)
+    !      
+    CHARACTER(*),INTENT(in) :: filename
+    CHARACTER*20,DIMENSION(:),POINTER :: tabvarname
+    INTEGER :: nDimensions,nVariables
+    INTEGER :: nAttributes,unlimitedDimId,i
+    INTEGER :: ncid,status,dimid
+    !     
+    status = nf90_open(filename,NF90_NOWRITE,ncid)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",filename
+       STOP
+    ENDIF
+    !      
+    status = nf90_inquire(ncid,nDimensions,nVariables,nAttributes, &                                                      
+         unlimitedDimId) 
+    !
+    ALLOCATE(tabvarname(nVariables))
+    !
+    DO i=1,nVariables
+       status = nf90_inquire_variable(ncid,i,tabvarname(i))
+    END DO
+
+  END SUBROUTINE read_ncdf_Varname
+  !
+  !
+  SUBROUTINE copy_ncdf_att_var(varname,filein,fileout)
+    !      
+    CHARACTER(*),INTENT(in) :: filein,fileout
+    CHARACTER(*),INTENT(in) :: varname
+    INTEGER :: ncid_in,ncid_out,status,varid_in,varid_out
+    !     
+    !      print *,'filein = ',filein,fileout
+    status = nf90_open(filein,NF90_NOWRITE,ncid_in)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open input netcdf file : ",filein
+       STOP
+    ENDIF
+    !     							     	   
+    status = nf90_open(fileout,NF90_WRITE,ncid_out)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open output netcdf file : ",fileout
+       STOP
+    ENDIF
+    !  
+    !      print *,'ici1'
+    status = nf90_inq_varid(ncid_in,varname,varid_in)
+    status = nf90_inq_varid(ncid_out,varname,varid_out)
+    !
+    status = nf90_redef(ncid_out)
+    !      
+    status = nf90_copy_att(ncid_in,varid_in,'units',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'valid_min',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'valid_max',ncid_out,varid_out) 
+    status = nf90_copy_att(ncid_in,varid_in,'long_name',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'calendar',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'title',ncid_out,varid_out)     
+    status = nf90_copy_att(ncid_in,varid_in,'time_origin',ncid_out,varid_out) 
+    status = nf90_copy_att(ncid_in,varid_in,'positive',ncid_out,varid_out)                 
+    status = nf90_copy_att(ncid_in,varid_in,'tstep_sec',ncid_out,varid_out)          
+    status = nf90_copy_att(ncid_in,varid_in,'nav_model',ncid_out,varid_out)   
+    status = nf90_copy_att(ncid_in,varid_in,'Minvalue=',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'Maxvalue=',ncid_out,varid_out)  
+    status = nf90_copy_att(ncid_in,varid_in,'short_name',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'online_operation',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'axis',ncid_out,varid_out)            
+    status = nf90_copy_att(ncid_in,varid_in,'interval_operation',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'interval_write',ncid_out,varid_out) 
+    status = nf90_copy_att(ncid_in,varid_in,'associate',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'actual_range',ncid_out,varid_out) 
+    status = nf90_copy_att(ncid_in,varid_in,'longitude',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'latitude',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'scale_factor',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'add_offset',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'missing_value',ncid_out,varid_out) 
+    !      
+    status = nf90_enddef(ncid_out)  
+    !
+    status = nf90_close(ncid_in)
+    status = nf90_close(ncid_out)
+    !      print *,'ici2'
+    ! 
+  END SUBROUTINE copy_ncdf_att_var
+  !
+  !
+  SUBROUTINE copy_ncdf_att_latlon(varname,filein,fileout,min,max)
+    !      
+    CHARACTER(*),INTENT(in) :: filein,fileout
+    CHARACTER(*),INTENT(in) :: varname
+    REAL*8 :: min,max
+    INTEGER :: ncid_in,ncid_out,status,varid_in,varid_out
+    !     
+    status = nf90_open(filein,NF90_NOWRITE,ncid_in)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",filein
+       STOP
+    ENDIF
+    !     							     	   
+    status = nf90_open(fileout,NF90_WRITE,ncid_out)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",fileout
+       STOP
+    ENDIF
+    !  
+    status = nf90_inq_varid(ncid_in,varname,varid_in)
+    status = nf90_inq_varid(ncid_out,varname,varid_out)
+    !
+    status = nf90_redef(ncid_out)
+    !      
+    SELECT CASE (varname)
+       !      
+    CASE('nav_lon')     
+       status = nf90_copy_att(ncid_in,varid_in,'units',ncid_out,varid_out) 
+       status = nf90_put_att(ncid_out,varid_out,'valid_min',REAL(min,4))
+       status = nf90_put_att(ncid_out,varid_out,'valid_max',REAL(max,4))
+       status = nf90_copy_att(ncid_in,varid_in,'long_name',ncid_out,varid_out)
+       status = nf90_copy_att(ncid_in,varid_in,'nav_model',ncid_out,varid_out)
+       status = nf90_copy_att(ncid_in,varid_in,'title',ncid_out,varid_out)
+       !
+    CASE('nav_lat')
+       status = nf90_copy_att(ncid_in,varid_in,'units',ncid_out,varid_out) 
+       status = nf90_put_att(ncid_out,varid_out,'valid_min',REAL(min,4))
+       status = nf90_put_att(ncid_out,varid_out,'valid_max',REAL(max,4))
+       status = nf90_copy_att(ncid_in,varid_in,'long_name',ncid_out,varid_out)
+       status = nf90_copy_att(ncid_in,varid_in,'nav_model',ncid_out,varid_out)
+       status = nf90_copy_att(ncid_in,varid_in,'title',ncid_out,varid_out) 
+       !
+    END SELECT
+    !      
+    status = nf90_enddef(ncid_out)  
+    !
+    status = nf90_close(ncid_in)
+    status = nf90_close(ncid_out)
+  END SUBROUTINE copy_ncdf_att_latlon
+
+  !*************************************************************
+  !**************************************************************
+  !
+  INTEGER FUNCTION Get_NbDims( varname , filename )
+    !
+    CHARACTER(*),INTENT(in) :: varname,filename
+    INTEGER :: status,ncid,varid    
+    !      
+    status = nf90_open(TRIM(filename),NF90_NOWRITE,ncid)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",TRIM(filename)
+       STOP
+    ENDIF
+    status = nf90_inq_varid(ncid,TRIM(varname),varid)     
+    status = nf90_inquire_variable(ncid, varid , ndims = Get_NbDims)
+    !
+    RETURN
+    !
+  END FUNCTION Get_NbDims
+  !
+  !
+  LOGICAL FUNCTION Dims_Existence( dimname , filename )
+    !
+    CHARACTER(*),INTENT(in) :: dimname,filename
+    INTEGER :: status,ncid,dimid    
+    !      
+    status = nf90_open(TRIM(filename),NF90_NOWRITE,ncid)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",TRIM(filename)
+       STOP
+    ENDIF
+    status = nf90_inq_dimid(ncid,dimname,dimid)
+    !      
+    IF (status/=nf90_noerr) THEN
+       Dims_Existence = .FALSE.
+    ELSE
+       Dims_Existence = .TRUE.
+    ENDIF
+    !
+    RETURN
+    !
+  END FUNCTION Dims_Existence
+  !
+END MODULE io_netcdf
Index: /utils/tools_ticket2413/NESTING_AGRIF/src/par_kind.F90
===================================================================
--- /utils/tools_ticket2413/NESTING_AGRIF/src/par_kind.F90	(revision 12863)
+++ /utils/tools_ticket2413/NESTING_AGRIF/src/par_kind.F90	(revision 12863)
@@ -0,0 +1,40 @@
+MODULE par_kind
+   !!======================================================================
+   !!                   ***  MODULE par_kind  ***
+   !! Ocean :  define the kind of real for the whole model
+   !!======================================================================
+   !! History :  1.0  ! 2002-06  (G. Madec)  Original code
+   !!            3.3  ! 2010-12  (G. Madec)  add a standard length of character strings
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTEGER, PUBLIC, PARAMETER ::   jpbyt   = 8    !: real size for mpp communications
+   INTEGER, PUBLIC, PARAMETER ::   jpbytda = 4    !: real size in input data files 4 or 8
+
+   ! Number model from which the SELECTED_*_KIND are requested:
+   !             4 byte REAL       8 byte REAL
+   ! CRAY:           -            precision = 13
+   !                              exponent = 2465
+   ! IEEE:      precision = 6     precision = 15
+   !            exponent = 37     exponent = 307
+
+   !                                                                !!** Floating point **
+   INTEGER, PUBLIC, PARAMETER ::   sp = SELECTED_REAL_KIND( 6, 37)   !: single precision (real 4)
+   INTEGER, PUBLIC, PARAMETER ::   dp = SELECTED_REAL_KIND(12,307)   !: double precision (real 8)
+   INTEGER, PUBLIC, PARAMETER ::   wp = dp                              !: working precision
+
+   !                                                                !!** Integer **
+   INTEGER, PUBLIC, PARAMETER ::   i4 = SELECTED_INT_KIND( 9)        !: single precision (integer 4)
+   INTEGER, PUBLIC, PARAMETER ::   i8 = SELECTED_INT_KIND(14)        !: double precision (integer 8)
+   
+   !                                                                !!** Integer **
+   INTEGER, PUBLIC, PARAMETER ::   lc = 256                          !: Lenght of Character strings
+
+   !!----------------------------------------------------------------------
+   !! NEMO 3.3 , NEMO Consortium (2018)
+   !! $Id: par_kind.F90 10068 2018-08-28 14:09:04Z nicolasmartin $ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+END MODULE par_kind
Index: /utils/tools_ticket2413/NESTING_AGRIF/src/par_oce.F90
===================================================================
--- /utils/tools_ticket2413/NESTING_AGRIF/src/par_oce.F90	(revision 12863)
+++ /utils/tools_ticket2413/NESTING_AGRIF/src/par_oce.F90	(revision 12863)
@@ -0,0 +1,4 @@
+module par_oce
+
+integer :: nbcellsx, nbcellsy
+end module par_oce
Index: /utils/tools_ticket2413/NESTING_AGRIF/src/variables.f90
===================================================================
--- /utils/tools_ticket2413/NESTING_AGRIF/src/variables.f90	(revision 12863)
+++ /utils/tools_ticket2413/NESTING_AGRIF/src/variables.f90	(revision 12863)
@@ -0,0 +1,10 @@
+module variables
+
+REAL,  DIMENSION(:,:),  POINTER :: nav_lon, nav_lat
+REAL,  DIMENSION(:,:),  POINTER :: glamt
+
+CHARACTER*100 ::   parent_coordinate_file
+
+end module variables
+
+
Index: /utils/tools_ticket2413/OBSTOOLS/OOO/bin/ooo
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/OOO/bin/ooo	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/OOO/bin/ooo	(revision 12863)
@@ -0,0 +1,4 @@
+#!/usr/bin/env python2.7
+import ooo
+if __name__ == '__main__':
+    ooo.main()
Index: /utils/tools_ticket2413/OBSTOOLS/OOO/doc/Makefile
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/OOO/doc/Makefile	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/OOO/doc/Makefile	(revision 12863)
@@ -0,0 +1,153 @@
+# Makefile for Sphinx documentation
+#
+
+# You can set these variables from the command line.
+SPHINXOPTS    =
+SPHINXBUILD   = sphinx-build
+PAPER         =
+BUILDDIR      = build
+
+# Internal variables.
+PAPEROPT_a4     = -D latex_paper_size=a4
+PAPEROPT_letter = -D latex_paper_size=letter
+ALLSPHINXOPTS   = -d $(BUILDDIR)/doctrees $(PAPEROPT_$(PAPER)) $(SPHINXOPTS) source
+# the i18n builder cannot share the environment and doctrees with the others
+I18NSPHINXOPTS  = $(PAPEROPT_$(PAPER)) $(SPHINXOPTS) source
+
+.PHONY: help clean html dirhtml singlehtml pickle json htmlhelp qthelp devhelp epub latex latexpdf text man changes linkcheck doctest gettext
+
+help:
+	@echo "Please use \`make <target>' where <target> is one of"
+	@echo "  html       to make standalone HTML files"
+	@echo "  dirhtml    to make HTML files named index.html in directories"
+	@echo "  singlehtml to make a single large HTML file"
+	@echo "  pickle     to make pickle files"
+	@echo "  json       to make JSON files"
+	@echo "  htmlhelp   to make HTML files and a HTML help project"
+	@echo "  qthelp     to make HTML files and a qthelp project"
+	@echo "  devhelp    to make HTML files and a Devhelp project"
+	@echo "  epub       to make an epub"
+	@echo "  latex      to make LaTeX files, you can set PAPER=a4 or PAPER=letter"
+	@echo "  latexpdf   to make LaTeX files and run them through pdflatex"
+	@echo "  text       to make text files"
+	@echo "  man        to make manual pages"
+	@echo "  texinfo    to make Texinfo files"
+	@echo "  info       to make Texinfo files and run them through makeinfo"
+	@echo "  gettext    to make PO message catalogs"
+	@echo "  changes    to make an overview of all changed/added/deprecated items"
+	@echo "  linkcheck  to check all external links for integrity"
+	@echo "  doctest    to run all doctests embedded in the documentation (if enabled)"
+
+clean:
+	-rm -rf $(BUILDDIR)/*
+
+html:
+	$(SPHINXBUILD) -b html $(ALLSPHINXOPTS) $(BUILDDIR)/html
+	@echo
+	@echo "Build finished. The HTML pages are in $(BUILDDIR)/html."
+
+dirhtml:
+	$(SPHINXBUILD) -b dirhtml $(ALLSPHINXOPTS) $(BUILDDIR)/dirhtml
+	@echo
+	@echo "Build finished. The HTML pages are in $(BUILDDIR)/dirhtml."
+
+singlehtml:
+	$(SPHINXBUILD) -b singlehtml $(ALLSPHINXOPTS) $(BUILDDIR)/singlehtml
+	@echo
+	@echo "Build finished. The HTML page is in $(BUILDDIR)/singlehtml."
+
+pickle:
+	$(SPHINXBUILD) -b pickle $(ALLSPHINXOPTS) $(BUILDDIR)/pickle
+	@echo
+	@echo "Build finished; now you can process the pickle files."
+
+json:
+	$(SPHINXBUILD) -b json $(ALLSPHINXOPTS) $(BUILDDIR)/json
+	@echo
+	@echo "Build finished; now you can process the JSON files."
+
+htmlhelp:
+	$(SPHINXBUILD) -b htmlhelp $(ALLSPHINXOPTS) $(BUILDDIR)/htmlhelp
+	@echo
+	@echo "Build finished; now you can run HTML Help Workshop with the" \
+	      ".hhp project file in $(BUILDDIR)/htmlhelp."
+
+qthelp:
+	$(SPHINXBUILD) -b qthelp $(ALLSPHINXOPTS) $(BUILDDIR)/qthelp
+	@echo
+	@echo "Build finished; now you can run "qcollectiongenerator" with the" \
+	      ".qhcp project file in $(BUILDDIR)/qthelp, like this:"
+	@echo "# qcollectiongenerator $(BUILDDIR)/qthelp/Offlineobservationoperator.qhcp"
+	@echo "To view the help file:"
+	@echo "# assistant -collectionFile $(BUILDDIR)/qthelp/Offlineobservationoperator.qhc"
+
+devhelp:
+	$(SPHINXBUILD) -b devhelp $(ALLSPHINXOPTS) $(BUILDDIR)/devhelp
+	@echo
+	@echo "Build finished."
+	@echo "To view the help file:"
+	@echo "# mkdir -p $$HOME/.local/share/devhelp/Offlineobservationoperator"
+	@echo "# ln -s $(BUILDDIR)/devhelp $$HOME/.local/share/devhelp/Offlineobservationoperator"
+	@echo "# devhelp"
+
+epub:
+	$(SPHINXBUILD) -b epub $(ALLSPHINXOPTS) $(BUILDDIR)/epub
+	@echo
+	@echo "Build finished. The epub file is in $(BUILDDIR)/epub."
+
+latex:
+	$(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex
+	@echo
+	@echo "Build finished; the LaTeX files are in $(BUILDDIR)/latex."
+	@echo "Run \`make' in that directory to run these through (pdf)latex" \
+	      "(use \`make latexpdf' here to do that automatically)."
+
+latexpdf:
+	$(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex
+	@echo "Running LaTeX files through pdflatex..."
+	$(MAKE) -C $(BUILDDIR)/latex all-pdf
+	@echo "pdflatex finished; the PDF files are in $(BUILDDIR)/latex."
+
+text:
+	$(SPHINXBUILD) -b text $(ALLSPHINXOPTS) $(BUILDDIR)/text
+	@echo
+	@echo "Build finished. The text files are in $(BUILDDIR)/text."
+
+man:
+	$(SPHINXBUILD) -b man $(ALLSPHINXOPTS) $(BUILDDIR)/man
+	@echo
+	@echo "Build finished. The manual pages are in $(BUILDDIR)/man."
+
+texinfo:
+	$(SPHINXBUILD) -b texinfo $(ALLSPHINXOPTS) $(BUILDDIR)/texinfo
+	@echo
+	@echo "Build finished. The Texinfo files are in $(BUILDDIR)/texinfo."
+	@echo "Run \`make' in that directory to run these through makeinfo" \
+	      "(use \`make info' here to do that automatically)."
+
+info:
+	$(SPHINXBUILD) -b texinfo $(ALLSPHINXOPTS) $(BUILDDIR)/texinfo
+	@echo "Running Texinfo files through makeinfo..."
+	make -C $(BUILDDIR)/texinfo info
+	@echo "makeinfo finished; the Info files are in $(BUILDDIR)/texinfo."
+
+gettext:
+	$(SPHINXBUILD) -b gettext $(I18NSPHINXOPTS) $(BUILDDIR)/locale
+	@echo
+	@echo "Build finished. The message catalogs are in $(BUILDDIR)/locale."
+
+changes:
+	$(SPHINXBUILD) -b changes $(ALLSPHINXOPTS) $(BUILDDIR)/changes
+	@echo
+	@echo "The overview file is in $(BUILDDIR)/changes."
+
+linkcheck:
+	$(SPHINXBUILD) -b linkcheck $(ALLSPHINXOPTS) $(BUILDDIR)/linkcheck
+	@echo
+	@echo "Link check complete; look for any errors in the above output " \
+	      "or in $(BUILDDIR)/linkcheck/output.txt."
+
+doctest:
+	$(SPHINXBUILD) -b doctest $(ALLSPHINXOPTS) $(BUILDDIR)/doctest
+	@echo "Testing of doctests in the sources finished, look at the " \
+	      "results in $(BUILDDIR)/doctest/output.txt."
Index: /utils/tools_ticket2413/OBSTOOLS/OOO/doc/make.bat
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/OOO/doc/make.bat	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/OOO/doc/make.bat	(revision 12863)
@@ -0,0 +1,190 @@
+@ECHO OFF
+
+REM Command file for Sphinx documentation
+
+if "%SPHINXBUILD%" == "" (
+	set SPHINXBUILD=sphinx-build
+)
+set BUILDDIR=build
+set ALLSPHINXOPTS=-d %BUILDDIR%/doctrees %SPHINXOPTS% source
+set I18NSPHINXOPTS=%SPHINXOPTS% source
+if NOT "%PAPER%" == "" (
+	set ALLSPHINXOPTS=-D latex_paper_size=%PAPER% %ALLSPHINXOPTS%
+	set I18NSPHINXOPTS=-D latex_paper_size=%PAPER% %I18NSPHINXOPTS%
+)
+
+if "%1" == "" goto help
+
+if "%1" == "help" (
+	:help
+	echo.Please use `make ^<target^>` where ^<target^> is one of
+	echo.  html       to make standalone HTML files
+	echo.  dirhtml    to make HTML files named index.html in directories
+	echo.  singlehtml to make a single large HTML file
+	echo.  pickle     to make pickle files
+	echo.  json       to make JSON files
+	echo.  htmlhelp   to make HTML files and a HTML help project
+	echo.  qthelp     to make HTML files and a qthelp project
+	echo.  devhelp    to make HTML files and a Devhelp project
+	echo.  epub       to make an epub
+	echo.  latex      to make LaTeX files, you can set PAPER=a4 or PAPER=letter
+	echo.  text       to make text files
+	echo.  man        to make manual pages
+	echo.  texinfo    to make Texinfo files
+	echo.  gettext    to make PO message catalogs
+	echo.  changes    to make an overview over all changed/added/deprecated items
+	echo.  linkcheck  to check all external links for integrity
+	echo.  doctest    to run all doctests embedded in the documentation if enabled
+	goto end
+)
+
+if "%1" == "clean" (
+	for /d %%i in (%BUILDDIR%\*) do rmdir /q /s %%i
+	del /q /s %BUILDDIR%\*
+	goto end
+)
+
+if "%1" == "html" (
+	%SPHINXBUILD% -b html %ALLSPHINXOPTS% %BUILDDIR%/html
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished. The HTML pages are in %BUILDDIR%/html.
+	goto end
+)
+
+if "%1" == "dirhtml" (
+	%SPHINXBUILD% -b dirhtml %ALLSPHINXOPTS% %BUILDDIR%/dirhtml
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished. The HTML pages are in %BUILDDIR%/dirhtml.
+	goto end
+)
+
+if "%1" == "singlehtml" (
+	%SPHINXBUILD% -b singlehtml %ALLSPHINXOPTS% %BUILDDIR%/singlehtml
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished. The HTML pages are in %BUILDDIR%/singlehtml.
+	goto end
+)
+
+if "%1" == "pickle" (
+	%SPHINXBUILD% -b pickle %ALLSPHINXOPTS% %BUILDDIR%/pickle
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished; now you can process the pickle files.
+	goto end
+)
+
+if "%1" == "json" (
+	%SPHINXBUILD% -b json %ALLSPHINXOPTS% %BUILDDIR%/json
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished; now you can process the JSON files.
+	goto end
+)
+
+if "%1" == "htmlhelp" (
+	%SPHINXBUILD% -b htmlhelp %ALLSPHINXOPTS% %BUILDDIR%/htmlhelp
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished; now you can run HTML Help Workshop with the ^
+.hhp project file in %BUILDDIR%/htmlhelp.
+	goto end
+)
+
+if "%1" == "qthelp" (
+	%SPHINXBUILD% -b qthelp %ALLSPHINXOPTS% %BUILDDIR%/qthelp
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished; now you can run "qcollectiongenerator" with the ^
+.qhcp project file in %BUILDDIR%/qthelp, like this:
+	echo.^> qcollectiongenerator %BUILDDIR%\qthelp\Offlineobservationoperator.qhcp
+	echo.To view the help file:
+	echo.^> assistant -collectionFile %BUILDDIR%\qthelp\Offlineobservationoperator.ghc
+	goto end
+)
+
+if "%1" == "devhelp" (
+	%SPHINXBUILD% -b devhelp %ALLSPHINXOPTS% %BUILDDIR%/devhelp
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished.
+	goto end
+)
+
+if "%1" == "epub" (
+	%SPHINXBUILD% -b epub %ALLSPHINXOPTS% %BUILDDIR%/epub
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished. The epub file is in %BUILDDIR%/epub.
+	goto end
+)
+
+if "%1" == "latex" (
+	%SPHINXBUILD% -b latex %ALLSPHINXOPTS% %BUILDDIR%/latex
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished; the LaTeX files are in %BUILDDIR%/latex.
+	goto end
+)
+
+if "%1" == "text" (
+	%SPHINXBUILD% -b text %ALLSPHINXOPTS% %BUILDDIR%/text
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished. The text files are in %BUILDDIR%/text.
+	goto end
+)
+
+if "%1" == "man" (
+	%SPHINXBUILD% -b man %ALLSPHINXOPTS% %BUILDDIR%/man
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished. The manual pages are in %BUILDDIR%/man.
+	goto end
+)
+
+if "%1" == "texinfo" (
+	%SPHINXBUILD% -b texinfo %ALLSPHINXOPTS% %BUILDDIR%/texinfo
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished. The Texinfo files are in %BUILDDIR%/texinfo.
+	goto end
+)
+
+if "%1" == "gettext" (
+	%SPHINXBUILD% -b gettext %I18NSPHINXOPTS% %BUILDDIR%/locale
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Build finished. The message catalogs are in %BUILDDIR%/locale.
+	goto end
+)
+
+if "%1" == "changes" (
+	%SPHINXBUILD% -b changes %ALLSPHINXOPTS% %BUILDDIR%/changes
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.The overview file is in %BUILDDIR%/changes.
+	goto end
+)
+
+if "%1" == "linkcheck" (
+	%SPHINXBUILD% -b linkcheck %ALLSPHINXOPTS% %BUILDDIR%/linkcheck
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Link check complete; look for any errors in the above output ^
+or in %BUILDDIR%/linkcheck/output.txt.
+	goto end
+)
+
+if "%1" == "doctest" (
+	%SPHINXBUILD% -b doctest %ALLSPHINXOPTS% %BUILDDIR%/doctest
+	if errorlevel 1 exit /b 1
+	echo.
+	echo.Testing of doctests in the sources finished, look at the ^
+results in %BUILDDIR%/doctest/output.txt.
+	goto end
+)
+
+:end
Index: /utils/tools_ticket2413/OBSTOOLS/OOO/doc/source/conf.py
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/OOO/doc/source/conf.py	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/OOO/doc/source/conf.py	(revision 12863)
@@ -0,0 +1,246 @@
+# -*- coding: utf-8 -*-
+#
+# Offline observation operator documentation build configuration file, created by
+# sphinx-quickstart on Mon Oct  7 17:21:35 2013.
+#
+# This file is execfile()d with the current directory set to its containing dir.
+#
+# Note that not all possible configuration values are present in this
+# autogenerated file.
+#
+# All configuration values have a default; values that are commented out
+# serve to show the default.
+
+import sys, os
+
+# If extensions (or modules to document with autodoc) are in another directory,
+# add these directories to sys.path here. If the directory is relative to the
+# documentation root, use os.path.abspath to make it absolute, like shown here.
+sys.path.insert(0, os.path.abspath('../..'))
+
+# -- General configuration -----------------------------------------------------
+
+# If your documentation needs a minimal Sphinx version, state it here.
+#needs_sphinx = '1.0'
+
+# Add any Sphinx extension module names here, as strings. They can be extensions
+# coming with Sphinx (named 'sphinx.ext.*') or your custom ones.
+extensions = ['sphinx.ext.autodoc', 'sphinx.ext.intersphinx']
+
+# Add any paths that contain templates here, relative to this directory.
+templates_path = ['_templates']
+
+# The suffix of source filenames.
+source_suffix = '.rst'
+
+# The encoding of source files.
+#source_encoding = 'utf-8-sig'
+
+# The master toctree document.
+master_doc = 'index'
+
+# General information about the project.
+project = u'Offline observation operator'
+copyright = u'2013, Andrew Ryan'
+
+# The version info for the project you're documenting, acts as replacement for
+# |version| and |release|, also used in various other places throughout the
+# built documents.
+#
+# The short X.Y version.
+version = '0.1'
+# The full version, including alpha/beta/rc tags.
+release = '0.1.0'
+
+# The language for content autogenerated by Sphinx. Refer to documentation
+# for a list of supported languages.
+#language = None
+
+# There are two options for replacing |today|: either, you set today to some
+# non-false value, then it is used:
+#today = ''
+# Else, today_fmt is used as the format for a strftime call.
+#today_fmt = '%B %d, %Y'
+
+# List of patterns, relative to source directory, that match files and
+# directories to ignore when looking for source files.
+exclude_patterns = []
+
+# The reST default role (used for this markup: `text`) to use for all documents.
+#default_role = None
+
+# If true, '()' will be appended to :func: etc. cross-reference text.
+#add_function_parentheses = True
+
+# If true, the current module name will be prepended to all description
+# unit titles (such as .. function::).
+#add_module_names = True
+
+# If true, sectionauthor and moduleauthor directives will be shown in the
+# output. They are ignored by default.
+#show_authors = False
+
+# The name of the Pygments (syntax highlighting) style to use.
+pygments_style = 'sphinx'
+
+# A list of ignored prefixes for module index sorting.
+#modindex_common_prefix = []
+
+
+# -- Options for HTML output ---------------------------------------------------
+
+# The theme to use for HTML and HTML Help pages.  See the documentation for
+# a list of builtin themes.
+html_theme = 'default'
+
+# Theme options are theme-specific and customize the look and feel of a theme
+# further.  For a list of options available for each theme, see the
+# documentation.
+#html_theme_options = {}
+
+# Add any paths that contain custom themes here, relative to this directory.
+#html_theme_path = []
+
+# The name for this set of Sphinx documents.  If None, it defaults to
+# "<project> v<release> documentation".
+#html_title = None
+
+# A shorter title for the navigation bar.  Default is the same as html_title.
+#html_short_title = None
+
+# The name of an image file (relative to this directory) to place at the top
+# of the sidebar.
+#html_logo = None
+
+# The name of an image file (within the static path) to use as favicon of the
+# docs.  This file should be a Windows icon file (.ico) being 16x16 or 32x32
+# pixels large.
+#html_favicon = None
+
+# Add any paths that contain custom static files (such as style sheets) here,
+# relative to this directory. They are copied after the builtin static files,
+# so a file named "default.css" will overwrite the builtin "default.css".
+html_static_path = ['_static']
+
+# If not '', a 'Last updated on:' timestamp is inserted at every page bottom,
+# using the given strftime format.
+#html_last_updated_fmt = '%b %d, %Y'
+
+# If true, SmartyPants will be used to convert quotes and dashes to
+# typographically correct entities.
+#html_use_smartypants = True
+
+# Custom sidebar templates, maps document names to template names.
+#html_sidebars = {}
+
+# Additional templates that should be rendered to pages, maps page names to
+# template names.
+#html_additional_pages = {}
+
+# If false, no module index is generated.
+#html_domain_indices = True
+
+# If false, no index is generated.
+#html_use_index = True
+
+# If true, the index is split into individual pages for each letter.
+#html_split_index = False
+
+# If true, links to the reST sources are added to the pages.
+#html_show_sourcelink = True
+
+# If true, "Created using Sphinx" is shown in the HTML footer. Default is True.
+#html_show_sphinx = True
+
+# If true, "(C) Copyright ..." is shown in the HTML footer. Default is True.
+#html_show_copyright = True
+
+# If true, an OpenSearch description file will be output, and all pages will
+# contain a <link> tag referring to it.  The value of this option must be the
+# base URL from which the finished HTML is served.
+#html_use_opensearch = ''
+
+# This is the file name suffix for HTML files (e.g. ".xhtml").
+#html_file_suffix = None
+
+# Output file base name for HTML help builder.
+htmlhelp_basename = 'Offlineobservationoperatordoc'
+
+
+# -- Options for LaTeX output --------------------------------------------------
+
+latex_elements = {
+# The paper size ('letterpaper' or 'a4paper').
+#'papersize': 'letterpaper',
+
+# The font size ('10pt', '11pt' or '12pt').
+#'pointsize': '10pt',
+
+# Additional stuff for the LaTeX preamble.
+#'preamble': '',
+}
+
+# Grouping the document tree into LaTeX files. List of tuples
+# (source start file, target name, title, author, documentclass [howto/manual]).
+latex_documents = [
+  ('index', 'Offlineobservationoperator.tex', u'Offline observation operator Documentation',
+   u'Andrew Ryan', 'manual'),
+]
+
+# The name of an image file (relative to this directory) to place at the top of
+# the title page.
+#latex_logo = None
+
+# For "manual" documents, if this is true, then toplevel headings are parts,
+# not chapters.
+#latex_use_parts = False
+
+# If true, show page references after internal links.
+#latex_show_pagerefs = False
+
+# If true, show URL addresses after external links.
+#latex_show_urls = False
+
+# Documents to append as an appendix to all manuals.
+#latex_appendices = []
+
+# If false, no module index is generated.
+#latex_domain_indices = True
+
+
+# -- Options for manual page output --------------------------------------------
+
+# One entry per manual page. List of tuples
+# (source start file, name, description, authors, manual section).
+man_pages = [
+    ('index', 'offlineobservationoperator', u'Offline observation operator Documentation',
+     [u'Andrew Ryan'], 1)
+]
+
+# If true, show URL addresses after external links.
+#man_show_urls = False
+
+
+# -- Options for Texinfo output ------------------------------------------------
+
+# Grouping the document tree into Texinfo files. List of tuples
+# (source start file, target name, title, author,
+#  dir menu entry, description, category)
+texinfo_documents = [
+  ('index', 'Offlineobservationoperator', u'Offline observation operator Documentation',
+   u'Andrew Ryan', 'Offlineobservationoperator', 'One line description of project.',
+   'Miscellaneous'),
+]
+
+# Documents to append as an appendix to all manuals.
+#texinfo_appendices = []
+
+# If false, no module index is generated.
+#texinfo_domain_indices = True
+
+# How to display URL addresses: 'footnote', 'no', or 'inline'.
+#texinfo_show_urls = 'footnote'
+
+
+# Example configuration for intersphinx: refer to the Python standard library.
+intersphinx_mapping = {'http://docs.python.org/': None}
Index: /utils/tools_ticket2413/OBSTOOLS/OOO/doc/source/index.rst
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/OOO/doc/source/index.rst	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/OOO/doc/source/index.rst	(revision 12863)
@@ -0,0 +1,23 @@
+.. Offline observation operator documentation master file, created by
+   sphinx-quickstart on Mon Oct  7 17:21:35 2013.
+   You can adapt this file completely to your liking, but it should at least
+   contain the root `toctree` directive.
+
+Welcome to Offline observation operator's documentation!
+========================================================
+
+Contents:
+
+.. toctree::
+   :maxdepth: 2
+
+   intro
+
+
+Indices and tables
+==================
+
+* :ref:`genindex`
+* :ref:`modindex`
+* :ref:`search`
+
Index: /utils/tools_ticket2413/OBSTOOLS/OOO/doc/source/intro.rst
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/OOO/doc/source/intro.rst	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/OOO/doc/source/intro.rst	(revision 12863)
@@ -0,0 +1,57 @@
+
+Introduction
+------------
+
+The offline observation operator quick start script involves simple
+computation and manipulation of NEMO namelists.
+
+Quick start script
+------------------
+
+.. code-block:: none
+
+   ooo -h
+   usage: ooo [-h] [-w WORK_DIR] [-f FORECAST_TYPES] [-l LEAD_TIMES]
+              [-o OBS_TYPES] [--class4]
+              DATE NAMELIST
+   
+   positional arguments:
+     DATE                  Run date.
+     NAMELIST              NEMO namelist to edit.
+   
+   optional arguments:
+     -h, --help            show this help message and exit
+     -w WORK_DIR, --work-dir WORK_DIR
+     -f FORECAST_TYPES, --forecast-types FORECAST_TYPES
+                           Choice of forecast,persistence,climatology
+     -l LEAD_TIMES, --lead-times LEAD_TIMES
+                           Forecast lead times
+     -o OBS_TYPES, --obs-types OBS_TYPES
+                           Choice of namobs types.
+     --class4              Flag to choose class 4 file outputs
+     --dry-run             Flag to test namelist building without submitting.
+     --cmd COMMAND         Submit task to run.
+     -v, --verbose         Prints difference between before and after namelists.
+
+
+The above command line utility ``ooo`` can be used to edit **NEMO** namelists. 
+
+Run
+---
+
+.. automodule:: ooo.run
+   :members:
+
+
+Locators
+--------
+
+.. automodule:: ooo.locator
+   :members:
+
+Fortran
+-------
+
+.. automodule:: ooo.nml
+   :members:
+
Index: /utils/tools_ticket2413/OBSTOOLS/OOO/ooo/__init__.py
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/OOO/ooo/__init__.py	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/OOO/ooo/__init__.py	(revision 12863)
@@ -0,0 +1,3 @@
+import nml
+import locator
+from ooo import main
Index: /utils/tools_ticket2413/OBSTOOLS/OOO/ooo/locator.py
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/OOO/ooo/locator.py	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/OOO/ooo/locator.py	(revision 12863)
@@ -0,0 +1,151 @@
+"""Locates input files and calculates namelist attributes
+
+    Typically a user will have files distributed throughout the hard drive
+    and it makes little or no sense to try to capture all use cases.
+
+    >>> date = "20130101"
+    >>> namobs = observations(date, types=["profbfiles"])
+
+    >>> namooo, namcl4 = forecasts(date, types=["forecast", "persistence"], lead_times=[12, 36, 60])
+"""
+
+def observations(date, types=None):
+    """Responsible for locating observation files
+
+    Valid **namobs** observation types.
+
+    * profbfiles
+    * sstfbfiles
+    * slafbfiles
+
+    :param date: The verification date in string format ``'%Y%m%d'``
+    :param types: A list of namobs observation types
+
+    :returns: namobs namelist dictionary
+    """
+    namobs = {"ln_t3d": False,
+              "ln_s3d": False,
+              "ln_ena": False,
+              "ln_profb": False,
+              "ln_sst": False,
+              "ln_sstfb": False,
+              "ln_reysst": False,
+              "ln_ghrsst": False,
+              "ln_sla": False,
+              "ln_slafb": False,
+              "ln_sladt": False}
+    if types is None: types = []
+    for obtype in types: 
+        if obtype == "profbfiles":
+            namobs[obtype] = profbfiles(date)
+            namobs["ln_t3d"] = True
+            namobs["ln_s3d"] = True
+            namobs["ln_profb"] = True
+        elif obtype == "sstfbfiles":
+            namobs[obtype] = sstfbfiles(date)
+            namobs["ln_sst"] = True
+            namobs["ln_sstfb"] = True
+        elif obtype == "slafbfiles":
+            namobs[obtype] = slafbfiles(date)
+            namobs["ln_sla"] = True
+            namobs["ln_slafb"] = True
+    return namobs
+
+def profbfiles(date):
+    """Observation file locator stub
+
+    .. note:: User-specified stub
+
+    :param date: The verification date in string format ``'%Y%m%d'``
+    :returns: List of files
+    """
+    files = ['profb.nc']
+    return files
+
+def sstfbfiles(date):
+    """Observation file locator stub
+
+    .. note:: User-specified stub
+
+    :param date: The verification date in string format ``'%Y%m%d'``
+    :returns: List of files
+    """
+    files = ['sstfb.nc']
+    return files
+
+def slafbfiles(date):
+    """Observation file locator stub
+
+    .. note:: User-specified stub
+
+    :param date: The verification date in string format ``'%Y%m%d'``
+    :returns: List of files
+    """
+    files = ['slafb.nc']
+    return files
+
+def forecasts(date, types=None, lead_times=None):
+    """Responsible for locating forecast fields
+
+    :param date: The verification date in string format ``'%Y%m%d'``
+    :param types: A list of forecast system types
+    :param lead_times: A list of lead_times to search for
+
+    :returns: tuple of namelist data, (namooo, namcl4)
+    """
+    namooo = {}
+    namcl4 = {}
+    if types is None: types = []
+    if lead_times is None: lead_times = []
+
+    # Initialise data
+    ooo_files = []
+    nn_ooo_idx = []
+    cl4_vars = []
+    cl4_fcst_idx = []
+
+    # Search for files
+    for type in types:
+        files = []
+        in_indices = []
+        out_indices = []
+        for ilt, lead_time in enumerate(lead_times):
+            file, index = field(date, type=type, lead_time=lead_time)
+            files.append(file)
+            in_indices.append(index)
+            out_indices.append(ilt + 1)
+        # Expand return lists
+        ooo_files += files
+        nn_ooo_idx += in_indices
+        cl4_fcst_idx += out_indices
+        cl4_vars += len(files) * [type]
+
+    # Namoo
+    namooo["ooo_files"] = ooo_files
+    namooo["nn_ooo_idx"] = nn_ooo_idx
+
+    # Namcl4
+    namcl4["cl4_vars"] = cl4_vars
+    namcl4["cl4_fcst_idx"] = cl4_fcst_idx
+
+    return namooo, namcl4
+
+def field(date, type=None, lead_time=None):
+    """Forecast field locator
+
+    Maps verification date and lead time off set to file name and
+    index along file *time_counter*
+
+    .. note:: User-specified stub
+
+    :param date: The verification date in string format ``'%Y%m%d'``
+    :param type: Forecast type
+    :param lead_time: Forecast off set
+
+    :returns: (**path**, **index**)
+    """
+    # Worker function
+    file = 'nofile'
+    index = -1
+    return file, index
+
Index: /utils/tools_ticket2413/OBSTOOLS/OOO/ooo/nml.py
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/OOO/ooo/nml.py	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/OOO/ooo/nml.py	(revision 12863)
@@ -0,0 +1,479 @@
+"""Collection of Fortran 90 namelist helper functions.
+
+    A common way to interface with a Fortran executable is via
+    an input file called a namelist. This module defines
+    functions which simplify the process of updating and
+    extending namelist data.
+
+    .. note:: This module is especially lightweight and follows the
+              batteries included philosophy. As such, only standard
+              library modules are required to use this code.
+
+    Walkthrough
+    ===========
+
+    New namelist
+    ------------
+
+    A typical usage is to create and update a Fortran namelist on the fly.
+
+    >>> import nml
+    >>> namid = "namfoo"
+    >>> text = nml.new(namid)
+    >>> data = {"x": nml.tostring([1, 2, 3])}
+    >>> text = nml.update(namid, text, data)
+    >>> print text
+    &namfoo
+       x = 1 2 3
+    /
+    <BLANKLINE>
+
+    In the above snippet :func:`tostring` has been used to sanitize the input
+    Python list. This function cleverly maps string data and numeric data to
+    the correct Fortran syntax.
+
+    However, the :func:`new` function takes care of many of the above steps automatically.
+    Where appropriate :func:`sanitize` has been embedded to reduce the need
+    to worry about data format problems. Take for example,
+
+    >>> print nml.new("namfoo", data={"x": range(3)})
+    &namfoo
+       x = 0 1 2
+    /
+    <BLANKLINE>
+
+    Parse existing namelist
+    -----------------------
+
+    In order to update a namelist it is necessary to convert the namelist text into
+    a dictionary of *key, value* pairs which can be manipulated in the usual Pythonic
+    fashion before being piped back out to disk.
+
+    In everyday usage text will be read from files, here however for illustration
+    purposes I have hand written a namelist.
+
+    >>> text = '''
+    ... &namfoo
+    ...     x = y  ! A description of the variables
+    ... /
+    ... &nambar
+    ...     ln_on = .TRUE. ! A description of the variables
+    ... /
+    ... '''
+
+    This can be parsed by invoking the :func:`variables` command.
+
+    >>> nml.variables(text)
+    {'x': 'y', 'ln_on': '.TRUE.'}
+
+    Or by using the :func:`namelists` function to split the file into sub-lists.
+
+    >>> nml.namelists(text)
+    {'namfoo': '&namfoo\\n    x = y  ! A description of the variables\\n/', 'nambar': '&nambar\\n    ln_on = .TRUE. ! A description of the variables\\n/'}
+    >>> sublists = nml.namelists(text)
+    >>> print sublists["nambar"]
+    &nambar
+        ln_on = .TRUE. ! A description of the variables
+    /
+
+    Which can be parsed into a dictionary as before.
+
+    >>> print nml.variables(sublists["nambar"])
+    {'ln_on': '.TRUE.'}
+
+
+    Update/replace data
+    -------------------
+
+    There are two ways of modifying values inside a Fortran namelist. 
+
+    Replace
+        The first is to simply replace a set of variables with new values. This behaviour is accomplished
+        via the :func:`replace` function. This approach simply overwrites existing variables. No knowledge
+        of sub-namelist structure is required to modify a string of text. 
+
+    .. note:: Additional variables will not be added to a namelist via this approach
+
+    Update
+        The second is to extend the set of variables contained within a namelist. This functionality is
+        controlled by the :func:`update` function. Here, variables which are not already specified are
+        added using a templated namelist line.
+
+    .. note:: It is essential to specify which sub-namelist is to be updated before modification takes place
+
+    Pipe to/from file
+    -----------------
+
+    As typical NEMO namelists are no larger than a few tens of kilobytes
+    it makes sense to process namelists as single strings instead of
+    line by line.
+
+    >>> path = "foo.nml"
+    >>> text = nml.new("namfoo")
+
+    To write to a file simply invoke the writer.
+
+    >>> # Write to file
+    >>> nml.writer(path, text)
+
+    To read from a file specify the path to be read.
+
+    >>> # Read from file
+    >>> text = nml.reader(path)
+
+    Join multiple namelists
+    -----------------------
+
+    Since the namelists are regular Python strings there is no need for a 
+    specific *join* function. Namelists can be combined in whatever manner
+    is most pleasing to the eye.
+
+    >>> namoff = nml.new("namoff")
+    >>> namcl4 = nml.new("namcl4")
+    >>> # new line join
+    >>> print "\\n".join([namoff, namcl4])
+    &namoff
+    /
+    <BLANKLINE>
+    &namcl4
+    /
+    <BLANKLINE>
+
+    >>> # Or addition
+    >>> print namoff + namcl4
+    &namoff
+    /
+    &namcl4
+    /
+    <BLANKLINE>
+
+    Module functions
+    ================
+
+"""
+__version__ = "0.1.0"
+import re
+from numbers import Number
+
+def reader(path):
+    """Reads a file into a string
+
+    Reads whole file into single string. Typically, 
+    namelists are small enough to be stored in memory
+    while updates and edits are being performed.
+
+    :param path: Path to input file
+    :returns: entire file as a single string
+
+    """
+    with open(path, "r") as handle:
+        text = handle.read()
+    return text
+
+def writer(path, text):
+    """Writes to a file from a string
+
+    Handy way of piping a processed namelist into
+    a file.
+
+    :param path: Path to output file
+    :param text: Input text to process
+
+    """
+    with open(path, "w") as handle:
+        handle.write(text)
+
+def update(namid, text, data, convert=True):
+    """Extends namelist definition.
+
+    Similar to replace this function alters the values
+    of variables defined within a namelist. In addition to
+    replacing values it also creates definitions if the
+    variable is not found in the namelist. As such, the
+    namelist id must be specified.
+
+    :param namid: Namelist id
+    :param text: Input text to process
+    :param data: Dictionary of variables
+    :keyword convert: Sanitizes input data before replacement takes place
+
+    :returns: Text
+
+    .. seealso:: :func:`replace` :func:`sanitize`
+    """
+    sublists = namelists(text)
+    assert namid in sublists, "Warning: invalid namid specified!"
+
+    # Sanitize inputs
+    if convert:
+        data = sanitize(data)
+
+    # Parse subsection
+    namtext = sublists[namid]
+    subdata = variables(namtext)
+    subvars = subdata.keys()
+
+    # Replace existing variables in namtext
+    tmptext = replace(namtext, data)
+    text = text.replace(namtext, tmptext)
+    namtext = tmptext
+
+    # Identify new variables
+    vars = data.keys()
+    newvars = list(set(vars) - set(subvars))
+    newvars.sort()
+
+    # Append new vars to namid
+    lines = namtext.split("\n")
+    for v in newvars:
+        newline = "   %s = %s" % (v, data[v])
+        lines.insert(-1, newline)
+    newtext = "\n".join(lines)
+
+    # Replace old namtext with new namtext
+    text = text.replace(namtext, newtext)
+    return text
+
+def replace(text, data, convert=True):
+    """Edits existing variables.
+
+    Pattern matches and substitutes variables inside
+    a string of text. This is independent of namid and
+    as such is useful for modifying existing variables.
+    To append new variables the :func:`update` function 
+    is required.
+
+    >>> text = '''
+    ... &namobs
+    ...    ln_sst = .TRUE. ! Logical switch for SST observations
+    ... /
+    ... '''
+    >>> data = {"ln_sst": ".FALSE."}
+    >>> print replace(text, data)
+    <BLANKLINE>
+    &namobs
+       ln_sst = .FALSE. ! Logical switch for SST observations
+    /
+    <BLANKLINE>
+
+    .. note :: This does not append new variables to a namelist
+
+    :param text: string to process
+    :param data: dictionary with which to modify **text**
+    :keyword convert: Sanitizes input data before replacement takes place
+
+    :returns: string with new data values
+
+    .. seealso:: :func:`update`, :func:`sanitize`
+    """
+    if convert:
+        data = sanitize(data)
+    for k, v in data.iteritems():
+        pat = r"(%s\s*=\s*).+?(\s*[!\n])" % (k,)
+        repl = r"\g<1>%s\g<2>" % (v,)
+        text = re.sub(pat, repl, text)
+    return text
+
+def variables(text):
+    """Retrieves dictionary of variables in text.
+
+    >>> text = '''
+    ... &namobs
+    ...    ln_sst = .TRUE. ! Logical switch for SST observations
+    ... /
+    ... '''
+    >>> variables(text)
+    {'ln_sst': '.TRUE.'}
+
+    :param text: Input text to process
+
+    :returns: A dictionary of variable, value pairs.
+
+    """
+    data = {}
+    pairs = re.findall(r"\n\s*(\w+)\s*=\s*(.+?)\s*(?=[!\n])", text)
+    for key, value in pairs:
+        data[key] = value
+    return data
+
+def namelists(text):
+    """Retrieves dictionary of namelists in text.
+
+    Useful for isolating sub-namelists.
+
+    >>> text = '''
+    ... &namobs
+    ...    ln_sst = .TRUE. ! Logical switch for SST observations
+    ... /
+    ... '''
+    >>> namelists(text)
+    {'namobs': '&namobs\\n   ln_sst = .TRUE. ! Logical switch for SST observations\\n/'}
+
+    :param text: Input text to process
+
+    :returns: A dictionary of id, text block key, value pairs
+
+    """
+    # Boundary case
+    if text.startswith("&"):
+        text = "\n" + text
+    # Regular expression
+    results = re.findall(r"\n(&(\w+).*?\n/)", text, re.DOTALL)
+    data = {}
+    for content, namid in results:
+        data[namid] = content
+    return data
+
+def tostring(data):
+    """Maps standard Python data to Fortran namelist format.
+
+    >>> tostring([1, 2, 3])
+    '1 2 3'
+    >>> tostring(["foo.nc", "bar.nc"])
+    "'foo.nc', 'bar.nc'"
+    >>> tostring(True)
+    '.TRUE.'
+
+    :param data: Input Python data
+
+    :returns: Namelist formatted string
+
+    .. seealso:: :func:`sanitize`
+    """
+    if isinstance(data, list):
+        if all_numeric(data):
+            delim = " "
+        else:
+            delim = ", "
+        text = delim.join([convert(item) for item in data])
+    else:
+        text = convert(data)
+    return text
+
+def all_numeric(inputs):
+    # Checks all list entries are numbers
+    flag = True
+    for input in inputs:
+        if not isinstance(input, Number):
+            flag = False
+            break
+    return flag
+
+def numeric(word):
+    # Tests input string is numeric data
+    parts = word.split(" ")
+    try:
+        map(float, parts)
+        flag = True
+    except ValueError:
+        flag = False
+    return flag
+
+def logical(word):
+    # Tests input string is numeric data
+    if word.upper() in [".FALSE.", ".TRUE."]:
+        flag = True
+    else:
+        flag = False
+    return flag
+
+def listed(word):
+    # Tests input string is not a list
+    if ("," in word) or (" " in word):
+        flag = True
+    else:
+        flag = False
+    return flag
+
+def quote(word):
+    word = str(word)
+    if not quoted(word):
+        word = "'%s'" % (word,)
+    return word
+
+def convert(word):
+    # Conversion function
+    if isinstance(word, str):
+        if (quoted(word) or numeric(word) 
+            or logical(word) or listed(word)):
+            result = "%s" % (word,)
+        else:
+            result = quote(word)
+    elif isinstance(word, bool):
+        if word:
+            result = ".TRUE."
+        else:
+            result = ".FALSE."
+    else:
+        result = str(word)
+    return result
+
+def quoted(word):
+    # Checks if string begins/ends with quotation marks
+    if (word.startswith("'") and word.endswith("'")):
+        flag = True
+    elif (word.startswith('"') and word.endswith('"')):
+        flag = True
+    else: 
+        flag = False
+    return flag
+
+def same_type(data):
+    # True if all entries are the same type
+    types = map(type, data)
+    if len(set(types)) == 1:
+        flag = True
+    else:
+        flag = False
+    return flag
+
+def sanitize(data):
+    """Converts dictionary values into Fortran namelist format.
+
+    This is a more typical way to prepare data for inclusion in
+    a Fortran namelist. Instead of manually applying :func:`tostring`
+    to every element of the input data, **sanitize** fixes the entire
+    data set.
+
+    >>> sanitize({"x": True})
+    {'x': '.TRUE.'}
+    >>> 
+
+    :param data: Dictionary to convert
+
+    :returns: Dictionary whose values are in Fortran namelist format
+
+    .. seealso:: :func:`tostring`
+    """
+    replacements = [(k, tostring(v)) for k, v in data.items()]
+    data.update(replacements)
+    return data
+
+def new(namid, data=None, convert=True):
+    """Creates a new Fortran namelist
+
+    >>> new("namobs")
+    '&namobs\\n/\\n'
+    >>> print new("namobs")
+    &namobs
+    /
+    <BLANKLINE>
+
+    :param namid: Name for the new namelist
+
+    :keyword data: Specifies an initial dictionary with which to
+                   populate the namelist
+    :type data: dict
+    :keyword convert: Sanitizes input data before replacement takes place
+
+    :returns: string representation of a Fortran namelist
+    """
+    text = "&{namid}\n/\n".format(namid=namid)
+    if data is not None:
+        text = update(namid, text, data, convert=convert)
+    return text
+
+if __name__ == '__main__':
+    import doctest
+    doctest.testmod()
+
Index: /utils/tools_ticket2413/OBSTOOLS/OOO/ooo/ooo.py
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/OOO/ooo/ooo.py	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/OOO/ooo/ooo.py	(revision 12863)
@@ -0,0 +1,124 @@
+#!/usr/bin/env python2.7
+
+import os
+import shutil
+
+# Local imports
+import locator
+import nml
+import run
+
+def parse_args():
+    import argparse
+    parser = argparse.ArgumentParser()
+    parser.add_argument("date", metavar="DATE", 
+                        help="Run date.")
+    parser.add_argument("-w", "--work-dir", default=os.getcwd())
+    parser.add_argument("-f", "--forecast-types", default="forecast",
+                        help="Choice of forecast,persistence,climatology")
+    parser.add_argument("-l", "--lead-times", default="12",
+                        help="Forecast lead times")
+    parser.add_argument("-o", "--obs-types", default="profbfiles",
+                        help="Choice of namobs types.")
+    parser.add_argument("--class4", dest="ln_cl4", action="store_true",
+                        help="Flag to choose class 4 file outputs")
+    parser.add_argument("--dry-run", action="store_true",
+                        help="Flag to test namelist building without submitting.")
+    parser.add_argument("--cmd", dest="command", default="./opa",
+                        help="Submit task to run.")
+    parser.add_argument("-v", "--verbose", action="store_true",
+                        help="Prints difference between before and after namelists.")
+    parser.add_argument("namelist", metavar="NAMELIST", 
+                        help="NEMO namelist to edit.")
+    args = parser.parse_args()
+    args.forecast_types = args.forecast_types.split(',')
+    args.obs_types = args.obs_types.split(',')
+    args.lead_times = map(int, args.lead_times.split(','))
+    return args
+
+def printdiff(text1, text2):
+    # Provides nice text difference summary of namelists
+    import difflib
+    lines1 = text1.splitlines()
+    lines2 = text2.splitlines()
+    d = difflib.Differ()
+    result = list(d.compare(lines1, lines2))
+    text = '\n'.join(result)
+    print text
+
+def main():
+    args = parse_args()
+    date = args.date
+    print "Processing", args.namelist, " for", args.date
+    
+    # Move to working directory
+    if not os.path.exists(args.work_dir):
+        os.makedirs(args.work_dir)
+    os.chdir(args.work_dir)
+
+    # Collect forecast files
+    types = args.forecast_types
+    lead_times = args.lead_times
+    namooo, namcl4 = locator.forecasts(date=date,
+                                       types=types,
+                                       lead_times=lead_times)
+
+    # Process NEMO namelist
+    text = nml.reader(args.namelist)
+    sublists = nml.namelists(text)
+
+    # Verbose save original text
+    if args.verbose:
+        original_text = text
+
+    # namooo
+    if "namooo" not in sublists:
+        # Attach boilerplate
+        text += nml.new("namooo")
+    text = nml.update("namooo", text, data=namooo)
+
+    # namcl4
+    if "namcl4" not in sublists:
+        # Attach boilerplate
+        text += nml.new("namcl4")
+    namcl4["cl4_leadtime"] = lead_times
+    namcl4["cl4_date"] = nml.quote(date)
+    namcl4["cl4_match_len"] = len(namcl4["cl4_vars"])
+    namcl4["cl4_fcst_len"] = len(namcl4["cl4_leadtime"])
+    # Add naming convention
+    namcl4["cl4_sys"] = "FOAM"
+    namcl4["cl4_cfg"] = "orca025"
+    namcl4["cl4_vn"] = "'1.0'"
+    namcl4["cl4_prefix"] = "class4"
+    namcl4["cl4_contact"] = "example@example.com"
+    namcl4["cl4_inst"] = "institute"
+    text = nml.update("namcl4", text, data=namcl4)
+
+    # namrun
+    namrun = {"nn_date0": nml.quote(date)}
+    text = nml.update("namrun", text, data=namrun)
+
+    # namobs
+    namobs = locator.observations(date=date,
+                                  types=args.obs_types)
+    namobs["ln_cl4"] = args.ln_cl4
+    text = nml.update("namobs", text, data=namobs)
+
+    # Verbose print namelist differences
+    if args.verbose:
+        printdiff(original_text, text)
+
+    # pipe text to file
+    tmp = args.namelist+".tmp"
+    nml.writer(tmp, text)
+    shutil.move(tmp, args.namelist)
+
+    # Run job
+    if not args.dry_run:
+        run.submit(command=args.command)
+    
+
+
+if __name__ == '__main__':
+    main()
+
Index: /utils/tools_ticket2413/OBSTOOLS/OOO/ooo/run.py
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/OOO/ooo/run.py	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/OOO/ooo/run.py	(revision 12863)
@@ -0,0 +1,27 @@
+"""
+
+The NEMO offline observation operator is built and runs similarly to the
+online NEMO model.
+ 
+"""
+import subprocess
+import shlex
+import os
+
+class SubmitError(Exception):
+    pass
+
+def submit(command="./opa"):
+    """Simple function that runs the code.
+
+    This can be customised based on the particular environment
+    used to submit MPI or serial tasks. For simplicity, this
+    function calls opa.
+
+    By default, this program runs ``./opa``.
+
+    :returns: retcode
+    """
+    retcode = subprocess.call(shlex.split(command))
+    return retcode
+
Index: /utils/tools_ticket2413/OBSTOOLS/OOO/ooo/test_nml.py
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/OOO/ooo/test_nml.py	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/OOO/ooo/test_nml.py	(revision 12863)
@@ -0,0 +1,248 @@
+#!/usr/bin/env python2.7
+import unittest
+import nml
+
+def version(vn):
+    # Converts module version string to int tuple as PEP-440
+    return tuple(map(int, vn.split(".")))
+
+HEADER = """
+!! =====================================
+!! An example FORTRAN 90 namelist
+!! =====================================
+&namex
+"""
+NOHEADER = "&namex\n"
+LOGIC = " ln_test = .TRUE. ! Comment\n"
+NUMERIC = " nn_off_idx = 1 2 3\n"
+NOSPACE = " nn_off_idx=1 2 3\n"
+NEGATIVE = " nn_off_idx = -1 -2 -3\n"
+LIST = " off_files = 'a.nc' 'b.nc' 'c.nc' ! Comment\n"
+STRING = ' contact = "example@nowhere.com" ! Comment\n'
+COMMENT = ' ! x = y '
+FOOTER = "/\n"
+NOFOOTER = "/"
+
+class TestNamelist(unittest.TestCase):
+    def setUp(self):
+        self.logic_text = "\n".join([HEADER, LOGIC, FOOTER])
+        self.numeric_text = "\n".join([HEADER, NUMERIC, FOOTER])
+        self.nospace_text = "\n".join([HEADER, NOSPACE, FOOTER])
+        self.neg_numeric_text = "\n".join([HEADER, NEGATIVE, FOOTER])
+        self.list_text = "\n".join([HEADER, LIST, FOOTER])
+        self.mix_text = "\n".join([HEADER, LIST, NUMERIC, FOOTER])
+        self.string_text = "\n".join([HEADER, STRING, FOOTER])
+        self.comment_text = "\n".join([HEADER, COMMENT, FOOTER])
+        self.no_trail_text = "\n".join([HEADER, NUMERIC, LIST, NOFOOTER])
+
+    def test_should_handle_footer(self):
+        data = nml.variables(self.no_trail_text)
+        truth = {"nn_off_idx": "1 2 3",
+                 "off_files": "'a.nc' 'b.nc' 'c.nc'"}
+        self.assertDictEqual(data, truth)
+
+    def test_mix_data(self):
+        data = nml.variables(self.mix_text)
+        truth = {"nn_off_idx": "1 2 3",
+                 "off_files": "'a.nc' 'b.nc' 'c.nc'"}
+        self.assertDictEqual(data, truth)
+
+    def test_comment_data(self):
+        data = nml.variables(self.comment_text)
+        truth = {}
+        self.assertDictEqual(data, truth)
+
+    def test_logical_data(self):
+        data = nml.variables(self.logic_text)
+        truth = {"ln_test": ".TRUE."}
+        self.assertDictEqual(data, truth)
+
+    def test_numeric_data(self):
+        data = nml.variables(self.numeric_text)
+        truth = {"nn_off_idx": "1 2 3"}
+        self.assertDictEqual(data, truth)
+
+    def test_nospace_data(self):
+        data = nml.variables(self.nospace_text)
+        truth = {"nn_off_idx": "1 2 3"}
+        self.assertDictEqual(data, truth)
+
+    def test_negative_numeric_data(self):
+        data = nml.variables(self.neg_numeric_text)
+        truth = {"nn_off_idx": "-1 -2 -3"}
+        self.assertDictEqual(data, truth)
+
+    def test_string_data(self):
+        data = nml.variables(self.string_text)
+        truth = {"contact": '"example@nowhere.com"'}
+        self.assertDictEqual(data, truth)
+
+    def test_list_data(self):
+        data = nml.variables(self.list_text)
+        truth = {"off_files": "'a.nc' 'b.nc' 'c.nc'"}
+        self.assertDictEqual(data, truth)
+
+    def test_replace_variable_comment(self):
+        FIXTURE = " x = 'y' ! comment \n"
+        RESULT = " x = 'z' ! comment \n"
+        text = nml.replace(FIXTURE, {"x": "z"})
+        self.assertEqual(text, RESULT)
+
+    def test_replace_variable_no_comment(self):
+        FIXTURE = " x = 'y' \n"
+        RESULT = " x = 'z' \n"
+        text = nml.replace(FIXTURE, {"x": "z"})
+        self.assertEqual(text, RESULT)
+
+    def test_replace_variable_no_space(self):
+        FIXTURE = " x='y' \n"
+        RESULT = " x='z' \n"
+        text = nml.replace(FIXTURE, {"x": "z"})
+        self.assertEqual(text, RESULT)
+
+    def test_replace_variable_no_space_comment(self):
+        FIXTURE = " x='y' ! comment \n"
+        RESULT = " x='z' ! comment \n"
+        text = nml.replace(FIXTURE, {"x": "z"})
+        self.assertEqual(text, RESULT)
+
+    @unittest.skipIf(version(nml.__version__) < (1, 0),
+                     "Not implemented in this version")
+    def test_multiline_variable_replace(self):
+        # As a result of a code review
+        FIXTURE = " x = 1, \n     2"
+        RESULT =  " x = 3, \n     4"
+        text = nml.replace(FIXTURE, {"x": [3,4]})
+        self.assertEqual(text, RESULT)
+
+class TestCombinedNamelists(unittest.TestCase):
+    def setUp(self):
+        self.minimal = """&namone
+/"""
+        self.blanks = """
+&namone
+/
+&namtwo
+/
+"""
+        self.contents = """
+&namone
+Content 1
+/
+&namtwo
+Content 2
+/
+"""
+        self.contents_slash = """
+&namone
+Content 1 ! Y/N
+/
+&namtwo
+Content 2
+/
+"""
+    def test_should_select_name_from_minimal_namelist(self):
+        data = nml.namelists(self.minimal)
+        result = {"namone": "&namone\n/"}
+        self.assertDictEqual(data, result)
+
+    def test_should_select_names(self):
+        data = nml.namelists(self.blanks)
+        result = {"namone": "&namone\n/",
+                  "namtwo": "&namtwo\n/"}
+        self.assertDictEqual(data, result)
+
+    def test_should_select_contents(self):
+        data = nml.namelists(self.contents)
+        result = {"namone": "&namone\nContent 1\n/",
+                  "namtwo": "&namtwo\nContent 2\n/"}
+        self.assertDictEqual(data, result)
+
+    def test_should_select_contents_with_forward_slash(self):
+        data = nml.namelists(self.contents_slash)
+        result = {"namone": "&namone\nContent 1 ! Y/N\n/",
+                  "namtwo": "&namtwo\nContent 2\n/"}
+        self.assertDictEqual(data, result)
+
+
+class TestToString(unittest.TestCase):
+    def setUp(self):
+        self.char_list = ["a.nc", "b.nc", "c.nc"]
+        self.num_list = [1, 3, 7]
+        self.char = "foo@bar.com"
+        self.num = 10
+        self.mixed_list = ["foo.nc", -1, True]
+        self.mixed_str_list = map(nml.quote, ["foo.nc", "-1", ".TRUE."])
+
+    def test_should_format_mixed_list(self):
+        data = nml.tostring(self.mixed_list)
+        result = "'foo.nc', -1, .TRUE."
+        self.assertEqual(data, result)
+
+    def test_should_format_numeric_list(self):
+        data = nml.tostring(self.num_list)
+        result = "1 3 7"
+        self.assertEqual(data, result)
+
+    def test_should_format_character_list(self):
+        data = nml.tostring(self.char_list)
+        result = "'a.nc', 'b.nc', 'c.nc'"
+        self.assertEqual(data, result)
+
+    def test_should_format_strings(self):
+        data = nml.tostring(self.char)
+        result = "'%s'" % (self.char,)
+        self.assertEqual(data, result)
+
+    def test_should_format_numbers(self):
+        data = nml.tostring(self.num)
+        result = str(self.num)
+        self.assertEqual(data, result)
+
+    def test_should_not_format_numeric_string(self):
+        input = "3.14159"
+        self.assertEqual(nml.tostring(input), input)
+
+    def test_should_format_logicals(self):
+        data = nml.tostring(True)
+        result = ".TRUE."
+        self.assertEqual(data.upper(), result)
+
+    def test_should_not_format_string_of_list_data(self):
+        for input in ["1 2 3", "1, 2, 3", ".TRUE. .FALSE."]:
+            case = nml.tostring(input)
+            self.assertEqual(case, input)
+
+    def test_should_treat_mixed_numeric_character_data_as_character(self):
+        case = nml.tostring(self.mixed_str_list)
+        result = "'foo.nc', '-1', '.TRUE.'"
+        self.assertEqual(case, result)
+
+class TestUpdateNamelist(unittest.TestCase):
+    def setUp(self):
+        self.empty = """
+&namone
+/
+"""
+        self.single = """
+&namone
+   x = 'y'
+/
+"""
+        self.single_update = """
+&namone
+   x = 'z'
+/
+"""
+
+    def test_should_append_new_variable_to_namelist(self):
+        trial = nml.update("namone", self.empty, {"x": "'y'"})
+        self.assertEqual(trial, self.single)
+
+    def test_should_update_existing_variables(self):
+        trial = nml.update("namone", self.single, {"x": "'z'"})
+        self.assertEqual(trial, self.single_update)
+
+if __name__ == '__main__':
+    unittest.main()
+
Index: /utils/tools_ticket2413/OBSTOOLS/OOO/setup.py
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/OOO/setup.py	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/OOO/setup.py	(revision 12863)
@@ -0,0 +1,9 @@
+from distutils.core import setup
+setup(name='Offline observation operator',
+      version='0.1',
+      description='NEMO Offline observation operator',
+      author='Andrew Ryan',
+      author_email='andrew.ryan@metoffice.gov.uk',
+      packages=['ooo',],
+      scripts=['bin/ooo'],
+      )
Index: /utils/tools_ticket2413/OBSTOOLS/dataplot/README
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/dataplot/README	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/dataplot/README	(revision 12863)
@@ -0,0 +1,12 @@
+dataplot.pro - IDL widget based program to read in netcdf feedback and data
+files and plot observation and background values.
+
+example calls:
+
+dataplot,filenamearray
+dataplot,filenamearray,/batchplot,/gif
+dataplot,filenamearray,/batchplot,/ps
+
+use
+
+man,'dataplot' in idl for more information
Index: /utils/tools_ticket2413/OBSTOOLS/dataplot/colorbar_idl.pro
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/dataplot/colorbar_idl.pro	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/dataplot/colorbar_idl.pro	(revision 12863)
@@ -0,0 +1,212 @@
+;+
+PRO colorbar_idl, datain, colors, lablevels, datalevels, data=data, $
+	textcolor=textcolor, mincolor=mincolor, position=position
+;--------------------------------------------------------------------
+; datain - gives the range of values which are represented by colors
+; colors - color values
+; lablevels - label levels
+;
+; Author:  D. J. Lea    Nov 2008
+;--------------------------------------------------------------------
+
+; keep current graphics keywords
+
+psave=!p
+xsave=!x
+ysize=!y
+
+	if (n_elements(mincolor) eq 3) then $
+	      TVLCT,mincolor(0),mincolor(1),mincolor(2),0 
+
+    mx=max(datain,min=mn)
+
+	normal=1
+	if (keyword_set(data)) then normal=0
+
+    
+    if (keyword_set(data)) then begin				; data coords
+    y1 = !y.crange(0)-0.1*(!y.crange(1)-!y.crange(0))     
+    y2 = !y.crange(0)-0.05*(!y.crange(1)-!y.crange(0))
+    x1 = !x.crange(0)+0.1*(!x.crange(1)-!x.crange(0))
+    x2 = !x.crange(0)+0.9*(!x.crange(1)-!x.crange(0))
+    endif else begin						; normal coords
+    y1 = !y.window(0)-0.11*(!y.window(1)-!y.window(0))     
+    y2 = !y.window(0)-0.05*(!y.window(1)-!y.window(0))
+;;    y1 = !y.window(0)+0.05*(!y.window(1)-!y.window(0))     
+;;    y2 = !y.window(0)+0.1*(!y.window(1)-!y.window(0))
+    x1 = !x.window(0)+0.076*(!x.window(1)-!x.window(0))
+    x2 = !x.window(0)+0.924*(!x.window(1)-!x.window(0))
+    endelse
+
+    if (n_elements(position) eq 4) then begin
+    	coords=position
+    endif else begin
+	coords=[x1,y1,x2,y2]
+    endelse
+
+    print,'coords: ',coords
+	print, 'normal: ',normal, ' data: ',keyword_set(data)
+
+;    nb = N_ELEMENTS(colors)               
+;    x=coords(0)+(coords(2)-coords(0))*findgen(nb+1)/nb
+;    
+;    FOR i=0,nb-1 DO BEGIN
+;;    print,colors(i)
+;    polyfill, transpose([[x(i),x(i+1),x(i+1),x(i),x(i)],$
+;      [coords(1),coords(1),coords(3),coords(3),coords(1)]]),$
+;      color=colors(i), data=data, normal=normal
+;    ENDFOR
+
+;Position is always in normal units will need to do a conversion if 
+; data units required...
+
+    fill=0
+    cell_fill=1
+
+    maxdat=mx
+    mindat=mn
+    if (n_elements(datalevels) gt 0) then begin
+	    maxdat=max(datalevels,min=mindat)
+;            mindat=mindat+(1./!d.table_size)*(maxdat-mindat)
+;            print,'datalevels ',datalevels
+    endif
+
+; fix to prevent zero contour range
+    if (maxdat eq mindat) then begin
+        if (maxdat eq 0) then begin
+    	maxdat = maxdat + 1e-20
+        mindat = mindat - 1e-20
+        endif else begin
+        maxdat = maxdat * 1.01
+        mindat = mindat * 0.99
+        if (maxdat lt mindat) then begin
+        	tmp = mindat
+                mindat = maxdat
+                maxdat = tmp
+        endif
+        endelse
+    endif
+    
+    array1d=(findgen(!d.table_size+1))/!d.table_size*(maxdat-mindat)+mindat
+;    array1d=(findgen(!d.table_size+10)-10)/!d.table_size*(maxdat-mindat)+mindat
+
+	print,'!d.table_size ',!d.table_size
+
+;	print,'array1d ',array1d
+        print,'min array1d ',min(array1d), max(array1d)
+        print,'datain ',datain
+        print,'mx ',mx,' mn ',mn
+
+    if (n_elements(datalevels) gt 0) then print, 'datalevels ', datalevels
+        
+    array2d=array1d#replicate(1,2)
+    if (n_elements(datalevels) lt 2) then datalevels=array1d
+    
+;    print, 'datalevels ', datalevels
+;	print,'cell_fill ',cell_fill
+
+    TVLCT, R, G, B, /get
+    TVLCT,R(1),G(1),B(1),0        ; bodge fix for wrong black contour   
+
+	if (n_elements(data) gt 0) then print,'data = ',data
+        if (n_elements(normal) gt 0) then print,'normal = ',normal
+        print,coords
+
+; draw a few times to remove gaps
+    nel=n_elements(datalevels)
+    print, 'datalevels ',datalevels(0), datalevels(nel-1), nel
+    print, 'array2d ',min(array2d), max(array2d)
+    if (datalevels(0) lt datalevels(nel-1)) then begin 
+    for i=0,2 do begin    
+    contour, array2d, levels=datalevels, fill=fill, cell_fill=cell_fill, $
+    POSITION=coords, /noerase, xstyle=5, ystyle=5, data=data, normal=normal
+    endfor
+    endif
+
+    TVLCT,R(0),G(0),B(0),0 
+
+    numlablevels=n_elements(lablevels)
+    sigfig=1
+	strlabs=strarr(numlablevels)
+
+	repeat begin
+        widstr=strtrim(string(sigfig+8),2)
+; output 2 significant figures except if 0.
+
+        for i = 0, numlablevels-1 do begin
+        format='(g'+widstr+'.'+strtrim(string(sigfig),2)+')'
+	strlabs(i)=strcompress(string(lablevels(i),format=format),/remove_all)
+
+;	print,i,'.',strlabs(i),'.',format
+
+        if (strmid(strlabs(i),0,1) eq '0' or strmid(strlabs(i),0,2) eq '-0') then begin
+        	format='(g'+widstr+'.'+strtrim(string(sigfig-1),2)+')'
+	        strlabs(i)=strcompress(string(lablevels(i),format=format),/remove_all) 
+;                print,i,'.',strlabs(i),'.',format               
+        endif
+
+;	print,i,'.',strlabs(i),'.',format 
+
+; trim out spaces
+	strlabs(i)=strtrim(strlabs(i),2)
+       
+        strtemp=strlabs(i)
+; strip off last two characters if there is 0 after the decimal place
+; with a number thereafter
+        ptpos=strpos(strtemp,'.0')
+        len=strlen(strtemp)
+;        if ptpos gt 0 then print,ptpos,len
+        if ptpos gt 0 and len-2 ge ptpos then begin
+		strlabs(i)=strmid(strtemp,0,len-1)		        
+        endif
+
+;if the remaining last character is a point (.) then get rid of it
+	ptpos=strpos(strlabs(i),'.')
+        len=strlen(strlabs(i))
+;	print,ptpos, len
+	if ptpos gt 0 and ptpos eq len-1 then begin
+        	strlabs(i)=strmid(strlabs(i),0,len-1)
+        endif
+        
+        endfor
+;        print,strlabs
+;        print,strlen(strlabs)
+        sigfig=sigfig+1
+        whe=where(strpos(strlabs,'e') gt 0, numexps)
+;        print,'whe ',whe, numexps
+; all labels should be unique
+; should be all exps or none 
+; give up if sigfigs 255       
+	endrep until (n_elements(unique(strlabs)) eq numlablevels $
+        	and (numexps eq 0 or numexps eq numlablevels) $
+        	or sigfig gt 255) 
+
+    pcharsize=!p.charsize
+    if (pcharsize lt 1) then pcharsize=1
+;    tolx=0.01*pcharsize*(!x.crange(1)-!x.crange(0))
+    tolx=0.01*(x2-x1)
+    
+    ypos = y1-0.02*pcharsize*(!y.crange(1)-!y.crange(0))
+    for i = 0, numlablevels-1 do begin
+;      xpos = x1 + float(i)/float(n_elements(lablevels)-1)*(x2-x1)
+	xpos = x1 + (lablevels(i)-mn)/(mx-mn)*(x2-x1)		; position labels correctly relative 
+
+	if (xpos ge x1-tolx and xpos le x2+tolx) then begin 	; don't print any labels off the edge 
+
+;      xyouts, xpos, ypos, strcompress(string(lablevels(i),format='(f7.2)'),/remove_all), $
+;              color=!d.table_size-1, data=data, normal=normal, align=0.5
+
+	if (n_elements(textcolor) eq 3) then $
+	      TVLCT,textcolor(0),textcolor(1),textcolor(2),0 
+;	print,'xyouts ',xpos, ypos, ' ',strlabs(i)
+        xyouts, xpos, ypos, strlabs(i), data=data, normal=normal, align=0.5 
+	endif
+
+    endfor
+
+; restore graphics keywords
+!p=psave
+!x=xsave
+!y=ysize
+                    
+END
Index: /utils/tools_ticket2413/OBSTOOLS/dataplot/dataplot.pro
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/dataplot/dataplot.pro	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/dataplot/dataplot.pro	(revision 12863)
@@ -0,0 +1,4517 @@
+;+----------------------------------------------------------------------------------------
+; dataplot.pro
+; IDL widget based plotting routine for plotting observation and background values
+;
+; Author: D. J. Lea     -  Feb 2008
+;
+;+----------------------------------------------------------------------------------------
+;example calls:
+;
+;dataplot,filenamearray
+;dataplot,filenamearray,/batch,/gif			; plots data directly to a gif
+;dataplot,filenamearray,/batch,/ps			; plots data directly to a ps
+;dataplot,filenamearray,/batch,area=area            ; area 4 element array or descriptive string
+;dataplot, longitude, latitude, deparr, dayarr, valarr, bkgarr
+;dataplot, [longitude, latitude, deparr, dayarr, valarr, bkgarr], rmdi=rmdi, filename=filename 
+;
+;optional keywords
+;area			descriptive string or array [minlon,minlat,maxlon,maxlat]
+;typeplot=1-5 		plot obs-bkg or obs bkg etc 
+;alldays=1 		plot all days otherwise just plot first day    
+;depths			[depmin,depmax] in metres
+;showmdt		plot mdt
+;obstypeselect		string array of selected obs types to plot 
+;printobstypes		keyword to print unique obs types to the terminal
+;
+;+-----------------------------------------------------------------------------------------
+; Note the upper two slider bars control the depth range
+; the lower two slider bars control the day range
+;------------------------------------------------------------------------------------------
+
+
+; Event-handling procedure. 
+PRO dataplot_event, ev 
+ 
+  ; Retrieve the anonymous structure contained in the user value of 
+  ; the top-level base widget.  
+ 
+  WIDGET_CONTROL, ev.TOP, GET_UVALUE=stash 
+  WIDGET_CONTROL, ev.ID, GET_UVALUE=uval 
+
+;  print,uval
+
+;  print,'event'
+;  print,stash.depmin
+
+;  position = [!X.Window[0], !Y.Window[0], !X.Window[1], !Y.Window[1]]
+;  print,position 
+;  xsize = (position(2) - position(0)) * !D.X_VSIZE
+;  ysize = (position(3) - position(1)) * !D.Y_VSIZE
+;  xstart = position(0) * !D.X_VSIZE
+;  ystart = position(1) * !D.Y_VSIZE
+;  print,xsize,ysize,xstart,ystart
+  
+  ; If the event is generated in the draw widget, update the 
+  ; label values with the current cursor position and the value 
+  ; of the data point under the cursor. Note that since we have 
+  ; passed a pointer to the image array rather than the array 
+  ; itself, we must dereference the pointer in the 'image' field 
+  ; of the stash structure before getting the subscripted value. 
+ 
+  IF (TAG_NAMES(ev, /STRUCTURE_NAME) eq 'WIDGET_DRAW') THEN BEGIN 
+	xdev= ev.X 
+	ydev= ev.Y
+        
+;        print, 'xdev ',xdev, ' ydev ',ydev
+        
+; convert the pointer position to a data position
+  	arr=CONVERT_COORD( xdev, ydev, /device, /to_data) 
+  	xdata=arr(0)
+	ydata=arr(1)
+
+;	print, xdata , ydata        
+        
+;        print, 'xdev: ',xdev,' ydev: ',ydev,' xdata: ',xdata, ' ydata: ',ydata
+;    WIDGET_CONTROL, stash.label1, $ 
+;      SET_VALUE='X position: ' + STRING(xdata) 
+;    WIDGET_CONTROL, stash.label2, $ 
+;      SET_VALUE='Y position: ' + STRING(ydata) 
+;;    WIDGET_CONTROL, stash.label3, $ 
+;;      SET_VALUE='Value: ' + $ 
+;;      STRING((*stash.imagePtr)[ev.X, ev.Y], FORMAT='(Z12)') 
+;    WIDGET_CONTROL, stash.label3, $ 
+
+
+   ; What kind of event is this?
+
+;eventTypes = ['DOWN', 'UP', 'MOTION']
+;0 1 2
+;thisEvent = ev.type
+
+;print, 'ev.type ',ev.type
+
+CASE ev.type OF
+   0: BEGIN
+; dragbox start
+   print, 'down ',xdev,ydev, xdata, ydata
+         ; Turn motion events on for the draw widget.
+
+      Widget_Control, stash.draw, Draw_Motion_Events=1
+
+	; dragbox
+         ; Create a pixmap. Store its ID. Copy window contents into it.
+
+      Window, /Free, /Pixmap, XSize=stash.im_size(1), YSize=stash.im_size(2)
+      stash.pixID = !D.Window
+      Device, Copy=[0, 0, stash.im_size(1), stash.im_size(2), 0, 0, stash.drawID]
+;      WSet, stash.drawID
+
+	print,stash.im_size(0), stash.im_size(1), stash.im_size(2), stash.pixID, stash.drawID
+      
+      stash.xcorn=xdev
+      stash.ycorn=ydev
+      
+      stash.xdatacorn=xdata
+      stash.ydatacorn=ydata
+   
+;   RETURN
+   ENDCASE
+   1: BEGIN
+; dragbox close
+   print, 'up ',xdev,ydev, xdata, ydata
+         ; Turn draw motion events off. Clear any events queued for widget.
+
+      Widget_Control, stash.draw, Draw_Motion_Events=0, Clear_Events=1
+
+       WSet, stash.drawID
+      Device, Copy=[0, 0, stash.im_size(1), stash.im_size(2), 0, 0, stash.pixID]
+      WDelete, stash.pixID
+           
+      ; zoom in
+
+; dragbox   
+; avoid zooming if no dragging has occurred
+	pixdiffx = min([abs(stash.xcorn-xdev),abs(stash.ycorn-ydev)])       
+        print, '** Pixdiffx ',pixdiffx, stash.xcorn-xdev, stash.ycorn-ydev
+        if (pixdiffx gt 1 and finite(xdata) and finite(ydata)) then begin
+
+   	minxdata = min([stash.xdatacorn, xdata], max=maxxdata)
+        minydata = min([stash.ydatacorn, ydata], max=maxydata)
+
+
+	if (minxdata ge -180 and maxxdata le 360 and minydata ge -90 and maxydata le 90) then begin
+
+                stash.xrange=[minxdata,maxxdata]
+        	stash.yrange=[minydata,maxydata]
+                
+	        plotpoints,stash
+        endif
+        endif	
+           
+;   RETURN
+   ENDCASE
+   2: BEGIN
+; drag box motion
+;   print, 'motion: ',ev.x, ev.y
+
+      WSet, stash.drawID
+      Device, Copy=[0, 0, stash.im_size(1), stash.im_size(2), 0, 0, stash.pixID]
+
+   
+   sx = stash.xcorn
+   sy = stash.ycorn
+
+      PlotS, [sx, sx, xdev, xdev, sx], [sy, ydev, ydev, sy, sy], /Device, $
+          Color=!p.color
+;         Color=255
+   
+   ENDCASE
+   
+;   RETURN
+   7: begin
+		print,'mouse wheel event ',ev.clicks
+		if (ev.clicks eq 1 or ev.clicks eq -1) then begin
+		print,'zoom in/out'
+
+		print,'stash.depmin ',stash.depmin
+
+		print,'xdata ',xdata
+                
+                if (finite(xdata) and finite(ydata)) then begin
+
+; make an adjustment if we're in the Pacific
+	xrange=stash.xrange
+        typeproj=stash.typeproj
+	if (xrange(1) gt 180 and typeproj eq 1) then if (xdata lt 0) then xdata=xdata+360 
+       
+
+		oxrange=stash.xrange
+		oyrange=stash.yrange
+
+		dataplot_zoom, stash, xdata, ydata, ev.clicks
+
+; plot only if a change has been made
+		if (stash.xrange(0) ne oxrange(0) or stash.yrange(0) ne oyrange(0) $
+                    or stash.xrange(1) ne oxrange(1) or stash.yrange(1) ne oyrange(1)) then $
+			plotpoints, stash
+
+		endif
+                
+                endif
+
+   ENDCASE
+ENDCASE
+
+
+
+
+
+
+
+
+;      SET_VALUE='Value: ' + STRING(ev.release) 
+
+;	if(ev.release eq 1) then begin
+;		print,'left click - search for nearest point'
+	if(ev.release eq 1 or ev.release eq 4) then begin		; mouse click
+
+; might want a generalised point selection routine
+; for this routine and for plotpoints
+
+		print,'xdata ',xdata, ' ydata ',ydata
+                print,'xdev ',xdev, 'ydev ',ydev
+
+		if (finite(xdata) and finite(ydata)) then begin
+
+		print, 'finite'
+
+		xarr1=stash.xarr
+		yarr1=stash.yarr
+		dep1=stash.dep
+		dayarr=stash.dayarr
+		daymin=stash.daymin
+		daymax=stash.daymax
+                obstypes1=stash.obstypes
+ 		xrange=stash.xrange
+		yrange=stash.yrange
+		xs=xrange(1)-xrange(0)
+		ys=yrange(1)-yrange(0)
+		rmdi=stash.rmdi
+;                if (stash.salinity eq 0) then begin
+;		  obs1=stash.obs
+;		  bkg1=stash.bkg
+;                 qcarr1=stash.qcarr
+;                endif else begin
+;		  obs1=stash.obs2
+;		  bkg1=stash.bkg2
+;                 qcarr1=stash.qcarr2
+;		endelse                		
+                typeproj=stash.typeproj
+
+; make an adjustment if we're in the Pacific
+	if (xrange(1) gt 180 and typeproj eq 1) then if (xdata lt 0) then xdata=xdata+360 
+
+; set reasonable dist criteria
+
+		distmax=(xs/100.)^2+(ys/100.)^2
+;		print,'distmax ',distmax
+
+
+		selpoints,stash,lonsel, latsel, innovsel, qcsel, daysel, obstypsel, obnumsel, numsel, typestr 
+
+; get max min daysel
+		mindaysel=min(daysel, max=maxdaysel)
+
+;		print, 'selpoints ',obnumsel
+
+		if (n_elements(lonsel) gt 0) then begin
+		dist=((lonsel-xdata)^2+(latsel-ydata)^2)
+		res=min(dist,whd)		; whd is the minumum dist point index
+
+;		print,lonsel
+
+	xselstr=""
+	yselstr=""
+	valselstr=""
+	qcselstr=""
+	datestr=""
+        obnumselstr=""
+        mindatestr=""
+        maxdatestr=""
+
+;	print,'whd(0) ',whd(0)
+;        print,'res ',res, ' distmax ',distmax
+
+	obstypstr=""		
+	if (whd(0) gt -1 and res lt distmax) then begin		
+	xsel=lonsel(whd)
+	ysel=latsel(whd)
+ 
+ 	print,'xsel ',xsel,' ysel ',ysel       
+ ; make an adjustment if we're in the Pacific
+	if (xrange(1) gt 180 and typeproj eq 1) then if (xsel gt 180) then xsel=xsel-360 
+               
+	valsel=innovsel(whd)
+	qcsel=qcsel(whd)
+	datesel=daysel(whd)
+	obstypsel=obstypsel(whd)
+	obnumsel=obnumsel(whd)
+
+	xselstr=string(xsel)
+	yselstr=string(ysel)
+	valselstr=string(valsel)	
+	qcselstr=string(qcsel)
+;	datestr=string(datesel)
+	obstypstr=string(obstypsel(0))
+        obnumselstr=string(obnumsel(0))
+        print,'datesel(0) ',datesel(0) 
+        print,'obnumsel(0) ',obnumsel(0)
+	jul_to_dtstr,datesel(0),datestr
+        jul_to_dtstr,mindaysel,mindatestr
+        jul_to_dtstr,maxdaysel,maxdatestr
+   
+	if (ev.release eq 4) then begin
+        
+        	print,'ev.release ',ev.release
+
+;		window
+		wh=where(xarr1 eq xsel and yarr1 eq ysel)
+                print,'xsel ',xsel
+;                print,'xarr1 ',xarr1
+		dep2=dep1(wh)
+
+		if (wh(0) gt -1) then begin
+		if (stash.density eq 0) then begin
+
+         if (stash.salinity eq 0) then begin
+;                  print,'salinity eq 0'
+            obs2=stash.obs(wh)
+		      bkg2=stash.bkg(wh)
+            qcarr2=stash.qcarr(wh)
+         endif else begin
+;                  print,'salinity eq 1'
+		      obs2=stash.obs2(wh)
+		      bkg2=stash.bkg2(wh)
+            qcarr2=stash.qcarr2(wh)
+		   endelse
+
+      endif else begin
+
+         if (stash.filetype eq 'CRT') then begin
+
+            bkgU=stash.bkg(wh)
+            bkgV=stash.bkg2(wh)
+            bkg2=sqrt(bkgU*bkgU + bkgV*bkgV)
+
+            obsU=stash.obs(wh)
+            obsV=stash.obs2(wh)
+            obs2=sqrt(obsU*obsU + obsV*obsV)
+
+            qcarr2=stash.qcarr(wh)
+
+         endif else begin
+
+;            print,'density eq 1'
+            bkgt=stash.bkg(wh)
+            bkgs=stash.bkg2(wh)
+            obst=stash.obs(wh)
+            obss=stash.obs2(wh)                  
+;		       obs2=obst+obss
+;            bkg2=bkgt+bkgs
+		      obs2=eos_nemo(obst,obss)
+            bkg2=eos_nemo(bkgt,bkgs)
+            wh2=where(bkgt eq rmdi or bkgs eq rmdi)
+            if (wh2(0) gt -1) then begin
+               obs2(wh2)=rmdi
+               bkg2(wh2)=rmdi
+            endif
+            qcarr2=max([[stash.qcarr(wh)],[stash.qcarr2(wh)]],dim=2)                                		
+
+         endelse
+
+		endelse
+
+;		val2=abs(obs1(wh)-bkg1(wh))
+		val2=abs(obs2-bkg2)
+;		obs2=obs1(wh)
+;		bkg2=bkg1(wh)
+		obstype2=obstypes1(wh)
+;                qcarr2=qcarr1(wh)
+                dayarr2=dayarr(wh)
+;		val2=sqrt(val1(wh)^2)
+		
+;		print,'val2 ',val2(wh2)
+;		print,'dep2 ',dep2(wh2)
+;		plot,val2(wh2),dep2(wh2),ystyle=1,xstyle=1
+
+		profilewindow,dep2,val2,obs2,bkg2,obstype2,qcarr2,dayarr2,datestr,xselstr,yselstr,rmdi, salinity=stash.salinity, $
+                	plot_bad_obs=stash.plot_bad_obs, white_on_black=stash.white_on_black, coltable=stash.coltable, $
+                        	depmax=stash.depmax, depmin=stash.depmin
+
+
+; set graphics back to main window
+;  		WSET, stash.drawID
+ 		print,'ev release'
+		plotpoints,stash
+                
+                endif     ; wh(0)>-1
+
+	endif			; ev.release 4 (right mouse)
+        endif         
+	endif			; left or right mouse click
+	
+    WIDGET_CONTROL, stash.label1, $ 
+      SET_VALUE=stash.labt1 + strtrim(xselstr,1) 
+    WIDGET_CONTROL, stash.label2, $ 
+      SET_VALUE=stash.labt2 + strtrim(yselstr,1) 
+     WIDGET_CONTROL, stash.label3, $ 
+      SET_VALUE=typestr+': ' + strtrim(valselstr,1) 
+     WIDGET_CONTROL, stash.label4, $ 
+      SET_VALUE=stash.labt4 + strtrim(qcselstr,1) 
+     WIDGET_CONTROL, stash.label5, $
+      SET_VALUE=stash.labt5 + strtrim(datestr,1)
+     WIDGET_CONTROL, stash.label6, $ 
+      SET_VALUE=stash.labt6 + strtrim(valselstr,1) 
+;     WIDGET_CONTROL, stash.label7, $ 
+;      SET_VALUE=stash.labt7 + strtrim(string(innovsd),1)
+     WIDGET_CONTROL, stash.label8, $
+      SET_VALUE=stash.labt8 + strtrim(obstypstr,1)
+     WIDGET_CONTROL, stash.label9, $
+      SET_VALUE=stash.labt9 + strtrim(obnumselstr,1)
+     WIDGET_CONTROL, stash.label10, $
+      SET_VALUE=stash.labt10 + string(mindatestr) + ' ' + string(maxdatestr)
+		
+	endif else begin			; not finite
+
+	print, 'not finite'
+        
+; check for colorbar click
+		if (ydev lt 80) then begin        
+ 	        toplevel=stash.base
+	        fmx=stash.fmx
+        	fmn=stash.fmn
+      	        mx=stash.mx
+        	mn=stash.mn
+   		inputmxmnwindow, fmx, fmn, mx, mn, stash.rmdi, toplevel, success
+		if (success eq 1) then begin
+        	stash.fmx=fmx
+        	stash.fmn=fmn
+        	plotpoints,stash
+        	endif
+                endif
+        
+        endelse			; finite
+
+	endif
+
+		
+      
+;      print,tag_names(ev)
+;      print,ev.id
+;      print,ev.top
+;      print,ev.handler
+;      print,ev.type
+;      print,ev.press
+;      print,ev.release
+;      print,ev.clicks
+;      print,ev.modifiers
+;      print,ev.ch
+;      print,ev.key
+       
+   ENDIF                   ; end of widget draw events
+ 
+  ; If the event is generated in a button, destroy the widget 
+  ; hierarchy. We know we can use this simple test because there 
+  ; is only one button in the application. 
+ 
+
+;  IF (TAG_NAMES(ev, /STRUCTURE_NAME) eq 'WIDGET_COMBOBOX') THEN BEGIN
+;   IF (uval eq 'LEVELLIST') THEN BEGIN
+
+   IF (uval eq 'LEVELCHOICE') THEN BEGIN
+
+	stash.depmin=ev.value
+
+		print,'levelchoice'
+	print, 'stash.depmin: ',stash.depmin
+	print, 'stash.depmax: ',stash.depmax
+
+	if (stash.depmin ge stash.depmax) then begin
+		stash.depmax=stash.depmin
+	if (stash.depmax gt stash.depmaxl) then stash.depmax=stash.depmaxl
+
+;set sliderb position
+	WIDGET_CONTROL, stash.sliderb, set_value=stash.depmax
+
+	endif
+	
+
+		plotpoints, stash
+
+		
+;		   print,ev.index,widget_info(ev.id,/combobox_gettext)
+  
+  ENDIF
+
+   IF (uval eq 'LEVELCHOICEB') THEN BEGIN
+
+	stash.depmax=ev.value
+
+		print,'levelchoiceb'
+	print, 'stash.depmin: ',stash.depmin
+	print, 'stash.depmax: ',stash.depmax
+
+	if (stash.depmax le stash.depmin) then begin
+		stash.depmin=stash.depmax
+	if (stash.depmin lt stash.depminl) then stash.depmin=stash.depminl
+
+;set sliderb position
+	WIDGET_CONTROL, stash.slider, set_value=stash.depmin
+
+	endif
+	
+
+		plotpoints, stash
+
+		
+;		   print,ev.index,widget_info(ev.id,/combobox_gettext)
+  
+  ENDIF
+
+
+  IF (uval eq 'DATERANGE1') THEN BEGIN
+
+	odaymin=stash.daymin
+        odaymax=stash.daymax
+  
+  	stash.daymin=ev.value
+;	print, 'ev.drag ',ev.drag
+
+; set slider label
+	jul_to_dtstr,stash.daymin,dayminstr, /notime
+        WIDGET_CONTROL, stash.slider1label, $ 
+        SET_VALUE='min date: '+dayminstr 
+
+	if (stash.daymin ge stash.daymax) then begin
+;		stash.daymax=stash.daymin+1
+		stash.daymax=stash.daymin
+	if (stash.daymax gt stash.daymaxl) then stash.daymax=stash.daymaxl
+
+;set slider2 position
+	WIDGET_CONTROL, stash.slider2, set_value=stash.daymax
+; set slider 2 label
+	jul_to_dtstr,stash.daymax,daymaxstr, /notime
+        WIDGET_CONTROL, stash.slider2label, $ 
+        SET_VALUE='max date: '+daymaxstr 
+	
+        
+	endif
+	
+	print,'daterange1'
+;	if (ev.drag eq 0) then
+        if (stash.daymin ne odaymin or stash.daymax ne odaymax) then plotpoints,stash
+	
+  ENDIF
+  IF (uval eq 'DATERANGE2') THEN BEGIN
+
+	odaymin=stash.daymin
+        odaymax=stash.daymax
+  
+  	stash.daymax=ev.value
+
+; set slider label
+	jul_to_dtstr,stash.daymax,daymaxstr, /notime
+        WIDGET_CONTROL, stash.slider2label, $ 
+        SET_VALUE='max date: '+daymaxstr 
+
+	if (stash.daymax le stash.daymin) then begin
+;		stash.daymin=stash.daymax-1
+		stash.daymin=stash.daymax
+	if (stash.daymin lt stash.dayminl) then stash.daymin=stash.dayminl
+
+;set slider1 position
+	WIDGET_CONTROL, stash.slider1, set_value=stash.daymin
+; set slider 2 label
+	jul_to_dtstr,stash.daymin,dayminstr, /notime
+        WIDGET_CONTROL, stash.slider1label, $ 
+        SET_VALUE='min date: '+dayminstr 
+
+	endif
+	
+	print,'daterange2'
+;	if (ev.drag eq 0) then 
+        if (stash.daymin ne odaymin or stash.daymax ne odaymax) then plotpoints,stash
+
+  ENDIF
+  
+	IF (uval eq "RADIO1") THEN BEGIN
+		print,'uval eq RADIO1'
+		stash.typeplot=1
+                print, 'typeplot ',stash.typeplot
+		plotpoints,stash
+	ENDIF
+	IF (uval eq "RADIO2") THEN BEGIN
+		print,'uval eq RADIO2'	
+		stash.typeplot=2
+                print, 'typeplot ',stash.typeplot
+		plotpoints,stash
+	ENDIF
+  	IF (uval eq "RADIO3") THEN BEGIN
+		print,'uval eq RADIO3'
+		stash.typeplot=3
+                print, 'typeplot ',stash.typeplot
+		plotpoints,stash
+	ENDIF
+  	IF (uval eq "RADIO4") THEN BEGIN
+		print,'uval eq RADIO4'
+		stash.typeplot=4
+                print, 'typeplot ',stash.typeplot
+		plotpoints,stash
+	ENDIF
+
+	IF (uval eq "RADIO5") THEN BEGIN
+		print,'uval eq RADIO5'
+		stash.ombtypeplot=1
+                print, 'ombtypeplot ',stash.ombtypeplot
+		plotpoints,stash
+	ENDIF
+	IF (uval eq "RADIO6") THEN BEGIN
+		print,'uval eq RADIO6'
+		stash.ombtypeplot=2
+                print, 'ombtypeplot ',stash.ombtypeplot
+		plotpoints,stash
+	ENDIF
+	IF (uval eq "RADIO7") THEN BEGIN
+		print,'uval eq RADIO7'
+		stash.ombtypeplot=3
+                print, 'ombtypeplot ',stash.ombtypeplot
+		plotpoints,stash
+	ENDIF
+
+	IF (uval eq "RADIO01") THEN BEGIN
+		print,'uval eq RADIO01'
+		stash.typeproj=1
+		stash.xrange=stash.xrangedef
+		stash.yrange=stash.yrangedef
+		plotpoints,stash
+	ENDIF
+	IF (uval eq "RADIO02") THEN BEGIN
+		print,'uval eq RADIO02'	
+		stash.typeproj=2
+		stash.xrange=stash.xrangedef
+		stash.yrange=stash.yrangedef
+		plotpoints,stash
+	ENDIF
+  	IF (uval eq "RADIO03") THEN BEGIN
+		print,'uval eq RADIO03'
+		stash.typeproj=3
+		stash.xrange=stash.xrangedef
+		stash.yrange=stash.yrangedef
+		plotpoints,stash
+	ENDIF
+
+	IF (uval eq "RADIO001") THEN BEGIN
+		print,'uval eq RADIO001 ev.select: ',ev.select
+		stash.plot_bad_obs=ev.select
+;		stash.xrange=stash.xrangedef
+;		stash.yrange=stash.yrangedef
+		plotpoints,stash
+	ENDIF
+
+
+	IF (uval eq "RADIOSAL") THEN BEGIN
+	    print,'uval eq RADIOSAL ev.select: ',ev.select
+	    salinity=ev.select
+;            if (stash.filetype eq "Prof" or stash.filetype eq "feedback") then begin 
+	       stash.salinity=salinity
+  	       plotpoints,stash
+;	    endif
+	ENDIF
+
+
+	IF (uval eq "RADIODENSITY") THEN BEGIN
+            print,'uval eq RADIODENSITY ev.select: ',ev.select
+            density=ev.select
+            if (stash.filetype eq "CRT") then stash.salinity=0
+;            if (stash.filetype eq "Prof" or stash.filetype eq "CRT") then begin
+               stash.density=density  
+       	      plotpoints,stash
+;	         endif
+	ENDIF
+
+
+  IF (uval eq "PRINT") THEN BEGIN
+  	ps=1
+	eps=0
+	landscape=1
+  	pr2,file=stash.outfile+'.ps',landscape=landscape,ps=ps,eps=eps,color=1	
+  	plotpoints,stash
+	prend2,/view
+  ENDIF
+
+  IF (uval eq "SAVE") THEN BEGIN
+
+	thisDevice = !D.Name
+        psave=!p
+
+        Set_Plot, 'Z'			; do graphics in the background
+;	Device, Set_Resolution=[800,512], decomposed=0
+        Device, Set_Resolution=stash.picsize, decomposed=0
+        Erase                           ; clear any existing stuff
+        !p.charsize=0.75
+
+;	if (stash.white_on_black eq 0) then begin
+;; flip background and foreground color
+;                        pcolor=!p.color
+;                        pbackground=!p.background
+;                        !p.color=pbackground
+;                        !p.background=pcolor
+;
+;        endif
+;        print,'!p.color,!p.background ',!p.color,!p.background
+
+        setupct, r, g, b, coltable=stash.coltable, $
+        	white_on_black=stash.white_on_black		; setup color table
+; plot data
+  	plotpoints,stash
+	snapshot = TVRD()
+        WRITE_GIF,stash.outfile+'.gif',snapshot, r, g, b
+        Device, Z_Buffer=1		; reset graphics mode
+        Set_Plot, thisDevice
+;        !p.charsize=0.0
+	!p=psave
+        
+        spawn,'xv '+stash.outfile+'.gif'
+
+  ENDIF
+
+;Area selection
+
+  xrange=stash.xrange
+  yrange=stash.yrange
+  areasel,uval,xrange,yrange,success, toplevel=stash.base
+  if (success eq 1) then begin
+  stash.xrange=xrange
+  stash.yrange=yrange
+  plotpoints,stash
+  endif
+
+      
+  IF (uval eq "Timeseries") THEN BEGIN
+  	stash.numtimeseries=0
+        timeserieswindow,stash
+; set graphics back to main window
+;  		WSET, stash.drawID
+;; 		print,'ev release'
+;;		plotpoints,stash
+
+  ENDIF
+
+  IF (uval eq "Num timeseries") THEN BEGIN
+	stash.numtimeseries=1  
+        timeserieswindow,stash
+; set graphics back to main window
+;  		WSET, stash.drawID
+ 		print,'ev release'
+		plotpoints,stash
+
+  ENDIF
+
+  IF (uval eq "TS diagram") THEN BEGIN
+        tsdiagramwindow,stash
+; set graphics back to main window
+;  	WSET, stash.drawID
+ 	print,'ev release'
+	plotpoints,stash
+
+  ENDIF
+
+  IF (uval eq "Worst points") THEN BEGIN
+        worstpointswindow,stash
+  ENDIF
+
+  IF (uval eq "Filter type") THEN BEGIN
+  	filterwindow, stash
+  ENDIF
+
+  IF (uval eq "Low res map") THEN BEGIN
+;        stash.map_file=""
+        stash.hires_map=0       
+        Widget_Control, stash.loresmap, Set_Button=1
+        Widget_Control, stash.hiresmap, Set_Button=0
+        plotpoints,stash
+  ENDIF
+
+  IF (uval eq "Hi res map") THEN BEGIN
+;        stash.map_file="/opt/ukmo/wave/ukmo/data/map_europe.xdr"
+	stash.hires_map=1
+        Widget_Control, stash.loresmap, Set_Button=0
+        Widget_Control, stash.hiresmap, Set_Button=1
+        plotpoints,stash
+  ENDIF
+
+  IF (uval eq "Plot only bad obs") THEN BEGIN
+  	stash.plot_only_bad_obs = 1-stash.plot_only_bad_obs
+        Widget_Control, stash.pltonbado, Set_Button=stash.plot_only_bad_obs
+        if (stash.plot_bad_obs eq 1) then plotpoints,stash
+  ENDIF
+
+  IF (uval eq "White on black") THEN BEGIN
+        print,uval,' !p.color,!p.background ',!p.color,!p.background
+  	stash.white_on_black = 1-stash.white_on_black
+        Widget_Control, stash.whtonblack, Set_Button=stash.white_on_black
+;        IF (!d.name eq 'X') then begin 
+;                	WSET, stash.drawID
+;; flip background and foreground color
+;                        pcolor=!p.color
+;                        pbackground=!p.background
+;                        !p.color=pbackground
+;                        !p.background=pcolor
+
+        setupct, r, g, b, coltable=stash.coltable, $
+        	white_on_black=stash.white_on_black		; setup color table
+			
+                        plotpoints,stash
+;	endif
+
+
+  ENDIF
+
+
+  IF (uval eq "Square psym") THEN BEGIN
+        stash.sym=1
+        plotpoints,stash
+  ENDIF
+  IF (uval eq "Round psym") THEN BEGIN
+        stash.sym=2
+        plotpoints,stash
+  ENDIF
+
+  IF (uval eq "incsym") THEN BEGIN
+  	stash.symscale=stash.symscale*1.41421
+        plotpoints,stash
+  ENDIF
+  IF (uval eq "decsym") THEN BEGIN
+  	stash.symscale=stash.symscale/1.41421
+        plotpoints,stash
+  ENDIF
+  IF (uval eq "resetsym") THEN BEGIN
+  	stash.symscale=1.0
+        plotpoints,stash
+  ENDIF
+
+  IF (uval eq "vertgrad") THEN BEGIN
+  	stash.vertgrad=1-stash.vertgrad
+        Widget_Control, stash.vertgradmenu, Set_Button=stash.vertgrad
+        plotpoints,stash
+  ENDIF
+
+  IF (uval eq "Info") THEN BEGIN
+         infowindow
+  ENDIF
+
+  IF (uval eq "input max/min") THEN BEGIN
+        toplevel=stash.base
+        fmx=stash.fmx
+        fmn=stash.fmn
+        mx=stash.mx
+        mn=stash.mn
+   	inputmxmnwindow, fmx, fmn, mx, mn, stash.rmdi, toplevel, success
+	if (success eq 1) then begin
+        stash.fmx=fmx
+        stash.fmn=fmn
+        plotpoints,stash
+        endif
+        
+;        stash.mx=mx
+;        stash.mn=mn      
+;        info,stash.fmx
+;        info,stash.fmn
+;        info,stash.mx
+;        info,stash.mn
+
+  ENDIF
+
+	  
+; store values
+  WIDGET_CONTROL, ev.TOP, SET_UVALUE=stash 
+
+;  IF (TAG_NAMES(ev, /STRUCTURE_NAME) eq 'WIDGET_BUTTON') THEN BEGIN 
+  IF (uval eq "DONE") THEN BEGIN
+;    WIDGET_CONTROL, ev.TOP, /DESTROY 
+    WIDGET_CONTROL, stash.base, /DESTROY 
+  ENDIF 
+
+
+
+;	WIDGET_CONTROL, stash.label3, SET_VALUE=TAG_NAMES(ev, /STRUCTURE_NAME)
+;	print,TAG_NAMES(ev, /STRUCTURE_NAME), uval
+ 
+END 
+
+;-----------------
+; proceedures
+;-----------------
+
+;setup area ranges
+
+PRO areasel, uval, xrange, yrange, success, toplevel=toplevel
+
+;info, xrange
+;info, yrange
+
+success=0
+  
+  IF (uval eq "Global") THEN BEGIN
+    	xrange=[-180.,180.]
+        yrange=[-90.,90.]
+        success=1
+  ENDIF
+  IF (uval eq "Arctic") THEN BEGIN
+    	xrange=[-180.,180.]
+        yrange=[70.,90.]
+        success=1
+  ENDIF
+  IF (uval eq "N Atl") THEN BEGIN
+    	xrange=[-100.,0.]
+        yrange=[25.,70.]
+        success=1
+  ENDIF
+  IF (uval eq "Trop Atl") THEN BEGIN
+    	xrange=[-80.,20.]
+        yrange=[-25.,25.]
+        success=1
+  ENDIF
+  IF (uval eq "S Atl") THEN BEGIN
+    	xrange=[-70.,20.]
+        yrange=[-50.,-25.]
+        success=1
+  ENDIF
+  IF (uval eq "N Pac") THEN BEGIN		
+        xrange=[120.,-100.+360.]
+        yrange=[25.,70.]
+        success=1
+  ENDIF
+  IF (uval eq "Trop Pac") THEN BEGIN
+    	xrange=[120.,-80.+360.]
+        yrange=[-25.,25.]
+        success=1
+  ENDIF
+  IF (uval eq "S Pac") THEN BEGIN
+    	xrange=[120.,-70.+360.]
+        yrange=[-50.,-25.]
+        success=1
+  ENDIF
+  IF (uval eq "Indian") THEN BEGIN
+    	xrange=[20.,120.]
+        yrange=[-50.,30.]
+        success=1
+  ENDIF
+  IF (uval eq "S Ocean") THEN BEGIN
+    	xrange=[-180.,180.]
+        yrange=[-90.,-50.]
+        success=1
+  ENDIF
+  IF (uval eq "Pacific") THEN BEGIN
+    	xrange=[120.,-80.+360.]
+        yrange=[-50.,70.]
+        success=1
+  ENDIF
+   IF (uval eq "Atlantic") THEN BEGIN
+    	xrange=[-100.,20.]
+        yrange=[-50.,70.]
+        success=1
+  ENDIF
+   IF (uval eq "Med") THEN BEGIN
+    	xrange=[-15.,38.]
+        yrange=[30.,46.]
+        success=1
+  ENDIF
+   IF (uval eq "NWS") THEN BEGIN
+    	xrange=[-20.,13.]
+        yrange=[40.,65.]
+        success=1
+  ENDIF
+   IF (uval eq "Input Area") THEN BEGIN
+   	IF (n_elements(toplevel) gt 0) THEN BEGIN
+        print,'success b4',success
+   	inputareawindow, xrange, yrange, toplevel, success
+        print,'success af',success
+        ENDIF
+   ENDIF
+
+END
+
+ 
+;select points to plot
+
+PRO selpoints, stash, lonsel, latsel, innovsel, qcsel, daysel, obstypsel, obnumsel, numsel, typestr, $
+	daymin=daymin, daymax=daymax, salinity=salinity, rmsmean=rmsmean, innovsel2=innovsel2
+
+;		print, 'calling selpoints ',stash.netcdf, stash.txt
+      print, 'calling selpoints'
+
+		xarr1=stash.xarr
+		yarr1=stash.yarr
+		dep1=stash.dep
+                if (n_elements(salinity) eq 0) then salinity=stash.salinity
+		density=stash.density
+                mld=stash.mld
+      filetype=stash.filetype
+
+		obnum=stash.obnum
+;		obnum=lindgen(n_elements(xarr1))	; generate an array of observation numbers
+;                					; starting with zero
+
+;	        if (salinity eq 0) then begin                  
+;		  obs1=stash.obs
+;		  bkg1=stash.bkg
+;		  qcarr=stash.qcarr
+;                endif else begin
+;  		  obs1=stash.obs2
+;		  bkg1=stash.bkg2
+;		  qcarr=stash.qcarr2
+;                endelse              
+
+		if (salinity eq 0) then qcarr=stash.qcarr
+      if (salinity eq 1 or mld eq 1) then qcarr=stash.qcarr2
+      if (density  eq 1) then begin
+         if (filetype eq 'CRT') then qcarr=stash.qcarr $
+         else qcarr=max([[stash.qcarr],[stash.qcarr2]],dim=2)
+      endif
+
+		obstypes1=stash.obstypes
+		depmin=stash.depmin
+		depmax=stash.depmax
+		xrange=stash.xrange
+		yrange=stash.yrange
+		dayarr=stash.dayarr
+                fdayarr=long(dayarr+stash.dayshi)	; 0:00 hours should be plotted in prev day 
+		if (n_elements(daymin) eq 0) then daymin=stash.daymin
+		if (n_elements(daymax) eq 0) then daymax=stash.daymax
+		fdaymin=long(daymin)
+                fdaymax=long(daymax)
+		typeplot=stash.typeplot
+                ombtypeplot=stash.ombtypeplot
+		typeproj=stash.typeproj
+		xrange=stash.xrange
+		yrange=stash.yrange
+		rmdi=stash.rmdi
+
+		print,'dayarr ',max(dayarr)-2454710d, min(dayarr)-2454710d
+                print,'dayarr a',max(dayarr+stash.dayshi)-2454710d,min(dayarr+stash.dayshi)-2454710d
+		print,'stash.dayshi ',stash.dayshi
+
+		print,'fdayarr mx/mn ',max(fdayarr),min(fdayarr)
+                print,'fdaymin ',fdaymin,' fdaymax ',fdaymax
+
+		plot_bad_obs=stash.plot_bad_obs
+		
+		typestr=''
+
+		if (typeproj eq 2) then begin
+			xrange=[-999., 999.]
+			yrange=[0., 90.]
+		endif
+		if (typeproj eq 3) then begin
+			xrange=[-999., 999.]
+			yrange=[-90, 0.]
+		endif
+
+; add 360 if we're in the pacific
+
+		if (xrange(1) gt 180 and typeproj eq 1) then begin
+                print,'xrange(1) gt 180 ',xrange
+		    wh=where(xarr1 lt 0)
+                    xarr1(wh)=xarr1(wh)+360
+                endif
+
+		print,'dayarr(0): ',dayarr(0),fdayarr(0), daymin, daymax
+		
+;		if (plot_bad_obs eq 1) then begin
+		wh=where(dep1 ge depmin and dep1 le depmax and $
+			fdayarr ge fdaymin and fdayarr le fdaymax and $
+			xarr1 ge xrange(0) and xarr1 le xrange(1) and $
+			yarr1 ge yrange(0) and yarr1 le yrange(1))
+;		endif else begin
+;		wh=where(dep1 ge depmin and dep1 le depmax and $
+;			fdayarr ge fdaymin and fdayarr le fdaymax and $
+;			xarr1 ge xrange(0) and xarr1 le xrange(1) and $
+;			yarr1 ge yrange(0) and yarr1 le yrange(1) and qcarr eq 0)
+;		endelse		
+
+		nelwh=n_elements(wh)
+
+		print,'nelwh ',nelwh
+	
+		if (wh(0) gt -1) then begin
+;		   obssel=obs1(wh)
+;		   bkgsel=bkg1(wh)
+                                     
+		   qcsel=qcarr(wh)
+		   lonsel=xarr1(wh)
+		   latsel=yarr1(wh)
+		   daysel=dayarr(wh)
+		   depsel=dep1(wh)
+		   obstypsel=obstypes1(wh)
+         obnumsel=obnum(wh)
+         numsel=lonarr(nelwh)
+
+		   nel=n_elements(obssel)
+                   
+; select points here to avoid unnecessary density calculations                   
+
+         obssel1=stash.obs(wh)
+         bkgsel1=stash.bkg(wh)
+         obssel2=stash.obs2(wh)
+         bkgsel2=stash.bkg2(wh)
+
+         if (density eq 0 and mld eq 0) then begin   
+            if (salinity eq 0) then begin                  
+      		   obssel=obssel1
+		         bkgsel=bkgsel1
+            endif else begin
+  		         obssel=obssel2
+		         bkgsel=bkgsel2
+            endelse              
+         endif else begin
+            if (filetype eq 'CRT') then begin			 
+               bkgsel=sqrt(bkgsel1*bkgsel1 + bkgsel2*bkgsel2)
+               if (salinity eq 0) then begin
+                  obssel=sqrt(obssel1*obssel1 + obssel2*obssel2)
+               endif else begin
+                  obssel=stash.obs3(wh)                
+               endelse
+            endif else begin				; calculate density if mld flag set
+               obssel=eos_nemo(obssel1,obssel2)
+               bkgsel=eos_nemo(bkgsel1,bkgsel2)
+            endelse
+         endelse
+
+; create an array to store the sum of the square differences for calculating profile rms
+;		   omb2sel=(obssel - bkgsel)^2
+         nel=n_elements(obssel)
+      endif else begin			; if there are no obs then exit subroutine
+         nel=0
+			return
+                endelse  
+
+		if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+			innovseli=obssel^2
+                        innovseli2=bkgsel^2
+                        innovseli3=(obssel-bkgsel)^2
+                        innovseli4=obssel*bkgsel
+		endif else begin
+
+                             
+		if (ombtypeplot eq 1) then begin
+                	typestr='obs - bkg'
+                        innovseli=obssel-bkgsel
+                endif
+		if (ombtypeplot eq 2) then begin
+                	typestr='obs'
+                        innovseli=obssel
+                endif
+		if (ombtypeplot eq 3) then begin
+                	typestr='bkg'
+                        innovseli=bkgsel
+                endif
+
+		if (keyword_set(rmsmean)) then begin
+                	innovseli=innovseli
+                        innovseli2=innovseli^2
+                endif else begin
+
+		if (typeplot eq 1) then begin
+                	typestr='mean '+typestr
+                endif
+                if (typeplot eq 2) then begin
+                	typestr='rms '+typestr
+                        innovseli=innovseli^2
+                endif
+		if (typeplot eq 3) then begin
+                	typestr='sd '+typestr
+                        innovseli=innovseli^2		; ?
+                endif
+                if (typeplot eq 4) then begin
+                	typestr='mean sq '+typestr
+                        innovseli=innovseli^2
+                endif
+
+		endelse
+
+		endelse
+
+;      print,'bkgsel ',bkgsel
+;      print,'obssel ',obssel
+
+; tolerance check
+
+		if (wh(0) gt -1) then begin
+		   wh2=[-1]
+
+;	print,qcsel
+                   
+                   if (plot_bad_obs eq 0) then begin
+;		   if (typeplot eq 1 or typeplot eq 2 $
+;			or typeplot eq 3) then $
+		   if (ombtypeplot eq 1) then $
+;			wh2=where(bkgsel ne rmdi and obssel ne rmdi)
+			wh2=where(abs(bkgsel-rmdi) gt abs(rmdi)*0.01 and abs(obssel-rmdi) gt $
+	                        abs(rmdi)*0.01 and qcsel eq 0)	; tolerance rmdi check
+		   if (ombtypeplot eq 2) then $
+;                   if (typeplot eq 4) then $
+;		   	wh2=where(obssel ne rmdi)
+			wh2=where(abs(obssel-rmdi) gt abs(rmdi)*0.01 and qcsel eq 0)	;tol rmdi check
+		   if (ombtypeplot eq 3) then $
+;		   if (typeplot eq 5) then $	
+;			wh2=where(bkgsel ne rmdi)
+			wh2=where(abs(bkgsel-rmdi) gt abs(rmdi)*0.01 and qcsel eq 0)	;tol rmdi check
+
+; check for bad observations
+;		if (plot_bad_obs eq 1) then begin
+		endif else if (plot_bad_obs eq 1 and stash.plot_only_bad_obs eq 1) then begin
+;                	wh2=where(qcsel ne 0 or obssel eq rmdi or bkgsel eq rmdi, count)
+;                        wh2=where(qcsel ne 0 or abs(obssel-rmdi) lt abs(rmdi)*0.01,count) 
+			wh2=where(qcsel ne 0 and obssel ne rmdi)
+
+;                        wh2=where(qcsel ne 0 or abs(obssel-rmdi) lt abs(rmdi)*0.01 or abs(bkgsel-rmdi) lt abs(rmdi)*0.01,count) 
+;                        print,'bad obs: ',count
+;                        whtmp=where(qcsel eq 0, count)
+;                        print,'qcsel eq 0: ',count
+;                        whtmp=where(obssel eq 0, count)
+;                        print,'obssel eq 0: ',count
+;                        whtmp=where(bkgsel eq 0, count)
+;                        print,'bkgsel eq 0: ',count
+                endif else begin				; plot all observations
+;                	wh2=where(obssel)       
+                        wh2=where(obssel ne rmdi)
+                endelse
+
+		   if (wh2(0) gt -1) then begin
+		      obssel=obssel(wh2)
+		      bkgsel=bkgsel(wh2)
+                      innovseli=innovseli(wh2)
+;                      if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+                      if (n_elements(innovseli2) gt 0) then innovseli2=innovseli2(wh2)
+                      if (n_elements(innovseli3) gt 0) then innovseli3=innovseli3(wh2)
+                      if (n_elements(innovseli4) gt 0) then innovseli4=innovseli4(wh2)
+;		      endif
+		      qcsel=qcsel(wh2)
+		      lonsel=lonsel(wh2)
+		      latsel=latsel(wh2)
+		      daysel=daysel(wh2)
+		      depsel=depsel(wh2)
+		      obstypsel=obstypsel(wh2)
+                      obnumsel=obnumsel(wh2)
+;                      numsel=numsel(wh2)
+		   endif
+
+		print,'nelwh2 ',n_elements(wh2), typeplot, ombtypeplot
+		       
+		if (wh2(0) gt -1) then begin
+                
+                ; calculate vertical gradients if required
+	if (stash.filetype eq "Prof" and stash.vertgrad eq 1) then $
+	calcvertgrad, lonsel, latsel, daysel, obssel, bkgsel, qcsel, depsel, rmdi
+
+; average profiles on the same latitude and longitude
+; goes through each point and puts the average in the first instance and flags 
+; the others for later removal
+; this routine can also be used to bin data
+		depmx=max(depsel,min=depmn)
+		print,'depmn/mx: ',depmn, depmx
+		if (depmx gt depmn or stash.duplicates gt 0 or stash.differences or stash.bindata) then begin
+
+; sort by lat and lon
+; presumably will average in time also...
+
+		if (stash.bindata) then begin		; if we are binning data (in 1 deg bins)
+                					; use +0.5 to get nearest round number 
+		  latbin=double(fix((latsel+stash.binsize(1)/2.)*(1/stash.binsize(1))))/(1/stash.binsize(1))
+		  lonbin=double(fix((lonsel+stash.binsize(0)/2.)*(1/stash.binsize(0))))/(1/stash.binsize(0))			
+		  latlon=long(latbin*10000000d)+double(lonbin+180d)/360d
+                endif else begin
+		  latlon=long(double(latsel)*10000000d)+double(lonsel+180d)/360d
+                endelse
+                
+		elsort=sort(latlon)
+
+		latsel=latsel(elsort)
+		lonsel=lonsel(elsort)
+		obssel=obssel(elsort)
+                bkgsel=bkgsel(elsort)
+                innovseli=innovseli(elsort)
+;                if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+                if (n_elements(innovseli2) gt 0) then innovseli2=innovseli2(elsort)
+                if (n_elements(innovseli3) gt 0) then innovseli3=innovseli3(elsort)
+                if (n_elements(innovseli4) gt 0) then innovseli4=innovseli4(elsort)
+;		endif
+		qcsel=qcsel(elsort)
+                daysel=daysel(elsort)
+                depsel=depsel(elsort)
+		obstypsel=obstypsel(elsort)
+                obnumsel=obnumsel(elsort)
+;                numsel=numsel(elsort)
+		latlon=latlon(elsort)
+		
+		nel=n_elements(obssel)
+                accum=0
+                isave=0
+                lon1=-99999.0
+                lat1=-99999.0
+                latlon1=-99999.0
+                day1=-99999
+                num=0
+ 
+; 		if (nel gt 100) then begin
+;                info,latsel
+; 		print,latsel(0:100)
+;                info,lonsel
+;                print,lonsel(0:100)
+;                info,latlon
+;		print,latlon(0:100)
+ 
+; 		latsel(0:100)=latsel(50)
+;                lonsel(0:100)=lonsel(50)
+; 		latlon=long(double(latsel)*10000000d)+double(lonsel+180d)/360d
+ 
+;                endif
+                
+
+		print,'DJL ',max(daysel),min(daysel)
+
+; loop through the data averaging profiles at the same location               
+ 
+                sign=1                                            
+                if (stash.duplicates eq 2) then sign=-1		; plot the difference rather than the average	
+  
+                numsel=lonarr(nel)
+		for i=0L,nel-1 do begin
+                
+                if i mod 100000 eq 0 then print,i,nel
+
+;		if (plot_bad_obs eq 0 and obssel(i) ne rmdi) or $
+;                      	(plot_bad_obs eq 1 and lonsel(i) ne rmdi) then begin
+		
+; 		if (lonsel(i) ne lon1 or latsel(i) ne lat1) then begin
+
+; check for new profile or reaching the end of the data
+; check for the end of a day added
+
+		if ((latlon(i) ne latlon1) or (i eq nel-1) or (long(daysel(i)) ne long(day1))) then begin		
+
+;		print,i, latlon(i), latlon1, daysel(i), day1                
+;                if i gt 0 then stop
+		
+; average last profile
+		  if (isave ge 0 and num gt 0) then begin
+                
+                    if (num gt 1) then begin    
+                
+;                	print,num
+                        numsave=num
+                        if (stash.duplicates eq 2) then num=1
+
+			if (stash.bindata) then begin 
+ 			latsel(isave)=latsel(isave)/num
+                        lonsel(isave)=lonsel(isave)/num
+                        endif                          
+                	obssel(isave)=obssel(isave)/num
+                        bkgsel(isave)=bkgsel(isave)/num
+                        daysel(isave)=daysel(isave)/num
+                        depsel(isave)=depsel(isave)/num
+                        innovseli(isave)=innovseli(isave)/num
+;                        if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+                        if (n_elements(innovseli2) gt 0) then innovseli2(isave)=innovseli2(isave)/num
+                        if (n_elements(innovseli3) gt 0) then innovseli3(isave)=innovseli3(isave)/num
+                        if (n_elements(innovseli4) gt 0) then innovseli4(isave)=innovseli4(isave)/num
+;		        endif
+
+                        num=numsave
+
+; save the num	
+			numsel(isave)=num
+
+;                        if (fix(lonsel(isave)) eq -7297 and $
+;                            fix(latsel(isave)) eq -5935) then begin
+;                         print,'completed ',isave, num                        
+;			 print,'obssel ',obssel(isave)
+;                         print,'bkgsel ',bkgsel(isave)
+;                         endif
+                         
+                    endif else begin
+                    	numsel(isave)=num
+                    endelse
+                    if ((stash.duplicates gt 0 and num eq 1) or (stash.differences and num gt 1)) then begin
+                        obssel(isave)=rmdi
+                        bkgsel(isave)=rmdi
+                        lonsel(isave)=rmdi
+                        latsel(isave)=rmdi
+                        qcsel(isave)=rmdi
+                        innovseli(isave)=rmdi
+;                        if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+                        if (n_elements(innovseli2) gt 0) then innovseli2(isave)=rmdi
+                        if (n_elements(innovseli3) gt 0) then innovseli3(isave)=rmdi
+                        if (n_elements(innovseli4) gt 0) then innovseli4(isave)=rmdi
+;  		        endif
+                        
+                    endif
+                                           
+		  endif 
+
+		if (plot_bad_obs eq 0 and obssel(i) ne rmdi) or $
+                      	(plot_bad_obs eq 1 and lonsel(i) ne rmdi) then begin
+
+; start a new profile
+       		      lon1=lonsel(i)
+		      lat1=latsel(i)
+                      latlon1=latlon(i)
+                      day1=daysel(i)
+                      isave=i
+                      accum=1
+                      num=1
+
+		endif		; plot_bad_obs ...
+                      
+ ; accumulating                     
+                      
+		endif else begin
+                	
+		if (plot_bad_obs eq 0 and obssel(i) ne rmdi) or $
+                      	(plot_bad_obs eq 1 and lonsel(i) ne rmdi) then begin
+                        
+                	num=num+1
+
+			if (stash.bindata) then begin
+                        latsel(isave)=latsel(isave)+double(fix((1./stash.binsize(1))*(latsel(i)+stash.binsize(1)/2.)))/(1./stash.binsize(1))	;latsel(isave)+fix(latsel(i)+0.5)
+                        lonsel(isave)=lonsel(isave)+double(fix((1./stash.binsize(0))*(lonsel(i)+stash.binsize(0)/2.)))/(1./stash.binsize(0))	;lonsel(isave)+fix(lonsel(i)+0.5)
+                        endif
+
+                        obssel(isave)=obssel(isave)+obssel(i)*sign
+                        bkgsel(isave)=bkgsel(isave)+bkgsel(i)*sign
+                        innovseli(isave)=innovseli(isave)+innovseli(i)*sign
+;                        if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+                        if (n_elements(innovseli2) gt 0) then innovseli2(isave)=innovseli2(isave)+innovseli2(i)*sign
+                        if (n_elements(innovseli3) gt 0) then innovseli3(isave)=innovseli3(isave)+innovseli3(i)*sign
+                        if (n_elements(innovseli4) gt 0) then innovseli4(isave)=innovseli4(isave)+innovseli4(i)*sign
+; 		        endif
+
+                        qcsel(isave)=min([qcsel(isave),qcsel(i)])
+                        daysel(isave)=daysel(isave)+daysel(i)
+                        depsel(isave)=depsel(isave)+depsel(i)
+
+			if (stash.bindata) then begin
+                        latsel(i)=rmdi
+                        lonsel(i)=rmdi               
+                        endif         
+                        obssel(i)=rmdi
+                        bkgsel(i)=rmdi
+                        innovseli(i)=rmdi
+;                        if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+                        if (n_elements(innovseli2) gt 0) then innovseli2(i)=rmdi
+                        if (n_elements(innovseli3) gt 0) then innovseli3(i)=rmdi
+                        if (n_elements(innovseli4) gt 0) then innovseli4(i)=rmdi
+; 		        endif
+                        lonsel(i)=rmdi
+                        latsel(i)=rmdi
+                        qcsel(i)=rmdi
+
+;                        if (fix(lonsel(isave)*100) eq -7297 and $
+;                       	    fix(latsel(isave)*100) eq -5935) then begin
+;                         print,'isave ',isave, num                        
+;			  print,'obssel ',obssel(isave)
+;                         print,'bkgsel ',bkgsel(isave)
+;                        endif
+
+		endif		; plot_bad_obs ...
+                        
+                endelse 
+                      
+;                endif
+
+                endfor		; i  nobs
+
+		print,'DJL2x ',max(daysel),min(daysel)
+
+
+		wh5=where(lonsel ne rmdi)				; clears out but the averaged profiles
+                if (wh5(0) gt -1) then begin
+		      obssel=obssel(wh5)
+		      bkgsel=bkgsel(wh5)
+                      innovseli=innovseli(wh5)
+;                      if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+                      if (n_elements(innovseli2) gt 0) then innovseli2=innovseli2(wh5)
+                      if (n_elements(innovseli3) gt 0) then innovseli3=innovseli3(wh5)
+                      if (n_elements(innovseli4) gt 0) then innovseli4=innovseli4(wh5)
+;		      endif
+		      qcsel=qcsel(wh5)
+		      lonsel=lonsel(wh5)
+		      latsel=latsel(wh5)
+		      daysel=daysel(wh5)
+		      obstypsel=obstypsel(wh5)
+                      obnumsel=obnumsel(wh5)
+                      numsel=numsel(wh5)
+                      nel=n_elements(obssel)
+                endif else begin			; if there are no obs then exit subroutine
+                	nel=0
+			return
+                endelse               
+		endif
+
+		print,'nel wh5 ',n_elements(wh5)
+		print,'DJL3 ',max(daysel),min(daysel)
+
+		typeselect=stash.obstypeselect
+;                print, 'typeselect ',typeselect
+		if (typeselect(0) ne "") then begin
+;                typeselecta=strsplit(typeselect,' ,',/extract)		; split string on commas or spaces
+		typeselecta=strsplit(typeselect,',',/extract)		; split string on commas only
+                nel=n_elements(typeselecta)
+                print,'n_elements(typeselecta) ',nel
+                for i=0L,nel-1 do begin
+                ; string matching (understands * ?)
+                st1=strtrim(string(obstypsel),2)		; strip tailing and leading spaces
+                st2=strtrim(typeselecta(i),2)
+                wh6t=where(strmatch(st1,st2,/FOLD_CASE) EQ 1)	
+;                print, 'wh6t ',typeselecta(i), wh6t
+		if i eq 0 then wh6=wh6t else wh6=[wh6,wh6t]
+                endfor 
+;                print,n_elements(wh6)
+;                print,wh6
+                wh=where(wh6 gt -1)
+;                print,wh
+                if (wh(0) gt -1) then begin
+                      wh6=wh6(wh)
+		      obssel=obssel(wh6)
+		      bkgsel=bkgsel(wh6)
+                      innovseli=innovseli(wh6)
+;                      if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+                      if (n_elements(innovseli2) gt 0) then innovseli2=innovseli2(wh6)
+                      if (n_elements(innovseli3) gt 0) then innovseli3=innovseli3(wh6)
+                      if (n_elements(innovseli4) gt 0) then innovseli4=innovseli4(wh6)
+;		      endif
+		      qcsel=qcsel(wh6)
+		      lonsel=lonsel(wh6)
+		      latsel=latsel(wh6)
+		      daysel=daysel(wh6)
+		      obstypsel=obstypsel(wh6)
+                      obnumsel=obnumsel(wh6)
+                      numsel=numsel(wh6)
+                      nel=n_elements(obssel)
+;                      print, 'nel (in obstypeselect) ',nel
+                endif else begin			; if there are no obs then exit subroutine
+                	print,'no matching obs'
+			nel=0
+                endelse               
+		endif                	
+                
+                if (stash.printobstypes eq 1) then begin
+		s=sort(obstypsel)
+                sobstypsel=obstypsel(s)
+		u=uniq(sobstypsel)
+		print,"unique obs types: ",sobstypsel(u) 
+		endif
+
+		print,'nel ',nel
+		stash.symsize=1.0
+		if (nel gt 250) then stash.symsize=0.75
+		if (nel gt 1000) then stash.symsize=0.5
+		if (nel gt 2000) then stash.symsize=0.25
+		if (nel lt 20) then stash.symsize=2.0
+
+		if (!d.name eq 'Z') then stash.symsize=stash.symsize/2
+
+		print,'stash.symsize: ',stash.symsize
+
+; save data for mean and rms plots
+; for ombtypeplot=3 typeplot=2 innovsel = (obs - bkg)^2		mean value available from obssel(i) - bkgsel(i)
+
+; copy innovseli to innovsel (if we've got some valid data to plot / save)
+		if (nel gt 0) then innovsel=innovseli
+
+		if (stash.txt eq 1 and stash.bindata eq 1) then begin
+ 
+; The file contains:  longitude, latitude, num of points, obs mean, bkg mean
+;         mean sq obs,    mean sq bkg,        mean sq obs - bkg, 	mean obs * bkg 
+                
+                outfile=stash.outfile+'_selpoints.txt'
+                print, 'saving data to ',outfile
+                OPENW, unit, outfile, /get_lun
+;   	           printf,unit,'Output selpoints data: '
+                printf,unit, 3					; file version
+                printf,unit, typeplot
+                printf,unit, stash.bindata
+                printf,unit, xrange, yrange
+                printf,unit, min(daysel), max(daysel) 
+
+                for i=0L,nel-1 do begin
+                	   printf,unit, lonsel(i), latsel(i), numsel(i), obssel(i), bkgsel(i), $
+                        	   innovseli(i), innovseli2(i), innovseli3(i), innovseli4(i), $
+                        	   format='(2d10.3, i8, 6d18.8)'
+                endfor
+                FREE_LUN, unit
+               
+      endif
+
+		if (stash.netcdf eq 1 and stash.bindata eq 1) then begin
+
+                outfile=stash.outfile+'_selpoints.nc'
+                print, 'saving data to ',outfile
+
+                nid=NCDF_CREATE( outfile, /CLOBBER )
+                
+                NCDF_ATTPUT, nid, 'version', 3, /SHORT, /GLOBAL
+                NCDF_ATTPUT, nid, 'bindata', stash.bindata, /FLOAT, /GLOBAL
+                NCDF_ATTPUT, nid, 'xrange0', xrange(0), /FLOAT, /GLOBAL
+                NCDF_ATTPUT, nid, 'xrange1', xrange(1), /FLOAT, /GLOBAL
+                NCDF_ATTPUT, nid, 'yrange0', yrange(0), /FLOAT, /GLOBAL
+                NCDF_ATTPUT, nid, 'yrange1', yrange(1), /FLOAT, /GLOBAL
+                NCDF_ATTPUT, nid, 'mindaysel', min(daysel), /FLOAT, /GLOBAL
+                NCDF_ATTPUT, nid, 'maxdaysel', max(daysel), /FLOAT, /GLOBAL
+                
+                print, 'nel ',nel
+                nelid = NCDF_DIMDEF( nid, 'n', nel )
+                
+                lonid = NCDF_VARDEF ( nid, 'longitudes', [nelid], /FLOAT )
+                latid = NCDF_VARDEF ( nid, 'latitudes', [nelid], /FLOAT ) 
+                numid = NCDF_VARDEF ( nid, 'num', [nelid], /LONG )
+                obsid = NCDF_VARDEF ( nid, 'obs_mean', [nelid], /FLOAT )
+                bkgid = NCDF_VARDEF ( nid, 'bkg_mean', [nelid], /FLOAT )
+                innovseli1id = NCDF_VARDEF ( nid, 'obs_mean_sq', [nelid], /FLOAT )
+                innovseli2id = NCDF_VARDEF ( nid, 'bkg_mean_sq', [nelid], /FLOAT )
+                innovseli3id = NCDF_VARDEF ( nid, 'omb_mean_sq', [nelid], /FLOAT )
+                innovseli4id = NCDF_VARDEF ( nid, 'otimesb_mean', [nelid], /FLOAT )
+                NCDF_CONTROL, nid, /ENDEF
+                
+                if (nel gt 0) then begin
+                NCDF_VARPUT, nid, lonid, lonsel
+                NCDF_VARPUT, nid, latid, latsel
+                NCDF_VARPUT, nid, numid, numsel
+                NCDF_VARPUT, nid, obsid, obssel
+                NCDF_VARPUT, nid, bkgid, bkgsel
+                NCDF_VARPUT, nid, innovseli1id, innovseli
+                NCDF_VARPUT, nid, innovseli2id, innovseli2
+                NCDF_VARPUT, nid, innovseli3id, innovseli3
+                NCDF_VARPUT, nid, innovseli4id, innovseli4
+                endif
+                
+                NCDF_CLOSE, nid
+                
+		endif
+
+      if (stash.filterout ne '') then begin
+
+         ; write out filtered feedback file in new feedback format
+         ; with some filthy fudges to emulate NEMOVAR format
+         if (nel gt 0) then begin
+
+            print, 'writing filtered feedback file ',stash.filterout
+
+            ; split type string in two to be used as STATION_IDENTIFIER and STATION_TYPE
+            typesel=strarr(nel)
+            instsel=strarr(nel)
+
+            for iob = 0, nel-1 do begin
+               tempsel=strsplit(obstypsel[iob],/extract)
+               typesel[iob]=tempsel[0]
+               ; catch for data without space and instrument id in types (e.g. altimeter)
+               instsel[iob]=''
+               if (n_elements(tempsel) gt 1 ) then $
+                  instsel[iob]=tempsel[1]
+            endfor
+
+            ; setup netcdf file
+            nid=NCDF_CREATE( stash.filterout, /CLOBBER )
+
+            ; global attribute to emulate NEMOVAR feedback files
+            NCDF_ATTPUT, nid, 'title', "NEMO observation operator output", /GLOBAL
+            if (stash.obstypeselect ne '' ) then $
+               NCDF_ATTPUT, nid, 'filter', stash.obstypeselect, /GLOBAL
+            NCDF_ATTPUT, nid, 'minday', min(daysel), /FLOAT, /GLOBAL
+            NCDF_ATTPUT, nid, 'maxday', max(daysel), /FLOAT, /GLOBAL
+
+            nobid = NCDF_DIMDEF( nid, 'N_OBS', nel )
+            ndepid = NCDF_DIMDEF( nid, 'N_LEVELS', 1 ) ; temporarily input 1d profile arrays
+
+            if (stash.filetype eq 'feedback') then begin
+
+               ncvars = stash.varname
+               nnvars = n_elements(ncvars)
+
+            endif else begin
+
+               nnvars = 1
+               ncvars = stash.filetype
+               if (stash.filetype eq 'Prof') then begin
+                  ncvars = 'POTM'
+                  if (salinity eq 1) then ncvars = 'PSAL'
+                  nextid = NCDF_DIMDEF( nid, 'N_EXTRA', 1 )
+               endif 
+
+            endelse
+
+            nvarid = NCDF_DIMDEF( nid, 'N_VARS', nnvars )
+
+            nentid = NCDF_DIMDEF( nid, 'N_ENTRIES', 1 )
+
+            nstrnamid = NCDF_DIMDEF( nid, 'STRINGNAM', 8 )
+            nstrwmoid = NCDF_DIMDEF( nid, 'STRINGWMO', 8 )
+            nstrtypid = NCDF_DIMDEF( nid, 'STRINGTYP', 4 )
+            nstrjulid = NCDF_DIMDEF( nid, 'STRINGJULD', 14 )
+
+            varid = NCDF_VARDEF ( nid, 'VARIABLES', [nstrnamid,nvarid], /CHAR )
+            entid = NCDF_VARDEF ( nid, 'ENTRIES', [nstrnamid,nentid], /CHAR )
+            signid = NCDF_VARDEF ( nid, 'STATION_IDENTIFIER', [nstrwmoid,nobid], /CHAR )
+            typeid = NCDF_VARDEF ( nid, 'STATION_TYPE', [nstrtypid,nobid], /CHAR )
+
+            lonid = NCDF_VARDEF ( nid, 'LONGITUDE', [nobid], /DOUBLE )
+            latid = NCDF_VARDEF ( nid, 'LATITUDE', [nobid], /DOUBLE )
+            depid = NCDF_VARDEF ( nid, 'DEPTH', [nobid], /DOUBLE )
+;            depid = NCDF_VARDEF ( nid, 'DEPTH', [ndepid,nobid], /DOUBLE )
+            julid = NCDF_VARDEF ( nid, 'JULD', [nobid], /DOUBLE )
+            jrefid = NCDF_VARDEF ( nid, 'JULD_REFERENCE', [nstrjulid], /CHAR )
+
+            obsqcid = NCDF_VARDEF ( nid, 'OBSERVATION_QC', [nobid], /LONG )
+
+            FillVal=9999
+            NCDF_ATTPUT, nid, depid, '_Fillvalue', FillVal, /DOUBLE
+            NCDF_ATTPUT, nid, obsqcid, '_Fillvalue', FillVal, /LONG
+
+            obsids=intarr(nnvars)
+            bkgids=intarr(nnvars)
+            qcids=intarr(nnvars)
+            lqcids=intarr(nnvars)
+
+            for ivar = 0, nnvars-1 do begin
+
+               obsids[ivar] = NCDF_VARDEF ( nid, ncvars[ivar]+'_OBS', [nobid], /FLOAT )
+               NCDF_ATTPUT, nid, obsids[ivar], '_Fillvalue', FillVal, /FLOAT
+               bkgids[ivar] = NCDF_VARDEF ( nid, ncvars[ivar]+'_Hx', [nobid], /FLOAT )
+               NCDF_ATTPUT, nid, bkgids[ivar], '_Fillvalue', FillVal, /FLOAT
+               qcids[ivar] = NCDF_VARDEF ( nid, ncvars[ivar]+'_QC', [nobid], /LONG )
+               NCDF_ATTPUT, nid, qcids[ivar], '_Fillvalue', FillVal, /FLOAT
+               lqcids[ivar] = NCDF_VARDEF ( nid, ncvars[ivar]+'_LEVEL_QC', [nobid], /LONG )
+               NCDF_ATTPUT, nid, lqcids[ivar], '_Fillvalue', FillVal, /FLOAT
+
+            endfor
+
+            NCDF_CONTROL, nid, /ENDEF
+
+            JulDRef = '19500101000000'
+            NCDF_VARPUT, nid, jrefid, JulDRef
+            RefDate = JULDAY(fix(strmid(JulDRef,4,2)), fix(strmid(JulDRef,6,2)), fix(strmid(JulDRef,0,4)), $
+                             fix(strmid(JulDRef,8,2)), fix(strmid(JulDRef,10,2)), fix(strmid(JulDRef,12,2)))
+            NCDF_VARPUT, nid, julid,daysel-RefDate 
+
+            NCDF_VARPUT, nid, varid, ncvars 
+            NCDF_VARPUT, nid, entid, 'Hx'
+
+            NCDF_VARPUT, nid, lonid, lonsel
+            NCDF_VARPUT, nid, latid, latsel
+
+            NCDF_VARPUT, nid, depid, fltarr(nel)
+            NCDF_VARPUT, nid, obsqcid, fltarr(nel)+1
+
+            for ivar = 0, nnvars-1 do begin
+
+               NCDF_VARPUT, nid, obsids[ivar], obssel
+               NCDF_VARPUT, nid, bkgids[ivar], bkgsel
+               NCDF_VARPUT, nid, qcids[ivar], qcsel+1
+               NCDF_VARPUT, nid, lqcids[ivar], fltarr(nel)+1
+
+            endfor
+
+            NCDF_VARPUT, nid, typeid, typesel
+            NCDF_VARPUT, nid, signid, instsel
+
+         endif
+
+         NCDF_CLOSE, nid
+
+      endif ; filterout
+
+		if (nel gt 0) then begin	
+
+		   if (typeplot eq 2) then begin
+                        innovsel=sqrt(innovsel)
+                   endif
+		   if (typeplot eq 3) then begin
+;  std dev = sqrt ( mean x2 - (mean x)^2)
+			x2=innovsel
+			print,'typeplot ',typeplot,' ombtypeplot ',ombtypeplot
+			if (ombtypeplot eq 1) then $
+                        	innovsel=sqrt(x2-(obssel-bkgsel)^2)
+                        if (ombtypeplot eq 2) then $
+                        	innovsel=sqrt(x2-(obssel)^2)                        
+                        if (ombtypeplot eq 3) then $
+                        	innovsel=sqrt(x2-(bkgsel)^2)                        
+                   endif
+
+		   if (keyword_set(rmsmean)) then begin
+                   	innovsel=innovseli						; mean 
+                        if (n_elements(innovseli2) gt 0) then innovsel2=innovseli2	; rms                  
+                   endif
+
+
+		   innovmean=total(innovsel)/nel
+		   innovmean2=total(innovsel^2)/nel
+		   innovsd=sqrt(innovmean2-innovmean^2)
+		   print,'mean innovsel ',innovmean
+		   print,'sd innovsel ',innovsd
+
+		endif
+
+		
+
+		endif
+
+		endif
+
+		wh=where(numsel eq 0)
+                if (wh(0) gt -1) then numsel(wh)=1
+
+END
+
+PRO setupct, r, g, b, coltable=coltable, white_on_black=white_on_black
+
+if (coltable eq 0 or coltable lt -2) then begin
+; get color table and modify
+                loadct, 13
+                stretch, -40, 256
+;                tvlct,r,g,b,/get                
+;                r(0)=0
+;                g(0)=0
+;                b(0)=0
+;                r(255)=255
+;                g(255)=255
+;                b(255)=255              
+;                tvlct,r,g,b
+endif else begin
+	if (coltable eq -1) then begin
+		restore_colors, 'spectrum.clr'
+	endif else if (coltable eq -2) then begin
+                restore_colors, '~frbe/spectrum_alt.xdr',/asis
+        endif else begin
+		loadct,coltable
+        endelse            
+endelse
+
+tvlct,r,g,b,/get
+i0=0
+i1=255
+if (n_elements(white_on_black) eq 1 and !d.name ne "PS") then begin
+	if (white_on_black eq 0) then begin
+     		i0=255
+                i1=0   
+        endif
+endif
+r(i0)=0
+g(i0)=0
+b(i0)=0
+r(i1)=255
+g(i1)=255
+b(i1)=255              
+tvlct,r,g,b
+
+END
+
+PRO plotpoints, stash
+
+		nplots=1
+                if (stash.pmulti eq 2) then nplots=stash.pmulti
+
+		for nplot=0,nplots-1 do begin
+
+		if (stash.busy eq 1) then return
+		stash.busy = 1
+
+		num_cols=254
+
+		print,"!d.name ",!d.name 
+		IF (stash.drawID gt -1) then begin
+  		IF (!d.name eq 'X' or !d.name eq 'Z') then begin 
+                        device, decomposed=0
+	        endif
+                IF (!d.name eq 'X') then WSET, stash.drawID
+		endif
+
+		IF (!d.name ne 'Z') then setupct, r, g, b, $
+                   coltable=stash.coltable,white_on_black=stash.white_on_black		; setup color table
+
+		noerase=0
+		if (stash.pmulti eq 2) then begin
+                	if (stash.pmultinum gt 0) then noerase=1
+                	!p.multi=[stash.pmultinum,2,1]
+                        stash.pmultinum=(stash.pmultinum+1) mod 2
+                endif else begin
+                	!p.multi=0
+                endelse
+                
+;		xarr1=stash.xarr
+;		yarr1=stash.yarr
+;		dep1=stash.dep
+;		obs1=stash.obs
+;		bkg1=stash.bkg
+;		depmin=stash.depmin
+		xrange=stash.xrange
+		yrange=stash.yrange
+;		dayarr=stash.dayarr
+		daymin=stash.daymin
+		daymax=stash.daymax
+;		typeplot=stash.typeplot
+		typeproj=stash.typeproj
+;                print,"stash.map_file: ",stash.map_file
+;		if (strlen(stash.map_file) gt 0) then map_file=stash.map_file
+                                
+;		print,depmin,xrange,yrange
+
+  		dummy=[0,0]
+		
+		
+;		plot,dummy,/nodata,yrange=[-90,90],xrange=[-180,180]
+;		plot,dummy,/nodata,yrange=[-50,80],xrange=[-110,40],$
+;			xstyle=1,ystyle=1, xtitle='Longitude',ytitle='Latitude'
+
+		if (typeproj ne 1) then begin
+		    	origlon=0.
+			if (typeproj eq 2) then begin 
+                        	origlat=90.
+                                if (yrange(0) lt 0) then yrange(0)=45
+                                if (yrange(1) lt 0) then yrange(1)=90
+                        endif
+			if (typeproj eq 3) then begin 
+                        	origlat=-90.
+                                if (yrange(0) gt 0) then yrange(0)=-90
+                                if (yrange(1) gt 0) then yrange(1)=-45                               
+                        endif      
+			;scale=0.35
+                        smap = map_proj_init('Polar Stereographic')
+		endif
+
+		; select points to plot
+		typestr=""
+                
+spawn,'echo plotpoints 1 `date`'
+                
+		selpoints, stash, lonsel, latsel, innovsel, qcsel, daysel, obstypsel, obnumsel, numsel, typestr
+                
+spawn,'echo plotpoints 2 `date`'
+
+		if (stash.txt eq 0 and stash.netcdf eq 0) then begin
+		nelsel=n_elements(innovsel)
+
+                nptsstr=strtrim(string(nelsel),2)
+                print,nptsstr, nelsel
+
+;		if (nelsel gt 0) then begin
+
+
+
+		;convert lats and lons to projection positions
+;                if (nelsel gt 0) then begin
+;                print,'min/max lonsel: ',min(lonsel),max(lonsel)
+;		if (typeproj ne 1) then begin
+;                  coords = map_proj_forward(lonsel,latsel,MAP=smap)
+;		  lonsel=coords(0,*)
+;		  latsel=coords(1,*)
+;		endif
+;                endif
+
+
+
+		print,'nelsel: ',nelsel
+		nelinnov=n_elements(innovsel)
+		print,'nelinnov: ',nelinnov
+
+                jul_to_dtstr, daymin, dateminstr, /notime
+                jul_to_dtstr, daymax, datemaxstr, /notime		
+
+                strtsal=''
+;                print,'stash.filetype ',stash.filetype
+                if (stash.filetype eq "Prof" or stash.filetype eq "feedback") then begin
+                	   strtsal='T:  '
+                     if (stash.salinity eq 1) then strtsal='S:  '
+                     if (stash.density  eq 1) then strtsal='Density:  '
+                     if (stash.mld eq 1) then strtsal='MLD:  '
+                endif else begin
+                     if (stash.filetype eq "CRT") then begin
+                	      strtsal='U:  '
+                        if (stash.salinity eq 1) then strtsal='V:  '
+                        if (stash.density  eq 1) then strtsal='Speed:  '
+                        if (stash.salinity eq 1 and stash.density  eq 1) then strtsal='Total Speed:  '
+                     endif else begin
+                	      strtsal=stash.filetype+':  '
+                     endelse
+                endelse
+                if (stash.vertgrad eq 1) then strtsal='Grad '+strtsal
+		nptsstr2='Points: '+nptsstr+'  '
+		titlestr=strtsal+typestr+': '+dateminstr+' to '+datemaxstr
+		print,'titlestr ',titlestr
+
+; get max and min values
+		mx=0
+                mn=0
+                meaninnov=0
+                rmsinnov=0
+		if (nelinnov gt 0) then begin
+; NB these values are just the rms and mean of the points plotted...
+; and do not take account of the datapoints used in profiles plotted...
+		   mx=max(innovsel)
+                   mn=min(innovsel)
+		   meaninnov=avg(innovsel)
+                   rmsinnov=sqrt(avg(innovsel^2))
+;                   n=total(numsel)
+;                   wh=where(numsel gt 0)
+;                   print, 'innovsel: ',max(innovsel), min(innovsel)
+;                   print, 'numsel: ',max(numsel), min(numsel)
+;                   if (n gt 0) then begin
+;                      x=total(innovsel(wh)*numsel(wh))
+;                      x2=total(innovsel(wh)^2*numsel(wh))
+;                      meaninnov=x/n
+;                      rmsinnov=sqrt(x2/n)
+;                   endif
+                endif
+
+		subtitle=''
+		subtitle=nptsstr2+'depths: '+strtrim(string(long(stash.depmin)),2)+'-'+$
+                	strtrim(string(long(stash.depmax)),2)
+                if (stash.obstypeselect ne "") then subtitle=subtitle+'  filtered type: '+stash.obstypeselect        
+ 		subtitle=subtitle+'  extrema: '+$
+                	strtrim(string(mn,format='(G0.4)'),2)+', '+strtrim(string(mx,format='(G0.4)'),2)
+		subtitle=subtitle+'  mean: '+strtrim(string(meaninnov,format='(G0.4)'))+$
+                	' rms: '+strtrim(string(rmsinnov,format='(G0.4)'))
+		
+;                print,'noerase ',noerase
+                
+		if (typeproj ne 1) then begin                 
+                 map_set, /STEREOGRAPHIC, origlat, 0, /continents, title=titlestr+'!C'+subtitle, $
+                         ymargin=[10.,5.], /label, latlab=xrange(0), lonlab=yrange(0), $
+                         limit=[yrange(0),xrange(0),yrange(1),xrange(1)],/isotropic, hires=stash.hires_map, noerase=noerase
+                endif else begin        
+                  P0lon=0
+                  P0lat=0
+                  if (xrange(1) gt 180) then P0lon=180
+                  print,'ranges: ',yrange(0),xrange(0),yrange(1),xrange(1)
+                  map_set, P0lat, P0lon, /continents, title=titlestr+'!C'+subtitle, $
+                         ymargin=[10.,5.], /label, latlab=xrange(0), lonlab=yrange(0), $
+                         limit=[yrange(0),xrange(0),yrange(1),xrange(1)],/isotropic, hires=stash.hires_map, noerase=noerase  
+                endelse
+
+                                                                 
+		if (nelsel eq 0 or nelinnov eq 0) then begin 
+;			pp_contour,fld,title=titlestr,/nodata, /proportional, map_file=map_file
+		endif else begin
+;			pp_contour,fld,title=titlestr,/nodata, /proportional, map_file=map_file
+                          
+                if (stash.fmx ne stash.rmdi) then mx=stash.fmx
+                if (stash.fmn ne stash.rmdi) then mn=stash.fmn
+
+		print,'setting stash mx/mn'
+		stash.mx=mx
+                stash.mn=mn
+
+;		levs=contour_levels([mn,mx],nlevels=15)
+;		levs=findgen(10+1)/10.*(mx-mn)+mn
+
+		print, 'mn mx ',mn,mx
+
+
+
+;; De-select points outside window?
+;		
+;    xnd= [ -!X.s(0), 1. ]/!X.s(1)
+;    ynd= [ -!Y.s(0), 1. ]/!Y.s(1) 
+;    ov=0                ; overlap 
+;    clip_data= [ (!ppp.position(0)-ov)*xnd(1) + xnd(0) , $
+;                 (!ppp.position(1)-ov)*ynd(1) + ynd(0) , $
+;                 (!ppp.position(2)+ov)*xnd(1) + xnd(0) , $
+;                 (!ppp.position(3)+ov)*ynd(1) + ynd(0) ]
+;
+;	wh=where(lonsel ge clip_data(0) and lonsel le clip_data(2)  and $
+;               latsel ge clip_data(1) and latsel  le clip_data(3))
+;	       if (wh(0) gt -1) then begin
+;	       	latsel=latsel(wh)
+;		lonsel=lonsel(wh)
+;		innovsel=innovsel(wh)
+;	       endif
+
+
+		print,'daymin=',daymin
+		print,'daymax=',daymax
+;		print,dayarr(wh)
+
+	
+;		titlestr=typestr+': '+titlestr
+		
+
+
+		mx=max(innovsel)
+                mn=min(innovsel)
+                if (stash.fmx ne stash.rmdi) then mx=stash.fmx
+                if (stash.fmn ne stash.rmdi) then mn=stash.fmn
+                
+;                stash.mx=mx
+;                stash.mn=mn
+                
+;		levs=contour_levels([mn,mx],nlevels=30)
+		levs=findgen(15)/15.*(mx-mn)+mn
+                                
+                print, 'typeproj: ',typeproj
+		
+;		wh=sort(innovsel)
+;		print,'innovsel ',innovsel(wh)
+
+		clr=fix((innovsel-mn)/(mx-mn)*(num_cols-1))+1
+
+; prevent colours going out of range
+		wh=where(clr lt 1)
+                if (wh(0) gt -1) then clr(wh)=1
+                wh=where(clr gt num_cols)
+                if (wh(0) gt -1) then clr(wh)=num_cols
+
+;		print,'clr ',clr(wh)
+
+                case stash.sym of
+		1: USERSYM, [-1,-1,1,1,-1],[1,-1,-1,1,1], /FILL
+                2: usersym, cos(2.0*!pi*indgen(17)/16.0), sin(2.0*!pi*indgen(17)/16.0), thick=2.0, /fill
+                endcase
+                 
+                 spawn,'echo plotpoints 3 `date`'
+                 
+;;		rgb=transpose(reform(color24_to_rgb(clr),nelwh,3))
+
+		symsize=stash.symsize*stash.symscale  
+;		for i=0L,nelsel-1 do $
+;	        plots,lonsel(i),latsel(i),psym=8,color=clr,symsize=symsize
+
+		if (stash.bindata eq 0) then begin
+        	plots,lonsel,latsel,psym=8,color=clr,symsize=symsize,noclip=0
+;       	        plots,lonsel,latsel,psym=3,color=clr
+
+;		print, 'lonsel latsel'
+;		print,lonsel, format='(4g20.10)'
+;                print,latsel, format='(4g20.10)'
+		endif
+                
+                
+;                print, 'lonseld latseld'
+;		print,lonsel - lonsel(0), format='(4g20.10)'
+;                print,latsel - latsel(0), format='(4g20.10)'
+
+;		wh=where(lonsel eq lonsel(0) and latsel eq latsel(0))
+;                print,wh
+
+		endelse
+
+                 spawn,'echo plotpoints 4 `date`'
+		print,"stash.symsize ",stash.symsize
+
+		print,'limit=',[yrange(0),xrange(0),yrange(1),xrange(1)]
+
+;		endif       ; nel lonsel > 0 
+                
+		if (stash.bindata) then begin
+                     fillval=-32000
+                     mxlat=max(latsel)
+                     mnlat=min(latsel)
+                     mxlon=max(lonsel)
+                     mnlon=min(lonsel)
+                     dlon=stash.binsize(0)
+                     dlat=stash.binsize(1)
+                     nlats=(mxlat-mnlat)/dlat+1
+                     nlons=(mxlon-mnlon)/dlon+1
+                     print,'nlons ',nlons,' nlats ',nlats
+                     if (nlats ge 2 and nlons ge 2) then begin
+                     innovsel2=fltarr(nlons,nlats)
+;                     latsel2=fltarr(nlons,nlats)
+;                     lonsel2=fltarr(nlons,nlats)
+			latsel2=findgen(nlats)*dlat+mnlat
+                        lonsel2=findgen(nlons)*dlon+mnlon
+                     innovsel2(*)=fillval			; missing data
+;                     latsel2(*)=fillval
+;                     lonsel2(*)=fillval
+                     nelin=n_elements(innovsel)
+                     print,mnlat,mnlon
+                     iiarr=(lonsel-mnlon)/dlon
+                     ijarr=(latsel-mnlat)/dlat
+                     print,min(ijarr),max(ijarr),min(ijarr),max(ijarr)
+                     info,latsel2
+                     info,lonsel2
+                     for i=0L,nelin-1 do begin
+                     ii=iiarr(i)
+                     iip=ii+1
+                     if (iip ge nlons-1) then iip=ii
+                     iim=ii-1
+                     if (iim lt 0) then iim=0
+                     ij=ijarr(i)
+                     ijp=ij+1
+                     if (ijp ge nlats-1) then ijp=ij
+                     ijm=ij-1
+                     if (ijm lt 0) then ijm=0
+
+                     innovsel2(ii,ij)=innovsel(i)
+                     ; fill in gaps
+                     if (innovsel2(iip,ij) eq fillval) then innovsel2(iip,ij)=innovsel(i)
+                     if (innovsel2(ii,ijp) eq fillval) then innovsel2(ii,ijp)=innovsel(i)
+                     if (innovsel2(iim,ij) eq fillval) then innovsel2(iim,ij)=innovsel(i)
+                     if (innovsel2(ii,ijm) eq fillval) then innovsel2(ii,ijm)=innovsel(i)
+;                     latsel2(ii,ij)=latsel(i)
+;                     lonsel2(ii,ij)=lonsel(i)
+                     endfor 
+                     info,latsel2
+                     print,latsel2
+                     info,lonsel2
+                     print,lonsel2
+                     
+                     TVLCT, R, G, B, /get
+		     TVLCT,R(1),G(1),B(1),0        ; bodge fix for wrong black contour   
+
+			wh=where(innovsel2 gt mx-(mx-mn)*0.001 and innovsel2 ne fillval)
+                        if (wh(0) gt -1) then innovsel2(wh)=mx-(mx-mn)*0.001
+			wh=where(innovsel2 lt mn and innovsel2 ne fillval)
+                        if (wh(0) gt -1) then innovsel2(wh)=mn
+
+		     levs2=nice_contourlevels([mn,mx],nlevels=50)
+
+ 		     contour,innovsel2,lonsel2,latsel2,levels=levs2, /overplot, /cell_fill, min_value=-1000
+                     
+                     TVLCT,R(0),G(0),B(0),0		; restore original colour table
+                     endif
+                     
+		endif
+
+		if (daymin eq daymax and daymin eq 0) then begin
+                	print,'No data file'
+                        xyouts, 0.15, 0.5, 'No data files', /normal, charsize=8
+                endif
+
+; plot colorbar
+		levs=nice_contourlevels([mn,mx],nlevels=10)
+
+		print, levs
+                
+		barclr=findgen(num_cols)+1
+                colorbar_idl, [mn,mx], barclr, levs
+		endif				; stash.txt eq 0
+
+		stash.busy=0
+
+                if (stash.pmulti eq 2) then begin
+                	typeproj=stash.typeproj
+                        print, 'old stash.typeproj: ',stash.typeproj	
+                	if (typeproj eq 2) then stash.typeproj=3		;plot north and south poles 
+                	if (typeproj eq 3) then stash.typeproj=2
+                        print, 'new stash.typeproj: ',stash.typeproj
+                endif
+
+		endfor			; nplots
+
+
+end
+
+;------------------------------------------
+;Profile plotting window and event handling
+;------------------------------------------
+
+PRO profilewindow_event, ev
+  WIDGET_CONTROL, ev.TOP, GET_UVALUE=stash2 
+  WIDGET_CONTROL, ev.ID, GET_UVALUE=uval 
+	print,uval
+	if (uval eq "PRINTPW") then begin
+		ps=1
+		eps=0
+		landscape=1
+		pr2,file="~/plotprofile.ps",landscape=landscape,ps=ps,eps=eps,color=1
+		plotprofile,stash2
+		prend2,/view
+	endif
+        if (uval eq "SAVEPW") then begin
+  		thisDevice = !D.Name
+        	psave=!p
+
+        	Set_Plot, 'Z'			; do graphics in the background
+		Device, Set_Resolution=[640,480]    ; clear any existing stuff
+        	!p.charsize=0.75
+
+		if (stash2.white_on_black eq 0) then begin
+; flip background and foreground color
+                        pcolor=!p.color
+                        pbackground=!p.background
+                        !p.color=pbackground
+                        !p.background=pcolor
+
+        	endif
+        	print,'!p.color,!p.background ',!p.color,!p.background
+
+        	setupct, r, g, b, $
+                   coltable=stash2.coltable,white_on_black=stash2.white_on_black		; setup color table
+; plot data
+  		plotprofile,stash2
+		snapshot = TVRD()
+        	WRITE_GIF,"~/plotprofile.gif",snapshot, r, g, b
+        	Device, Z_Buffer=1		; reset graphics mode
+        	Set_Plot, thisDevice
+		!p=psave
+        
+        	spawn,'xv ~/plotprofile.gif'
+        
+        endif
+        if (uval eq "TXTPW") then begin
+        	plotprofile,stash2,/txt
+        endif
+end
+
+PRO plotprofile,stash2, txt=txt
+
+	if (n_elements(txt) eq 0) then txt=0
+
+;** need to deal with multiple times
+
+	dep2=stash2.dep2
+	val2=stash2.val2
+	obs2=stash2.obs2
+	bkg2=stash2.bkg2
+	obstype2=stash2.obstype2
+        qcarr2=stash2.qcarr2
+        dayarr2=stash2.dayarr2
+	datestr=stash2.datestr
+	xselstr=stash2.xselstr
+	yselstr=stash2.yselstr
+	rmdi=stash2.rmdi
+
+        multstr=""
+	mindayarr2=min(dayarr2,max=maxdayarr2)
+        
+        whs=sort(dayarr2)
+        u=uniq(dayarr2)
+
+        nu=n_elements(u)
+        dayarr2u=dayarr2(u)
+
+        print,'dayarr2u: ',dayarr2u
+        
+        if (maxdayarr2 ne mindayarr2) then multstr="mult times "+strtrim(string(nu),2)
+
+;	print,'obstype2 ',obstype2
+
+	print,'profile plot_bad_obs: ',stash2.plot_bad_obs
+	print, obs2
+        print, bkg2
+        print, qcarr2
+
+		if (stash2.plot_bad_obs eq 0) then begin
+		wh=where(obs2 ne rmdi and qcarr2 eq 0)
+                endif else begin
+;                wh=where(obs2 eq obs2)
+		wh=where(obs2 ne rmdi)
+                endelse
+                
+		if (wh(0) gt -1) then begin
+		depo1=dep2(wh)
+		valo1=val2(wh)
+		obso1=obs2(wh)
+		bkgo1=bkg2(wh)
+                qcarro1=qcarr2(wh)
+		endif
+                
+                
+		if (stash2.plot_bad_obs eq 0) then begin
+ 		wh=where(bkg2 ne rmdi and qcarr2 eq 0)
+		endif else begin
+;                wh=where(bkg2 eq bkg2)
+		wh=where(bkg2 ne rmdi)
+                endelse
+
+		if (wh(0) gt -1) then begin
+		depb1=dep2(wh)
+		valb1=val2(wh)
+		obsb1=obs2(wh)
+		bkgb1=bkg2(wh)
+                qcarrb1=qcarr2(wh)
+		endif
+                
+
+;loop thru times
+
+		if (n_elements(bkgb1) gt 0) then begin 
+                	xmx=max([obso1,bkgb1],min=xmn)
+                        ymx=max([depo1,depb1],min=ymn)
+                endif else begin
+                	xmx=max(obso1,min=xmn)
+                        ymx=max(depo1,min=ymn)
+                endelse
+
+; set max and min depth based on selection of depths from the main window
+		if (ymx gt stash2.depmax) then ymx=stash2.depmax
+                if (ymn lt stash2.depmin) then ymn=stash2.depmin
+
+; reset xrange based on new ymx and ymn
+		if (n_elements(bkgb1) gt 0) then begin 
+                        wh1=where(depo1 ge ymn and depo1 le ymx)
+                        wh2=where(depb1 ge ymn and depb1 le ymx)
+                	if (wh1(0) gt -1 and wh2(0) gt -1) then xmx=max([obso1(wh1),bkgb1(wh2)],min=xmn)
+                endif else begin
+                        wh1=where(depo1 ge ymn and depo1 le ymx)
+                	if (wh1(0) gt -1) then xmx=max(obso1(wh1),min=xmn)
+                endelse
+
+; add a little bit to xrange to make plots look better
+		if (xmn eq xmx) then begin 
+                	xmn=xmn-0.5
+                        xmx=xmx+0.5
+                endif
+		dxrange=(xmx-xmn)*0.02
+                xmx=xmx+dxrange
+                xmn=xmn-dxrange
+
+; add a little bit to yrange to make plots look better
+		if (ymn eq ymx) then begin 
+                	ymn=ymn-0.5
+                        ymx=ymx+0.5
+                endif
+		dyrange=(ymx-ymn)*0.01
+                ymx=ymx+dyrange
+                ymn=ymn-dyrange
+		print,'** yrange: ',ymn, ymx
+
+		if (txt eq 1) then begin
+		        outfile='dataplot_profile.txt'
+			print, 'saving data to ',outfile
+			OPENW, unit, outfile, /get_lun
+                endif
+	
+		for t=0,nu-1 do begin					; loop through times
+
+		wht=where(dayarr2 eq dayarr2u(t))
+		depo=depo1(wht)
+                valo=valo1(wht)
+                obso=obso1(wht)
+                bkgo=bkgo1(wht)
+                qcarro=qcarro1(wht)
+                dayarro=dayarr2(wht)
+		if (n_elements(depb1) gt 0) then depb=depb1(wht)
+                if (n_elements(valb1) gt 0) then valb=valb1(wht)
+                if (n_elements(obsb1) gt 0) then obsb=obsb1(wht)
+                if (n_elements(bkgb1) gt 0) then bkgb=bkgb1(wht)
+                if (n_elements(qcarrb1) gt 0) then qcarrb=qcarrb1(wht)
+                
+
+
+;print data
+
+;		if (txt eq 1) then begin
+;		print,'rmdi: ',rmdi
+;                print,'profile data'
+;		for i=0,n_elements(depo)-1 do begin
+;                	print,depo(i),obso(i),bkgo(i),qcarro(i)
+;                endfor
+;                print,'profile data'
+;		for i=0,n_elements(depb)-1 do begin
+;                	print,depb(i),obsb(i),bkgb(i),qcarrb(i)
+;                endfor
+;		endif
+
+		typestr="type: "+string(obstype2(0))
+	
+;get variable type
+		vartype=size(obstype2,/type)
+		if (vartype ne 7) then begin
+			if (obstype2(0) eq rmdi) then typestr=""
+		endif
+
+; line thickness
+		thick1=2
+                thick2=2
+
+;		color1='FFCC66'x
+		color1=102
+		color2=!p.color
+                color3=234
+                
+                linestyle1=0
+                linestyle2=0
+                
+		who=sort(depo)
+                whb=sort(depb)
+
+		obso_srto=obso(who)
+                depo_srto=depo(who)
+                qcarro_srto=qcarro(who)
+                whbad=where(qcarro ne 0)
+                
+                if (txt eq 0) then begin
+                
+                if (t eq 0) then $
+ 		plot,obso_srto,depo_srto,ystyle=1,xstyle=1,linestyle=linestyle1,$
+			xrange=[xmn,xmx],yrange=[ymx,ymn],thick=thick1, $
+			psym=-4,ytitle='Level',xtitle='Value', $
+			title=datestr+" "+multstr+" ("+xselstr+","+yselstr+")   "+typestr, /nodata
+               
+                oplot,obso_srto,depo_srto,linestyle=linestyle1,psym=-4, thick=thick1, color=color1
+                if (whbad(0) gt -1) then begin
+                	oplot,obso_srto(whbad),depo_srto(whbad),psym=4, thick=thick1, color=color3
+                        oplot,obso_srto(whbad),depo_srto(whbad),psym=1, thick=thick1, color=color3
+                endif
+		if (n_elements(bkgb) gt 0) then oplot,bkgb(whb),depb(whb),psym=-5,thick=thick2, color=color2,$
+                	linestyle=linestyle2
+		xcoord=0.8
+		ycoord=0.2
+;                if (stash2.salinity eq 1) then xcoord=0.15	; left corner legend for salinity
+		nel=n_elements(who)
+                if (obso(who(0)) lt obso(who(nel-1))) then xcoord=0.15 
+                if (t eq 0) then $
+
+                  ycoord2=ycoord-0.05
+                  xcoord2=xcoord+0.03
+                  xcoord3=xcoord+0.05
+                  plots, [xcoord,xcoord2],[ycoord,ycoord], psym=-4, linestyle=linestyle1, /normal, $
+                  	thick=thick1, color=color1
+                  xyouts, xcoord+0.05, ycoord, 'obs', /normal
+                  plots, [xcoord,xcoord2],[ycoord2,ycoord2], psym=-5, linestyle=linestyle2, /normal, $
+                  	thick=thick2, color=color2
+                  xyouts, xcoord+0.05, ycoord2, 'bkg',/normal                
+                
+                endif else begin	; txt
+                  
+                  printf, unit,'observations ',n_elements(who)              
+                  for i=0L,n_elements(who)-1 do begin              
+                  	printf, unit, depo(i), obso(i), dayarro(i), format='(3f18.5)'
+                  endfor
+                  printf, unit, 'background ',n_elements(who) 
+                  for i=0L,n_elements(whb)-1 do begin
+                  	printf, unit, depb(i), bkgb(i), dayarro(i), format='(3f18.5)'
+                  endfor              
+                                
+                endelse
+                                        
+                endfor  ; t
+                
+                if (txt eq 1) then FREE_LUN, unit
+                
+end
+
+PRO profilewindow,dep2,val2,obs2,bkg2,obstype2,qcarr2,dayarr2,datestr,xselstr,yselstr,rmdi,salinity=salinity, $
+		plot_bad_obs=plot_bad_obs, density=density, white_on_black=white_on_black, coltable=coltable, $
+                depmax=depmax, depmin=depmin
+	basepw=WIDGET_BASE(/column)
+	drawpw = WIDGET_DRAW(basepw, XSIZE=640, YSIZE=480)
+        buttonBase = Widget_Base(basepw, Row=1)
+	buttonpw = WIDGET_BUTTON(buttonBase, VALUE='Print',uvalue="PRINTPW") 
+	button2pw = WIDGET_BUTTON(buttonBase, VALUE='Save',uvalue="SAVEPW")
+        button3pw = WIDGET_BUTTON(buttonBase, VALUE='Text file',uvalue="TXTPW")
+	WIDGET_CONTROL, basepw, /REALIZE
+	
+        if (n_elements(salinity) eq 0) then salinity=0
+        if (n_elements(density) eq 0) then density=0
+	if (n_elements(plot_bad_obs) eq 0) then plot_bad_obs=0
+        if (n_elements(white_on_black) eq 0) then white_on_black=1
+
+		stash2 = { dep2:dep2,val2:val2,obs2:obs2, bkg2:bkg2, $
+			obstype2:obstype2, qcarr2:qcarr2, dayarr2:dayarr2, $
+			datestr:datestr,xselstr:xselstr, yselstr:yselstr, $
+			rmdi:rmdi, salinity:salinity, plot_bad_obs:plot_bad_obs,$
+                        density:density, white_on_black:white_on_black, $
+                        coltable:coltable, depmax:depmax, depmin:depmin }
+
+		plotprofile,stash2
+
+	WIDGET_CONTROL, basepw, SET_UVALUE=stash2	
+
+	XMANAGER, 'profilewindow', basepw, /NO_BLOCK	
+end
+
+;---------------------------------------
+;Worst points, window and event handling
+;---------------------------------------
+
+PRO worstpoints,stash2
+
+;stash2 is a combination of main stash and worstpoints specific stuff
+
+        xrange=stash2.xrange
+        yrange=stash2.yrange
+        selpoints,stash2,lonsel, latsel, innovsel, qcsel, daysel, obstypsel, obnumsel, obnumsel, numsel, typestr 
+
+	str1='Worst points in '+$
+        '   lons ('+strtrim(string(xrange(0)),2)+','+strtrim(string(xrange(1)),2)+$
+                	')   lats ('+strtrim(string(yrange(0)),2)+','+strtrim(string(yrange(1)),2)+')'+$
+        '   depths '+strtrim(string(long(stash2.depmin)),2)+'-'+strtrim(string(long(stash2.depmax)),2)                
+        print,str1
+
+	WIDGET_CONTROL, stash2.wwlabel1, set_value=str1
+
+        count=n_elements(innovsel)
+        wh=sort(abs(innovsel))
+        wh0=reverse(wh)			; reverse order starting with the largest        
+        cmax=min([count,10])
+	stash2.lonselw(0:cmax-1)=lonsel(wh0(0:cmax-1))
+        stash2.latselw(0:cmax-1)=latsel(wh0(0:cmax-1))
+        stash2.dayselw(0:cmax-1)=daysel(wh0(0:cmax-1))
+        print,'lon      lat       '+typestr+'     qc         date    '
+        for j1=1,cmax do begin
+           j=j1-1
+	    jul_to_dtstr,daysel(wh0(j)),datestr
+;           datedt=jul_to_dt(daysel(wh0(j)))
+;           datestr=strtrim(fix(datedt.year),2)+'/'+ $
+;	     strtrim(string(fix(datedt.month),format='(i2.2)'),2)+'/'+ $
+;	     strtrim(string(fix(datedt.day),format='(i2.2)'),2)+' '+ $
+;	     strtrim(string(fix(datedt.hour),format='(i2.2)'),2)+':'+ $
+;	     strtrim(string(fix(datedt.minute),format='(i2.2)'),2)+':'+ $
+;	     strtrim(string(fix(datedt.second),format='(i2.2)'),2)
+	   
+           print,lonsel(wh0(j)),latsel(wh0(j)),innovsel(wh0(j)),$
+                qcsel(wh0(j)),' ',datestr
+
+        endfor
+        
+        if (n_elements(stash2) gt 0) then begin
+        i=0
+	WIDGET_CONTROL, stash2.labels2(i,0), set_value="Lon" & i=i+1
+	WIDGET_CONTROL, stash2.labels2(i,0), set_value="Lat" & i=i+1
+	WIDGET_CONTROL, stash2.labels2(i,0), set_value=typestr & i=i+1
+	WIDGET_CONTROL, stash2.labels2(i,0), set_value="QC" & i=i+1
+        WIDGET_CONTROL, stash2.labels2(i,0), set_value="Date" & i=i+1
+        
+        for j1=1,cmax do begin
+           j=j1-1
+           jul_to_dtstr,daysel(wh0(j)),datestr
+;           datedt=jul_to_dt(daysel(wh0(j)))
+;           datestr=strtrim(fix(datedt.year),2)+'/'+ $
+;	     strtrim(string(fix(datedt.month),format='(i2.2)'),2)+'/'+ $
+;	     strtrim(string(fix(datedt.day),format='(i2.2)'),2)+' '+ $
+;	     strtrim(string(fix(datedt.hour),format='(i2.2)'),2)+':'+ $
+;	     strtrim(string(fix(datedt.minute),format='(i2.2)'),2)+':'+ $
+;	     strtrim(string(fix(datedt.second),format='(i2.2)'),2)
+
+        i=0
+	WIDGET_CONTROL, stash2.labels2(i,j1), $
+        	set_value=strtrim(string(lonsel(wh0(j)),format='(f9.3)'),2) & i=i+1
+	WIDGET_CONTROL, stash2.labels2(i,j1), $
+        	set_value=strtrim(string(latsel(wh0(j)),format='(f9.3)'),2) & i=i+1
+	WIDGET_CONTROL, stash2.labels2(i,j1), set_value=strtrim(string(innovsel(wh0(j))),2) & i=i+1
+	WIDGET_CONTROL, stash2.labels2(i,j1), set_value=strtrim(string(qcsel(wh0(j))),2) & i=i+1
+        WIDGET_CONTROL, stash2.labels2(i,j1), set_value=strtrim(datestr,2) & i=i+1
+
+;           print,lonsel(wh0(j)),latsel(wh0(j)),innovsel(wh0(j)),$
+;                qcsel(wh0(j)),' ',datestr
+
+        endfor
+
+        
+        endif
+	        
+
+
+
+end
+
+pro worstpointswindow,stash
+	basepw=WIDGET_BASE(/column)
+;	drawpw = WIDGET_DRAW(basepw, XSIZE=640, YSIZE=480)
+
+	wwlabel1 = WIDGET_LABEL(basepw, XSIZE=480, VALUE="Worst points")
+                
+        nj=11
+        ni=5
+	labels=intarr(nj)
+        for j=0,nj-1 do begin        
+          labels(j)=Widget_Base(basepw,row=1)
+        endfor
+
+        labsiz=[50,50,50,50,125]
+	labels2=intarr(ni+2,nj)
+        for j=0,nj-1 do begin
+         for i=0,ni-1 do begin
+         labels2(i,j) = WIDGET_LABEL(labels(j), XSIZE=labsiz(i), $ 
+    VALUE="a") 
+ 	 endfor
+         if (j gt 0) then begin
+         labels2(i,j) = WIDGET_BUTTON(labels(j), VALUE='Zoom to', uvalue="Zoom to "+strtrim(string(j),2))
+         labels2(i+1,j) = WIDGET_BUTTON(labels(j), VALUE='Profile', uvalue="Profile "+strtrim(string(j),2))
+         endif
+        endfor
+
+        stashb={ wwlabel1:wwlabel1, labels2:labels2, ni:ni, nj:nj, lonselw:dblarr(10), latselw:dblarr(10), dayselw:dblarr(10)}
+	stash2=CREATE_STRUCT(stash,stashb)
+
+	buttonpw = WIDGET_BUTTON(basepw, VALUE='Print',uvalue="PRINTPW") 
+               
+	WIDGET_CONTROL, basepw, /REALIZE
+        worstpoints,stash2
+	WIDGET_CONTROL, basepw, SET_UVALUE=stash2
+	XMANAGER, 'worstpointswindow', basepw, /NO_BLOCK
+end
+
+PRO worstpointswindow_event, ev
+  WIDGET_CONTROL, ev.TOP, GET_UVALUE=stash2 
+  WIDGET_CONTROL, ev.ID, GET_UVALUE=uval 
+	print,uval
+
+		xarr1=stash2.xarr
+		yarr1=stash2.yarr
+		dep1=stash2.dep
+		dayarr=stash2.dayarr
+		daymin=stash2.daymin
+		daymax=stash2.daymax
+                obstypes1=stash2.obstypes
+                xrange=stash2.xrange
+		yrange=stash2.yrange
+		xs=xrange(1)-xrange(0)
+		ys=yrange(1)-yrange(0)
+		rmdi=stash2.rmdi
+                if (stash2.salinity eq 0) then begin
+		  obs1=stash2.obs
+		  bkg1=stash2.bkg
+                  qcarr1=stash2.qcarr
+                endif else begin
+		  obs1=stash2.obs2
+		  bkg1=stash2.bkg2
+                  qcarr1=stash2.qcarr2
+		endelse                	
+
+	if (uval eq "PRINTTSW") then begin
+		ps=1
+		eps=0
+		landscape=1
+		pr2,file="~/worstpoints.ps",landscape=landscape,ps=ps,eps=eps,color=1
+		worstpoints,stash2
+		prend2,/view
+	endif
+        print,strmid(uval,0,7)
+        if (strcmp(strmid(uval,0,7),"Zoom to")) then begin
+        	num=fix(strmid(uval,7,3))
+                xsel=stash2.lonselw(num-1)
+                ysel=stash2.latselw(num-1)
+                print,num,xsel,ysel  
+                dataplot_zoom,stash2, xsel, ysel, 1
+                plotpoints,stash2              
+                           
+        endif
+        if (strcmp(strmid(uval,0,7),"Profile")) then begin
+        	num=fix(strmid(uval,7,3))
+                xsel=stash2.lonselw(num-1)
+                ysel=stash2.latselw(num-1)
+                daysel=stash2.dayselw(num-1)
+;                print,num,xsel,ysel,daysel,daysel-long(daysel),float(daysel)
+;                info,dayarr
+;                info,daysel
+;		info,xarr1
+;                info,ysel
+;                info,yarr1
+;                info,xsel
+                
+                wh1=where(xarr1 eq xsel and yarr1 eq ysel)
+;                print,'dayarr(wh1) ',dayarr(wh1), float(dayarr(wh1))
+;                print,'dayarr(wh1)-long ',dayarr(wh1)-long(dayarr(wh1))
+;                print,'dep1(wh1) ',dep1(wh1)
+                wh2=where(xarr1 eq xsel and yarr1 eq ysel and float(dayarr) eq float(daysel))
+;                print,'wh2 ',wh2
+;                if (wh2(0) gt -1) then print,'daysel(wh2) ',daysel(wh2)
+       
+        	wh=where(xarr1 eq xsel and yarr1 eq ysel and long(dayarr) eq long(daysel))
+                if (wh(0) gt -1) then begin
+		dep2=dep1(wh)
+		val2=abs(obs1(wh)-bkg1(wh))
+		obs2=obs1(wh)
+		bkg2=bkg1(wh)
+		obstype2=obstypes1(wh)
+                qcarr2=qcarr1(wh)
+                dayarr2=dayarr(wh)
+		jul_to_dtstr,stash2.dayselw(num-1),datestr
+		xselstr=string(xsel)
+		yselstr=string(ysel)
+
+		profilewindow,dep2,val2,obs2,bkg2,obstype2,qcarr2,dayarr2,datestr,xselstr,yselstr,rmdi, salinity=stash2.salinity, $
+                	white_on_black=stash.white_on_black, coltable=stash.coltable, depmax=stash.depmax, depmin=stash.depmin
+                endif
+	endif
+
+; store values
+  WIDGET_CONTROL, ev.TOP, SET_UVALUE=stash2 
+
+end
+
+PRO filterwindow, stash
+
+	val=stash.obstypeselect
+
+	obstypes=stash.obstypes
+        uniquetypes=strjoin(obstypes(uniq(obstypes, sort(obstypes))),string(10b))
+        
+	base = WIDGET_BASE(GROUP_LEADER=stash.base ,/modal,/column) 
+        
+        
+	intextid = CW_FIELD(base, TITLE = "Filter type", /FRAME, value=val, uvalue='intext', /RETURN_EVENTS) 
+        outtextid = WIDGET_TEXT(base, value="Choose from:"+string(10b)+uniquetypes, $
+        	scr_xsize=200, scr_ysize=200, /scroll) 
+
+	buttonBase = Widget_Base(base, Row=1)
+	   cancelID = Widget_Button(buttonBase, Value='Cancel', uvalue='cancel')
+	   acceptID = Widget_Button(buttonBase, Value='Accept', uvalue='accept')
+
+	WIDGET_CONTROL, base, /REALIZE 
+
+	ptr = Ptr_New({text:"", nocancel:0})
+
+	stash2={ ptr:ptr, intextid:intextid }
+        WIDGET_CONTROL, base, SET_UVALUE=stash2, /No_Copy
+
+	XMANAGER, 'filterwindow', base        
+
+        theText = (*ptr).text
+        nocancel = (*ptr).nocancel
+        Ptr_Free, ptr
+        
+        print, 'finished ',theText, nocancel
+
+; if obstypeselect has changed then replot the points
+                
+        if (stash.obstypeselect ne theText and nocancel eq 1) then begin
+                stash.obstypeselect=theText
+        	plotpoints,stash
+        endif
+        
+        
+end
+
+PRO filterwindow_event, ev
+  WIDGET_CONTROL, ev.TOP, GET_UVALUE=stash2 
+  WIDGET_CONTROL, ev.ID, GET_UVALUE=uval
+  WIDGET_CONTROL, ev.ID, GET_VALUE=val
+;  	info,uval
+;        info,val
+	print,uval
+        print,val
+
+	if (uval eq "accept" or uval eq "intext") then begin
+;        stash2.val=val
+
+	Widget_Control, stash2.intextid, Get_Value=theText
+	print,'the text ',theText
+
+        (*stash2.ptr).text=theText
+        (*stash2.ptr).nocancel=1
+        endif         
+        
+;   WIDGET_CONTROL, ev.TOP, SET_UVALUE=stash2       
+        
+        WIDGET_CONTROL, ev.top, /DESTROY
+
+end
+
+;--------------------------------------
+; Input area
+;--------------------------------------
+
+PRO inputareawindow, xrange, yrange, toplevel, success
+
+        val1=xrange(0)
+        val2=xrange(1)
+        val3=yrange(0)
+        val4=yrange(1)
+        
+	base = WIDGET_BASE(GROUP_LEADER=toplevel,/modal,/column) 
+                
+	intextid1 = CW_FIELD(base, TITLE = "lon1", /FRAME, value=val1, uvalue='intext1', /RETURN_EVENTS) 
+ 	intextid2 = CW_FIELD(base, TITLE = "lon2", /FRAME, value=val2, uvalue='intext2', /RETURN_EVENTS) 
+	intextid3 = CW_FIELD(base, TITLE = "lat1", /FRAME, value=val3, uvalue='intext3', /RETURN_EVENTS) 
+	intextid4 = CW_FIELD(base, TITLE = "lat2", /FRAME, value=val4, uvalue='intext4', /RETURN_EVENTS) 
+
+;       outtextid = WIDGET_TEXT(base, value="Choose from:"+string(10b)+uniquetypes, $
+;        	scr_xsize=200, scr_ysize=200, /scroll) 
+
+	buttonBase = Widget_Base(base, Row=1)
+	   acceptID = Widget_Button(buttonBase, Value='Accept', uvalue='accept')
+	   cancelID = Widget_Button(buttonBase, Value='Cancel', uvalue='cancel')
+
+	WIDGET_CONTROL, base, /REALIZE 
+
+	ptr = Ptr_New({text1:"", text2:"", text3:"", text4:"", nocancel:0})
+
+	stash2={ ptr:ptr, intextid1:intextid1,  intextid2:intextid2, $
+         	intextid3:intextid3, intextid4:intextid4}
+        WIDGET_CONTROL, base, SET_UVALUE=stash2, /No_Copy
+
+	XMANAGER, 'inputareawindow', base        
+
+        lon1 = (*ptr).text1
+        lon2 = (*ptr).text2
+        lat1 = (*ptr).text3
+        lat2 = (*ptr).text4
+        nocancel = (*ptr).nocancel
+        Ptr_Free, ptr
+        
+        print, 'finished ',lon1, lon2, lat1, lat2, nocancel
+
+; if obstypeselect has changed then replot the points
+                
+        if (nocancel eq 1) then begin
+		xrange=[float(lon1),float(lon2)]
+                yrange=[float(lat1),float(lat2)]
+                xrange=xrange(sort(xrange))
+                yrange=yrange(sort(yrange))
+                wh=where(xrange gt 360)
+                if (wh(0) gt -1) then xrange(wh)=360
+                wh=where(xrange lt -180)
+                if (wh(0) gt -1) then xrange(wh)=-180
+                wh=where(yrange gt 90)
+                if (wh(0) gt -1) then yrange(wh)=90
+                wh=where(yrange lt -90)
+                if (wh(0) gt -1) then yrange(wh)=-90
+                
+                if (xrange(0) eq xrange(1)) then xrange(1)=xrange(1)+0.1 
+                if (yrange(0) eq yrange(1)) then yrange(1)=yrange(1)+0.1
+                
+                success=1
+        endif
+        
+        
+end
+
+PRO inputareawindow_event, ev
+  WIDGET_CONTROL, ev.TOP, GET_UVALUE=stash2 
+  WIDGET_CONTROL, ev.ID, GET_UVALUE=uval
+  WIDGET_CONTROL, ev.ID, GET_VALUE=val
+;  	info,uval
+;        info,val
+	print,uval
+        print,val
+
+	if (uval eq 'accept') then begin
+;        stash2.val=val
+
+	Widget_Control, stash2.intextid1, Get_Value=theText1
+	Widget_Control, stash2.intextid2, Get_Value=theText2
+        Widget_Control, stash2.intextid3, Get_Value=theText3
+        Widget_Control, stash2.intextid4, Get_Value=theText4
+	print,'the text ',theText1, theText2, theText3, theText4
+
+        (*stash2.ptr).text1=theText1
+        (*stash2.ptr).text2=theText2
+        (*stash2.ptr).text3=theText3
+        (*stash2.ptr).text4=theText4
+        (*stash2.ptr).nocancel=1
+        endif         
+        
+;   WIDGET_CONTROL, ev.TOP, SET_UVALUE=stash2       
+        
+        WIDGET_CONTROL, ev.top, /DESTROY
+
+end
+
+;--------------------------------------
+; Input max min
+;--------------------------------------
+
+PRO inputmxmnwindow, fmx, fmn, mx, mn, rmdi, toplevel, success
+
+	print,'fmx/mn ',fmx,fmn
+        print,'mx/mn ',mx,mn
+
+        val1=mx
+        val2=mn
+
+	base = WIDGET_BASE(GROUP_LEADER=toplevel,/modal,/column) 
+                
+	intextid1 = CW_FIELD(base, TITLE = "mx", /FRAME, value=val1, uvalue='intext1', /RETURN_EVENTS) 
+ 	intextid2 = CW_FIELD(base, TITLE = "mn", /FRAME, value=val2, uvalue='intext2', /RETURN_EVENTS) 
+
+	text="Max and min not locked"
+        if (fmx ne rmdi) then text="Max locked"
+        if (fmn ne rmdi) then text="Min Locked"
+        if (fmx ne rmdi and fmn ne rmdi) then text="Max and min locked"
+        outtextid = WIDGET_TEXT(base, value=text, $
+        	scr_xsize=200, scr_ysize=40) 
+
+	buttonBase = Widget_Base(base, Row=1)
+	   acceptID = Widget_Button(buttonBase, Value='Accept/lock', uvalue='accept')
+           resetID = Widget_Button(buttonBase, Value='Reset/free', uvalue='reset')
+	   cancelID = Widget_Button(buttonBase, Value='Cancel', uvalue='cancel')
+           
+
+	WIDGET_CONTROL, base, /REALIZE 
+
+	ptr = Ptr_New({text1:"", text2:"", nocancel:0})
+
+	stash2={ ptr:ptr, intextid1:intextid1,  intextid2:intextid2}
+        WIDGET_CONTROL, base, SET_UVALUE=stash2, /No_Copy
+
+	XMANAGER, 'inputmxmnwindow', base        
+
+        fmx = float((*ptr).text1)
+        fmn = float((*ptr).text2)
+
+	info, fmx
+        info, fmn
+
+        nocancel = (*ptr).nocancel
+        Ptr_Free, ptr
+        
+        print, 'finished ',fmx,fmn, mx, mn
+
+; if obstypeselect has changed then replot the points
+                
+        if (nocancel eq 1) then begin                
+                success=1
+        endif
+	if (nocancel eq 2) then begin
+        	fmx=rmdi
+                fmn=rmdi
+                success=1
+        endif
+ 
+end
+
+PRO inputmxmnwindow_event, ev
+  WIDGET_CONTROL, ev.TOP, GET_UVALUE=stash2 
+  WIDGET_CONTROL, ev.ID, GET_UVALUE=uval
+  WIDGET_CONTROL, ev.ID, GET_VALUE=val
+;  	info,uval
+;        info,val
+	print,'uval ',uval,' val ',val
+
+	if (uval eq 'accept') then begin
+;        stash2.val=val
+
+	Widget_Control, stash2.intextid1, Get_Value=theText1
+	Widget_Control, stash2.intextid2, Get_Value=theText2
+	print,'the text ',theText1, theText2
+
+        (*stash2.ptr).text1=theText1
+        (*stash2.ptr).text2=theText2
+        (*stash2.ptr).nocancel=1
+        endif         
+
+	if (uval eq 'reset') then begin
+        (*stash2.ptr).nocancel=2
+        endif
+        
+;   WIDGET_CONTROL, ev.TOP, SET_UVALUE=stash2       
+        
+        WIDGET_CONTROL, ev.top, /DESTROY
+
+end
+
+
+
+pro infowindow
+	basepw=WIDGET_BASE(/column)
+	xsz=360
+
+        iwlabel0 = WIDGET_LABEL(basepw, XSIZE=xsz, VALUE="Dataplot")
+        iwlabela = WIDGET_LABEL(basepw, XSIZE=xsz, VALUE="--------")
+        iwlabelb = WIDGET_LABEL(basepw, XSIZE=xsz, VALUE="")      
+	iwlabel1 = WIDGET_LABEL(basepw, XSIZE=xsz, VALUE="To report bugs or for help")
+        iwlabel2 = WIDGET_LABEL(basepw, XSIZE=xsz, VALUE="contact Dan Lea")
+        iwlabel3 = WIDGET_LABEL(basepw, XSIZE=xsz, VALUE="daniel.lea@metoffice.gov.uk")
+ 	               
+	WIDGET_CONTROL, basepw, /REALIZE
+
+;	WIDGET_CONTROL, basepw, SET_UVALUE=stash2
+;	XMANAGER, 'worstpointswindow', basepw, /NO_BLOCK
+end
+
+PRO dataplot_zoom, stash, xdata, ydata, zoominout
+
+		xrange=stash.xrange
+		yrange=stash.yrange
+		xrangedef=stash.xrangedef
+		yrangedef=stash.yrangedef
+	
+
+		print,xrange,yrange
+
+;		zx=xrange(0)
+;		zy=yrange(0)
+		sx=xrange(1)-xrange(0)
+		sy=yrange(1)-yrange(0)
+		sxd=xrangedef(1)-xrangedef(0)
+		syd=yrangedef(1)-yrangedef(0)
+
+		print,sx,sy
+
+		if (zoominout eq 1) then begin
+		sx=sx/2.
+		sy=sy/2.
+; try to squarify for zoomed in version
+		sx2=(sx+sy)/2.
+;		sx=max(sx,sx2)
+;		sy=max(sy,sx2) 
+;		sx=(sx+sx2)/2.
+;		sy=(sy+sx2)/2.
+
+; try to tend to initial proportions for zooming in
+		sx=(sx+1.0*(sxd*0.5/(sxd+syd)))/2.
+                sy=(sy+1.0*(syd*0.5/(sxd+syd)))/2.
+
+		endif
+		if (zoominout eq -1) then begin
+		sx=sx*2.
+		sy=sy*2.
+ ; try to make similar to initial proportions for zooming out               
+                sx2=(sx+sy)*2.
+		sx=(sx+sx2*(sxd*0.5/(sxd+syd)))/2.
+		sy=(sy+sx2*(syd*0.5/(sxd+syd)))/2.
+                
+		endif
+		
+
+		print,'sx sy ',sx,sy, xdata, ydata
+
+                oxrange=xrange                
+		
+		xrange=[xdata-sx/2.,xdata+sx/2.]
+		yrange=[ydata-sy/2.,ydata+sy/2.]
+
+		if (oxrange(1) le 180) then begin		; 0 longitude centred
+		if (xrange(0) lt xrangedef(0)) then xrange(0)=xrangedef(0)
+		if (xrange(1) gt xrangedef(1)) then xrange(1)=xrangedef(1)
+		endif else begin				; 180 longitude centred
+ 		if (xrange(0) lt xrangedef(0)+180) then xrange(0)=xrangedef(0)+180
+		if (xrange(1) gt xrangedef(1)+180) then xrange(1)=xrangedef(1)+180
+		endelse               
+
+		if (yrange(0) lt yrangedef(0)) then yrange(0)=yrangedef(0)
+		if (yrange(1) gt yrangedef(1)) then yrange(1)=yrangedef(1)
+
+		print,'xrange ',xrange,' yrange ',yrange
+                
+                stash.xrange=xrange
+		stash.yrange=yrange
+
+end
+
+;---------------------------------------
+;Time series plotting and event handling
+;---------------------------------------
+
+PRO plottimeseries, stash
+ 
+		xrange=stash.xrange
+		yrange=stash.yrange
+;		dayarr=stash.dayarr
+		daymin=stash.daymin
+		daymax=stash.daymax
+		dayminl=stash.dayminl
+      daymaxl=stash.daymaxl
+
+		numtimeseries=stash.numtimeseries		; if 1 then plot number of points
+
+;		print,depmin,xrange,yrange
+
+;		wh=where(dep1 eq ev.index)
+;		wh=where(dep1 eq depmin and $
+;			dayarr ge daymin and dayarr le daymax)
+
+;	
+
+;		nelwh=n_elements(wh)
+
+		; select points to plot
+		typestr=''
+
+		if (stash.plottssel eq 1) then begin
+         dayminl=daymin
+         daymaxl=daymax
+      endif
+
+		print,'djl ',dayminl,daymaxl, min(stash.dayarr), max(stash.dayarr)
+
+		selpoints, stash, lonsel, latsel, innovsel, qcsel, daysel, obstypsel, obnumsel, numsel, typestr, $
+                	daymin=dayminl, daymax=daymaxl, /rmsmean, innovsel2=innovsel2
+
+		print,'djl ',min(daysel), max(daysel)
+
+		if (stash.plottssel eq 1) then begin
+                	daymaxl=daymaxl+1
+                endif
+		   
+
+;		plot,daysel, ystyle=1
+
+		print,'n_elements(daysel) ',n_elements(daysel), min(daysel), max(daysel) 
+		print, dayminl, daymaxl
+
+; group in 1/4 day bins
+
+;		binspday=double(4.0)    ; every 6 hours
+;                binspday=double(8.0)    ; every 3 hours
+		binspday=double(stash.binspday)
+		nbins=(daymaxl-dayminl)*binspday+1
+
+		print, daymaxl, dayminl, binspday
+
+                x2arr=dblarr(nbins)
+                xarr=dblarr(nbins)
+                narr=dblarr(nbins)
+                tarr=dblarr(nbins)
+		meants=dblarr(nbins)
+                rmsts=dblarr(nbins)
+  
+		print, 'nbins: ',nbins
+
+		if n_elements(innovsel) gt 0 then begin
+
+		print,max(daysel),min(daysel)
+  
+                for ibin=0L,nbins-1 do begin
+                  timmn=double(dayminl)+ibin/binspday
+                  timmx=timmn+1/binspday
+;                  print, ibin, timmn, timmx, timmx-timmn
+                  wh=where(daysel ge timmn and daysel lt timmx, count)
+                  print, 'ibin ',ibin, timmn, timmx, count
+; redo based on the number of observations
+                  if (wh(0) ne -1) then begin
+                  innovsels=innovsel(wh)
+                  innovsel2s=innovsel2(wh)
+                  numsels=numsel(wh)
+                  
+		  x2arr(ibin)=total(innovsel2s*numsels)
+		  xarr(ibin)=total(innovsels*numsels)
+;		  narr(ibin)=n_elements(innovsels)
+		  narr(ibin)=total(numsels)
+;                  print,ibin, x2arr(ibin), xarr(ibin)
+                  endif
+                  tarr(ibin)=timmn
+                endfor
+
+		meants=xarr/narr
+                rmsts=sqrt(x2arr/narr)
+
+;		print,'meants: ',meants
+;		print,'rmsts: ',rmsts
+
+		endif	; n_elements(innovsel)
+
+		wh=where(finite(meants))		; find finite values
+		ymx=max([meants(wh),rmsts(wh)],min=ymn)
+
+;put a bit of white space around ymx,ymn
+		dymxmn=(ymx-ymn)*0.02
+                ymx=ymx+dymxmn
+                ymn=ymn-dymxmn
+
+		print,'ymx/mn ',ymx,ymn
+
+                strtsal=''
+;                print,'stash.filetype ',stash.filetype
+                if (stash.filetype eq 'Prof' or stash.filetype eq 'feedback') then begin
+                	strtsal='T:  '
+                        if (stash.salinity eq 1) then strtsal='S:  '
+                endif else begin
+                	strtsal=stash.filetype+':  '
+                endelse
+
+                title=strtsal+typestr+'   lons ('+string(xrange(0))+','+string(xrange(1))+$
+                	')   lats ('+string(yrange(0))+','+string(yrange(1))+')'  
+                print,title            
+
+;                dtarr=jul_to_dt(tarr)   
+		dtarr=tarr-0.5			; convert back to julian day
+
+		xmx=max(dtarr,min=xmn)
+;put a bit of white space around xmx,xmn
+		dxmxmn=(xmx-xmn)*0.02
+                xmx=xmx+dxmxmn
+                xmn=xmn-dxmxmn
+
+
+;date_label = LABEL_DATE(DATE_FORMAT = $ 
+;   ['%I:%S', '%H', '%D %M, %Y']) 
+
+;date_label = LABEL_DATE(DATE_FORMAT = $ 
+;   ['%D %M, %Y']) 
+
+date_label = LABEL_DATE(DATE_FORMAT=['%D-%M','%Y'])
+
+
+
+	if (stash.txt eq 0) then begin
+	if (numtimeseries ne 1) then begin                       
+		plot,dtarr, meants, xstyle=1, linestyle=1, yrange=[ymn,ymx], title=title, $
+                       ytitle=typestr, xrange=[xmn,xmx], $
+                       XTICKUNITS=['Time', 'Time'], XTICKFORMAT = ['LABEL_DATE'],YMARGIN=[6,4] 
+;   XTICKFORMAT = ['LABEL_DATE'], $ 
+;   XTICKUNITS = ['Day'], $ 
+;   XTICKINTERVAL = 4 
+
+		plot, dtarr, rmsts, xstyle=1, yrange=[ymn,ymx], /noerase, $
+                       ytitle=typestr, xrange=[xmn,xmx], $
+                       XTICKUNITS=['Time', 'Time'], XTICKFORMAT = ['LABEL_DATE'],YMARGIN=[6,4]
+;   XTICKFORMAT = ['LABEL_DATE'], $ 
+;   XTICKUNITS = ['Day'], $ 
+;   XTICKINTERVAL = 4 
+
+
+		xcoord=0.8
+		ycoord=0.9
+		ycoord=0.35
+                ycoord=0.2
+;		ukmo_legend,xcoord=xcoord,ycoord=ycoord,delta_y=0.05,$
+;			['RMS','mean'],linestyle=[0,1],/normal
+
+                  ycoord2=ycoord-0.05
+                  xcoord2=xcoord+0.03
+                  xcoord3=xcoord+0.05
+                  plots, [xcoord,xcoord2],[ycoord,ycoord], linestyle=0, /normal
+                  xyouts, xcoord3, ycoord, 'RMS', /normal
+                  plots, [xcoord,xcoord2],[ycoord2,ycoord2], linestyle=1, /normal
+                  xyouts, xcoord3, ycoord2, 'mean',/normal                
+
+	endif else begin
+		plot,dtarr, narr, xstyle=1, title=title, $
+                       ytitle='number of obs', $ 
+                       XTICKUNITS=['Time', 'Time'], XTICKFORMAT = ['LABEL_DATE'],YMARGIN=[6,4]
+;   XTICKFORMAT = ['LABEL_DATE'], $ 
+;   XTICKUNITS = ['Day'], $ 
+;   XTICKINTERVAL = 4 
+      
+	endelse
+	endif else begin
+
+        outfile=stash.outfile+'_timeseries.txt'
+	print, 'saving data to ',outfile
+	OPENW, unit, outfile, /get_lun
+;   		printf,unit,'Output timeseries data: '
+		printf,unit, strtsal
+                printf,unit, typestr
+                printf,unit, xrange, yrange
+                printf,unit, binspday
+                nel=n_elements(dtarr)
+                for i=0L,nel-1 do begin
+                	printf,unit, dtarr(i), narr(i), meants(i), rmsts(i),format='(d18.8,d18.2,d18.8,d18.8)'
+                endfor
+        FREE_LUN, unit
+
+	endelse
+
+;		print,'min/max lonsel: ',min(lonsel),max(lonsel)
+
+end
+
+PRO timeserieswindow, stash
+	basepw=WIDGET_BASE(/column)
+	drawpw = WIDGET_DRAW(basepw, XSIZE=640, YSIZE=480)
+        buttons=Widget_Base(basepw,row=1)
+        
+        tlb = Widget_Base(buttons,Title='Push-Buttons', row=1, Scr_XSize=400,$
+       /Exclusive)
+; no_release only sends select events (not release ones)
+   	buttonp1 = Widget_Button(tlb, Value='1 bin per day',uvalue='RADIO1',/no_release)
+   	buttonp2 = Widget_Button(tlb, Value='2 bins',uvalue='RADIO2',/no_release)
+   	buttonp3=  Widget_Button(tlb, Value='4 bins',uvalue='RADIO3',/no_release)
+   	buttonp4 = Widget_Button(tlb, Value='8 bins',uvalue='RADIO4',/no_release)
+
+	if (stash.binspday eq 1) then Widget_Control, buttonp1, Set_Button=1
+	if (stash.binspday eq 2) then Widget_Control, buttonp2, Set_Button=1
+       	if (stash.binspday eq 4) then Widget_Control, buttonp3, Set_Button=1
+	if (stash.binspday eq 8) then Widget_Control, buttonp4, Set_Button=1
+ 
+        tlb2 = Widget_Base(buttons,Title='Push-Buttons', row=1, Scr_XSize=100,$
+       /NonExclusive)
+	buttonpa1= Widget_Button(tlb2, Value='plot selected period',uvalue='PLOTSEL')
+
+
+	Widget_Control, buttonpa1, Set_Button=stash.plottssel
+        
+	buttonpw = WIDGET_BUTTON(buttons, VALUE='Print',uvalue='PRINTTSW') 
+        buttonpw2 = WIDGET_BUTTON(buttons, VALUE='Output',uvalue='OUTPUTTSW')
+        
+	WIDGET_CONTROL, basepw, /REALIZE
+
+	xyouts,0.2,0.5,'working...',/normal,charsize=2.5
+	
+        plottimeseries,stash
+
+	WIDGET_CONTROL, basepw, SET_UVALUE=stash	
+
+	XMANAGER, 'timeserieswindow', basepw, /NO_BLOCK	
+end
+
+PRO timeserieswindow_event, ev
+  WIDGET_CONTROL, ev.TOP, GET_UVALUE=stash 
+  WIDGET_CONTROL, ev.ID, GET_UVALUE=uval 
+	print,uval
+	if (uval eq 'PRINTTSW') then begin
+		ps=1
+		eps=0
+		landscape=1
+		pr2,file='~/timeseries.ps',landscape=landscape,ps=ps,eps=eps,color=1
+		plottimeseries,stash
+		prend2,/view
+	endif
+        if (uval eq 'OUTPUTTSW') then begin
+        	savetxt=stash.txt
+                stash.txt=1
+        	plottimeseries,stash
+                stash.txt=savetxt
+        endif
+        if (uval eq 'RADIO1') then begin
+        	stash.binspday=1
+                plottimeseries,stash        	
+        endif
+        if (uval eq 'RADIO2') then begin
+        	stash.binspday=2
+                plottimeseries,stash        	
+        endif
+        if (uval eq 'RADIO3') then begin
+        	stash.binspday=4
+                plottimeseries,stash        	
+        endif
+        if (uval eq 'RADIO4') then begin
+        	stash.binspday=8
+                plottimeseries,stash        	
+        endif
+        if (uval eq 'PLOTSEL') then begin
+        	stash.plottssel=1-stash.plottssel
+                print,'stash.plottssel ',stash.plottssel
+                WIDGET_CONTROL, ev.TOP, SET_UVALUE=stash
+                plottimeseries,stash        
+        endif
+
+        
+end
+
+;----------------------------------------
+; T-S diagram plotting and event handling
+;----------------------------------------
+
+PRO plottsdiagram, stash
+ 
+		xrange=stash.xrange
+		yrange=stash.yrange
+;		dayarr=stash.dayarr
+		daymin=stash.daymin
+		daymax=stash.daymax
+		dayminl=stash.dayminl
+                daymaxl=stash.daymaxl
+                xarr=stash.xarr
+                yarr=stash.yarr
+                rmdi=stash.rmdi
+
+		; select T and S points to plot
+		typestr=''
+      		selpoints, stash, lonsel, latsel, innovsel, qcsel, daysel, obstypsel, obnumsel, numsel, typestr, $
+                	daymin=dayminl, daymax=daymaxl, salinity=1
+                        
+                ; select points with salinity
+                
+                nel=n_elements(lonsel)
+                
+                if (nel gt 0) then begin
+
+		  bkg=stash.bkg
+                  bkg2=stash.bkg2
+                  obs=stash.obs
+                  obs2=stash.obs2
+                  dep=stash.dep
+                  strtarr=0
+ 		  depmin=stash.depmin
+		  depmax=stash.depmax
+                 
+		  for i=0L,nel-1 do begin
+			wh=where(lonsel(i) eq xarr and latsel(i) eq yarr and $
+                          dep ge depmin and dep le depmax )
+                        if (wh(0) gt -1) then begin
+                        if (strtarr eq 0) then begin
+                          strtarr=1
+                          bkgsel=bkg(wh)
+                          bkg2sel=bkg2(wh)
+                          obssel=obs(wh)
+                          obs2sel=obs2(wh)
+                        endif else begin
+		          bkgsel=[bkgsel,bkg(wh)]
+                          bkg2sel=[bkg2sel,bkg2(wh)]
+		          obssel=[obssel,obs(wh)]
+                          obs2sel=[obs2sel,obs2(wh)]
+                        endelse
+                        endif              
+                  endfor
+
+               ;filter out points with missing data
+               
+               wh=where(bkgsel ne rmdi and bkg2sel ne rmdi $
+                    and obssel ne rmdi and obs2sel ne rmdi)
+               
+                if (wh(0) gt -1) then begin
+                  obssel=obssel(wh)
+                  bkgsel=bkgsel(wh)
+                  obs2sel=obs2sel(wh)
+                  bkg2sel=bkg2sel(wh)              
+                  
+                  xmn=min([obssel,bkgsel],max=xmx)
+                  ymn=min([obs2sel,bkg2sel],max=ymx)
+               
+               title='T-S diagram: dep '+string(depmin)+'-'+string(depmax)
+               
+		plot,obssel,obs2sel,psym=4, color='FFFFFF'x, xtitle='Temperature',ytitle='Salinity',$
+                	xrange=[xmn,xmx], yrange=[ymn,ymx],xstyle=1,ystyle=1, title=title
+                oplot,bkgsel,bkg2sel,psym=5, color='FFCC66'x
+
+		xcoord=0.8
+		ycoord=0.9
+		ycoord=0.2
+;		ukmo_legend,xcoord=xcoord,ycoord=ycoord,delta_y=0.05,$
+;			['obs','bkg'],psym=[4,5],color=['FFFFFF'x, 'FFCC66'x],/normal
+
+                  ycoord2=ycoord-0.05
+                  xcoord2=xcoord+0.03
+                  xcoord3=xcoord+0.05
+                  plots, [xcoord,xcoord2],[ycoord,ycoord], psym=4, color='FFFFFF'x, /normal
+                  xyouts, xcoord+0.05, ycoord, 'obs', /normal
+                  plots, [xcoord,xcoord2],[ycoord2,ycoord2], psym=5, color='FFCC66'x, /normal
+                  xyouts, xcoord+0.05, ycoord2, 'bkg',/normal                
+
+
+               endif
+               endif
+
+end
+
+PRO tsdiagramwindow, stash
+	basepw=WIDGET_BASE(/column)
+	drawpw = WIDGET_DRAW(basepw, XSIZE=640, YSIZE=480)
+	buttonpw = WIDGET_BUTTON(basepw, VALUE='Print',uvalue='PRINTTSW') 
+	WIDGET_CONTROL, basepw, /REALIZE
+	
+        plottsdiagram,stash
+
+	WIDGET_CONTROL, basepw, SET_UVALUE=stash	
+
+	XMANAGER, 'tsdiagramwindow', basepw, /NO_BLOCK	
+end
+
+PRO tsdiagramwindow_event, ev
+  WIDGET_CONTROL, ev.TOP, GET_UVALUE=stash 
+  WIDGET_CONTROL, ev.ID, GET_UVALUE=uval 
+	print,uval
+	if (uval eq 'PRINTTSW') then begin
+		ps=1
+		eps=0
+		landscape=1
+		pr2,file='~/tsdiagram.ps',landscape=landscape,ps=ps,eps=eps,color=1
+		plottsdiagram,stash
+		prend2,/view
+	endif
+end
+
+PRO jul_to_dtstr, daysel, datestr, notime=notime
+
+;print,'called jul_to_dtstr ',daysel
+
+; IDL Julian days start at 12 noon
+
+	CALDAT, daysel(0)-0.5, Month, Day, Year, Hour, Minute, Second
+           datestr=strtrim(fix(year),2)+'/'+ $
+	     strtrim(string(fix(month),format='(i2.2)'),2)+'/'+ $
+	     strtrim(string(fix(day),format='(i2.2)'),2)
+             
+             if (n_elements(notime) eq 0) then $
+             	datestr=datestr+' '+$
+	     strtrim(string(fix(hour),format='(i2.2)'),2)+':'+ $
+	     strtrim(string(fix(minute),format='(i2.2)'),2)+':'+ $
+	     strtrim(string(fix(second),format='(i2.2)'),2)
+
+;           datedt=jul_to_dt(daysel)
+;           datedt=datedt(0)
+;           datestr=strtrim(fix(datedt.year),2)+'/'+ $
+;	     strtrim(string(fix(datedt.month),format='(i2.2)'),2)+'/'+ $
+;	     strtrim(string(fix(datedt.day),format='(i2.2)'),2)+' '+ $
+;	     strtrim(string(fix(datedt.hour),format='(i2.2)'),2)+':'+ $
+;	     strtrim(string(fix(datedt.minute),format='(i2.2)'),2)+':'+ $
+;	     strtrim(string(fix(datedt.second),format='(i2.2)'),2)
+
+;print,datestr
+
+END
+
+;-----------------------------------------------------------------------
+; MAIN routine
+; Widget creation routine. 
+;  dataplot, [longitude, latitude, deparr, dayarr, valarr, bkgarr]
+;+
+PRO dataplot, indata, rmdi=rmdi, filename=filename, salinity=salinity, batch=batch, $
+	ps=ps, gif=gif, area=area, typeplot=typeplot, ombtypeplot=ombtypeplot, $
+        alldays=alldays, depths=depths, $
+        mx=mx, mn=mn, showmdt=showmdt, obstypeselect=obstypeselect, printobstypes=printobstypes, $
+        daterange=daterange, timeseries=timeseries, binspday=binspday, plot_bad_obs=plot_bad_obs, $
+        plot_only_bad_obs=plot_only_bad_obs, $
+        numtimeseries=numtimeseries, txt=txt, netcdf=netcdf, vertgrad=vertgrad, healthcheck=healthcheck, $
+        duplicates=duplicates, differences=differences, outfile=outfile, white_on_black=white_on_black, $
+        bindata=bindata, symscale=symscale, hiresmap=hiresmap, coltable=coltable, $
+        picsize=picsize, pmulti=pmulti, typeproj=typeproj, dayrange=dayrange, $
+        notfussy=notfussy, mld=mld, binsize=binsize, filterout=filterout
+;-
+	
+; DJL switch off wave compatibility mode
+res=execute('waveoff')
+
+; string array obstypeselect
+
+if (n_elements(obstypeselect) eq 0) then obstypeselect=''
+if (n_elements(printobstypes) eq 0) then printobstypes=''
+if (n_elements(filterout) eq 0) then filterout=''
+
+if (n_elements(binspday) eq 0) then binspday=4		; plot timeseries every 6 hours
+plottssel=0	; plot selected period of timeseries
+if (n_elements(plot_bad_obs) eq 0) then plot_bad_obs=0	; don't plot bad obs
+
+if (n_elements(plot_only_bad_obs) eq 0) then plot_only_bad_obs=1	; plot only bad obs if selected
+if (n_elements(white_on_black) eq 0) then white_on_black=1
+
+if (n_elements(duplicates) eq 0) then duplicates=0	; plot only duplicates if selected
+if (n_elements(differences) eq 0) then differences=0	; plot only differences if selected
+
+if (n_elements(numtimeseries) eq 0) then numtimeseries=0	; plot time series of O-B
+
+if (n_elements(txt) eq 0) then txt=0
+
+if (n_elements(netcdf) eq 0) then netcdf=0			; if 1 the output netcdf data
+
+print,obstypeselect
+
+if (n_elements(salinity) eq 0) then salinity=0
+density=0
+if (n_elements(vertgrad) eq 0) then vertgrad=0
+
+if (n_elements(mld) eq 0) then mld=0
+
+if (n_elements(outfile) eq 0) then outfile="dataplot"
+
+if (n_elements(bindata) eq 0) then bindata=0
+
+if (n_elements(binsize) eq 0) then binsize=[1.0,1.0]
+
+if (n_elements(symscale) eq 0) then symscale=1.0
+
+if (n_elements(hiresmap) eq 0) then begin
+	hires_map=0
+endif else begin
+	hires_map=hiresmap
+endelse
+
+if (n_elements(rmdi) eq 0) then rmdi=0
+
+if (n_elements(coltable) eq 0) then begin
+	coltable=-1
+endif
+
+if (n_elements(picsize) ne 2) then picsize=[800,512]	; default gif resolution
+
+if (n_elements(pmulti) eq 0) then pmulti=0		; default pmulti
+
+sz=size(indata)
+nsz=n_elements(sz)
+type=sz(nsz-2)	; get type 2 integer, 4 float, 7 string
+if (type eq 7) then filename=indata
+
+if (type ne 7) then begin
+   nel=n_elements(indata)
+   nel8=nel/8
+   numobs=nel8
+
+   ; get input values
+   if (nel gt 0) then begin
+      indata=reform(indata,numobs,8)
+      xarr=indata(*,0)
+      yarr=indata(*,1)
+      dep=indata(*,2)
+      dayarrin=indata(*,3)
+      obs=indata(*,4)
+      bkg=indata(*,5)
+      obs2=rmdi
+      obs3=rmdi
+      bkg2=rmdi
+      qcarr=long(indata(*,6))
+      qcarr2=rmdi
+      obnum=rmdi
+      obstypes=long(indata(*,7))
+      filetype="generic"
+      
+      print, 'djl max/min dayarrin ',max(dayarrin), min(dayarrin)
+      print, 'djl max/min qcarr ',max(qcarr), min(qcarr)
+      
+   endif
+endif else begin
+   if (n_elements(filename) eq 0) then begin
+       print,'ERROR: No filename supplied'
+       print,'call: dataplot, filenamearr'
+       return
+   endif
+endelse
+
+;read in data
+if (n_elements(filename) gt 0) then begin
+	read_cdfobs, filename, numobs=numobs, Latitudes=yarr, Longitudes=xarr, $
+	      obs=obs, modelvals=bkg, qcs=qcarr, $
+         ob2=obs2, modelval2=bkg2, qc2=qcarr2, $
+         ob3=obs3, $
+         Dates=dayarrin, rmdi=rmdi, $
+	      depths=dep, nodates=0, types=obstypes, $
+         filetype=filetype, iobs=iobs, jobs=jobs, MDT=MDT, error=error, profilenum=obnum, $
+         notfussy=notfussy, VarName=varname
+
+	if (error eq 1) then begin
+           numobs=0
+           dayarrin=0
+           rmdi=-99999
+           xarr=rmdi
+           yarr=rmdi
+           obs=rmdi
+           bkg=rmdi
+           qcarr=1
+           dayarrin=rmdi
+           dayarr=rmdi
+           dep=rmdi
+           filetype=""
+           obstypes=rmdi
+           obnum=0
+	endif 
+
+	print,'error ',error, numobs
+
+	if (numobs gt 0) then begin
+        print, 'numobs ',numobs
+
+;setup obnum if it is not produced by read_cdfobs
+
+	if (n_elements(obnum) ne numobs and numobs gt 0) then begin
+		obnum=lindgen(n_elements(numobs))	; generate an array of observation numbers
+                					; starting with zero
+        endif
+
+
+
+;if gt 180 then make longitudes negative
+
+	  wh=where(xarr ge 180 and xarr le 360)
+	  if (wh(0) gt -1) then begin
+ 	    xarr(wh)=xarr(wh)-360
+	  endif
+
+
+;calculate vertical gradient
+;
+;	  if (filetype eq "Prof") then $
+;	  calcvertgrad, xarr, yarr, dayarrin, obs, bkg, qcarr, obs2,bkg2, qcarr2, dep, rmdi
+
+; adjust qc values for profile obs data (1 = good)
+	  wh=where(bkg ne rmdi)
+          if (n_elements(bkg2) gt 0) then begin
+            wh2=where(bkg2 ne rmdi)
+	    if (filetype eq "Prof" and wh(0) eq -1 and wh2(0) eq -1) then begin
+              qcarr=qcarr-1 
+              qcarr2=qcarr2-1
+	    endif
+	  endif
+ 
+          if (keyword_set(showmdt) eq 1) then begin
+	    bkg=MDT
+          endif
+
+
+	  print,'rmdi ',rmdi
+
+	  print,'file read in'
+
+spawn,'echo part 1 `date`'
+
+	  if (n_elements(rmdi) eq 0) then rmdi=-1.07374e+09
+
+	  qcarr=fix(qcarr)
+
+	endif		; numobs
+
+	print,'endif numobs'
+
+; select area
+
+        sz=size(area)
+        nsz=n_elements(sz)
+        type=sz(nsz-2)	; get type 2 integer, 4 float, 7 string
+        if (type eq 7) then areasel, area, xrange, yrange, success
+        if (type eq 4 or type eq 2) then begin
+	  if (nsz eq 4) then begin
+             xrange=[area(0),area(2)]
+             yrange=[area(1),area(3)]
+          endif
+	endif			
+
+; set missing obs types to missing data
+        if (n_elements(obs2) eq 0) then begin
+          obs2=rmdi
+          bkg2=rmdi
+          qcarr2=rmdi
+       endif
+        if (n_elements(obs3) eq 0) then begin
+          obs3=rmdi
+          bkg3=rmdi
+          qcarr3=rmdi
+       endif
+
+endif		; filename
+
+if (n_elements(varname) eq 0) then varname=''
+
+	  if (n_elements(dayarrin) ne numobs) then dayarrin=replicate(1,numobs)
+;	    dep=replicate(0,numobs)
+
+
+	  if (size(dayarrin,/type) eq 8) then begin 
+  	    dayarr=dayarrin.julian
+          endif else begin
+  	    dayarr=dayarrin
+            dayarr=dayarr+0.5			; dataplot prefers each day to be a different integer
+          endelse
+
+print,'xxx'
+
+;set contour range mn, mx
+if (n_elements(mx) eq 0) then fmx=rmdi else fmx=mx
+if (n_elements(mn) eq 0) then fmn=rmdi else fmn=mn
+mx=fmx
+mn=fmn
+
+
+
+  ; Define a monochrome image array for use in the application. 
+;  READ_PNG, FILEPATH('mineral.png', $ 
+;    SUBDIR=['examples', 'data']), image 
+ 
+  ; Place the image array in a pointer heap variable, so we can 
+  ; pass the pointer to the event routine rather than passing the 
+  ; entire image array. 
+;  imagePtr=PTR_NEW(image, /NO_COPY) 
+ 
+  ; Retrieve the size information from the image array. 
+;  im_size=SIZE(*imagePtr) 
+
+;---------------
+;Setup defaults
+;---------------
+
+  busy=0
+  wh=where(dep ge 0)
+  depminl=0.
+  depmaxl=1.
+  if( wh(0) gt -1) then depminl=min(dep(wh),max=depmaxl)
+  depscl=fix((depmaxl-depminl)/100.)
+  if (depscl lt 1) then depscl=1
+  depmin=depminl
+;  depmax=depmin+depscl  
+  depmax=depmaxl
+  pmultinum=0
+
+if (n_elements(depths) eq 2) then begin
+
+ depmin=max([depminl,depths(0)])
+ depmax=min([depmaxl,depths(1)])
+endif
+
+	print,'n_elements(typeplot) ',n_elements(typeplot)
+
+   if (n_elements(typeplot) eq 0) then typeplot=1
+;   if (n_elements(where(bkg ne bkg(0))) gt 1) then begin
+;   	typeplot=3
+;   endif else begin
+;   	typeplot=4
+;   endelse
+;   endif
+   if (typeplot gt 4) then typeplot=4
+   if (typeplot lt 1) then typeplot=1
+   
+   if (n_elements(ombtypeplot) eq 0) then begin
+    if (n_elements(where(bkg ne bkg(0))) gt 1) then begin
+   	ombtypeplot=1
+    endif else begin
+   	ombtypeplot=2
+    endelse
+   endif
+   if (ombtypeplot gt 3) then ombtypeplot=3
+   if (ombtypeplot lt 1) then ombtypeplot=1
+
+   	print,'typeplot ',typeplot, ' ombtypeplot ',ombtypeplot
+   
+    if (n_elements(typeproj) eq 0) then typeproj=1
+
+	xrangedef=[-110.,40.]
+	yrangedef=[-50.,80.]
+	wh=where(xarr lt xrangedef(0) or xarr gt xrangedef(1) or $
+		yarr lt yrangedef(0) or yarr gt yrangedef(1),count)
+	if (count gt 0) then begin
+		xrangedef=[-180.,180.]
+		yrangedef=[-90.,90.]
+	endif
+
+	if (n_elements(xrange) eq 0) then begin
+ 	xrange=xrangedef
+	yrange=yrangedef
+        endif
+	symsize=1.0
+
+;  map_file=""
+
+;  plot_bad_obs=0
+
+  dayshi=-10.d/86400.		; small shift to group 0:00 hours with the previous day
+;  dayshi=-0.1d
+
+  wh=where(dayarr gt 0 and dayarr lt 9000000)
+;  print,dayarr
+;  print,wh(0)
+  if (wh(0) gt -1) then begin
+    daymin=min(dayarr(wh)+dayshi,max=daymax)
+  endif else begin
+    daymax=0
+    daymin=0
+  endelse
+;  daymax=maxday
+;  daymin=minday
+  dayminl=daymin
+  daymaxl=daymax
+  
+
+  print,'** dayminl daymaxl ', dayminl, daymaxl
+
+; ** Health check file   
+	if (keyword_set(healthcheck)) then begin
+		OPENW, unit, outfile+'_health.txt', /get_lun
+   		printf,unit,' Health check data '
+                printf,unit,'-------------------'
+                printf,unit,' Number of files ',n_elements(filename)
+                printf,unit,' List of files '
+		printf,unit,filename
+                printf,unit,' Filetype ',filetype
+                printf,unit,' Number of observations ',numobs
+                printf,unit,' Date range in julian days ',dayminl, daymaxl,format='(a,2f20.8)'
+		jul_to_dtstr,dayminl,datestr1
+                jul_to_dtstr,daymaxl,datestr2
+		printf,unit,' Date range ',datestr1,' - ',datestr2
+                mxo=0 & mno=0 
+                mxb=0 & mnb=0 
+                mxob=0 & mnob=0
+                rmsomb=0 & meanomb=0
+;                info,obs
+;                print,obs
+;                info,bkg
+;                print,bkg 
+;                print,'rmdi: ',rmdi
+;                wh=where(obs ne rmdi and qcarr lt 1,counto)
+; check for missing data within a tolerance 
+		wh=where(abs((obs-rmdi)/rmdi) gt 0.01 and qcarr lt 1, counto)
+;                print,'min ',min(abs((bkg(wh)-rmdi)/rmdi))
+;                print,'min ',min(bkg(wh)), min(obs(wh))
+;                print,'min ',max(bkg(wh)), max(obs(wh))
+                if (counto gt 0) then mxo=max(obs(wh),min=mno)
+;               wh=where(bkg ne rmdi and qcarr lt 1,countb)
+		wh=where(abs((bkg-rmdi)/rmdi) gt 0.01 and qcarr lt 1, countb)
+                if (countb gt 0) then mxb=max(bkg(wh),min=mnb)
+;                wh=where(obs ne rmdi and bkg ne rmdi and qcarr lt 1,countob)
+		wh=where(abs((obs-rmdi)/rmdi) gt 0.01 and $
+                	abs((bkg-rmdi)/rmdi) gt 0.01 and qcarr lt 1, countob)
+                if (countob gt 0) then mxob=max(obs(wh)-bkg(wh),min=mnob)
+; calculate rms / mean
+		if (countob gt 0) then begin
+		   x=total(obs(wh)-bkg(wh))
+                   x2=total((obs(wh)-bkg(wh))^2)
+                   nel=n_elements(wh)
+                   meanomb=x/nel
+                   rmsomb=sqrt(x2/nel)
+                endif
+ 
+                printf,unit,' Max/min obs ',mxo,mno
+                printf,unit,' Max/min bkg ',mxb,mnb
+                printf,unit,' Max/min obs-bkg ',mxob,mnob
+                printf,unit,' RMS/mean obs-bkg ',rmsomb,meanomb
+                printf,unit,' Number of good observations ',counto
+                printf,unit,' Number of bad observations ', numobs-counto
+
+                mxo=0 & mno=0 
+                mxb=0 & mnb=0 
+                mxob=0 & mnob=0 
+                rmsomb=0 & meanomb=0 
+                wh=where(obs2 ne rmdi and qcarr2 lt 1,counto) 
+                if (counto gt 0) then mxo=max(obs2(wh),min=mno)
+                wh=where(bkg2 ne rmdi and qcarr2 lt 1,countb)
+                if (countb gt 0) then mxb=max(bkg2(wh),min=mnb)
+                wh=where(obs2 ne rmdi and bkg2 ne rmdi and qcarr2 lt 1,countob)
+                if (countob gt 0) then mxob=max(obs2(wh)-bkg2(wh),min=mnob)
+; calculate rms / mean
+		if (countob gt 0) then begin
+		   x=total(obs2(wh)-bkg2(wh))
+                   x2=total((obs2(wh)-bkg2(wh))^2)
+                   nel=n_elements(wh)
+                   meanomb=x/nel
+                   rmsomb=sqrt(x2/nel)
+                endif
+                
+                printf,unit,' Max/min obs2 ',mxo,mno
+                printf,unit,' Max/min bkg2 ',mxb,mnb
+                printf,unit,' Max/min obs2-bkg2 ',mxob,mnob
+                printf,unit,' RMS/mean obs2-bkg2 ',rmsomb,meanomb                
+                printf,unit,' Number of good observations2 ',counto
+                printf,unit,' Number of bad observations2 ', numobs-counto
+
+	        FREE_LUN,unit
+        endif
+
+        daymax=daymaxl			; default to show everything
+        if (keyword_set(alldays)) then daymax=daymaxl         ;print alldays
+        if (n_elements(daterange) eq 2) then begin
+        	daymin=daterange(0)
+                if (daterange(0) lt dayminl) then daymin=dayminl
+                if (daterange(0) gt daymaxl) then daymin=daymaxl
+                if (daterange(1) gt dayminl and daterange(1) le daymaxl) then begin
+                	daymax=daterange(1)
+                endif else begin
+                daymax=daymaxl                
+                endelse
+        endif
+        if (n_elements(daterange) eq 1) then begin		; select number of days before end or after beginning
+             	print,'daymin b4: ',daymin, daymax
+                daymax=daymaxl
+                daymin=dayminl
+                if (daterange(0) lt 0) then begin
+                	if (daterange(0) eq -9999) then begin
+                        	daymin=daymax
+                        endif else begin
+	                	daymin=daymax+daterange(0)
+                        endelse
+                endif
+                if (daterange(0) gt 0) then daymax=daymin+daterange(0)
+        endif                                 
+
+; select day from the start day
+	if (n_elements(dayrange) eq 1) then begin
+        	daymin=dayminl+dayrange
+                daymax=daymin
+        endif
+
+	if (n_elements(dayrange) eq 2) then begin
+        	daymin=dayminl+dayrange(0)
+                daymax=dayminl+dayrange(1)
+        endif
+
+
+; prevent error where only one day plotted  
+	daymaxsl=daymaxl
+        dayminsl=dayminl
+	if (daymaxsl le dayminsl+1) then daymaxsl=dayminsl+1
+; stop day going out of range
+	if (daymax gt daymaxl) then daymax=daymaxl
+        if (daymax lt dayminl) then daymax=dayminl
+        if (daymin lt dayminl) then daymin=dayminl
+        if (daymin gt daymaxl) then daymin=daymaxl
+
+	print,'daymin af: ',daymin, daymax
+
+  sym=1
+   
+;-------------
+;Setup window
+;-------------
+
+if (not keyword_set(batch)) then begin 
+  ; Create a base widget to hold the application. 
+;	base0=WIDGET_BASE()
+
+  base = WIDGET_BASE(/COLUMN,mbar=bar) 
+;   base = WIDGET_BASE(/row)
+
+ 
+  ; setup menu bar
+  
+  menu1 = WIDGET_BUTTON(bar, VALUE='Areas', /MENU) 
+button1 = WIDGET_BUTTON(menu1, VALUE='Global', uvalue='Global') 
+button2 = WIDGET_BUTTON(menu1, VALUE='Arctic', uvalue='Arctic')
+button2a = WIDGET_BUTTON(menu1, VALUE='Atlantic', uvalue='Atlantic') 
+button3 = WIDGET_BUTTON(menu1, VALUE='N Atl', uvalue='N Atl')
+button4 = WIDGET_BUTTON(menu1, VALUE='Trop Atl', uvalue='Trop Atl')
+button5 = WIDGET_BUTTON(menu1, VALUE='S Atl', uvalue='S Atl')
+button5a = WIDGET_BUTTON(menu1, VALUE='Pacific', uvalue='Pacific')
+button6 = WIDGET_BUTTON(menu1, VALUE='N Pac', uvalue='N Pac')
+button7 = WIDGET_BUTTON(menu1, VALUE='Trop Pac', uvalue='Trop Pac')
+button8 = WIDGET_BUTTON(menu1, VALUE='S Pac', uvalue='S Pac')
+button9 = WIDGET_BUTTON(menu1, VALUE='Indian', uvalue='Indian')
+button10 = WIDGET_BUTTON(menu1, VALUE='S Ocean', uvalue='S Ocean')
+button11 = WIDGET_BUTTON(menu1, VALUE='Med', uvalue='Med')
+button12 = WIDGET_BUTTON(menu1, VALUE='N West Shelf', uvalue='NWS')
+button13 = WIDGET_BUTTON(menu1, VALUE='Input Area', uvalue='Input Area')
+
+  menu2 = WIDGET_BUTTON(bar, VALUE='Plot', /MENU)
+button1 = WIDGET_BUTTON(menu2, VALUE='Timeseries', uvalue='Timeseries')
+button1a =  WIDGET_BUTTON(menu2, VALUE='Num timeseries', uvalue='Num timeseries')
+button2 = WIDGET_BUTTON(menu2, VALUE='T-S diagram', uvalue='TS diagram') 
+
+  menu1a = WIDGET_BUTTON(bar, VALUE='Find',/MENU)
+button1a= WIDGET_BUTTON(menu1a, VALUE='Worst points', uvalue='Worst points')
+button1a1 = WIDGET_BUTTON(menu1a, VALUE='Filter type', uvalue='Filter type')
+
+  menu3 = WIDGET_BUTTON(bar, VALUE='Config', /MENU)
+loresmap = WIDGET_BUTTON(menu3, VALUE='Low res map', uvalue='Low res map', /checked_menu)
+hiresmap = WIDGET_BUTTON(menu3, VALUE='Hi res map', uvalue='Hi res map', /checked_menu)
+
+button3 = WIDGET_BUTTON(menu3, VALUE='Square psym', uvalue='Square psym')
+button4 = WIDGET_BUTTON(menu3, VALUE='Round psym', uvalue='Round psym')
+
+pltonbado = WIDGET_BUTTON(menu3, VALUE='Plot only bad obs', uvalue='Plot only bad obs', /checked_menu)
+
+whtonblack = WIDGET_BUTTON(menu3, VALUE='White on black', uvalue='White on black', /checked_menu)
+
+incsym = WIDGET_BUTTON(menu3, VALUE='Psym size+ ', uvalue='incsym')
+decsym = WIDGET_BUTTON(menu3, VALUE='Psym size- ', uvalue='decsym')
+resetsym = WIDGET_BUTTON(menu3, VALUE='Psym size reset ', uvalue='resetsym')
+
+vertgradmenu = WIDGET_BUTTON(menu3, VALUE='Vert gradient', uvalue='vertgrad', /checked_menu)
+button12 = WIDGET_BUTTON(menu3, VALUE='Input max/min', uvalue='input max/min')
+
+
+  menu4 = WIDGET_BUTTON(bar, VALUE='Help', /MENU)
+help1 = WIDGET_BUTTON(menu4, VALUE='Info', uvalue='Info')
+
+if (n_elements(filename) gt 0) then begin
+  menu5 = WIDGET_BUTTON(bar, VALUE=filename[0])
+nel=n_elements(filename)
+nel2=nel
+nelmx=32
+if (nel2 gt nelmx) then nel2=nelmx
+for i=0L, nel2-1 do begin
+  id = WIDGET_BUTTON(menu5, VALUE=filename[i])
+endfor
+if (nel gt nelmx) then id=WIDGET_BUTTON(menu5, VALUE='... etc ...')
+endif
+
+Widget_Control, loresmap, Set_Button=1
+Widget_Control, vertgradmenu, Set_Button=vertgrad 
+
+Widget_Control, pltonbado, Set_Button=plot_only_bad_obs
+Widget_Control, whtonblack, Set_Button=white_on_black
+ 
+  ; Create a draw widget based on the size of the image, and 
+  ; set the MOTION_EVENTS keyword so that events are generated 
+  ; as the cursor moves across the image. Setting the BUTTON_EVENTS 
+  ; keyword rather than MOTION_EVENTS would require the user to 
+  ; click on the image before an event is generated. 
+
+;	im_size=[2,1024,800]
+;	im_size=[2,800,800]
+;	im_size=[2,800,720]
+;	im_size=[2,1024,720]
+        im_size=[2,1024,680]
+;	im_size=[2,800,640]
+
+  draw = WIDGET_DRAW(base, XSIZE=im_size[1], YSIZE=im_size[2], $ 
+    /BUTTON_EVENTS,/WHEEL_EVENTS, uvalue='MAPWINDOW') 
+
+;	base2=widget_base(GROUP_LEADER=base,/column)
+
+;  droplist = WIDGET_COMBOBOX(base2,value=string([indgen(101)]),$
+;  	uvalue='LEVELLIST', FRAME=2)
+
+;  button = WIDGET_BUTTON(base2, value='test',uvalue='test')
+
+
+;	print,'depminl/maxl ',depminl, depmaxl
+;        print,'value depmin ',depmin
+;        print,'value depmax ',depmax
+
+depmaxlsl=depmaxl
+depminlsl=depminl
+if (depmaxlsl eq depminlsl) then depmaxlsl=depmaxlsl+1
+print, 'depminlsl, depmaxlsl ',depminlsl, depmaxlsl
+  slider = WIDGET_SLIDER(base,maximum=depmaxlsl,minimum=depminlsl,scroll=depscl,$
+  	value=depmin,uvalue='LEVELCHOICE', ysize=32)
+
+  sliderb = WIDGET_SLIDER(base,maximum=depmaxlsl,minimum=depminlsl, scroll=depscl,$
+        value=depmax,uvalue='LEVELCHOICEB', ysize=32)
+
+
+  jul_to_dtstr,daymin,dayminstr,/notime
+  slider1label = WIDGET_LABEL(base, VALUE="min date: "+dayminstr, xsize=800,ysize=14)
+  slider1 = WIDGET_SLIDER(base,minimum=dayminsl,maximum=daymaxsl,scroll=1,$
+  	value=daymin,uvalue='DATERANGE1',/suppress_value,/drag)
+
+  jul_to_dtstr,daymax,daymaxstr,/notime
+  slider2label = WIDGET_LABEL(base, VALUE="max date: "+daymaxstr, xsize=800,ysize=14)
+  slider2 = WIDGET_SLIDER(base,minimum=dayminsl,maximum=daymaxsl,scroll=1,$
+  	value=daymax,uvalue='DATERANGE2',/suppress_value,/drag)
+
+
+
+;  slider1 = WIDGET_SLIDER(base,minimum=dayminl,maximum=daymaxl,scroll=1,$
+;  	value=daymin,uvalue='DATERANGE1',PRO_SET_VALUE="datesliderset",/drag)
+;
+;  slider2 = WIDGET_SLIDER(base,minimum=dayminl,maximum=daymaxl,scroll=1,$
+;  	value=daymax,uvalue='DATERANGE2',PRO_SET_VALUE="datesliderset",/drag)
+	 
+  ; Labels for stats
+   
+  labt1='Lon: '
+  labt2='Lat: '
+  labt3='Value: '
+  labt4='QC: '
+  labt5='Date: '
+  labt6='Value: '
+  labt7=' '
+  labt8='Type: ' 
+  labt9='obnum: '
+  labt10='visible date range: '
+  
+  ; Create label widgets to hold the cursor position and 
+  ; Hexadecimal value of the pixel under the cursor. 
+  labelb=Widget_Base(base,row=1)
+  
+  labsiz=105
+  labsizl1=150
+  labsizlg=150
+  labsizl2=135
+  label7=0
+  lb_ysize=14
+  label1 = WIDGET_LABEL(labelb, XSIZE=labsiz, $ 
+    VALUE=labt1, ysize=lb_ysize) 
+  label2 = WIDGET_LABEL(labelb, XSIZE=labsiz, $ 
+    VALUE=labt2, ysize=lb_ysize) 
+  label3 = WIDGET_LABEL(labelb, XSIZE=labsizl1, $ 
+    VALUE=labt3, ysize=lb_ysize) 
+  label4 = WIDGET_LABEL(labelb, XSIZE=labsiz, $ 
+    VALUE=labt4, ysize=lb_ysize)
+  label5 = WIDGET_LABEL(labelb, XSIZE=labsizlg, $ 
+    VALUE=labt5, ysize=lb_ysize) 
+  label6 = WIDGET_LABEL(labelb, XSIZE=labsiz, $ 
+    VALUE=labt6, ysize=lb_ysize)
+;  label7 = WIDGET_LABEL(labelb, XSIZE=labsiz, $ 
+;    VALUE=labt7, ysize=lb_ysize)
+  label8 = WIDGET_LABEL(labelb, XSIZE=labsizl2, $ 
+    VALUE=labt8, ysize=lb_ysize)
+  label9 = WIDGET_LABEL(labelb, XSIZE=labsiz, $ 
+    VALUE=labt9, ysize=lb_ysize)
+
+  labelb2 = Widget_Base(base,row=1)
+  label10 = WIDGET_LABEL(labelb2, XSIZE=1024, $
+    VALUE=labt10, ysize=lb_ysize)
+
+   tlba = Widget_Base(base,row=1)
+
+   t1b = Widget_Base(tlba,Title='Push-Buttons', row=1, Scr_XSize=200,$
+   /Exclusive)
+   button1 = Widget_Button(t1b, Value='mean',uvalue='RADIO1',/no_release)
+   button2 = Widget_Button(t1b, Value='rms',uvalue='RADIO2',/no_release)
+   button3 = Widget_Button(t1b, Value='sd',uvalue='RADIO3',/no_release)
+   button4 = Widget_Button(t1b, Value='ms',uvalue='RADIO4',/no_release)
+
+   if (typeplot eq 1) then Widget_Control, button1, Set_Button=typeplot
+   if (typeplot eq 2) then Widget_Control, button2, Set_Button=typeplot
+   if (typeplot eq 3) then Widget_Control, button3, Set_Button=typeplot
+   if (typeplot eq 4) then Widget_Control, button4, Set_Button=typeplot
+  
+   t1c = Widget_Base(tlba,Title='Push-Buttons', row=1, Scr_XSize=200,$
+   /Exclusive)
+   button5 = Widget_Button(t1c, Value='obs - bkg', uvalue='RADIO5',/no_release)
+   button6 = Widget_Button(t1c, Value='obs', uvalue='RADIO6',/no_release)
+   button7 = Widget_Button(t1c, Value='bkg', uvalue='RADIO7',/no_release)
+
+   if (ombtypeplot eq 1) then Widget_Control, button5, /Set_Button
+   if (ombtypeplot eq 2) then Widget_Control, button6, /Set_Button
+   if (ombtypeplot eq 3) then Widget_Control, button7, /Set_Button
+
+;   tlb = Widget_Base(tlba,Title='Push-Buttons', row=1, Scr_XSize=400,$
+;   /Exclusive)
+;; no_release only sends select events (not release ones)
+;   button1 = Widget_Button(tlb, Value='rms Obs - Bkg',uvalue='RADIO1',/no_release)
+;   button2 = Widget_Button(tlb, Value='sum(Obs - Bkg)^2',uvalue='RADIO2',/no_release)
+;   button3=  Widget_Button(tlb, Value='Obs - Bkg',uvalue='RADIO3',/no_release)
+;   button4 = Widget_Button(tlb, Value='Obs',uvalue='RADIO4',/no_release)
+;   button5 = Widget_Button(tlb, Value='Bkg',uvalue='RADIO5',/no_release)
+;
+;   if (typeplot eq 1) then Widget_Control, button1, Set_Button=typeplot
+;   if (typeplot eq 2) then Widget_Control, button2, Set_Button=typeplot
+;   if (typeplot eq 3) then Widget_Control, button3, Set_Button=typeplot
+;   if (typeplot eq 4) then Widget_Control, button4, Set_Button=typeplot
+;   if (typeplot eq 5) then Widget_Control, button5, Set_Button=typeplot
+  
+   tlb1 = Widget_Base(tlba,Title='Push-Buttons', row=1, Scr_XSize=220,$
+   /Exclusive)
+   button01 = Widget_Button(tlb1, Value='Lat/Lon',uvalue='RADIO01',/no_release)
+   button02 = Widget_Button(tlb1, Value='N Polar',uvalue='RADIO02',/no_release)
+   button03 = Widget_Button(tlb1, Value='S Polar',uvalue='RADIO03',/no_release)
+
+    Widget_Control, button01, Set_Button=typeproj
+
+
+   tlb1a = Widget_Base(tlba,Title='Push-Buttons', row=1, Scr_XSize=250,$
+   /NonExclusive)
+   button001 = Widget_Button(tlb1a, Value='Plot Bad Obs', uvalue='RADIO001')
+
+   Widget_Control, button001, Set_Button=plot_bad_obs
+
+
+   if filetype eq 'CRT' then begin
+
+      button002 = Widget_Button(tlb1a, Value='Meridional', uvalue='RADIOSAL')
+      Widget_Control, button002, Set_Button=salinity
+
+      button003 = Widget_Button(tlb1a, Value='Speed', uvalue='RADIODENSITY')
+      Widget_Control, button003, Set_Button=density
+
+   endif else begin
+;         tlb1b = Widget_Base(tlba,Title='Push-Buttons', row=1, Scr_XSize=90,$
+;         /NonExclusive)
+      button002 = Widget_Button(tlb1a, Value='Salinity', uvalue='RADIOSAL')
+      Widget_Control, button002, Set_Button=salinity
+;         tlb1c = Widget_Base(tlba,Title='Push-Buttons', row=1, Scr_XSize=90,$
+;          /NonExclusive)
+      button003 = Widget_Button(tlb1a, Value='Density', uvalue='RADIODENSITY')
+      Widget_Control, button003, Set_Button=density
+   endelse
+
+ 
+   tlb2= Widget_Base(tlba,row=1)
+  button = WIDGET_BUTTON(tlb2, VALUE='Print',uvalue="PRINT") 
+  button = WIDGET_BUTTON(tlb2, VALUE='Save',uvalue="SAVE")
+   
+  button = WIDGET_BUTTON(tlb2, VALUE='Done',uvalue="DONE") 
+
+
+
+  ; Realize the widget hierarchy. 
+  WIDGET_CONTROL, base, /REALIZE 
+;  WIDGET_CONTROL, base2, /REALIZE 
+;   WIDGET_CONTROL, tlb, /REALIZE 
+
+  ; Retrieve the widget ID of the draw widget. Note that the widget 
+  ; hierarchy must be realized before you can retrieve this value. 
+  WIDGET_CONTROL, draw, GET_VALUE=drawID 
+
+ 
+  ; Create an anonymous array to hold the image data and widget IDs 
+  ; of the label widgets. 
+;  stash = { imagePtr:imagePtr, label1:label1, label2:label2, $ 
+;            label3:label3, $
+;	    xarr:xarr, yarr:yarr, dep:dep, val:val } 
+
+
+spawn,'echo part 2 `date`'
+
+
+  stash = { label1:label1, label2:label2, $ 
+            label3:label3, label4:label4, $
+            label5:label5, label6:label6, $
+            label7:label7, label8:label8, $
+            label9:label9, label10:label10, $
+            labt1:labt1, labt2:labt2, $
+            labt3:labt3, labt4:labt4, $
+            labt5:labt5, labt6:labt6, $
+            labt7:labt7, labt8:labt8, $
+            labt9:labt9, labt10:labt10, $
+            slider1label:slider1label, $
+            slider2label:slider2label, $
+            drawID:drawID, draw:draw, base:base, $
+            im_size:im_size, pixID:0, $
+            xcorn:0, ycorn:0, xdatacorn:0.0, ydatacorn:0.0, $
+            slider1:slider1, slider2:slider2, $
+            slider:slider, sliderb:sliderb, $
+            hiresmap:hiresmap, loresmap:loresmap, vertgradmenu:vertgradmenu, $
+            pltonbado:pltonbado, plot_only_bad_obs:plot_only_bad_obs, $
+            whtonblack:whtonblack, white_on_black:white_on_black, $
+            duplicates:duplicates, differences:differences, $
+            bindata:bindata, binsize:binsize, $
+            filetype:filetype, $
+            xarr:xarr, yarr:yarr, dep:dep, dayarr:dayarr, $
+            obs:obs, bkg:bkg, qcarr:qcarr, obstypes: obstypes, $
+            obs2:obs2, obs3:obs3, bkg2:bkg2, qcarr2:qcarr2, $
+            obnum:obnum, $
+            depmin:depmin, typeplot:typeplot, ombtypeplot:ombtypeplot, $
+            typeproj:typeproj, $
+            hires_map:hires_map, $
+            plot_bad_obs:plot_bad_obs, salinity: salinity, $
+            density:density, vertgrad:vertgrad, mld:mld, $
+            daymin:daymin, daymax:daymax, dayminl:dayminl, daymaxl:daymaxl, $
+            dayshi:dayshi, $
+            depminl:depminl, depmaxl:depmaxl, depmax:depmax, depscl:depscl, $
+            xrange:xrange, yrange:yrange, $
+            fmx:fmx, fmn:fmn, mx:mx, mn:mn, $
+            symsize:symsize, sym:sym, picsize:picsize, $
+            pmulti:pmulti, pmultinum:pmultinum, $
+            outfile:outfile, $ 
+            xrangedef:xrangedef, yrangedef:yrangedef, rmdi:rmdi, $
+            obstypeselect:obstypeselect, printobstypes:printobstypes, $
+            plottssel:plottssel, $
+            binspday:binspday, numtimeseries:numtimeseries, txt:txt, netcdf:netcdf, $
+            busy:busy, symscale:symscale, coltable:coltable, $
+            filterout:filterout, varname:varname } 
+	     
+  ; Set the user value of the top-level base widget equal to the 
+  ; 'stash' array. 
+  WIDGET_CONTROL, base, SET_UVALUE=stash 
+ 
+  ; Make the draw widget the current IDL drawable area. 
+  WSET, drawID 
+
+spawn,'echo part 3 `date`' 
+
+  ; Draw the image into the draw widget. 
+  plotpoints, stash
+
+; plotpoints updates mx/mn values make sure these are included
+  WIDGET_CONTROL, base, SET_UVALUE=stash 
+
+spawn,'echo part 4 `date`' 
+
+  ; Call XMANAGER to manage the widgets. 
+  XMANAGER, 'dataplot', base, /NO_BLOCK
+;  XMANAGER, 'dataplot', base
+endif else begin
+
+;do batch
+
+print,"batch"
+
+drawID=-1
+
+print, 'filetype: ',filetype
+
+  stash = { drawID:drawID,$	    
+            filetype:filetype, $
+            xarr:xarr, yarr:yarr, dep:dep, dayarr:dayarr, $
+            obs:obs, bkg:bkg, qcarr:qcarr, obstypes: obstypes, $
+            obs2:obs2, bkg2:bkg2, qcarr2:qcarr2, $
+            obnum:obnum, $
+            depmin:depmin, typeplot:typeplot, ombtypeplot:ombtypeplot, $
+            typeproj:typeproj, $
+            hires_map:hires_map, $
+            plot_only_bad_obs:plot_only_bad_obs, $
+            white_on_black:white_on_black, $
+            duplicates:duplicates, differences:differences, $
+            bindata: bindata, binsize:binsize, $
+            plot_bad_obs:plot_bad_obs, salinity: salinity, $
+            density:density, vertgrad:vertgrad, mld:mld, $
+            daymin:daymin, daymax:daymax, dayminl:dayminl, daymaxl:daymaxl, $
+            dayshi:dayshi, $            
+            depminl:depminl, depmaxl:depmaxl, depmax:depmax, depscl:depscl, $
+            xrange:xrange, yrange:yrange, $
+            fmx:fmx, fmn:fmn, mx:mx, mn:mn, $
+            symsize:symsize, sym:sym, picsize:picsize, $
+            pmulti:pmulti, pmultinum:pmultinum, $ 
+            outfile:outfile, $ 
+            xrangedef:xrangedef, yrangedef:yrangedef, rmdi:rmdi, $
+            obstypeselect:obstypeselect, printobstypes:printobstypes, $
+            plottssel:plottssel, $
+            binspday:binspday, numtimeseries:numtimeseries, txt:txt, netcdf:netcdf, $
+            busy:busy, symscale:symscale, coltable:coltable, $
+            filterout:filterout, varname:varname } 
+
+if (keyword_set(ps)) then begin
+  	ps=1
+	eps=0
+	landscape=1
+  	pr2,file=stash.outfile+'.ps',landscape=landscape,ps=ps,eps=eps,color=1	
+
+; plot data
+	if keyword_set(timeseries) then	begin	; plot timeseries if keyword is set
+        	plottimeseries,stash
+        endif else begin			; otherwise plot points on a map
+  		plotpoints,stash
+	endelse
+
+	prend2,view=0
+
+endif 
+
+if (keyword_set(gif)) then begin
+	thisDevice = !D.Name
+
+        Set_Plot, 'Z'			; do graphics in the background
+;	Device, Set_Resolution=[640,512], decomposed=0
+;	Device, Set_Resolution=[800,512], decomposed=0
+        Device, Set_Resolution=picsize, decomposed=0
+        Erase                           ; clear any existing stuff
+        !p.charsize=0.75
+        setupct, r, g, b, coltable=stash.coltable, $
+        	white_on_black=stash.white_on_black		; setup color table
+
+; plot data
+	if keyword_set(timeseries) then	begin	; plot timeseries if keyword is set
+        	plottimeseries,stash
+        endif else begin			; otherwise plot points on a map
+  		plotpoints,stash
+	endelse
+
+;	if (keyword_set(gif)) then begin
+;        IMAGE_GRAB, /gif, filename=stash.outfile+'.gif',/overwrite        
+	snapshot = TVRD()
+        WRITE_GIF,stash.outfile+'.gif',snapshot, r, g, b
+;        endif
+        Device, Z_Buffer=1		; reset graphics mode
+        Set_Plot, thisDevice
+        !p.charsize=0.0
+
+endif
+
+if (keyword_set(txt)) then begin
+	if keyword_set(timeseries) then	begin	; plot timeseries if keyword is set
+        	plottimeseries,stash
+        endif else begin			; otherwise plot points on a map
+  		plotpoints,stash
+;		print,'no txt version of plotpoints!'
+	endelse
+endif	
+
+if (keyword_set(netcdf)) then begin
+	if keyword_set(timeseries) then begin
+        	print,'no netcdf version of timeseries!'
+        endif else begin
+  		plotpoints,stash        
+        endelse
+endif
+
+if (stash.filterout ne '') then begin
+
+   selpoints, stash, lonsel, latsel, innovsel, qcsel, daysel, obstypsel, obnumsel, numsel, typestr
+
+endif
+
+endelse            ; batch
+ 
+END 
+
Index: /utils/tools_ticket2413/OBSTOOLS/dataplot/dataplot_txttimeseries.pro
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/dataplot/dataplot_txttimeseries.pro	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/dataplot/dataplot_txttimeseries.pro	(revision 12863)
@@ -0,0 +1,452 @@
+pro plotts1, arrsv, title, typestr, minperc=minperc, $
+	juldatemin=juldatemin, juldatemax=juldatemax, $
+        emax=emax, emin=emin
+;+--------------------------------------------------------
+; plot mean and rms timeseries
+;
+; Author:  D. J. Lea      Feb 2008
+;+--------------------------------------------------------
+
+;date_label = LABEL_DATE(DATE_FORMAT = $ 
+;   ['%D %M, %Y']) 
+
+;date_label = LABEL_DATE(DATE_FORMAT = $ 
+;   ['%D', '%M, %Y']) 
+;date_label = LABEL_DATE(DATE_FORMAT = $ 
+;   ['%M %Y']) 
+
+date_label = LABEL_DATE(DATE_FORMAT=['%D-%M','%Y'])
+
+
+; sort times (in case of a repeated day)
+
+timsrt=sort(arrsv(0,*))
+
+taxis=arrsv(0,timsrt)
+num=arrsv(1,timsrt)
+yaxis=arrsv(2,timsrt)
+yaxis2=arrsv(3,timsrt)
+
+; remove any zero times or non-finite values
+wh=where(taxis gt 0 and finite(yaxis) and finite(yaxis2))
+if (wh(0) gt -1) then begin
+taxis=taxis(wh)
+num=num(wh)
+yaxis=yaxis(wh)
+yaxis2=yaxis2(wh)
+endif
+
+; remove any with num lt than a specific value
+if (n_elements(minperc) eq 1) then begin
+maxnum=max(num,min=minnum)
+wh=where(num gt maxnum*minperc)
+if (wh(0) gt -1) then begin
+taxis=taxis(wh)
+num=num(wh)
+yaxis=yaxis(wh)
+yaxis2=yaxis2(wh)
+endif
+endif
+
+mxt=max(taxis,min=mnt)
+print, 'mnt mxt ',mnt, mxt
+
+ymx=max([yaxis,yaxis2],min=ymn)
+
+print, 'ymn ymx ',ymn,ymx
+
+;create a small amount of space around the max and min
+
+spc=(ymx-ymn)*0.05
+
+ymn=ymn-spc*3
+ymx=ymx+spc
+
+if (n_elements(emax) gt 0) then ymx=emax
+if (n_elements(emin) gt 0) then ymn=emin
+
+; setup time axis range
+
+skip=0
+xmx=max(taxis,min=xmn)
+if (n_elements(juldatemin) gt 0) then begin
+	if (xmn le juldatemin) then xmn=juldatemin
+        if (xmx le juldatemin) then skip=1
+endif
+if (n_elements(juldatemax) gt 0) then begin
+	if (xmx ge juldatemax) then xmx=juldatemax
+        if (xmn ge juldatemin) then skip=1
+endif
+
+if (skip eq 0) then begin
+;plot, arrsv(0,timsrt), arrsv(2,timsrt), xstyle=1, linestyle=1, $
+;   yrange=[ymn,ymx], $
+;   ytitle=typestr, title=title, $
+;   XTICKFORMAT = ['LABEL_DATE'], $ 
+;   XTICKUNITS = ['Day'], $ 
+;   XTICKINTERVAL = 4 
+
+;plot, arrsv(0,timsrt), arrsv(3,timsrt), xstyle=1, /noerase, $
+;   yrange=[ymn,ymx], $
+;   XTICKFORMAT = ['LABEL_DATE'], $ 
+;   XTICKUNITS = ['Day'], $ 
+;   XTICKINTERVAL = 4 
+
+;plot, arrsv(0,timsrt), arrsv(2,timsrt), xstyle=1, linestyle=1, $
+;   yrange=[ymn,ymx], $
+;   ytitle=typestr, title=title, $
+;   XTICKFORMAT = ['LABEL_DATE','LABEL_DATE'],$
+;   XTICKUNITS = ['Day','Month']
+
+;plot, arrsv(0,timsrt), arrsv(3,timsrt), xstyle=1, /noerase, $
+;   yrange=[ymn,ymx], $
+;   XTICKFORMAT = ['LABEL_DATE','LABEL_DATE'],$
+;   XTICKUNITS = ['Day','Month']
+
+;plot, taxis, yaxis, xstyle=1, linestyle=1, $
+;   yrange=[ymn,ymx], $
+;   ytitle=typestr, title=title, $
+;   XTICKFORMAT = ['LABEL_DATE']
+;   
+;plot, taxis, yaxis2, xstyle=1, /noerase, $
+;   yrange=[ymn,ymx], $
+;   XTICKFORMAT = ['LABEL_DATE']
+
+plot, taxis, yaxis, xstyle=1, ystyle=1, linestyle=1, $
+   yrange=[ymn,ymx], xrange=[xmn,xmx], $
+   ytitle=typestr, title=title, $
+   XTICKUNITS=['Time', 'Time'], XTICKFORMAT = ['LABEL_DATE'],YMARGIN=[6,4]
+
+plot, taxis, yaxis2, xstyle=4+1, ystyle=4+1, /noerase, $
+   yrange=[ymn,ymx], xrange=[xmn,xmx], $
+   XTICKUNITS=['Time', 'Time'], XTICKFORMAT = ['LABEL_DATE'],YMARGIN=[6,4]
+	
+
+
+; key
+		xcoord=0.8
+		ycoord=0.9
+		ycoord=0.35
+                ycoord=0.2
+
+                  ycoord2=ycoord-0.05
+                  xcoord2=xcoord+0.03
+                  xcoord3=xcoord+0.05
+                  plots, [xcoord,xcoord2],[ycoord,ycoord], linestyle=0, /normal
+                  xyouts, xcoord3, ycoord, 'RMS', /normal
+                  plots, [xcoord,xcoord2],[ycoord2,ycoord2], linestyle=1, /normal
+                  xyouts, xcoord3, ycoord2, 'mean',/normal                
+
+endif
+
+end
+
+
+; plot number
+
+pro plotts2, arrsv, title, typestr, minperc=minperc, $
+	juldatemin=juldatemin, juldatemax=juldatemax
+   
+
+; number
+;
+
+;date_label = LABEL_DATE(DATE_FORMAT = $ 
+;   ['%D %M, %Y']) 
+
+;date_label = LABEL_DATE(DATE_FORMAT = $ 
+;   ['%M %Y']) 
+
+date_label = LABEL_DATE(DATE_FORMAT=['%D-%M','%Y'])
+
+
+
+timsrt=sort(arrsv(0,*))
+
+taxis=arrsv(0,timsrt)
+yaxis=arrsv(1,timsrt)
+
+wh=where(taxis gt 0 and finite(yaxis))	 ; remove any zero times and non-finite vals
+if (wh(0) gt -1) then begin
+taxis=taxis(wh)
+yaxis=yaxis(wh)
+endif
+mxt=max(taxis,min=mnt)
+print, 'mnt mxt ',mnt, mxt
+
+;plot, arrsv(0,timsrt), arrsv(1,timsrt), xstyle=1, $
+;   ytitle='Number of obs assim', title=title, $
+;   XTICKFORMAT = ['LABEL_DATE'], $ 
+;   XTICKUNITS = ['Day'], $ 
+;   XTICKINTERVAL = 4 
+
+;info, taxis
+;info, yaxis
+
+;print,taxis, yaxis
+
+;plot, taxis, yaxis, xstyle=1, $
+;   ytitle='Number of obs assim', title=title, $
+;   XTICKFORMAT = ['LABEL_DATE']
+
+ymx=max(yaxis)*1.05
+
+; setup time axis range
+
+skip=0
+xmx=max(taxis,min=xmn)
+if (n_elements(juldatemin) gt 0) then begin
+	if (xmn le juldatemin) then xmn=juldatemin
+        if (xmx le juldatemin) then skip=1
+endif
+if (n_elements(juldatemax) gt 0) then begin
+	if (xmx ge juldatemax) then xmx=juldatemax
+        if (xmn ge juldatemin) then skip=1
+endif
+
+if (skip eq 0) then $
+plot, taxis, yaxis, xstyle=1, ystyle=1, $
+   ytitle='Number of obs assim', title=title, yrange=[0,ymx], xrange=[xmn,xmx],$
+   XTICKUNITS = ['Time', 'Time'], XTICKFORMAT = ['LABEL_DATE'],YMARGIN=[6,4]
+
+
+print,'min time ',min(arrsv(0,timsrt)),max(arrsv(0,timsrt)) 
+
+end
+
+PRO dataplot_txttimeseries, files, gif=gif, ps=ps, filtstr=filtstr, view=view, $
+	bin=bin, minperc=minperc, datemin=datemin, datemax=datemax, notitle=notitle, $
+        emax=emax, emin=emin
+
+; DJL switch off wave compatibility mode
+res=execute("waveoff")
+
+if (n_elements(filtstr) eq 0) then filtstr=""
+if (n_elements(view) eq 0) then view=0
+
+print, 'dataplot_txttimeseries '
+
+if (n_elements(datemin) gt 0) then begin
+	; month, day, year
+	juldatemin=julday(datemin(1),datemin(2), datemin(0))
+        print, 'juldatemin set:', juldatemin, datemin
+endif
+if (n_elements(datemax) gt 0) then begin
+	; month, day, year
+	juldatemax=julday(datemax(1),datemax(2), datemax(0))
+        print, 'juldatemax set:', juldatemax, datemax
+endif
+
+
+
+numfiles=n_elements(files)
+
+print,'numfiles ',numfiles
+
+imax=500
+	arrs=dblarr(4,imax)
+	arr=dblarr(4)
+	arrsv=dblarr(4,10000)
+
+j=0L		; position in full array
+for ii=0,numfiles-1 do begin
+	print,files(ii)
+        OPENR, unit, files(ii), /get_lun
+        obstypestr=""
+        readf,unit,obstypestr
+        typestr=""
+        readf,unit,typestr
+        xrange=fltarr(2)
+        readf,unit,xrange
+        yrange=fltarr(2)
+        readf,unit,yrange
+        binspday=0.0
+        readf,unit,binspday
+
+	i=0
+	while (~ eof(unit) and i lt imax) do begin        
+        readf,unit,arr
+	print,i,arr
+        if arr(1) eq 0 then arr(2:*)=0
+        print,arr
+        arrs(*,i)=arr
+        i=i+1
+        endwhile
+ 
+	numtimes=i
+	print, 'numtimes ',numtimes
+        
+        if (numtimes ge binspday) then begin
+        	print,arrs(*,numtimes-binspday:numtimes-1)
+
+; store daily values from each file in full time series array
+
+	arrsv(*,j:j+binspday-1)=arrs(*,numtimes-binspday:numtimes-1)
+        j=j+binspday
+
+	endif else begin 
+        if (numtimes gt 0) then begin
+        
+        print, '** numtimes ',numtimes
+        print, arrs(*,0:numtimes-1)  
+        arrsv(*,j:j+numtimes-1)=arrs(*,0:numtimes-1)        
+        j=j+numtimes
+                
+        endif
+        endelse
+                
+        FREE_LUN, unit
+        
+        print, obstypestr
+        print, typestr
+        print, xrange
+        print, yrange
+        print, binspday
+endfor	
+
+print, 'j ',j
+
+arrsv=arrsv(*,0:j-1)
+
+;stop
+
+; bin up the data
+
+;print,arrsv
+
+if (n_elements(bin) gt 0) then begin
+if (bin gt 1) then begin
+; time 0 num 1 mean 2 rms 3
+arrsv2=dblarr(4,j/bin)
+for i=0,j/bin-1 do begin
+
+	arrsvtemp=arrsv(*,i*bin:(i+1)*bin-1)
+        print,arrsvtemp
+	wh=where(arrsvtemp(1,*) gt 0)		; number of obs gt 0
+;        print,wh
+        if (wh(0) gt -1) then begin 
+
+; number of obs
+        arrsv2(1,i)=total(arrsvtemp(1,wh))
+; mean
+        arrsv2(2,i)=total(arrsvtemp(2,wh)*arrsvtemp(1,wh))/arrsv2(1,i)
+; rms
+        arrsv2(3,i)=sqrt(total(arrsvtemp(3,wh)^2*arrsvtemp(1,wh))/arrsv2(1,i))
+; date (average)
+;	print,arrsv(0,i*bin)
+	arrsv2(0,i)=total(arrsvtemp(0,*))/bin
+;	print,arrsv2(0,i)
+
+	endif
+
+endfor
+
+info, arrsv2
+
+arrsv=arrsv2
+	
+endif
+endif
+
+nel=n_elements(arrsv(0,*))
+
+; produce 1 month/3 month/all average values
+
+finaltime=arrsv(0,nel-1)
+onemon=finaltime-30
+threemon=finaltime-90
+
+print,arrsv
+
+wh1=where(arrsv(0,*) gt onemon and arrsv(1,*) gt 0)
+wh3=where(arrsv(0,*) gt threemon and arrsv(1,*) gt 0)
+wh0=where(arrsv(1,*) gt 0)
+
+num1=total(arrsv(1,wh1))
+mean1=total(arrsv(2,wh1)*arrsv(1,wh1))/num1
+rms1=sqrt(total(arrsv(3,wh1)^2*arrsv(1,wh1))/num1)
+print,num1
+
+num3=total(arrsv(1,wh3))
+mean3=total(arrsv(2,wh3)*arrsv(1,wh3))/num3
+rms3=sqrt(total(arrsv(3,wh3)^2*arrsv(1,wh3))/num3)
+print,num3
+
+num0=total(arrsv(1,wh0))
+mean0=total(arrsv(2,wh0)*arrsv(1,wh0))/num0
+rms0=sqrt(total(arrsv(3,wh0)^2*arrsv(1,wh0))/num0)
+print,num0
+
+if (keyword_set(notitle)) then begin
+title1=""
+title=""
+endif else begin 
+subtitle=          'rms (mean), 1 month: '+strtrim(string(rms1,format='(G0.4)'),2)+$
+	'('+strtrim(string(mean1,format='(G0.3)'),2)+')'
+subtitle=subtitle+ ', 3 month: '+strtrim(string(rms3,format='(G0.4)'),2)+$
+	'('+strtrim(string(mean3,format='(G0.3)'),2)+')'
+subtitle=subtitle+ ', all: '+strtrim(string(rms0,format='(G0.4)'),2)+$
+	'('+strtrim(string(mean0,format='(G0.3)'),2)+')'
+
+
+fullfiltstr=''
+if (filtstr ne '') then fullfiltstr=' Type: '+filtstr
+
+title=obstypestr+typestr+'   lons ('+strtrim(string(xrange(0),format='(F0.2)'),2)+$
+	','+strtrim(string(xrange(1),format='(F0.2)'),2)+$
+        ')   lats ('+strtrim(string(yrange(0),format='(F0.2)'),2)+','+$
+        strtrim(string(yrange(1),format='(F0.2)'),2)+')'+fullfiltstr
+
+title1=title+'!C'+subtitle
+endelse
+
+if (keyword_set(gif)) then begin
+	thisDevice = !D.Name
+
+        Set_Plot, 'Z'			; do graphics in the background
+;	Device, Set_Resolution=[640,512], decomposed=0
+	Device, Set_Resolution=[800,512], decomposed=0
+        Erase                           ; clear any existing stuff
+        !p.charsize=0.75
+;        setupct, r, g, b		; setup color table
+
+	plotts1, arrsv, title1, typestr, minperc=minperc, $
+	juldatemin=juldatemin, juldatemax=juldatemax, $
+        emax=emax, emin=emin
+
+
+	snapshot = TVRD()
+        WRITE_GIF,'dataplot_timeseries.gif',snapshot, r, g, b
+
+	plotts2, arrsv, title, typestr, minperc=minperc, $
+	juldatemin=juldatemin, juldatemax=juldatemax
+
+        
+	snapshot = TVRD()
+        WRITE_GIF,'dataplot_numtimeseries.gif',snapshot, r, g, b
+
+        Device, Z_Buffer=1		; reset graphics mode
+        Set_Plot, thisDevice
+        !p.charsize=0.0
+
+endif
+
+if (keyword_set(ps)) then begin
+  ps=1
+  eps=0
+  landscape=1
+  pr2o,file='dataplot_timeseries.ps',landscape=landscape,ps=ps,eps=eps,color=1	
+  plotts1, arrsv, title1, typestr, minperc=minperc, $
+	juldatemin=juldatemin, juldatemax=juldatemax, $
+        emax=emax, emin=emin
+  prend2o,view=view
+  
+  pr2o,file='dataplot_numtimeseries.ps',landscape=landscape,ps=ps,eps=eps,color=1	
+  plotts2, arrsv, title, typestr, minperc=minperc, $
+	juldatemin=juldatemin, juldatemax=juldatemax
+  prend2o,view=view
+
+endif 
+
+end
+
Index: /utils/tools_ticket2413/OBSTOOLS/dataplot/eos_nemo.pro
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/dataplot/eos_nemo.pro	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/dataplot/eos_nemo.pro	(revision 12863)
@@ -0,0 +1,79 @@
+function eos_nemo, t_in, psal
+;------------------------------------------------------------------------------
+;
+; Purpose:
+;       To calculate the density using the equation of state used in NEMO.
+;       This is based on the Jackett and McDougall (1994) equation of state
+;       for calculating the in situ density based on potential temperature
+;       and salinity.
+;
+; Inputs:
+;       temperature    =>  1d array potential temperature (deg C)
+;       salinity       =>  1d array salinity (PSU)
+;
+; Outputs:
+;       rhop            =>  1d array pot density (kg/m**3)
+;
+; could add use a difference reference pressure
+; observations are in-situ temperature?
+;
+; Author:
+;       D. J. Lea. Dec 2006.
+;------------------------------------------------------------------------------
+
+          zws = SQRT( ABS( psal ) )
+
+	sz=size(t_in)
+	ndim=sz(0)
+	NO_LEVS=sz(ndim)
+	
+	prhop=psal*0.
+
+;                 
+          for jk = 0L, NO_LEVS-1 do begin  
+
+                   zt = T_IN(jk)
+                   zs = psal(jk)
+; * depth
+;                   zh = O_DEP_LEVS(jk)		;used in calculating insitu density only
+                   zsr= zws(jk)
+; * compute volumic mass pure water at atm pressure
+                   zr1= ( ( ( ( 6.536332e-9*zt-1.120083e-6 )*zt+1.001685e-4)*zt   $
+                      -9.095290e-3 )*zt+6.793952e-2 )*zt+999.842594
+; * seawater volumic mass atm pressure
+                   zr2= ( ( ( 5.3875e-9*zt-8.2467e-7 ) *zt+7.6438e-5 ) *zt   $
+                      -4.0899e-3 ) *zt+0.824493
+                   zr3= ( -1.6546e-6*zt+1.0227e-4 ) *zt-5.72466e-3
+                   zr4= 4.8314e-4
+
+; * potential volumic mass (reference to the surface)
+                   zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
+
+; * save potential volumic mass
+                   prhop(jk) = zrhop
+
+; * add the compression terms
+                   ze = ( -3.508914e-8*zt-1.248266e-8 ) *zt-2.595994e-6
+                   zbw= (  1.296821e-6*zt-5.782165e-9 ) *zt+1.045941e-4
+                   zb = zbw + ze * zs
+
+                   zd = -2.042967e-2
+                   zc =   (-7.267926e-5*zt+2.598241e-3 ) *zt+0.1571896
+                   zaw= ( ( 5.939910e-6*zt+2.512549e-3 ) *zt-0.1028859 ) *zt - 4.721788
+                   za = ( zd*zsr + zc ) *zs + zaw
+
+                   zb1=   (-0.1909078*zt+7.390729 ) *zt-55.87545
+                   za1= ( ( 2.326469e-3*zt+1.553190)*zt-65.00517 ) *zt+1044.077
+                   zkw= ( ( (-1.361629e-4*zt-1.852732e-2 ) *zt-30.41638 ) *zt + 2098.925 ) *zt+190925.6
+                   zk0= ( zb1*zsr + za1 )*zs + zkw
+
+;                   ; in situ density anomaly
+;                   prd(jk) = zrhop / (  1.0 - zh / ( zk0 - zh * ( za - zh * zb ) )  )
+;
+          endfor  
+
+
+
+return, prhop
+
+END                  
Index: /utils/tools_ticket2413/OBSTOOLS/dataplot/nice_contourlevels.pro
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/dataplot/nice_contourlevels.pro	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/dataplot/nice_contourlevels.pro	(revision 12863)
@@ -0,0 +1,60 @@
+function nice_contourlevels, data, nlevels=nlevels
+;+----------------------------------------------------------------------------------------
+; nice_contourlevels.pro
+;
+; Select nice contour levels based on the data input and the number of levels
+;
+; Author:  D. J. Lea     -  Feb 2008
+;
+;+----------------------------------------------------------------------------------------
+
+if (n_elements(nlevels) eq 0) then nlevels=15
+
+mx=max(data)
+mn=min(data)
+
+; use this to select colors to plot and labels
+
+clevels=findgen(nlevels)/nlevels*(mx-mn)+mn
+
+ocint=1./nlevels*(mx-mn)
+print,'ocint ',ocint
+
+; contour interval at 2 sig figs
+;digits=2
+;p10 = floor(alog10(abs(ocint)))
+;expo = 10.0d^(digits -1 - p10)
+;cint = long(ocint*expo)/expo
+;print,'cint ',cint
+
+;does it end in 5 or 0?
+digits=1
+p10 = floor(alog10(abs(ocint)))
+expo = 10.0d^(digits -1 - p10)
+cint = long(ocint*expo)/expo
+print,'cint ',cint
+
+if (mx ne mn) then begin
+mxfix=fix(mx/cint)*cint
+mnfix=fix(mn/cint)*cint
+print, mx, mxfix
+print, mn, mnfix
+
+; nice contour values
+
+;calculate new nlevels
+nlevels=fix((mxfix-mnfix)/cint+1)
+
+;print,nlevels
+if (nlevels gt 0) then begin
+	clevels=findgen(nlevels)*cint+mnfix
+endif else begin
+	clevels=mnfix
+endelse
+endif else begin
+	clevels=mn
+endelse
+
+return, clevels
+
+end
Index: /utils/tools_ticket2413/OBSTOOLS/dataplot/pr2.pro
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/dataplot/pr2.pro	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/dataplot/pr2.pro	(revision 12863)
@@ -0,0 +1,55 @@
+  PRO Pr2,device,$
+         bw=bw,$
+         color=o_color,$
+         pcl=pcl,$
+         ps=ps,$
+         cps=cps,$
+         eps=eps,$
+         cgm=cgm,$
+         screen=screen,$
+         transparency=o_transparency,$
+         encapsulated=encapsulated,$
+         bpp=bpp,$
+         portrait=portrait,$
+         landscape=landscape,$
+         table=table,$
+         reread=reread,$
+         noflip=noflip,$
+         verbose=verbose,$
+         xsize=xsize,$
+         ysize=ysize,$
+         xoffset=xoff,$
+         yoffset=yoff,$
+         scale=scale,$
+         file=file,$
+         destination=destination
+;+----------------------------------------------------------
+; NAME:pr2
+; like pr, but uses nice fonts
+;
+; Author:  D. J. Lea        Feb 2008
+;+----------------------------------------------------------
+
+COMMON pr2, view_landscape
+
+	set_plot,'ps'
+
+	if (n_elements(color) eq 0) then color=1
+        if (n_elements(landscape) eq 0) then landscape=1
+        if (keyword_set(portrait)) then landscape=0
+        encapsulated=1
+        if (keyword_set(eps)) then encapsulated=1
+        if (keyword_set(ps)) then encapsulated=0
+        
+        view_landscape=landscape
+        
+	DEVICE, filename=file, COLOR=color, landscape=landscape, $
+        	encapsulated=encapsulated, xsize=xsize, ysize=ysize
+
+
+!p.font=0
+device,/helv
+	 
+;return
+
+end
Index: /utils/tools_ticket2413/OBSTOOLS/dataplot/prend2.pro
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/dataplot/prend2.pro	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/dataplot/prend2.pro	(revision 12863)
@@ -0,0 +1,38 @@
+PRO PREND2,in_printer,keep=keep,noprint=noprint,double=double,$
+    view=view,spin_landscape_ps=spin_landscape_ps,$
+    eps_preview=eps_preview,colour_preview=colour_preview,$
+    dpi_preview=dpi_preview, suppress_stderr=suppress_stderr
+;+
+; NAME:prend
+; 
+; Author:  D. J. Lea       Feb 2008
+
+COMMON pr2, view_landscape
+
+; get filename of postscript device  
+
+r = fstat(!D.UNIT)
+filename = r.name
+
+device,/close          
+set_plot,'x'
+
+if keyword_set(view) then begin
+
+   if (view_landscape) then begin
+      spawn,'gv -orientation=landscape -swap '+filename
+   endif else begin
+      spawn,'gv '+filename 
+   endelse
+
+endif
+
+!p.font=-1
+!p.charsize=0
+!p.charthick=0
+!p.thick=0
+!p.background=0
+
+;return
+
+end
Index: /utils/tools_ticket2413/OBSTOOLS/dataplot/read_cdfobs.pro
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/dataplot/read_cdfobs.pro	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/dataplot/read_cdfobs.pro	(revision 12863)
@@ -0,0 +1,221 @@
+;+---------------------------------------------------------------------------
+PRO read_cdfobs, Files, NumObs=NumObs, $
+               Latitudes=Latitudes, Longitudes=Longitudes, Depths=Depths, $
+               Obs=Observations, ModelVals=ModelVals, qcs=QCs, $
+               Ob2=Observations2, ModelVal2=ModelVals2, qc2=QCs2, $
+               Ob3=Observations3, $
+               Dates=Dates, rmdi=rmdi, iobs=iobs, jobs=jobs, kobs=kobs, $
+	            Salinity=Salinity, nodates=nodates, types=types, $
+	            filetype=ObsType, quiet=quiet, MDT=MDT, $
+               ProfileNum=ProfileNum, error=error, $
+               notfussy=notfussy,VarName=VarName  
+;+--------------------------------------------------------------------------
+; Read in observation and feedback files
+; detects filetype and calls the appropriate reading routine
+;
+; Author:  D. J. Lea       Feb 2008
+;+--------------------------------------------------------------------------
+
+; Declare error label. 
+ON_IOERROR, IOERROR 
+	       
+error=0
+title=''
+
+; Set types to undefined
+types=-1 & tempvar=size(temporary(types))
+
+; Read in netcdf data file and observation operator
+;2. Work out which type of data is in the files by looking at the first one.
+ncid = ncdf_open(Files(0), /nowrite)
+if ncid lt 0 then message, 'Error opening file '+File
+result = NCDF_ATTINQ( ncid, 'title', /global)
+if result.datatype ne 'UNKNOWN' then ncdf_attget, ncid, 'title', Title, /global
+
+if string(Title) eq "NEMO observation operator output" then ObsType='feedback' $
+else $
+if string(Title) eq "Forecast class 4 file" then ObsType='ForecastClass4' $
+else $
+ObsType = 'none'
+
+if ObsType eq 'none' then begin
+  varid = ncdf_varid(ncid, 'POTM_CORRECTED')  
+  if varid ge 0 then ObsType = 'Prof' 
+  
+  varid = ncdf_varid(ncid, 'SLA')
+  if varid ge 0 then ObsType = 'SSH'
+  
+  varid = ncdf_varid(ncid, 'SST')
+  varid2 = ncdf_varid(ncid, 'sea_surface_temperature')
+  varid=max([varid,varid2])
+  if varid ge 0 then ObsType = 'SST'
+  
+  varid = ncdf_varid(ncid, 'SEAICE')
+  varid2 = ncdf_varid(ncid, 'sea_ice_concentration')
+  varid=max([varid,varid2])
+  if varid ge 0 then ObsType = 'SEAICE'    
+  
+  varid = ncdf_varid(ncid, 'LOGCHL')
+  varid2 = ncdf_varid(ncid, 'LogChl')
+  varid3 = ncdf_varid(ncid, 'CHL1_mean')
+  varid=max([varid,varid2,varid3])
+  if varid ge 0 then ObsType = 'LOGCHL'    
+  
+  varid = ncdf_varid(ncid, 'PCO2')
+  if varid ge 0 then ObsType = 'PCO2'
+
+  varid = ncdf_varid(ncid, 'UCRT')
+  varid2 = ncdf_varid(ncid, 'VCRT')
+  varid=max([varid,varid2])
+  if varid ge 0 then ObsType = 'CRT'    
+endif
+ 
+ncdf_close, ncid
+
+if not keyword_set(quiet) then print, 'Reading in data as type ',ObsType
+
+  if ObsType eq 'feedback' then begin
+  
+    if n_elements(DepRange) eq 0 then DepRange=[0,5000]  
+  
+    read_feedback, Files, DepRange=DepRange, VarName=VarName, NumData=numobs, $
+                OutLats=Latitudes, OutLons=Longitudes, $
+                OutInstruments=Instruments, OutPlatform=Platform, $
+                OutDeps=Depths,  $
+                OutObs1=Observations, OutObs2=Observations2, $
+                OutMod1=ModelVals, OutMod2=ModelVals2, $
+                OutQC1=QCs, OutQC2=QCs2, $
+                MDT=MDT, OutDates=Dates, $
+                rmdi=rmdi, quiet=quiet, $
+                OutProfileNum=ProfileNum
+                
+;                info, instruments
+;                info, platform
+                
+                types=Platform
+                if n_elements(instruments) gt 0 then types=Platform+' '+Instruments
+                
+  print, 'Varname: ',VarName
+  endif else if ObsType eq 'Prof' then begin
+  
+    if keyword_set(PlotModel) then begin
+      OutTMod = 1
+      OutSMod = 1
+    endif
+
+	if n_elements(DepRange) eq 0 then DepRange=[0,5000]
+    
+  read_enact, Files, DepRange=DepRange, NumData=NumData, $
+                OutLats=Latitudes, OutLons=Longitudes, $
+                Instruments=Instruments, Platform=Platform, $
+                OutDeps=Depths, OutSObs=OutSObs, OutSQC=OutSQC, $
+                OutTObs=OutTObs, OutTQC=OutTQC, OutDates=Dates, $
+                OutTMod=OutTMod, OutSMod=OutSMod, rmdi=rmdi, quiet=quiet, $
+                iobs=iobs, jobs=jobs, kobs=kobs, $
+                ProfileNum=ProfileNum
+
+	types=Instruments+' '+Platform
+
+; if salinity keyword is set then put salinity values first  
+    if keyword_set(Salinity) then begin		
+      Observations = OutSObs
+      ModelVals    = OutSMod    
+      QCs          = OutSQC
+      Observations2 = OutTObs
+      ModelVals2    = OutTMod
+      QCs2          = OutTQC
+    endif else begin
+      Observations = OutTObs
+      ModelVals    = OutTMod
+      QCs          = OutTQC
+      Observations2 = OutSObs
+      ModelVals2    = OutSMod
+      QCs2          = OutSQC
+    endelse 
+
+	numobs=numdata
+        numobs=n_elements(latitudes)
+	              
+  endif else if ObsType eq 'SSH' then begin
+    
+    read_sla, Files, NumObs=NumObs, $
+              Latitudes=Latitudes, Longitudes=Longitudes, $
+              ObsSLA=Observations, ModSLA=ModelVals, SLAQC=QCs, $
+              MDT=MDT, Satellites=Satellites, types=types, Dates=Dates, rmdi=rmdi, $
+	      iobs=iobs, jobs=jobs, mstp=mstp, quiet=quiet
+    Depths = fltarr(NumObs)
+    
+  endif else if ObsType eq 'SST' then begin
+     
+    read_sst, Files, NumObs=NumObs, $
+              Latitudes=Latitudes, Longitudes=Longitudes, $
+              ObsSST=Observations, ModSST=ModelVals, SSTQC=QCs, $
+              Dates=Dates, rmdi=rmdi, types=types, iobs=iobs, jobs=jobs, $
+              quiet=quiet
+    Depths = fltarr(NumObs)
+
+  endif else if ObsType eq 'SEAICE' then begin
+  
+    read_seaice, Files, NumObs=NumObs, $
+              Latitudes=Latitudes, Longitudes=Longitudes, $
+              Obs=Observations, Modarr=ModelVals, QC=QCs, $
+              Dates=Dates, rmdi=rmdi, iobs=iobs, jobs=jobs, nodates=nodates, $
+              quiet=quiet
+    Depths = fltarr(NumObs)
+  
+  endif else if ObsType eq 'LOGCHL' then begin
+      
+    read_chl, Files, NumObs=NumObs, $
+              Latitudes=Latitudes, Longitudes=Longitudes, $
+              Obs=Observations, Modarr=ModelVals, QC=QCs, $
+              Dates=Dates, rmdi=rmdi, iobs=iobs, jobs=jobs, nodates=nodates, $
+              quiet=quiet
+    Depths = fltarr(NumObs)
+             
+   endif else if ObsType eq 'PCO2' then begin
+      
+    read_pco2, Files, NumObs=NumObs, $
+              Latitudes=Latitudes, Longitudes=Longitudes, $
+              Obs=Observations, Modarr=ModelVals, QC=QCs, $
+              Dates=Dates, rmdi=rmdi, iobs=iobs, jobs=jobs, nodates=nodates, $
+              quiet=quiet
+    Depths = fltarr(NumObs)
+
+   endif else if ObsType eq 'CRT' then begin
+
+    read_crt, Files, NumObs=NumObs, $
+              OutLats=Latitudes, OutLons=Longitudes, $
+              OutTypes=Types, OutDates=Dates, $
+              OutUObs=Observations, OutVObs=Observations2, $
+              OutUMod=ModelVals, OutVMod=ModelVals2, Quiet=Quiet, $
+              FloatNum=FloatNum, QC=QCs, OutSpeed=Observations3
+    rmdi=0.0
+    QCs2=QCs
+    Depths = fltarr(NumObs)
+
+   endif else if ObsType eq 'ForecastClass4' then begin
+   
+    print, 'reading forecast class 4 files'
+    read_forc_class4, Files, NumObs=NumObs, $
+              Latitudes=Latitudes, Longitudes=Longitudes, $
+              Depths=Depths, $
+              Types=types, Dates=Dates, $
+              Obsarr=Observations, Obs2arr=Observations2, $
+              Modarr=ModelVals, Mod2arr=ModelVals2, $
+              QCs1=QCs, QCs2=QCs2, rmdi=rmdi, $
+              notfussy=notfussy
+                  
+  endif else message, 'Error: ObsType is not set correctly'                 
+
+  if (n_elements(types) eq 0) then begin
+  	  types=replicate(rmdi,NumObs)
+  endif
+
+  goto, NOERROR
+  
+IOERROR: error=1
+	 print,'read_cdfobs: an error occurred trying read files: ',files
+
+NOERROR:
+	
+END
Index: /utils/tools_ticket2413/OBSTOOLS/dataplot/read_enact.pro
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/dataplot/read_enact.pro	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/dataplot/read_enact.pro	(revision 12863)
@@ -0,0 +1,313 @@
+PRO read_enact, Files, DepRange=DepRange, $
+                NumData=NumData, $
+                OutLats=OutLats, OutLons=OutLons, Instruments=OutInst, $
+		Platform=OutPlatform, $
+                OutDeps=OutDeps, OutSObs=OutSObs, OutSQC=OutSQC, $
+                OutTObs=OutTObs, OutTQC=OutTQC, OutDates=OutDates, $
+                OutTMod=OutTMod, OutSMod=OutSMod, rmdi=rmdi, quiet=quiet, $
+                iobs=outiobs, jobs=outjobs, kobs=outkobs, $
+                ProfileNum=OutProfileNum
+
+;------------------------------------------------------------------------------------------
+;Program to read in data from an ENACT format file containing profile data.
+;
+; Inputs:
+;        File        => File name to be read in
+;        DepRange    => (optional) Range of depths for which the data is to be extracted.
+;
+; Outputs:
+;        NumProfs    => Number of profiles  -Integer
+;        Latitudes   => Latitudes(NumProfs) -Real
+;        Longitudes  => Longitudes(NumProfs) -Real
+;        Dates       => Dates(NumProfs)  -Date/time structure.
+;        Instruments => Instrument type (NumProfs) -String
+;        Depths      => Depths of each ob (NumProfs)  -Real
+;        Salinity    => Salinity (psu) (NumProfs)  -Real
+;        SalQC       => QC flag for salinity (NumProfs) 1=> Good  -Int
+;        Temperature => Temperature (deg C) (NumProfs)  -Real
+;        TempQC      => QC flag for temperature (NumProfs) 1=> Good  -Int
+;        ModelT      => Model temperature (deg C) (NumProfs)  -Real
+;        ModelS      => Model salinity (psu) (NumProfs)  -Real
+;        rmdi        => Missing data indicator  -Real
+;
+;Author: Matt Martin. 5/10/07.
+;------------------------------------------------------------------------------------------
+rmdi = 99999.
+if NOT keyword_set(DepRange) then DepRange=[0.,1.e1]   ;Default to top 10 metres.
+NumFiles=n_elements(Files)
+
+ifile2=0
+for ifile = 0, NumFiles-1 do begin
+  File = Files(ifile)
+  
+;1. Open the netcdf file
+  ncid = ncdf_open(File, /nowrite)
+  if ncid lt 0 and not keyword_set(quiet) then print, 'Error opening file '+File
+  if ncid ge 0 then begin
+  if not keyword_set(quiet) then print, 'Opened file '+File+' successfully'
+  
+  ;2. Get info about file
+  ncinfo = ncdf_inquire(ncid)
+;  if not keyword_set(quiet) then , ncinfo
+  ;3. Read in the relevant dimensions
+  for idim = 0, ncinfo.ndims-1 do begin
+    ncdf_diminq, ncid, idim, name, dimlen
+    if name eq 'N_PROF' then NumProfs = dimlen $
+    else if name eq 'N_LEVELS' then NumLevels = dimlen $
+    else if name eq 'STRING4' then str4 = dimlen
+  endfor
+ 
+  ;4. Set up arrays and read in the data
+
+  if (NumProfs gt 0) then begin  
+  JulDays = fltarr(NumProfs)
+  Latitudes = fltarr(NumProfs)
+  Longitudes = fltarr(NumProfs)
+  BytInsts = intarr(4, NumProfs)
+  Instruments = strarr(NumProfs)
+  Platforms = strarr(NumProfs)
+  Instrumentsa = strarr(NumLevels, NumProfs)
+  Platformsa = strarr(NumLevels, NumProfs)
+  Depths = fltarr(NumLevels, NumProfs)
+  Salinity = fltarr(NumLevels, NumProfs)
+  SalQC = intarr(NumLevels, NumProfs)
+  Temperature = fltarr(NumLevels, NumProfs)
+  TempQC = intarr(NumLevels, NumProfs)
+  ModelT = fltarr(NumLevels, NumProfs)
+  ModelS = fltarr(NumLevels, NumProfs)
+  ProfileNum = replicate(1,NumLevels)#indgen(NumProfs)
+    
+  varid = ncdf_varid(ncid, 'JULD')
+  ncdf_varget, ncid, varid, JulDays
+  
+;  print,JulDays
+  
+;  BaseDate = var_to_dt(1950,1,1)
+;  BaseDate=JULDAY(1,1,1950,0,0)
+  BaseDate=double(JULDAY(1,1,1950,0,0))		;should be at 0 UTC
+;  info,BaseDate
+  Dates = replicate(BaseDate, NumLevels,NumProfs)
+;  info,dates
+  for iprof = 0L, NumProfs-1 do begin
+    secs = JulDays(iprof)* 24. * 60. * 60.
+;    dt = dt_add(BaseDate, second=secs)
+    dt=BaseDate+JulDays(iprof)
+;    CALDAT, dt, mon, day, year, hour, minute, second
+;    print,dt-BaseDate, mon, day, year, hour, minute, second
+    Dates(0:NumLevels-1,iprof) = replicate(dt,NumLevels)
+  endfor
+
+  
+ 
+  varid = ncdf_varid(ncid, 'LONGITUDE')
+  ncdf_varget, ncid, varid, Longitudes
+
+  varid = ncdf_varid(ncid, 'LATITUDE')
+  ncdf_varget, ncid, varid, Latitudes
+
+  varid = ncdf_varid(ncid, 'DEPH_CORRECTED')
+  ncdf_varget, ncid, varid, Depths
+  res = ncdf_attinq( ncid, varid , '_FillValue')
+  if res.length gt 0 and res.datatype ne "UNKNOWN" then ncdf_attget, ncid, varid, '_FillValue', FillVal $
+  else begin
+    res = ncdf_attinq( ncid, varid , '_fillvalue')
+    ncdf_attget, ncid, varid, '_fillvalue', FillVal
+  endelse
+  pts = where(Depths eq FillVal, count)
+  if count gt 0 then Depths(pts) = rmdi
+
+;  if keyword_set(Salinity) then begin
+    varid = ncdf_varid(ncid, 'PSAL_CORRECTED')
+    if (varid ne -1) then  begin
+;    if not keyword_set(quiet) then print,'reading psal_corrected'
+    ncdf_varget, ncid, varid, Salinity
+    res = ncdf_attinq( ncid, varid , '_FillValue')
+    if res.length gt 0 and res.datatype ne "UNKNOWN" then ncdf_attget, ncid, varid, '_FillValue', FillVal $
+    else begin
+      res = ncdf_attinq( ncid, varid , '_fillvalue')
+      ncdf_attget, ncid, varid, '_fillvalue', FillVal
+    endelse
+    pts = where(Salinity eq FillVal, count)
+    if count gt 0 then Salinity(pts) = rmdi
+   endif      
+    varid = ncdf_varid(ncid, 'PSAL_CORRECTED_QC')
+    ncdf_varget, ncid, varid, SalQC
+    res = ncdf_attinq( ncid, varid , '_FillValue')
+    if res.length gt 0 and res.datatype ne "UNKNOWN" then ncdf_attget, ncid, varid, '_FillValue', FillVal $
+    else begin
+      res = ncdf_attinq( ncid, varid , '_fillvalue')
+      ncdf_attget, ncid, varid, '_fillvalue', FillVal
+    endelse
+    SalQC = SalQC - 48
+;  endif
+
+;  if keyword_set(Temperature) then begin
+    varid = ncdf_varid(ncid, 'POTM_CORRECTED')
+    if (varid ne -1) then  begin
+;    if not keyword_set(quiet) then print,'reading potm_corrected'
+    ncdf_varget, ncid, varid, Temperature
+    res = ncdf_attinq( ncid, varid , '_FillValue')
+    if res.length gt 0 and res.datatype ne "UNKNOWN" then ncdf_attget, ncid, varid, '_FillValue', FillVal $
+    else begin
+      res = ncdf_attinq( ncid, varid , '_fillvalue')
+      ncdf_attget, ncid, varid, '_fillvalue', FillVal
+    endelse
+;    if not keyword_set(quiet) then print,'Temp fill value ',fillval
+    pts = where(Temperature eq FillVal, count)
+    if count gt 0 then Temperature(pts) = rmdi
+   endif   
+    varid = ncdf_varid(ncid, 'POTM_CORRECTED_QC')
+    ncdf_varget, ncid, varid, TempQC
+    TempQC = TempQC - 48
+;   endif
+
+;  if keyword_set(OutTMod) then begin
+    varid = ncdf_varid(ncid, 'POTM_Hx')
+    if (varid ne -1) then begin
+    ncdf_varget, ncid, varid, ModelT
+    res = ncdf_attinq( ncid, varid , '_FillValue')
+    if res.length gt 0 and res.datatype ne "UNKNOWN" then ncdf_attget, ncid, varid, '_FillValue', FillVal $
+    else begin
+      res = ncdf_attinq( ncid, varid , '_fillvalue')
+      ncdf_attget, ncid, varid, '_fillvalue', FillVal
+    endelse
+    pts = where(ModelT eq FillVal, count)
+    if count gt 0 then ModelT(pts) = rmdi
+    endif else begin
+	ModelT=rmdi
+    endelse
+;   endif
+
+;  if keyword_set(OutSMod) then begin
+    varid = ncdf_varid(ncid, 'PSAL_Hx')
+    if (varid ne -1) then begin
+    ncdf_varget, ncid, varid, ModelS
+    res = ncdf_attinq( ncid, varid , '_FillValue')
+    if res.length gt 0 and res.datatype ne "UNKNOWN" then ncdf_attget, ncid, varid, '_FillValue', FillVal $
+    else begin
+      res = ncdf_attinq( ncid, varid , '_fillvalue')
+      ncdf_attget, ncid, varid, '_fillvalue', FillVal
+    endelse
+    pts = where(ModelS eq FillVal, count)
+    if count gt 0 then ModelS(pts) = rmdi
+    endif else begin
+	ModelS=rmdi
+    endelse
+;  endif
+
+  varid = ncdf_varid(ncid, 'WMO_INST_TYPE')
+  ncdf_varget, ncid, varid, BytInsts
+  
+  pts = where(BytInsts(0,*) eq 32 and $
+              BytInsts(1,*) eq 56 and $
+              BytInsts(2,*) eq 50 and $
+              BytInsts(3,*) eq 48, count)
+  if count gt 0 then Instruments(pts) = 'BUOYS'  ; 820
+  
+  pts = where(BytInsts(0,*) eq 32 and $
+              BytInsts(1,*) eq 52 and $
+              BytInsts(2,*) eq 48 and $
+              BytInsts(3,*) eq 49, count)
+  if count gt 0 then Instruments(pts) = 'XBT'    ; 401
+  
+  pts = where(BytInsts(0,*) eq 32 and $
+              BytInsts(1,*) eq 55 and $
+              BytInsts(2,*) eq 52 and $
+              BytInsts(3,*) eq 49, count)
+  if count gt 0 then Instruments(pts) = 'TESAC'  ; 741
+  
+  pts = where(BytInsts(0,*) eq 32 and $
+              BytInsts(1,*) eq 56 and $
+              BytInsts(2,*) eq 51 and $
+              BytInsts(3,*) eq 49, count)
+  if count gt 0 then Instruments(pts) = 'ARGO'   ; 831
+  
+  pts = where(Instruments eq '', count) 
+  if count gt 0 then Instruments(pts) = 'UNKNOWN'
+  
+  varid = ncdf_varid(ncid, 'PLATFORM_NUMBER')
+  ncdf_varget, ncid, varid, platforms
+  platforms=string(platforms)
+  
+  for i=0,numlevels-1 do begin
+    platformsa(i,*)=platforms
+    instrumentsa(i,*)=instruments
+  endfor
+
+  varid = ncdf_varid(ncid, 'IOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, iobsval
+
+  varid = ncdf_varid(ncid, 'JOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, jobsval
+
+  varid = ncdf_varid(ncid, 'KOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, kobsval
+    
+  ;Select those obs in the required depth range
+;  Lats = replv(Latitudes(*), [NumLevels,NumProfs],1)
+;  Lons = replv(Longitudes(*), [NumLevels,NumProfs],1)
+
+	Lons=fltarr(NumLevels,NumProfs)
+        Lats=fltarr(NumLevels,NumProfs)
+	iobs=fltarr(NumLevels,NumProfs)
+        jobs=fltarr(NumLevels,NumProfs)
+        
+	for i=0L,NumProfs-1 do begin
+          Lats(*,i)=Latitudes(i)
+          Lons(*,i)=Longitudes(i)
+          if (n_elements(iobsval) gt 0) then $
+	          iobs(*,i)=iobsval(i)
+          if (n_elements(jobsval) gt 0) then $
+          	  jobs(*,i)=jobsval(i)
+        endfor  
+  
+  pts = where(Depths ge DepRange(0) and Depths le DepRange(1), NumData)
+  
+  if ifile2 eq 0 then begin  
+    OutTObs = [Temperature(pts)]
+    OutSObs = [Salinity(pts)]
+    OutTMod = [ModelT(pts)]
+    OutSMod = [ModelS(pts)]
+    OutTQC  = [TempQC(pts)]
+    OutSQC  = [SalQC(pts)]
+    OutDeps = [Depths(pts)]
+    OutLats = [Lats(pts)]
+    OutLons = [Lons(pts)]
+    OutDates= [Dates(pts)]
+    OutInst= [Instrumentsa(pts)]    
+    OutPlatform= [Platformsa(pts)]
+    OutProfileNum = [ProfileNum(pts)]
+    if (n_elements(iobsval) gt 0) then outiobs = [iobs(pts)]
+    if (n_elements(jobsval) gt 0) then outjobs = [jobs(pts)]
+    if (n_elements(kobsval) gt 0) then outkobs = [kobsval(pts)]
+    
+  endif else begin
+    OutTObs = [OutTObs,Temperature(pts)]
+    OutSObs = [OutSObs,Salinity(pts)]
+    OutTMod = [OutTMod,ModelT(pts)]
+    OutSMod = [OutSMod,ModelS(pts)]
+    OutTQC  = [OutTQC,TempQC(pts)]
+    OutSQC  = [OutSQC,SalQC(pts)]
+    OutDeps = [OutDeps,Depths(pts)]
+    OutLats = [OutLats,Lats(pts)]
+    OutLons = [OutLons,Lons(pts)]
+    OutDates= [OutDates,Dates(pts)]
+    OutInst= [OutInst,Instrumentsa(pts)]
+    OutPlatform = [OutPlatform, Platformsa(pts)]
+    OutProfileNum = [OutProfileNum, ProfileNum(pts)]
+    if (n_elements(iobsval) gt 0) then outiobs = [outiobs, iobs(pts)]
+    if (n_elements(jobsval) gt 0) then outjobs = [outjobs, jobs(pts)]
+    if (n_elements(kobsval) gt 0) then outkobs = [outkobs, kobsval(pts)]
+
+  endelse
+
+	ifile2=ifile2+1
+   endif
+  ncdf_close, ncid
+
+
+	endif
+  
+endfor ;ifile
+
+END
Index: /utils/tools_ticket2413/OBSTOOLS/dataplot/read_feedback.pro
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/dataplot/read_feedback.pro	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/dataplot/read_feedback.pro	(revision 12863)
@@ -0,0 +1,283 @@
+PRO read_feedback, Files, DepRange=DepRange, VarName=VarNames, NumData=NumData, $
+                OutLats=OutLats, OutLons=OutLons, $
+                OutInstruments=OutInst, OutPlatform=OutPlatform, $
+                OutDeps=OutDeps,  $
+                OutObs1=OutObs1, OutObs2=OutObs2, $
+                OutMod1=OutMod1, OutMod2=OutMod2, $
+                OutQC1=OutQC1, OutQC2=OutQC2, $
+                MDT=MDT, OutDates=OutDates, $
+                rmdi=rmdi, quiet=quiet, $
+                OutProfileNum=OutProfileNum
+
+;------------------------------------------------------------------------------------------
+;Program to read in data from a feedback format file
+;
+; Inputs:
+;        File        => File name to be read in
+;        DepRange    => (optional) Range of depths for which the data is to be extracted.
+;
+; Outputs:
+
+;
+;Author: Matt Martin. 29/09/09
+;------------------------------------------------------------------------------------------
+rmdi = 99999.
+if NOT keyword_set(DepRange) then DepRange=[0.,1.e1]   ;Default to top 10 metres.
+NumFiles=n_elements(Files)
+
+ifile2=0
+numdata=0
+for ifile = 0, NumFiles-1 do begin
+  File = Files(ifile)
+  
+;1. Open the netcdf file
+  ncid = ncdf_open(File, /nowrite)
+  if ncid lt 0 and not keyword_set(quiet) then print, 'Error opening file '+File
+  if ncid ge 0 then begin
+  if not keyword_set(quiet) then print, 'Opened file '+File+' successfully'
+  
+  ;2. Get info about file
+  ncinfo = ncdf_inquire(ncid)
+
+  ;3. Read in the relevant dimensions
+  NumExtra = 0
+  for idim = 0, ncinfo.ndims-1 do begin
+    ncdf_diminq, ncid, idim, name, dimlen
+    if name eq 'N_OBS' then NumObs = dimlen $
+    else if name eq 'N_LEVELS' then NumLevels = dimlen $
+    else if name eq 'N_VARS' then NumVars = dimlen $
+    else if name eq 'N_QCF' then NumFlags = dimlen $
+    else if name eq 'N_ENTRIES' then NumEntries = dimlen $
+    else if name eq 'N_EXTRA' then NumExtra = dimlen $
+    else if name eq 'STRINGNAM' then strnam = dimlen $
+    else if name eq 'STRINGGRID' then strgrid = dimlen $
+    else if name eq 'STRINGWMO' then strwmo = dimlen $
+    else if name eq 'STRINGTYP' then strtyp = dimlen $
+    else if name eq 'STRINGJULD' then strjuld = dimlen
+  endfor
+ 
+  ;4. Set up arrays 
+
+  if (NumObs gt 0) then begin  
+    ByteNam = intarr(strnam, NumVars)
+    if (n_elements(NumEntries) eq 1) then ByteEntries = intarr(strnam, NumEntries)
+    ByteId = intarr(strwmo, NumObs)
+    ByteType = intarr(strtyp, NumObs)
+    ByteJulDRef = intarr(strjuld)
+    VarNames = strarr(NumVars)
+    if (n_elements(NumEntries) eq 1) then Entries = strarr(NumEntries)
+    Id = strarr(NumObs)
+    Type = strarr(NumObs)
+    if NumExtra gt 0 then begin
+      ByteExtra = intarr(strnam, NumExtra)    
+      Extra = strarr(NumExtra)    
+    endif 
+    Longitude = fltarr(NumObs)
+    Latitude  = fltarr(NumObs)
+    Depth     = fltarr(NumLevels, NumObs)
+    DepQC     = intarr(NumLevels, NumObs)
+    JulD      = dblarr(NumObs)
+    ObsQC     = intarr(NumObs)
+    PosQC     = intarr(NumObs)
+    JulDQC    = intarr(NumObs)
+    Obs       = fltarr(NumLevels, NumObs, NumVars)
+    Hx        = fltarr(NumLevels, NumObs, NumVars)
+    VarQC     = intarr(NumObs, NumVars)
+    LevelQC   = intarr(NumLevels, NumObs, NumVars)
+    
+  ;5. Read in the data  
+    varid = ncdf_varid(ncid, 'VARIABLES')
+    ncdf_varget, ncid, varid, ByteNam
+;    info, VarNames
+;    info, ByteNam
+    for ivar= 0, NumVars-1 do begin
+      VarNames(ivar) = string(ByteNam(*,ivar))
+    endfor
+    
+    if ifile2 eq 0 then VarName = VarNames(0)
+    if VarName ne VarNames(0) then message, 'Can only read in from files containing the same variables'
+    
+    varid = ncdf_varid(ncid, 'JULD_REFERENCE')
+    ncdf_varget, ncid, varid, ByteJulDRef
+    JulDRef = string(ByteJulDRef)
+    RefDate = JULDAY(fix(strmid(JulDRef,4,2)), fix(strmid(JulDRef,6,2)), fix(strmid(JulDRef,0,4)), $
+                     fix(strmid(JulDRef,8,2)), fix(strmid(JulDRef,10,2)), fix(strmid(JulDRef,12,2)))
+	print, 'RefDate: ',RefDate
+    varid = ncdf_varid(ncid, 'JULD')
+    ncdf_varget, ncid, varid, JulD
+;    print, JulD
+    Dates = dblarr(NumLevels, NumObs)
+    for iob = 0L, long(NumObs)-1L do begin
+      dt = RefDate + JulD(iob)
+;      print,dt, JulD(iob)
+      Dates(0:NumLevels-1, iob) = replicate(dt, NumLevels)
+    endfor
+    
+    varid = ncdf_varid(ncid, 'STATION_IDENTIFIER')
+    ncdf_varget, ncid, varid, ByteId
+    Identifier = string(ByteId)
+    
+    varid = ncdf_varid(ncid, 'STATION_TYPE')
+    ncdf_varget, ncid, varid, ByteType
+    Type = string(ByteType)
+   
+    varid = ncdf_varid(ncid, 'LONGITUDE')
+    ncdf_varget, ncid, varid, Longitude
+  
+    varid = ncdf_varid(ncid, 'LATITUDE')
+    ncdf_varget, ncid, varid, Latitude
+  
+    varid = ncdf_varid(ncid, 'DEPTH')
+    ncdf_varget, ncid, varid, Depth
+    ncdf_attget, ncid, varid, '_Fillvalue', FillVal
+    pts = where(Depth eq FillVal, count)
+    if count gt 0 then Depth(pts) = rmdi
+    
+    varid = ncdf_varid(ncid, 'OBSERVATION_QC')
+    ncdf_varget, ncid, varid, ObsQC
+    ncdf_attget, ncid, varid, '_Fillvalue', FillVal
+    pts = where(ObsQC eq FillVal, count)
+    if count gt 0 then ObsQC(pts) = rmdi      
+    
+    for ivar = 0, NumVars-1 do begin
+    
+      varid = ncdf_varid(ncid, strtrim(VarNames(ivar))+'_OBS')
+      ncdf_varget, ncid, varid, tmp
+      Obs(*,*,ivar) = tmp
+      ncdf_attget, ncid, varid, '_Fillvalue', FillValObs
+  
+      varid = ncdf_varid(ncid, strtrim(VarNames(ivar))+'_Hx')
+      if (varid gt -1) then begin
+         ncdf_varget, ncid, varid, tmp
+         Hx(*,*,ivar) = tmp
+         ncdf_attget, ncid, varid, '_Fillvalue', FillValHx
+      endif else begin
+         FillValHx=0
+      endelse 
+      
+      varid = ncdf_varid(ncid, strtrim(VarNames(ivar))+'_QC')
+      ncdf_varget, ncid, varid, tmp
+      VarQC(*,ivar) = tmp
+      ncdf_attget, ncid, varid, '_Fillvalue', FillValQC
+      
+      
+      varid = ncdf_varid(ncid, strtrim(VarNames(ivar))+'_LEVEL_QC')
+      ncdf_varget, ncid, varid, tmp
+      LevelQC(*,*,ivar) = tmp
+      ncdf_attget, ncid, varid, '_Fillvalue', FillValLevQC
+          
+    endfor        
+ 
+; 	print,' DJL levelqc(*,218,0) ',levelqc(*,218,0)
+; 	print,' DJL levelqc(*,218,1) ',levelqc(*,218,1)
+    
+    pts = where(Obs eq FillValObs, count)
+    if count gt 0 then Obs(pts) = rmdi
+    pts = where(Hx eq FillValHx, count)
+    if count gt 0 then Hx(pts) = rmdi   
+    pts = where(VarQC eq FillValQC, count)
+    if count gt 0 then VarQC(pts) = rmdi  
+    pts = where(LevelQC eq FillValLevQC, count)
+    if count gt 0 then LevelQC(pts) = rmdi        
+
+    Obs1 = Obs(*,*,0)
+    Hx1  = Hx(*,*,0)
+    VarQC1=LevelQC(*,*,0)    
+    if NumVars gt 1 then begin
+      Obs2 = Obs(*,*,1)
+      Hx2  = Hx(*,*,1)
+      VarQC2=LevelQC(*,*,1)    
+    endif
+    
+    if strtrim(VarName,2) eq 'SLA' then begin
+      MDT = fltarr(NumLevels, NumObs)
+      print, NumLevels, NumObs
+      varid = ncdf_varid(ncid, 'MDT')
+      ncdf_varget, ncid, varid, MDT
+      ncdf_attget, ncid, varid, '_Fillvalue', FillVal
+      pts = where(MDT eq FillVal, count)
+      if count gt 0 then MDT(pts) = rmdi   
+      Obs2 = MDT
+    endif
+          
+    ;6. Put the data into the correct form to be output from this routine
+    Platformsa = strarr(NumLevels, NumObs)
+    Instrumentsa = strarr(NumLevels, NumObs)
+    Lons = fltarr(NumLevels,NumObs)
+    Lats = fltarr(NumLevels,NumObs)
+    ProfileNum = lonarr(NumLevels,NumObs)
+        
+    for i=0,NumLevels-1 do begin
+      Platformsa(i,*)=Type
+      Instrumentsa(i,*)=Identifier
+    endfor
+      
+    for i=0L,long(NumObs)-1L do begin
+      Lats(*,i)=Latitude(i)
+      Lons(*,i)=Longitude(i)
+      ProfileNum(*,i) = i+1
+    endfor  
+;   
+   pts = where(Depth ge DepRange(0) and Depth le DepRange(1), NumDataInc)
+   NumData=NumData+NumDataInc
+;   
+   if ifile2 eq 0 then begin  
+     OutObs1 = [Obs1(pts)]
+     OutMod1 = [Hx1(pts)]
+     OutQC1  = [VarQC1(pts)]
+     OutDeps = [Depth(pts)]
+     OutLats = [Lats(pts)]
+     OutLons = [Lons(pts)]
+     OutDates= [Dates(pts)]
+     OutInst= [Instrumentsa(pts)]    
+     OutPlatform= [Platformsa(pts)]
+     OutProfileNum = [ProfileNum(pts)]
+     if NumVars eq 2 then begin
+       OutObs2 = [Obs2(pts)]     
+       OutMod2 = [Hx2(pts)]     
+       OutQC2  = [VarQC2(pts)]
+     endif
+   endif else begin
+     OutObs1 = [OutObs1, Obs1(pts)]
+     OutMod1 = [OutMod1, Hx1(pts)]
+     OutQC1  = [OutQC1, VarQC1(pts)]
+     OutDeps = [OutDeps, Depth(pts)]
+     OutLats = [OutLats, Lats(pts)]
+     OutLons = [OutLons, Lons(pts)]
+     OutDates= [OutDates, Dates(pts)]
+     OutInst= [OutInst, Instrumentsa(pts)]    
+     OutPlatform= [OutPlatform, Platformsa(pts)]
+     OutProfileNum = [OutProfileNum, ProfileNum(pts)]
+     if NumVars eq 2 then begin
+       OutObs2 = [OutObs2, Obs2(pts)]     
+       OutMod2 = [OutMod2, Hx2(pts)]     
+       OutQC2  = [OutQC2, VarQC2(pts)]
+     endif
+   endelse
+   
+   if NumVars eq 1 then begin
+     if VarName ne 'SLA' then OutObs2 = fltarr(n_elements(OutObs1)) + rmdi
+     OutMod2 = fltarr(n_elements(OutMod1)) + rmdi
+     OutQC2  = fltarr(n_elements(OutQC1)) + rmdi
+   endif
+; 
+   ifile2=ifile2+1
+   endif
+  ncdf_close, ncid
+  
+  endif
+  
+endfor ;ifile
+
+pts1 = where(OutQC1 eq 1, count1)
+pts2 = where(OutQC1 ne 1, count2)
+if count1 gt 0 then OutQc1(pts1) = 0
+if count2 gt 0 then OutQc1(pts2) = 1
+if NumVars gt 1 then begin
+  pts1 = where(OutQC2 eq 1, count1)
+  pts2 = where(OutQC2 ne 1, count2)
+  if count1 gt 0 then OutQc2(pts1) = 0
+  if count2 gt 0 then OutQc2(pts2) = 1
+endif
+
+END
Index: /utils/tools_ticket2413/OBSTOOLS/dataplot/read_seaice.pro
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/dataplot/read_seaice.pro	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/dataplot/read_seaice.pro	(revision 12863)
@@ -0,0 +1,178 @@
+PRO  read_seaice, Files, NumObs=NumObs, $
+               Latitudes=Latitudes, Longitudes=Longitudes, $
+               Obs=Obs, modarr=modarr, qc=qcarr, $
+               Dates=Dates, rmdi=rmdi, iobs=outiobs, jobs=outjobs, $
+               nodates=nodates, quiet=quiet
+;------------------------------------------------------------
+;IDL program to read in netcdf files of sea ice data.
+;
+;Author:   D. J. Lea       Feb 2008
+;
+;------------------------------------------------------------
+rmdi = -99999.
+NumFiles=n_elements(Files)
+;RefDate = '1950-01-01'
+;!DATE_SEPARATOR='-'
+RefDate=JULDAY(1,1,1950,0,0)		; should be at 0 UTC
+
+; could read in from file
+
+ifile2=0
+for ifile = 0, NumFiles-1 do begin
+;------------------------------------------------------------
+;1. Open the file containing the data
+  ncid = ncdf_open(Files(ifile), /nowrite)
+  if ncid lt 0 and not keyword_set(quiet) then print, 'Error opening file '+Files(ifile)
+  if ncid ge 0 then begin
+  if not keyword_set(quiet) then print, 'Opened file '+Files(ifile)+' successfully'
+
+;------------------------------------------------------------
+;2. Read in the dimensions in the file
+  ncinfo = ncdf_inquire(ncid)
+  ncdf_diminq, ncid, 0, name, NData
+  if Ndata gt 0 then begin
+
+;------------------------------------------------------------
+;3. Allocate the data arrays and read in the data
+  lons   = dblarr(NData)
+  lats   = dblarr(NData)
+  obsval = fltarr(NData)
+  modval = fltarr(NData)
+  bytQC  = bytarr(NData)  
+  QC     = fltarr(NData)
+  Dats   = dblarr(NData)
+  dts    = replicate(!dt_base, NData)
+  iobs = intarr(NData)
+  jobs = intarr(NData)
+
+; output attribute and variable info
+;  ncattinfo, id
+  
+  varid = ncdf_varid(ncid, 'lon')
+;  if not keyword_set(quiet) then print,varid
+  if (varid eq -1) then varid = ncdf_varid(ncid, 'LONGITUDE')
+  ncdf_varget, ncid, varid, lons
+  
+  varid = ncdf_varid(ncid, 'lat')
+;  if not keyword_set(quiet) then print,varid
+  if (varid eq -1) then varid = ncdf_varid(ncid, 'LATITUDE')
+  ncdf_varget, ncid, varid, lats
+
+  if (keyword_set(nodates) eq 0) then begin
+
+  varid = ncdf_varid(ncid, 'JULD')
+  if varid ne -1 then begin
+    ncdf_varget, ncid, varid, Dats
+    dts = Dats+RefDate
+  endif else begin
+    varid = ncdf_varid(ncid, 'time')
+    ncdf_varget, ncid, varid, secs_from_base
+    varid = ncdf_varid(ncid, 'SeaIce_dtime')
+    ncdf_varget, ncid, varid, dtime
+    ncdf_attget, ncid, varid, 'scale_factor', scale_factor    
+    if not keyword_set(quiet) then print,'dtime(0): ',dtime(0), scale_factor
+    dtime=dtime*scale_factor
+;    RefDate = '1981-01-01'
+    RefDate = JULDAY(1,1,1981,0,0)	; should be ref from 0 UTC
+    dtime = dtime + secs_from_base
+    dts = RefDate + dtime/86400.
+  endelse
+
+  endif
+
+  if not keyword_set(quiet) then print,'reading sea ice data'   
+  varid = ncdf_varid(ncid, 'sea_ice_concentration')
+    if not keyword_set(quiet) then print,varid
+    if (varid eq -1) then begin
+    	 varid2 = ncdf_varid(ncid, 'SEAICE')
+         if (varid2 ne -1) then ncdf_varget, ncid, varid2, obsval
+    endif
+    if (varid ne -1) then ncdf_varget, ncid, varid, obsval
+    if not keyword_set(quiet) then print,'scale_factor'
+  scale_factor=1.  
+  if (varid ne -1) then ncdf_attget, ncid, varid, 'scale_factor', scale_factor
+
+  if not keyword_set(quiet) then print,'_FillValue'
+  FillValue=99999
+      
+;  ncdf_attget, ncid, varid, '_FillValue', FillValue
+  if not keyword_set(quiet) then print,FillValue  
+
+  pts = where(obsval eq FillValue, count)
+
+  if not keyword_set(quiet) then print,'scale_factor ',scale_factor  
+  obsval=obsval*scale_factor
+  
+  if count gt 0 then obsval(pts) = rmdi
+
+
+  if not keyword_set(quiet) then print,'reading sea ice model values'
+  varid = ncdf_varid(ncid, 'SEAICE_Hx')
+  if (varid ne -1) then ncdf_varget, ncid, varid, modval
+
+  varid = ncdf_varid(ncid, 'IOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, iobs
+  
+  varid = ncdf_varid(ncid, 'JOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, jobs
+  
+
+  scale_factor=1
+  pts = where(modval eq FillValue or modval eq -9999, count)
+  
+  modval=modval*scale_factor
+  
+  if count gt 0 then modval(pts) = rmdi
+
+  	if not keyword_set(quiet) then print,'sea ice qc'
+
+  varid = ncdf_varid(ncid, 'SEAICE_QC')	     
+  if (varid ne -1) then begin
+   if not keyword_set(quiet) then print,'bytQC' 
+   ncdf_varget, ncid, varid, bytQC
+   ncdf_attget, ncid, varid, '_FillValue', FillValue
+   QC(*) = 0.
+   pts = where(bytQC eq FillValue, count)
+   if count gt 0 then QC(pts) = rmdi
+   pts = where(bytQC ne 48, count)
+   if count gt 0 then QC(pts) = 1.  
+  endif else begin
+   varid = ncdf_varid(ncid, 'confidence_flag')
+   ncdf_varget, ncid, varid, QC
+  endelse
+  
+  if ifile2 eq 0 then begin
+    Latitudes = [float(lats)]
+    Longitudes = [float(lons)]
+    Obs = [obsval]
+    Modarr = [modval]
+    QCarr = [QC]
+    Dates = [dts]
+    if (n_elements(iobs) gt 0) then outiobs = [iobs]
+    if (n_elements(jobs) gt 0) then outjobs = [jobs]
+  endif else begin
+    Latitudes = [Latitudes, float(lats)]
+    Longitudes = [Longitudes, float(lons)]
+    Obs = [Obs, obsval]
+    Modarr = [Modarr, modval]    
+    QCarr = [QCarr, QC]
+    Dates = [Dates, dts]
+    if (n_elements(iobs) gt 0) then outiobs = [outiobs, iobs]
+    if (n_elements(jobs) gt 0) then outjobs = [outjobs, jobs]
+  endelse      
+
+ifile2=ifile2+1
+endif
+
+  if not keyword_set(quiet) then print,'closing file'
+
+  ncdf_close, ncid
+
+endif
+endfor ; ifile  
+  
+NumObs = n_elements(Latitudes)
+
+if (n_elements(Modarr) ne NumObs) then Modarr=replicate(rmdi,NumObs)
+
+END
Index: /utils/tools_ticket2413/OBSTOOLS/dataplot/read_sla.pro
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/dataplot/read_sla.pro	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/dataplot/read_sla.pro	(revision 12863)
@@ -0,0 +1,312 @@
+;+
+PRO  read_sla, Files, NumObs=NumObs, $
+               Latitudes=Latitudes, Longitudes=Longitudes, $
+               ObsSLA=ObsSLA, ModSLA=ModSLA, SLAQC=SLAQC, $
+               MDT=MDT, Satellites=Satellites, Types=Types, Dates=Dates, rmdi=rmdi, $
+	       iobs=iobs, jobs=jobs, mstp=mstp, quiet=quiet, track=track
+;+-----------------------------------------------------------
+;IDL program to read in netcdf files of altimeter data.
+;
+;Author:  D. J. Lea       - Feb 2008
+;
+;------------------------------------------------------------
+rmdi = -99999.
+NumFiles=n_elements(Files)
+;RefDate = '1950-01-01'
+;!DATE_SEPARATOR='-'
+RefDate=JULDAY(1,1,1950,0,0)		; should be at 0 UTC
+
+ifile2=0
+for ifile = 0, NumFiles-1 do begin
+;------------------------------------------------------------
+;1. Open the file containing the data
+  ncid = ncdf_open(Files(ifile), /nowrite)
+  if ncid lt 0 and not keyword_set(quiet) then print, 'Error opening file '+Files(ifile)
+  if ncid ge 0 then begin
+  if not keyword_set(quiet) then print, 'Opened file '+Files(ifile)+' successfully'
+
+;------------------------------------------------------------
+;2. Read in the dimensions in the file
+  ncinfo = ncdf_inquire(ncid)
+;  var = ncdf_varinq( ncid, "SLA" )
+  if not keyword_set(quiet) then print,'ncinfo.ndims ',ncinfo.ndims
+  ncdf_diminq, ncid, 0, name, NData
+  NData2=0
+  cycles=1
+  if (ncinfo.ndims gt 2) then ncdf_diminq, ncid, 2, name, NData2
+  if (ncinfo.ndims gt 1) then ncdf_diminq, ncid, 1, name, cycles
+
+
+  if not keyword_set(quiet) then print,NData, NData2
+
+ NData=max([NData*cycles, NData2*cycles])
+
+; print,NData, NData2
+
+  if (NData gt 0) then begin
+;------------------------------------------------------------
+;3. Allocate the data arrays and read in the data
+  lons   = dblarr(NData)
+  lats   = dblarr(NData)
+  obsval = fltarr(NData)
+  modval = fltarr(NData)
+  mdtval = fltarr(NData)  
+  bytQC  = bytarr(NData)
+  QC     = fltarr(NData)
+  Dats   = dblarr(NData)
+  trackval  = intarr(NData)
+  Sats   = intarr(NData)
+  strSats= strarr(NData)
+  StrVal = strarr(8)
+;  dts    = replicate(!dt_base, NData)
+  dts = dblarr(NData)
+  
+;  info,lons 
+  varid = ncdf_varid(ncid, 'LONGITUDE')
+  scale_factor=1.
+  if (varid eq -1) then begin 
+  	varid = ncdf_varid(ncid, 'Longitudes')
+        if (varid eq -1) then begin
+             varid = ncdf_varid(ncid, 'longitude')
+        endif
+        ncdf_attget, ncid, varid, 'scale_factor', scale_factor
+  endif
+  ncdf_varget, ncid, varid, lons 
+  lons=lons*scale_factor
+;  info, lons
+  if (cycles gt 1) then begin
+    lonsn=lons
+    for i=1,cycles-1 do begin
+       lonsn=[lonsn,lons]
+    endfor
+    lons=lonsn
+  endif
+
+;  info, lons
+
+;  info,lats     
+  varid = ncdf_varid(ncid, 'LATITUDE')
+  scale_factor=1.
+  if (varid eq -1) then begin
+  	varid = ncdf_varid(ncid, 'Latitudes')
+        if (varid eq -1) then begin
+             varid = ncdf_varid(ncid, 'latitude')
+        endif
+        ncdf_attget, ncid, varid, 'scale_factor', scale_factor
+  endif
+  ncdf_varget, ncid, varid, lats
+  lats=lats*scale_factor
+;  info, lats
+  if (cycles gt 1) then begin
+    latsn=lats
+    for i=1,cycles-1 do begin
+       latsn=[latsn,lats]
+    endfor
+    lats=latsn
+  endif
+  
+;  info, lats
+    
+  varid = ncdf_varid(ncid, 'JULD')
+  if (varid eq -1) then begin
+        varid = ncdf_varid(ncid, 'time')
+  endif
+  if (varid ne -1) then begin 
+  	ncdf_varget, ncid, varid, Dats
+  endif else begin
+        varid = ncdf_varid(ncid, 'BeginDates')
+        ncdf_varget, ncid, varid, Bds
+;        print,bds
+;        info, bds
+        if (cycles gt 1) then begin
+           bds=transpose(bds)
+        endif
+        varid = ncdf_varid(ncid, 'NbPoints')
+        ncdf_varget, ncid, varid, nbpoints
+
+; Read in dataindexes and deltat in cls format file 
+; These are used to adjust dates 
+        varid = ncdf_varid(ncid, 'DeltaT')
+        if (varid ne -1) then begin 
+  	  ncdf_varget, ncid, varid, deltat
+          ncdf_attget, ncid, varid, 'scale_factor', scale_factor
+          deltat=deltat*scale_factor
+          varid = ncdf_varid(ncid, 'DataIndexes')
+          ncdf_varget, ncid, varid, dataindexes
+          
+        endif
+
+	print, 'deltat ',deltat
+;        print, 'dataindexes ',dataindexes
+
+;        info, nbpoints
+;        print,nbpoints
+;        info, cycles
+        cumbds=[0]
+        nbpointst=nbpoints
+        dataindexest=dataindexes
+        for i=1,cycles-1 do begin
+	 	nbpointst=[nbpointst,nbpoints]
+                dataindexest=[dataindexest,dataindexes]
+        endfor
+        cumbds=[0,total(nbpointst,/cumulative)]
+;       if not keyword_set(quiet) then print,'cumbds ',cumbds
+        nel=n_elements(Bds)
+;        info,nel
+;       if not keyword_set(quiet) then print,n_elements(dats)
+        for i=0,nel-1 do begin
+;        print,'*',i, cumbds(i+1)-cumbds(i) 
+;           print,i,cumbds(i),cumbds(i+1)-1
+           dats(cumbds(i):cumbds(i+1)-1)=bds(i)
+           trackval(cumbds(i):cumbds(i+1)-1)=i
+           dataindexest(cumbds(i):cumbds(i+1)-1)=dataindexest(cumbds(i):cumbds(i+1)-1)-dataindexest(cumbds(i))
+        endfor
+        
+; adjust dats based on dataindex
+	dats=dats+dataindexest*deltat/86400.
+        
+        
+;        print, dats
+  endelse
+
+
+          
+  dts=RefDate + Dats 
+    
+  varid = ncdf_varid(ncid, 'MISSION')
+  if (varid ne -1) then begin
+  ncdf_varget, ncid, varid, Sats
+  ncdf_attget, ncid, varid, 'Value_0', StrVal0           
+  ncdf_attget, ncid, varid, 'Value_1', StrVal1  
+  ncdf_attget, ncid, varid, 'Value_2', StrVal2  
+  ncdf_attget, ncid, varid, 'Value_3', StrVal3      
+  ncdf_attget, ncid, varid, 'Value_4', StrVal4  
+  ncdf_attget, ncid, varid, 'Value_5', StrVal5 
+  ncdf_attget, ncid, varid, 'Value_6', StrVal6    
+  ncdf_attget, ncid, varid, 'Value_7', StrVal7
+  StrVal=[StrVal0, StrVal1, StrVal2, StrVal3, StrVal4, $
+  	StrVal5, StrVal6, StrVal7]    
+  for ival = 0, 7 do begin
+    pts = where(Sats eq ival, count)
+    if count gt 0 then strSats(pts) = StrVal(ival)
+  endfor
+  endif
+
+  varid = ncdf_varid(ncid, 'SLA')
+  ncdf_varget, ncid, varid, obsval
+  ncdf_attget, ncid, varid, '_FillValue', FillValue
+  scale_factor=1.
+  add_offset=0.
+  ;if (ncinfo.ndims gt 2) then ncdf_attget, ncid, varid, 'scale_factor', scale_factor
+  ncviq=ncdf_varinq(ncid, varid)
+  for iatt=0,ncviq.natts-1 do begin
+    ncaiq=ncdf_attname(ncid, varid, iatt)
+    if ( ncaiq eq 'scale_factor') then ncdf_attget, ncid, varid, 'scale_factor', scale_factor
+    if ( ncaiq eq 'add_factor') then ncdf_attget, ncid, varid, 'add_factor', add_factor
+  endfor
+
+  if not keyword_set(quiet) then print,'SLA scale factor: ',scale_factor
+  if not keyword_set(quiet) then print,'SLA add offset: ',add_offset
+  if not keyword_set(quiet) then print,'SLA FillValue: ',FillValue
+  pts = where(obsval eq FillValue, count)
+;  if not keyword_set(quiet) then print,count
+  obsval=obsval*scale_factor+add_offset
+  if count gt 0 then obsval(pts) = rmdi
+  
+  varid = ncdf_varid(ncid, 'SLA_Hx')
+  if (varid ne -1) then begin
+  ncdf_varget, ncid, varid, modval
+  ncdf_attget, ncid, varid, '_FillValue', FillValue
+;  if not keyword_set(quiet) then print,'SLA_Hx FillValue ',FillValue
+  pts = where(modval eq FillValue or modval eq -9999.0, count)
+;  if not keyword_set(quiet) then print,count
+  if count gt 0 then modval(pts) = rmdi
+  endif
+    
+  varid = ncdf_varid(ncid, 'SLA_QC')
+  if (varid ne -1) then begin
+  ncdf_varget, ncid, varid, bytQC
+  ncdf_attget, ncid, varid, '_FillValue', FillValue
+  QC(*) = 0.
+  pts = where(bytQC eq FillValue, count)
+  if count gt 0 then QC(pts) = rmdi
+  pts = where(bytQC ne 48, count)
+  if count gt 0 then QC(pts) = 1.
+  endif
+  
+  varid = ncdf_varid(ncid, 'MDT')
+  if (varid ne -1) then ncdf_varget, ncid, varid, mdtval
+
+  varid = ncdf_varid(ncid, 'data_source')
+  if varid ne -1 then begin
+     ncdf_varget, ncid, varid, obstyp
+  endif else begin
+     varid = ncdf_varid(ncid, 'MISSION')
+     if varid ne -1 then ncdf_varget, ncid, varid, obstyp
+  endelse
+
+; reads in multi cycle data the wrong way round!
+  if (cycles gt 1) then begin
+      obsval=reform(obsval,[cycles,ndata/cycles])
+      obsval=transpose(obsval)
+      modval=reform(modval,[cycles,ndata/cycles])
+      modval=transpose(modval)
+      QC=reform(QC,[cycles,ndata/cycles])
+      QC=transpose(QC)
+  endif
+
+  varid = ncdf_varid(ncid, 'IOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, iobsval
+
+  varid = ncdf_varid(ncid, 'JOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, jobsval
+
+  varid = ncdf_varid(ncid, 'MSTP')
+  if (varid ne -1) then ncdf_varget, ncid, varid, mstpval
+
+;  info, obssla
+;  info, obsval
+;  info, modsla
+;  info, modval
+ 
+  if ifile2 eq 0 then begin
+    Latitudes = [float(lats)]
+    Longitudes = [float(lons)]
+    ObsSLA = [obsval(*)]
+    ModSLA = [modval(*)]
+    MDT = [mdtval]
+    SLAQC = [QC]
+    Dates = [dts]
+    Satellites = [strSats]
+    if (n_elements(obstyp) gt 0) then Types = [obstyp]
+    if (n_elements(iobsval) gt 0) then iobs = [iobsval]
+    if (n_elements(jobsval) gt 0) then jobs = [jobsval]
+   if (n_elements(mstpval) gt 0) then mstp = [mstpval]
+   if (n_elements(trackval) gt 0) then track = [trackval]
+  endif else begin
+    Latitudes = [Latitudes, float(lats)]
+    Longitudes = [Longitudes, float(lons)]
+    ObsSLA = [ObsSLA, obsval(*)]
+    ModSLA = [ModSLA, modval(*)]
+    MDT = [MDT, mdtval]    
+    SLAQC = [SLAQC, QC]
+    Dates = [Dates, dts]    
+    Satellites = [Satellites, strSats]
+    if (n_elements(obstyp) gt 0) then Types = [Types, obstyp]
+    if (n_elements(iobsval) gt 0) then iobs = [iobs, iobsval]
+    if (n_elements(jobsval) gt 0) then jobs = [jobs, jobsval]
+    if (n_elements(mstpval) gt 0) then mstp = [mstp, mstpval]
+    if (n_elements(trackval) gt 0) then tracks = [track, trackval]
+  endelse      
+
+ifile2=ifile2+1
+endif
+  ncdf_close, ncid
+
+endif
+
+endfor ; ifile  
+  
+NumObs = n_elements(Latitudes)
+
+END
Index: /utils/tools_ticket2413/OBSTOOLS/dataplot/read_sst.pro
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/dataplot/read_sst.pro	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/dataplot/read_sst.pro	(revision 12863)
@@ -0,0 +1,193 @@
+PRO  read_sst, Files, NumObs=NumObs, $
+               Latitudes=Latitudes, Longitudes=Longitudes, $
+               ObsSST=ObsSST, ModSST=ModSST, SSTQC=SSTQC, $
+               Dates=Dates, rmdi=rmdi, Types=Types, iobs=iobs, jobs=jobs, $
+               quiet=quiet
+;------------------------------------------------------------
+;IDL program to read in netcdf files of altimeter data.
+;
+;Author:  D. J. Lea        - Feb 2008
+;
+;------------------------------------------------------------
+rmdi = -99999.
+NumFiles=n_elements(Files)
+;print,NumFiles
+;RefDate = '1950-01-01'
+;!DATE_SEPARATOR='-'
+RefDate=JULDAY(1,1,1950,0,0)    ; should be at 0 UTC
+ifile2=0
+for ifile = 0, NumFiles-1 do begin
+;------------------------------------------------------------
+;1. Open the file containing the data
+  ncid = ncdf_open(Files(ifile), /nowrite)
+  if ncid lt 0 and not keyword_set(quiet) then print, 'Error opening file '+Files(ifile)
+  if ncid ge 0 then begin
+  if not keyword_set(quiet) then print, 'Opened file '+Files(ifile)+' successfully'
+
+;------------------------------------------------------------
+;2. Read in the dimensions in the file
+  ncinfo = ncdf_inquire(ncid)
+
+  if ncinfo.Ndims eq 1 then begin
+    ncdf_diminq, ncid, 0, name, NData
+  endif else if ncinfo.Ndims eq 2 then begin
+    ncdf_diminq, ncid, 1, name, NData
+    if (name eq "string8") then  ncdf_diminq, ncid, 0, name, NData
+  endif else if ncinfo.Ndims eq 3 then begin
+    ncdf_diminq, ncid, 1, name, NLats
+    ncdf_diminq, ncid, 2, name, NLons
+    NData = NLats * NLons
+  endif
+    
+  if not keyword_set(quiet) then print, 'Number of SST data points ',NData
+  
+  if (NData gt 0) then begin
+;------------------------------------------------------------
+;3. Allocate the data arrays and read in the data
+  lons   = dblarr(NData)
+  lats   = dblarr(NData)
+  obsval = fltarr(NData)
+  modval = fltarr(NData)
+  bytQC  = bytarr(NData)
+  QC     = fltarr(NData)
+  obstyp = intarr(NData)  
+  Dats   = dblarr(NData)
+  dts    = replicate(!dt_base, NData)
+  iobsa = intarr(NData)
+  jobsa = intarr(NData)
+  
+  varid = ncdf_varid(ncid, 'LONGITUDE')
+  if varid ne -1 then ncdf_varget, ncid, varid, lons $
+  else begin
+    varid = ncdf_varid(ncid, 'lon')
+    ncdf_varget, ncid, varid, lons
+  endelse
+  
+  varid = ncdf_varid(ncid, 'LATITUDE')
+  if varid ne -1 then ncdf_varget, ncid, varid, lats $
+  else begin
+    varid = ncdf_varid(ncid, 'lat')
+    ncdf_varget, ncid, varid, lats
+  endelse
+  
+  varid = ncdf_varid(ncid, 'JULD')
+  if varid ne -1 then begin
+    ncdf_varget, ncid, varid, Dats
+    dts=RefDate + Dats
+    
+  endif else begin
+    varid = ncdf_varid(ncid, 'time')
+    ncdf_varget, ncid, varid, secs_from_base
+    varid = ncdf_varid(ncid, 'sst_dtime')
+    ncdf_varget, ncid, varid, dtime
+    ncdf_attget, ncid, varid, 'scale_factor', scale_factor
+    dtime=dtime*scale_factor
+;    RefDate = '1981-01-01'
+    RefDate = JULDAY(1,1,1981,0,0)	; should be ref from 0 UTC
+    dtime = dtime + secs_from_base
+    dts = RefDate + dtime/86400.
+  endelse
+        
+  varid = ncdf_varid(ncid, 'SST')
+  if varid ne -1 then begin
+    ncdf_varget, ncid, varid, obsval
+    obsval=float(obsval)        ;ensure obsval is a floating point array
+    ncdf_attget, ncid, varid, '_FillValue', FillValue
+    pts = where(obsval eq FillValue, count)
+    if count gt 0 then obsval(pts) = rmdi
+  endif else begin
+    varid = ncdf_varid(ncid, 'sea_surface_temperature')
+    ncdf_varget, ncid, varid, obsval
+    obsval=float(obsval)	;ensure obsval is a floating point array
+    ncdf_attget, ncid, varid, '_FillValue', FillValue
+    ncdf_attget, ncid, varid, 'add_offset', Offset
+    ncdf_attget, ncid, varid, 'scale_factor', Scale
+    pts = where(obsval ne FillValue, count)
+    if count gt 0 then obsval(pts) = Offset + (obsval(pts) *Scale)
+    pts = where(obsval eq FillValue, count)
+    if count gt 0 then obsval(pts) = rmdi
+  endelse
+
+  varid = ncdf_varid(ncid, 'SST_Hx')
+  if varid ne -1 then begin
+    ncdf_varget, ncid, varid, modval
+    ncdf_attget, ncid, varid, '_FillValue', FillValue
+    pts = where(modval eq FillValue, count)
+    if count gt 0 then modval(pts) = rmdi
+  endif
+      
+  varid = ncdf_varid(ncid, 'SST_QC')
+  if varid ne -1 then begin
+    ncdf_varget, ncid, varid, bytQC
+    ncdf_attget, ncid, varid, '_FillValue', FillValue
+    QC(*) = 0.
+    pts = where(bytQC eq FillValue, count)
+    if count gt 0 then QC(pts) = rmdi
+    pts = where(bytQC ne 48, count)
+    if count gt 0 then QC(pts) = bytQC(pts)-48
+  endif else begin
+    varid = ncdf_varid(ncid, 'confidence_flag')
+    ncdf_varget, ncid, varid, bytQC
+    QC = float(bytQC)
+  endelse
+      
+  varid = ncdf_varid(ncid, 'SST_DATA_SOURCE')
+  if varid ne -1 then ncdf_varget, ncid, varid, obstyp $
+  else begin
+    varid = ncdf_varid(ncid, 'data_source')
+    if varid ne -1 then ncdf_varget, ncid, varid, obstyp
+  endelse
+
+  varid = ncdf_varid(ncid, 'callsign')
+  if varid ne -1 then begin 
+  	ncdf_varget, ncid, varid, callsign
+        tmp=strtrim(string(obstyp),2)+' '+strtrim(string(callsign),2)
+        obstyp=tmp
+  endif else begin
+   varid = ncdf_varid(ncid, 'SST_CALL_SIGN')
+   if varid ne -1 then begin 
+      ncdf_varget, ncid, varid, callsign
+        tmp=strtrim(string(obstyp),2)+' '+strtrim(string(callsign),2)
+        obstyp=tmp
+   endif
+  endelse
+
+  varid = ncdf_varid(ncid, 'IOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, iobsa
+  
+  varid = ncdf_varid(ncid, 'JOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, jobsa
+      
+  if ifile2 eq 0 then begin
+    Latitudes = [float(lats)]
+    Longitudes = [float(lons)]
+    ObsSST = [obsval]
+    ModSST = [modval]
+    SSTQC = [QC]
+    Dates = [dts]
+    Types = [obstyp]
+    iobs = [iobsa]
+    jobs = [jobsa]
+  endif else begin
+    Latitudes = [Latitudes, float(lats)]
+    Longitudes = [Longitudes, float(lons)]
+    ObsSST = [ObsSST, obsval]
+    ModSST = [ModSST, modval]
+    SSTQC = [SSTQC, QC]
+    Dates = [Dates, dts]    
+    Types = [Types, obstyp]
+    iobs = [iobs, iobsa]
+    jobs = [jobs, jobsa]       
+  endelse      
+
+  ifile2=ifile2+1
+  endif
+  ncdf_close, ncid
+
+  endif
+
+endfor ; ifile  
+  
+NumObs = n_elements(Latitudes)
+
+END
Index: /utils/tools_ticket2413/OBSTOOLS/python/increments_gen.py
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/python/increments_gen.py	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/python/increments_gen.py	(revision 12863)
@@ -0,0 +1,93 @@
+'''
+Generate a test increments file
+and the SlaReference file
+
+Requires coordinates and depth file
+
+D. J. Lea   Sep 2014
+'''
+
+import netCDF4
+import numpy as np
+
+# example files to get lon and lat
+exdir='/hpc/data/nwp/ofrd/frld/FORCING/ORCA2_LIM_nemo_v3.6'
+exfile1='coordinates.nc'
+
+infile1=exdir+'/'+exfile1
+fileid=netCDF4.Dataset(infile1, mode='r')
+nav_lon=fileid.variables['nav_lon'][:,:]
+nav_lat=fileid.variables['nav_lat'][:,:]
+fileid.close
+
+print np.shape(nav_lon)
+
+exfile2='data_1m_potential_temperature_nomask.nc'
+infile2=exdir+'/'+exfile2
+fileid=netCDF4.Dataset(infile2, mode='r')
+nav_lev=fileid.variables['depth'][:]
+fileid.close()
+
+nshp=np.shape(nav_lon)
+ny=nshp[0]
+nx=nshp[1]
+nz=np.size(nav_lev)
+nt=1
+
+#create a new file
+outdir='.'
+outfile='assim_background_increments_test.nc'
+
+print "creating: ",outfile
+ncfile=netCDF4.Dataset(outdir+'/'+outfile, mode='w', format='NETCDF3_CLASSIC')
+ncfile.createDimension('x',nx)
+ncfile.createDimension('y',ny)
+ncfile.createDimension('z',nz)
+ncfile.createDimension('t',size=0)
+ncnav_lat = ncfile.createVariable('nav_lat','f4',('y','x'))
+ncnav_lat[:,:]=nav_lat
+ncnav_lon = ncfile.createVariable('nav_lon','f4',('y','x'))
+ncnav_lon[:,:]=nav_lon
+ncnav_lev = ncfile.createVariable('nav_lev','f4',('z'))
+ncnav_lev[:]=nav_lev
+ncvar = ncfile.createVariable('bckineta','f8',('t','y','x'))
+ncvar[0,:,:]=0.1
+ncvar = ncfile.createVariable('bckins','f8',('t','z','y','x'))
+ncvar[0,:,:,:]=0.1
+ncvar = ncfile.createVariable('bckint','f8',('t','z','y','x'))
+ncvar[0,:,:,:]=0.1
+ncvar = ncfile.createVariable('bckinu','f8',('t','z','y','x'))
+ncvar[0,:,:,:]=0.1
+ncvar = ncfile.createVariable('bckinv','f8',('t','z','y','x'))
+ncvar[0,:,:,:]=0.1
+ncvar = ncfile.createVariable('bckinseaice','f8',('t','y','x'))
+ncvar[0,:,:]=0.1
+ncvar = ncfile.createVariable('bckinsshobias','f8',('t','y','x'))
+ncvar[0,:,:]=0.1
+ncvar = ncfile.createVariable('time_counter','f8',('t'))
+ncvar[0]=0
+ncvar = ncfile.createVariable('time','f8')
+ncvar[:]=10101
+ncvar = ncfile.createVariable('z_inc_dateb','f8')
+ncvar[:]=10101
+ncvar = ncfile.createVariable('z_inc_datef','f8')
+ncvar[:]=10102
+
+
+ncfile.close()
+
+#create sla reference file
+outfile='slaReferenceLevel_test.nc'
+
+print "creating: ",outfile
+ncfile=netCDF4.Dataset(outdir+'/'+outfile, mode='w', format='NETCDF3_CLASSIC')
+ncfile.createDimension('x',nx)
+ncfile.createDimension('y',ny)
+ncnav_lat = ncfile.createVariable('nav_lat','f4',('y','x'))
+ncnav_lat[:,:]=nav_lat
+ncnav_lon = ncfile.createVariable('nav_lon','f4',('y','x'))
+ncnav_lon[:,:]=nav_lon
+ncvar = ncfile.createVariable('sossheig','f4',('y','x'),fill_value=1e20)
+ncvar[:,:]=0.01
+
+ncfile.close()
Index: /utils/tools_ticket2413/OBSTOOLS/src/c4comb.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/c4comb.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/c4comb.F90	(revision 12863)
@@ -0,0 +1,702 @@
+PROGRAM c4comb
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM c4comb **
+   !!
+   !!  ** Purpose : Combine MPI decomposed class4 files into one file
+   !!
+   !!  ** Method  : Use of utilities from obs_utils, ooo_utils.
+   !!
+   !!  ** Action  : 
+   !!
+   !!   Usage:
+   !!     c4comb.exe outputfile inputfile1 inputfile2 ...
+   !!
+   !!   History :
+   !!----------------------------------------------------------------------
+   USE netcdf
+   USE obs_const
+   USE obs_utils
+   USE ooo_utils, ONLY: date_format, obfilldbl
+   USE toolspar_kind
+   IMPLICIT NONE
+   !! Command line setup
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nargs,    & !: number of command line arguments
+            & ia,       & !: argument loop index
+            & ninfiles    !: number of input files
+   !! Routine arguments
+   CHARACTER(len=256) :: cdoutfile
+   CHARACTER(len=256),ALLOCATABLE :: cdinfile(:)
+   !! Routine variables
+   CHARACTER(len=80) :: cpname
+   INTEGER,PARAMETER :: nstr=8, n128=128
+   INTEGER           ::    ncid,   & !: netcdf file id
+                        &  dimid,  & !: netcdf dimension id
+                        &  dpdim,  & !: netcdf dimension ids
+                        &  fcdim,  &
+                        &  vrdim,  &
+                        &  obdim,  &
+                        &  stdim,  &
+                        &  sxdim,  &
+                        &  fdvid,  & !: netcdf variable ids
+                        &  lonid,  &
+                        &  latid,  &
+                        &  depid,  &
+                        &  varid,  &
+                        &  unitid, &
+                        &  obvid,  &
+                        &  fcvid,  &
+                        &  prvid,  &
+                        &  clvid,  &
+                        &  dm2id,  &
+                        &  dm1id,  &
+                        &  mdtid,  &
+                        &  altid,  &
+                        &  qcvid,  &
+                        &  jdvid,  &
+                        &  mjdid,  &
+                        &  typid,  &
+                        &  idvid,  &
+                        &  ndeps,  & !: number depths
+                        &  nfcst,  & !: number forecast
+                        &  nvars,  & !: number variables
+                        &  nobs,   & !: number obs
+                        &  sdeps,  &
+                        &  sobs,   &
+                        &  l_dex,  &
+                        &  u_dex
+
+   INTEGER                   :: iob, idep, istat
+   INTEGER, DIMENSION(2)     :: dim2a, dim2b, dim2c, dim2d
+   INTEGER, DIMENSION(3)     :: dim3a
+   INTEGER, DIMENSION(4)     :: dim4a
+   INTEGER,  ALLOCATABLE, DIMENSION(:)           :: fcday
+   REAL(wp), ALLOCATABLE, DIMENSION(:)           :: modjd
+   !: Global Attributes
+   CHARACTER(len=40)                             :: nam_str, &
+                                                 & version,  &
+                                                 & contact,  &
+                                                 & sys_str,  &
+                                                 & cfg_str,  &
+                                                 & ins_str,  &
+                                                 & val_str,  &
+                                                 & dat_str,  &
+                                                 & obs_str
+   !: Variable Attributes
+   CHARACTER(len=100)                            :: lon_units, &
+                                                 &  lat_units, &
+                                                 &  dep_units, &
+                                                 &  jul_units, &
+                                                 &  mjd_units, &
+                                                 &  fcd_units, &
+                                                 &  lead_comment, &
+                                                 &  fcst_comment, &
+                                                 &  per_comment,  &
+                                                 &  cli_comment,  &
+                                                 &  dm2_comment,  &
+                                                 &  dm1_comment
+   CHARACTER(len=128)                            :: qc_comment,   &
+                                                 &  qc_flag_meaning
+   INTEGER, DIMENSION(2)                         :: qc_flag_value
+
+   !: Global Arrays
+   REAL(wp), ALLOCATABLE, DIMENSION(:)           :: g_lam, &
+                                                 &  g_phi, & 
+                                                 &  gjuld 
+   CHARACTER(len=n128),ALLOCATABLE,DIMENSION(:)  :: gtype
+   CHARACTER(len=nstr),ALLOCATABLE,DIMENSION(:)  ::        &
+                                                 &  g_id,  & 
+                                                 &  gvnam, & 
+                                                 &  gunit
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:)         :: g_dep
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)       :: g3dob, &
+                                                 &  g3dcl, &
+                                                 &  g3mdt, &
+                                                 &  g3alt, &
+                                                 &  g3dm2, &
+                                                 &  g3dm1
+   INTEGER(ik),  ALLOCATABLE, DIMENSION(:,:,:)   :: g3dqc
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:)     :: g3dmc, &
+                                                 &  g3dpr
+   !: Small Arrays  
+   REAL(wp), ALLOCATABLE, DIMENSION(:)       ::     s_lam, &
+                                                 &  s_phi, & 
+                                                 &  sjuld
+
+   CHARACTER(len=n128),ALLOCATABLE,DIMENSION(:) ::  stype
+   CHARACTER(len=nstr),ALLOCATABLE,DIMENSION(:) ::        &
+                                                 &  s_id 
+
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:)        :: s_dep
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)      :: s3dob, &
+                                                &  s3dcl, &
+                                                &  s3mdt, &
+                                                &  s3alt, &
+                                                &  s3dm2, &
+                                                &  s3dm1
+   INTEGER(ik),  ALLOCATABLE, DIMENSION(:,:,:)  :: s3dqc
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:)    :: s3dmc, &
+                                                &  s3dpr
+
+   !: File creation logical
+   LOGICAL                                     :: ln_cre
+
+   !: Optional variable logicals
+   LOGICAL                                     :: ln_init, &
+                                                & ln_mdt,  &
+                                                & ln_altbias, &
+                                                & ln_best
+   !! Command name
+   cpname='c4comb.exe'
+
+   !! Process command line
+   nargs = IARGC()
+   IF (nargs /= 2) THEN
+      WRITE(*, *) "Usage: c4comb.exe outputfile inputfile1 inputfile2 ..."
+      CALL abort()
+   END IF
+   CALL GETARG(1, cdoutfile)
+
+   !! Process input files
+   !! Set output file creation to off
+   ln_cre = .false.
+
+   !! Turn optional variables off
+   ln_init = .false.
+   ln_best = .false.
+   ln_altbias = .false.
+   ln_mdt = .false.
+
+   !! Compute size of output file
+   nobs = 0
+   ndeps= 0
+   ALLOCATE( cdinfile( nargs - 1 ) )
+   ninfiles = nargs - 1
+   DO ia = 1, ninfiles
+      CALL GETARG(ia+1, cdinfile(ia))
+      WRITE(*,*) "Opening : ", TRIM(cdinfile(ia))
+      !! Open Netcdf file
+      istat = nf90_open(TRIM(cdinfile(ia)),nf90_nowrite,ncid)
+      IF (istat == nf90_noerr) THEN
+         !! Turn output file creation on
+         ln_cre = .true.
+         !! Get Dimensions
+         CALL chkerr( nf90_inq_dimid(ncid, 'numobs',  dimid),              cpname, __LINE__ )
+         CALL chkerr( nf90_inquire_dimension(ncid,    dimid, len=sobs  ),  cpname, __LINE__ )
+         CALL chkerr( nf90_inq_dimid(ncid, 'numdeps', dimid),              cpname, __LINE__ )
+         CALL chkerr( nf90_inquire_dimension(ncid,    dimid, len=sdeps ),  cpname, __LINE__ )
+         CALL chkerr( nf90_inq_dimid(ncid, 'numfcsts',dimid),              cpname, __LINE__ )
+         CALL chkerr( nf90_inquire_dimension(ncid,    dimid, len=nfcst ),  cpname, __LINE__ )
+         CALL chkerr( nf90_inq_dimid(ncid, 'numvars', dimid),              cpname, __LINE__ )
+         CALL chkerr( nf90_inquire_dimension(ncid,    dimid, len=nvars ),  cpname, __LINE__ )
+         !! Close Netcdf file
+         CALL chkerr( nf90_close(ncid), cpname, __LINE__ )
+         !! Report on file contents
+         WRITE(*,'(2A)')'File = ', TRIM(cdinfile(ia))
+         WRITE(*,'(A,I9,A)')'has', sobs, ' observations'
+         !! Increment size
+         nobs  = nobs + sobs       !: Accumulate number of profiles
+         ndeps = MAX(ndeps, sdeps) !: Define maximum number of levels needed
+      END IF ! istat
+   END DO
+
+   !! Allocate global arrays
+   ALLOCATE( g_phi(nobs),                      &
+          &  g_lam(nobs),                      &
+          &  g_dep(ndeps, nobs),               &
+          &  g3dob(ndeps,        nvars, nobs), &
+          &  g3dmc(ndeps, nfcst, nvars, nobs), &
+          &  g3dpr(ndeps, nfcst, nvars, nobs), &
+          &  g3dcl(ndeps,        nvars, nobs), &
+          &  g3dm2(ndeps,        nvars, nobs), &
+          &  g3dm1(ndeps,        nvars, nobs), &
+          &  g3mdt(ndeps,        nvars, nobs), &
+          &  g3alt(ndeps,        nvars, nobs), &
+          &  g3dqc(ndeps,        nvars, nobs), &
+          &  gjuld(nobs),                      &
+          &  gtype(nobs),                      &
+          &  g_id(nobs),                       &
+          &  gvnam(nvars),                     &
+          &  gunit(nvars) )
+   ALLOCATE(fcday(nfcst), modjd(nfcst))
+
+   !! Fill with missing data value
+   g_dep(:,:)     = 99999.
+   g3dmc(:,:,:,:) = 99999.
+   g3dpr(:,:,:,:) = 99999.
+   g3dob(:,:,:)   = 99999.
+   g3dcl(:,:,:)   = 99999.
+   g3dm2(:,:,:)   = 99999.
+   g3dm1(:,:,:)   = 99999.
+   g3mdt(:,:,:)   = 99999.
+   g3alt(:,:,:)   = 99999.
+   g3dqc(:,:,:)   = NF90_FILL_SHORT
+
+   !! Read in each file
+   !  initialise global matrix indices
+   l_dex = 0
+   u_dex = 0
+
+   !! initialise Global attribute strings
+   nam_str = ''
+   version = ''
+   contact = ''
+   sys_str = ''
+   cfg_str = ''
+   ins_str = ''
+   val_str = ''
+   dat_str = ''
+   obs_str = ''
+
+   !! initialise Variable attribute strings
+   fcd_units = ''
+   lon_units = ''
+   lat_units = ''
+   dep_units = ''
+   jul_units = ''
+   mjd_units = ''
+   lead_comment = ''
+   fcst_comment = ''
+   per_comment  = ''
+   cli_comment  = ''
+   dm2_comment  = ''
+   dm1_comment  = ''
+   qc_comment  = ''
+   qc_flag_meaning  = ''
+
+   DO ia = 1, ninfiles
+      WRITE(*,*) "Opening : ", TRIM(cdinfile(ia))
+      !! Open Netcdf file
+      istat = nf90_open(TRIM(cdinfile(ia)),nf90_nowrite,ncid)
+      IF (istat == nf90_noerr) THEN
+         !! Get Global Attributes
+         CALL chkerr( nf90_get_att(ncid, nf90_global,'title',         nam_str),cpname, __LINE__)
+         CALL chkerr( nf90_get_att(ncid, nf90_global,'version',       version),cpname, __LINE__)
+         CALL chkerr( nf90_get_att(ncid, nf90_global,'contact',       contact),cpname, __LINE__)
+         CALL chkerr( nf90_get_att(ncid, nf90_global,'obs_type',      obs_str),cpname, __LINE__)
+         CALL chkerr( nf90_get_att(ncid, nf90_global,'system',        sys_str),cpname, __LINE__)
+         CALL chkerr( nf90_get_att(ncid, nf90_global,'configuration', cfg_str),cpname, __LINE__)
+         CALL chkerr( nf90_get_att(ncid, nf90_global,'institution',   ins_str),cpname, __LINE__)
+         CALL chkerr( nf90_get_att(ncid, nf90_global,'validity_time', val_str),cpname, __LINE__)
+         !! Get Dimensions of single file
+         CALL chkerr( nf90_inq_dimid(ncid, 'numdeps', dimid),              cpname, __LINE__ )
+         CALL chkerr( nf90_inquire_dimension(ncid,    dimid, len=sdeps ),  cpname, __LINE__ )
+         CALL chkerr( nf90_inq_dimid(ncid, 'numfcsts',dimid),              cpname, __LINE__ )
+         CALL chkerr( nf90_inquire_dimension(ncid,    dimid, len=nfcst ),  cpname, __LINE__ )
+         CALL chkerr( nf90_inq_dimid(ncid, 'numvars', dimid),              cpname, __LINE__ )
+         CALL chkerr( nf90_inquire_dimension(ncid,    dimid, len=nvars ),  cpname, __LINE__ )
+         CALL chkerr( nf90_inq_dimid(ncid, 'numobs',  dimid),              cpname, __LINE__ )
+         CALL chkerr( nf90_inquire_dimension(ncid,    dimid, len=sobs  ),  cpname, __LINE__ )
+         !! Check for Optional variables in first file
+         IF (ia == 1) THEN
+            !! Best estimate
+            istat = nf90_inq_varid(ncid,'best_estimate',dm2id)
+            IF (istat == nf90_noerr) THEN
+               ln_best = .TRUE.
+            ENDIF 
+            !! nrt_analysis
+            istat = nf90_inq_varid(ncid,'nrt_analysis',dm1id)
+            IF (istat == nf90_noerr) THEN
+               ln_init = .TRUE.
+            ENDIF 
+            !! Mean Dynamic Topography
+            istat = nf90_inq_varid(ncid,'mdt_reference',mdtid)
+            IF (istat == nf90_noerr) THEN
+               ln_mdt = .TRUE.
+            ENDIF 
+            !! Altimeter bias
+            istat = nf90_inq_varid(ncid,'altimeter_bias',altid)
+            IF (istat == nf90_noerr) THEN
+               ln_altbias = .TRUE.
+            ENDIF 
+         END IF
+         WRITE(*,*) TRIM(cdinfile(ia)), " contains ", sobs, " observations"
+         WRITE(*,*) TRIM(cdinfile(ia)), " contains ", sdeps, " depths"
+         WRITE(*,*) TRIM(cdinfile(ia)), " contains ", nfcst, " forecasts"
+         WRITE(*,*) TRIM(cdinfile(ia)), " contains ", nvars, " vars"
+         !! Read Variables
+         IF (sobs /= 0) THEN
+            !! Get Variable ids
+            CALL chkerr(nf90_inq_varid(ncid,'leadtime', fdvid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'longitude',   lonid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'latitude',    latid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'depth',       depid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'varname',     varid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'unitname',   unitid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'observation', obvid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'forecast',    fcvid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'persistence', prvid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'climatology', clvid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'qc',          qcvid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'juld',        jdvid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'modeljuld',   mjdid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'type',        typid) ,cpname, __LINE__ )
+            CALL chkerr(nf90_inq_varid(ncid,'id',          idvid) ,cpname, __LINE__ )
+            !! Get variable attributes
+            CALL chkerr(nf90_get_att(ncid, fdvid, 'units', fcd_units) ,cpname, __LINE__ )
+            CALL chkerr(nf90_get_att(ncid, lonid, 'units', lon_units) ,cpname, __LINE__ )
+            CALL chkerr(nf90_get_att(ncid, latid, 'units', lat_units) ,cpname, __LINE__ )
+            CALL chkerr(nf90_get_att(ncid, depid, 'units', dep_units) ,cpname, __LINE__ )
+            CALL chkerr(nf90_get_att(ncid, jdvid, 'units', jul_units) ,cpname, __LINE__ )
+            CALL chkerr(nf90_get_att(ncid, mjdid, 'units', mjd_units) ,cpname, __LINE__ )
+            CALL chkerr(nf90_get_att(ncid, fcvid, 'comment', fcst_comment) ,cpname, __LINE__ )
+            CALL chkerr(nf90_get_att(ncid, prvid, 'comment', per_comment)  ,cpname, __LINE__ )
+            CALL chkerr(nf90_get_att(ncid, clvid, 'comment', cli_comment)  ,cpname, __LINE__ )
+            CALL chkerr(nf90_get_att(ncid, fdvid, 'comment', lead_comment) ,cpname, __LINE__ )
+            CALL chkerr(nf90_get_att(ncid, qcvid, 'comment', qc_comment) ,cpname, __LINE__ )
+            CALL chkerr(nf90_get_att(ncid, qcvid, 'flag_value', qc_flag_value) ,cpname, __LINE__ )
+            CALL chkerr(nf90_get_att(ncid, qcvid, 'flag_meaning', qc_flag_meaning) ,cpname, __LINE__ )
+            !! Optional variables
+            IF (ln_best) THEN
+               CALL chkerr(nf90_inq_varid(ncid,'best_estimate',dm2id) ,cpname, __LINE__ )
+               CALL chkerr(nf90_get_att(ncid, dm2id, 'comment', dm2_comment)  ,cpname, __LINE__ )
+            ENDIF
+            IF (ln_init) THEN
+               CALL chkerr(nf90_inq_varid(ncid,'nrt_analysis', dm1id) ,cpname, __LINE__ )
+               CALL chkerr(nf90_get_att(ncid, dm1id, 'comment', dm1_comment)  ,cpname, __LINE__ )
+            ENDIF
+            IF (ln_mdt) THEN
+               CALL chkerr(nf90_inq_varid(ncid,'mdt_reference', mdtid) ,cpname, __LINE__ )
+            ENDIF
+            IF (ln_altbias) THEN
+               CALL chkerr(nf90_inq_varid(ncid,'altimeter_bias', altid) ,cpname, __LINE__ )
+            ENDIF
+
+            !! Allocate small arrays
+            ALLOCATE( s_lam(sobs), s_phi(sobs),  s_dep(sdeps, sobs),               &
+                   &  s3dob(sdeps,        nvars, sobs), & !: observations 
+                   &  s3dmc(sdeps, nfcst, nvars, sobs), & !: model data
+                   &  s3dpr(sdeps, nfcst, nvars, sobs), & !: persistence
+                   &  s3dcl(sdeps,        nvars, sobs), & !: climatology
+                   &  s3dm2(sdeps,        nvars, sobs), & !: best estimate
+                   &  s3dm1(sdeps,        nvars, sobs), & !: nrt_analysis
+                   &  s3mdt(sdeps,        nvars, sobs), & !: mdt
+                   &  s3alt(sdeps,        nvars, sobs), & !: altbias
+                   &  s3dqc(sdeps,        nvars, sobs), & !: QC
+                   &  sjuld(sobs), stype( sobs),  &
+                   &  s_id(sobs) )
+            !! Fill with missing data value
+            s3dmc(:,:,:,:) = 99999.
+            s3dpr(:,:,:,:) = 99999.
+            s3dob(:,:,:)   = 99999.
+            s3dcl(:,:,:)   = 99999.
+            s3dm2(:,:,:)   = 99999.
+            s3dm1(:,:,:)   = 99999.
+            s3mdt(:,:,:)   = 99999.
+            s3alt(:,:,:)   = 99999.
+            s3dqc(:,:,:)   = NF90_FILL_SHORT
+
+            !! Read variables into small arrays
+            CALL chkerr( nf90_get_var(ncid, fdvid, fcday), cpname, __LINE__ )       
+            CALL chkerr( nf90_get_var(ncid, lonid, s_lam), cpname, __LINE__ )       
+            CALL chkerr( nf90_get_var(ncid, latid, s_phi), cpname, __LINE__ )       
+            CALL chkerr( nf90_get_var(ncid, depid, s_dep), cpname, __LINE__ )       
+            CALL chkerr( nf90_get_var(ncid, obvid, s3dob), cpname, __LINE__ )       
+            CALL chkerr( nf90_get_var(ncid, fcvid, s3dmc), cpname, __LINE__ )       
+            CALL chkerr( nf90_get_var(ncid, prvid, s3dpr), cpname, __LINE__ )       
+            CALL chkerr( nf90_get_var(ncid, clvid, s3dcl), cpname, __LINE__ )       
+            CALL chkerr( nf90_get_var(ncid, qcvid, s3dqc), cpname, __LINE__ )       
+            CALL chkerr( nf90_get_var(ncid, jdvid, sjuld), cpname, __LINE__ )       
+            CALL chkerr( nf90_get_var(ncid, mjdid, modjd), cpname, __LINE__ )       
+            CALL chkerr( nf90_get_var(ncid, typid, stype), cpname, __LINE__ )       
+            CALL chkerr( nf90_get_var(ncid, idvid, s_id),  cpname, __LINE__ )       
+            !! Read unitname and varname into global arrays
+            CALL chkerr( nf90_get_var(ncid, varid, gvnam), cpname, __LINE__ )       
+            CALL chkerr( nf90_get_var(ncid, unitid,gunit), cpname, __LINE__ )       
+            !! Optional variables read
+            IF (ln_best) THEN
+               CALL chkerr( nf90_get_var(ncid, dm2id, s3dm2), cpname, __LINE__ )       
+            ENDIF
+            IF (ln_init) THEN
+               CALL chkerr( nf90_get_var(ncid, dm1id, s3dm1), cpname, __LINE__ )       
+            ENDIF
+            IF (ln_mdt) THEN
+               CALL chkerr( nf90_get_var(ncid, mdtid, s3mdt), cpname, __LINE__ )       
+            ENDIF
+            IF (ln_altbias) THEN
+               CALL chkerr( nf90_get_var(ncid, altid, s3alt), cpname, __LINE__ )       
+            ENDIF
+
+            !! Fill Global arrays
+            !  increment numobs indices
+            l_dex = u_dex + 1
+            u_dex = l_dex + sobs -1
+
+            g_lam(l_dex:u_dex)                          = s_lam(:)
+            g_phi(l_dex:u_dex)                          = s_phi(:)
+            g_dep(1:sdeps,  l_dex:u_dex)                = s_dep(1:sdeps,:)
+            g3dob(1:sdeps,1:nvars,l_dex:u_dex)          = s3dob(1:sdeps,1:nvars,:)
+            g3dmc(1:sdeps,1:nfcst,1:nvars,l_dex:u_dex)  = s3dmc(1:sdeps,1:nfcst,1:nvars,:)
+            g3dpr(1:sdeps,1:nfcst,1:nvars,l_dex:u_dex)  = s3dpr(1:sdeps,1:nfcst,1:nvars,:)
+            g3dcl(1:sdeps,1:nvars,l_dex:u_dex)          = s3dcl(1:sdeps,1:nvars,:)
+            g3dm2(1:sdeps,1:nvars,l_dex:u_dex)          = s3dm2(1:sdeps,1:nvars,:)
+            g3dm1(1:sdeps,1:nvars,l_dex:u_dex)          = s3dm1(1:sdeps,1:nvars,:)
+            g3mdt(1:sdeps,1:nvars,l_dex:u_dex)          = s3mdt(1:sdeps,1:nvars,:)
+            g3alt(1:sdeps,1:nvars,l_dex:u_dex)          = s3alt(1:sdeps,1:nvars,:)
+            g3dqc(1:sdeps,1:nvars,l_dex:u_dex)          = s3dqc(1:sdeps,1:nvars,:)
+            gjuld(l_dex:u_dex)                          = sjuld(:)
+            gtype(l_dex:u_dex)                          = stype(:)
+            g_id(l_dex:u_dex)                           = s_id(:)
+
+            !! Deallocate small array
+            DEALLOCATE( s_lam, s_phi, s_dep, s3dob, s3dmc, s3dpr, s3dcl, s3dqc, s3dm2, s3dm1, s3mdt, s3alt, sjuld, stype, s_id)
+         ENDIF ! sobs    
+         !! Close Netcdf file
+         CALL chkerr( nf90_close(ncid), cpname, __LINE__ )
+      END IF ! istat
+   END DO
+
+   !! Create Output file
+   IF (ln_cre) THEN
+      WRITE(*,*) 'Create the output file, ',trim(cdoutfile)
+      CALL chkerr( nf90_create(trim(cdoutfile),nf90_clobber,ncid),      cpname, __LINE__ )
+      !! Put Global Attributes
+      CALL date_format(dat_str) 
+      CALL chkerr( nf90_put_att(ncid, nf90_global,'title',          trim(nam_str)),cpname, __LINE__)
+      CALL chkerr( nf90_put_att(ncid, nf90_global,'version',        trim(version)),cpname, __LINE__)
+      CALL chkerr( nf90_put_att(ncid, nf90_global,'creation_date',  trim(dat_str)),cpname, __LINE__)
+      CALL chkerr( nf90_put_att(ncid, nf90_global,'contact',        trim(contact)),cpname, __LINE__)
+      CALL chkerr( nf90_put_att(ncid, nf90_global,'obs_type',       trim(obs_str)),cpname, __LINE__)
+      CALL chkerr( nf90_put_att(ncid, nf90_global,'system',         trim(sys_str)),cpname, __LINE__)
+      CALL chkerr( nf90_put_att(ncid, nf90_global,'configuration',  trim(cfg_str)),cpname, __LINE__)
+      CALL chkerr( nf90_put_att(ncid, nf90_global,'institution',    trim(ins_str)),cpname, __LINE__)
+      CALL chkerr( nf90_put_att(ncid, nf90_global,'validity_time',  trim(val_str)),cpname, __LINE__)
+      CALL chkerr( nf90_put_att(ncid, nf90_global,'best_estimate_description', &
+                              &       'analysis produced 2 days behind real time'),cpname, __LINE__)
+      CALL chkerr( nf90_put_att(ncid, nf90_global,'time_interp', 'daily average fields'),cpname, __LINE__)
+      WRITE(*,*) 'Succesfully put global attributes '
+
+      !! Define Dimensions
+      CALL chkerr( nf90_def_dim(ncid, 'numdeps',          ndeps, dpdim) ,cpname, __LINE__ )
+      CALL chkerr( nf90_def_dim(ncid, 'numfcsts',         nfcst, fcdim) ,cpname, __LINE__ )
+      CALL chkerr( nf90_def_dim(ncid, 'numvars',          nvars, vrdim) ,cpname, __LINE__ )
+      CALL chkerr( nf90_def_dim(ncid, 'numobs',           nobs,  obdim) ,cpname, __LINE__ )
+      CALL chkerr( nf90_def_dim(ncid, 'string_length8',   nstr,  stdim) ,cpname, __LINE__ )
+      CALL chkerr( nf90_def_dim(ncid, 'string_length128', n128,  sxdim) ,cpname, __LINE__ )
+      WRITE(*,*) 'Succesfully defined dimensions'
+
+      !! Define possible dimension permutations
+      ! 2d
+      dim2a(:) = (/ dpdim, obdim /) !: (/ ndeps, nobs  /) 
+      dim2b(:) = (/ stdim, obdim /) !: (/ nstr,  nobs  /)
+      dim2c(:) = (/ stdim, vrdim /) !: (/ nstr,  nvars /)
+      dim2d(:) = (/ sxdim, obdim /) !: (/ nstr,  nobs  /)
+      ! 3d
+      dim3a(:) = (/ dpdim, vrdim, obdim/) !: (/ ndeps, nvars, nobs /)
+      ! 4d
+      dim4a(:) = (/ dpdim, fcdim, vrdim, obdim /) !: (/ ndeps, nfcst, nvars, nobs /)
+
+
+      !! Create the variables
+      !  Forecast day
+      CALL chkerr( nf90_def_var(ncid, 'leadtime',  nf90_double, fcdim, fdvid)          ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, fdvid, 'long_name', 'Model forecast day offset') ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, fdvid, 'units',     trim(fcd_units))             ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, fdvid, 'comment',   trim(lead_comment))          ,cpname, __LINE__ )
+      WRITE(*,*) 'leadtime created'
+      !  longitude
+      CALL chkerr( nf90_def_var(ncid, 'longitude',    nf90_float, obdim, lonid)        ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, lonid, 'long_name', 'Longitudes')                ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, lonid, 'units',     trim(lon_units))             ,cpname, __LINE__ )
+      WRITE(*,*) 'lon created'
+      !  latitude
+      CALL chkerr( nf90_def_var(ncid, 'latitude',     nf90_float, obdim, latid)        ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, latid, 'long_name', 'Latitudes')                 ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, latid, 'units',     trim(lat_units))             ,cpname, __LINE__ )
+      WRITE(*,*) 'lat created'
+      !  depth
+      CALL chkerr( nf90_def_var(ncid, 'depth',        nf90_float, dim2a, depid)        ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, depid, 'long_name', 'Depths')                    ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, depid, 'units',     trim(dep_units))             ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, depid, '_FillValue',obfillflt)                    ,cpname, __LINE__ )
+      WRITE(*,*) 'dep created'
+      !  varname
+      CALL chkerr( nf90_def_var(ncid, 'varname',      nf90_char,  dim2c, varid)        ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, varid, 'long_name', 'Variable name')             ,cpname, __LINE__ )
+      WRITE(*,*) 'varname created'
+      !  unitname
+      CALL chkerr( nf90_def_var(ncid, 'unitname',     nf90_char,  dim2c, unitid)        ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid,  unitid, 'long_name', 'Unit name')              ,cpname, __LINE__ )
+      WRITE(*,*) 'unitname created'
+      !  obs
+      CALL chkerr( nf90_def_var(ncid, 'observation', nf90_float,  dim3a,  obvid)        ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, obvid, '_FillValue',obfillflt)                    ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid,  obvid, 'long_name', 'Observation value')         ,cpname, __LINE__ )
+      WRITE(*,*) 'obs created'
+      !  forecast
+      CALL chkerr( nf90_def_var(ncid, 'forecast',    nf90_float,  dim4a,  fcvid)        ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, fcvid, '_FillValue',obfillflt)                    ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, fcvid, 'long_name', 'Model forecast counterpart of obs. value')   ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, fcvid, 'comment',   trim(fcst_comment))           ,cpname, __LINE__ )
+      WRITE(*,*) 'forecast created'
+      !  persistence
+      CALL chkerr( nf90_def_var(ncid, 'persistence', nf90_float,  dim4a,  prvid)        ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, prvid, '_FillValue',obfillflt)                    ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, prvid, 'long_name', 'Model persistence counterpart of obs. value'),cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, prvid, 'comment',   trim(per_comment))            ,cpname, __LINE__ )
+      WRITE(*,*) 'persistence created'
+      !  clim
+      CALL chkerr( nf90_def_var(ncid, 'climatology', nf90_float,  dim3a, clvid)        ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, clvid, '_FillValue',obfillflt)                    ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, clvid, 'long_name', 'Climatological value')       ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, clvid, 'comment',   trim(cli_comment))            ,cpname, __LINE__ )
+      WRITE(*,*) 'clim created'
+      IF (ln_best) THEN
+         !  daym2
+         CALL chkerr( nf90_def_var(ncid, 'best_estimate', nf90_float,  dim3a, dm2id)    ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_att(ncid, dm2id, '_FillValue',obfillflt)                 ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_att(ncid, dm2id, 'long_name', 'Best estimate')           ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_att(ncid, dm2id, 'comment',   trim(dm2_comment))         ,cpname, __LINE__ )
+         WRITE(*,*) 'daym2 created'
+      ENDIF
+      IF (ln_init) THEN
+         !  daym1
+         CALL chkerr( nf90_def_var(ncid, 'nrt_analysis', nf90_float,  dim3a, dm1id)        ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_att(ncid, dm1id, '_FillValue',obfillflt)                    ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_att(ncid, dm1id, 'long_name', 'Near real time analysis')    ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_att(ncid, dm1id, 'comment',   trim(dm1_comment))            ,cpname, __LINE__ )
+         WRITE(*,*) 'daym1 created'
+      ENDIF
+      IF (ln_mdt) THEN
+         !  mdt
+         CALL chkerr( nf90_def_var(ncid, 'mdt_reference', nf90_float,  dim3a, mdtid)      ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_att(ncid, mdtid, '_FillValue',obfillflt)                    ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_att(ncid, mdtid, 'long_name', 'Mean dynamic topography')    ,cpname, __LINE__ )
+         WRITE(*,*) 'mdt created'
+      ENDIF
+      IF (ln_altbias) THEN
+         !  altbias
+         CALL chkerr( nf90_def_var(ncid, 'altimeter_bias', nf90_float,  dim3a, altid)     ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_att(ncid, altid, '_FillValue',obfillflt)                    ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_att(ncid, altid, 'long_name', 'Altimeter bias')             ,cpname, __LINE__ )
+         WRITE(*,*) 'altbias created'
+      ENDIF
+      !  qc
+      CALL chkerr( nf90_def_var(ncid, 'qc',          nf90_short,  dim3a, qcvid)         ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, qcvid, '_FillValue', NF90_FILL_SHORT)             ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, qcvid, 'long_name', 'Quality flags')              ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, qcvid, 'flag_value', qc_flag_value)               ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, qcvid, 'flag_meaning', qc_flag_meaning)           ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, qcvid, 'comment', qc_comment)                     ,cpname, __LINE__ )
+      WRITE(*,*) 'qc created'
+      !  juld
+      CALL chkerr( nf90_def_var(ncid, 'juld',       nf90_double,  obdim, jdvid)         ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, jdvid, '_FillValue',99999.)                       ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, jdvid, 'long_name', 'Observation time in Julian days'),cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, jdvid, 'units',     trim(jul_units))              ,cpname, __LINE__ )
+      WRITE(*,*) 'juld created'
+      !  modeljuld 
+      CALL chkerr( nf90_def_var(ncid, 'modeljuld',  nf90_double,  fcdim, mjdid)         ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, mjdid, 'long_name', 'Model field date in Julian days'),cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, mjdid, 'units',     trim(mjd_units))              ,cpname, __LINE__ )
+      WRITE(*,*) 'modeljuld created'
+      !  type
+      CALL chkerr( nf90_def_var(ncid, 'type',     nf90_char,      dim2d, typid)         ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, typid, 'long_name', 'Observation type')           ,cpname, __LINE__ )
+      WRITE(*,*) 'type created'
+      !  id
+      CALL chkerr( nf90_def_var(ncid, 'id',       nf90_char,      dim2b, idvid)         ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_att(ncid, idvid, 'long_name', 'Observation id')             ,cpname, __LINE__ )
+      WRITE(*,*) 'id created'
+      ! Close Netcdf file 
+      CALL chkerr( nf90_close(ncid) ,cpname, __LINE__ )  
+      !! Fill in the variables
+      CALL chkerr( nf90_open(trim(cdoutfile),nf90_write,ncid),                   cpname, __LINE__ )
+      WRITE(*,*) 'Create the variables ',trim(cdoutfile)
+      !  Forecast day
+      CALL chkerr( nf90_inq_varid(ncid, 'leadtime', fdvid)                ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, fdvid, fcday) ,cpname, __LINE__ )
+      WRITE(*,*) 'forecast day put'
+      !  longitude
+      CALL chkerr( nf90_inq_varid(ncid, 'longitude', lonid)                  ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, lonid, g_lam) ,cpname, __LINE__ )
+      WRITE(*,*) 'lon put'
+      !  latitude
+      CALL chkerr( nf90_inq_varid(ncid, 'latitude', latid)                   ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, latid, g_phi) ,cpname, __LINE__ )
+      WRITE(*,*) 'lat put'
+      !  depth
+      CALL chkerr( nf90_inq_varid(ncid, 'depth',depid)                       ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, depid, g_dep) ,cpname, __LINE__ )
+      WRITE(*,*) 'dep put'
+      ! varname
+      CALL chkerr( nf90_inq_varid(ncid, 'varname', varid)                    ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, varid, gvnam,(/1,1/), (/nstr,nvars/) ) ,cpname, __LINE__ )   
+      WRITE(*,*) 'var put'
+      ! unitname
+      CALL chkerr( nf90_inq_varid(ncid, 'unitname',unitid)                   ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, unitid, gunit,(/1,1/),(/nstr,nvars/) ) ,cpname, __LINE__ )   
+      WRITE(*,*) 'unitnam put'
+      ! obs
+      CALL chkerr( nf90_inq_varid(ncid, 'observation', obvid)                ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, obvid,g3dob ) ,cpname, __LINE__ )   
+      WRITE(*,*) 'obs put'
+      ! clim
+      CALL chkerr( nf90_inq_varid(ncid, 'climatology', clvid)                ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, clvid,g3dcl ) ,cpname, __LINE__ )   
+      WRITE(*,*) 'cli put'
+      IF (ln_best) THEN
+         ! daym2
+         CALL chkerr( nf90_inq_varid(ncid, 'best_estimate',dm2id)            ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_var(ncid, dm2id,g3dm2 ) ,cpname, __LINE__ )   
+         WRITE(*,*) 'daym2 put'
+      ENDIF
+      IF (ln_init) THEN 
+         ! daym1
+         CALL chkerr( nf90_inq_varid(ncid, 'nrt_analysis',dm1id)              ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_var(ncid, dm1id,g3dm1 ) ,cpname, __LINE__ )   
+         WRITE(*,*) 'daym1 put'
+      ENDIF
+      IF (ln_mdt) THEN 
+         ! mdt
+         CALL chkerr( nf90_inq_varid(ncid, 'mdt_reference', mdtid)              ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_var(ncid, mdtid, g3mdt ) ,cpname, __LINE__ )   
+         WRITE(*,*) 'mdt put'
+      ENDIF
+      IF (ln_altbias) THEN 
+         ! altbias
+         CALL chkerr( nf90_inq_varid(ncid, 'altimeter_bias', altid)             ,cpname, __LINE__ )
+         CALL chkerr( nf90_put_var(ncid, altid, g3alt ) ,cpname, __LINE__ )   
+         WRITE(*,*) 'altbias put'
+      ENDIF
+      ! persistence
+      CALL chkerr( nf90_inq_varid(ncid, 'persistence',prvid)                                 ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, prvid, g3dpr, (/1,1,1,1/) ,(/ ndeps,nfcst,nvars,nobs/) ) ,cpname, __LINE__ )   
+      WRITE(*,*) 'per put'
+      ! forecast
+      CALL chkerr( nf90_inq_varid(ncid, 'forecast',fcvid)                                      ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, fcvid, g3dmc, (/1,1,1,1/), (/ ndeps,nfcst,nvars,nobs/) ) ,cpname, __LINE__ )   
+      WRITE(*,*) 'fcst put'
+      ! qc
+      CALL chkerr( nf90_inq_varid(ncid, 'qc', qcvid)                         ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, qcvid,g3dqc ) ,cpname, __LINE__ )   
+      WRITE(*,*) 'qc put'
+      ! juld
+      CALL chkerr( nf90_inq_varid(ncid, 'juld',jdvid)                        ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, jdvid, gjuld) ,cpname, __LINE__ )   
+      WRITE(*,*) 'juld put'
+      ! modeljuld
+      CALL chkerr( nf90_inq_varid(ncid, 'modeljuld', mjdid)                  ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, mjdid, modjd,(/1/),(/nfcst/))          ,cpname, __LINE__ )   
+      WRITE(*,*) 'modjuld put'
+      ! type
+      CALL chkerr( nf90_inq_varid(ncid, 'type', typid)                       ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, typid, gtype,(/1,1/) , (/n128,nobs/) ) ,cpname, __LINE__ )   
+      WRITE(*,*) 'type put'
+      ! id
+      CALL chkerr( nf90_inq_varid(ncid, 'id', idvid)                         ,cpname, __LINE__ )
+      CALL chkerr( nf90_put_var(ncid, idvid, g_id,(/1,1/)  , (/nstr,nobs/) ) ,cpname, __LINE__ )   
+      WRITE(*,*) 'id put'
+      ! Close netcdf file
+      CALL chkerr( nf90_close(ncid),                                          cpname, __LINE__ )
+   END IF ! ln_cre
+   !! Deallocate Global arrays
+   DEALLOCATE( g_lam, g_phi, g_dep, g3dob, g3dmc, g3dpr, g3dcl, g3dm2, g3dm1, g3mdt, g3alt, g3dqc, gjuld, gtype, g_id, gvnam, gunit)
+   DEALLOCATE( fcday, modjd )
+
+   !! Deallocate input argument list
+   DEALLOCATE(cdinfile)
+END PROGRAM c4comb
Index: /utils/tools_ticket2413/OBSTOOLS/src/convmerge.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/convmerge.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/convmerge.F90	(revision 12863)
@@ -0,0 +1,131 @@
+MODULE convmerge
+
+   USE toolspar_kind
+   USE obs_fbm
+   USE obs_utils
+   IMPLICIT NONE
+
+CONTAINS
+
+   SUBROUTINE conv_fbmerge( cdoutfile, nfiles, fbdata )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE conv_fbmerg **
+      !!
+      !!  ** Purpose : Merge all fbfiles into a single fbfile
+      !!
+      !!  ** Method  : Use of utilities from obs_fbm.
+      !!
+      !!  ** Action  :
+      !!
+      !!   Optional :
+      !!     namelist = namobs.in    to select the observation range 
+      !!
+      !!   History :
+      !!        ! 2010 (K. Mogensen) Initial version
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdoutfile                ! Input file.
+      INTEGER :: nfiles                            ! Number of files
+      TYPE(obfbdata), dimension(nfiles) :: fbdata  ! Structure to merge
+      !! * Local variables
+      type(obfbdata) :: fbmerge
+      INTEGER,ALLOCATABLE  :: iset(:),inum(:),iindex(:)
+      INTEGER :: nmaxlev
+      INTEGER :: ia,ij,ii
+      REAL(fbdp), DIMENSION(nfiles) :: djulini, djulend
+      CHARACTER(len=8) :: cl_refdate
+      INTEGER :: irefdate,iyea,imon,iday,ihou,imin,isec
+      ! Namelist variables
+      CHARACTER(len=9) :: cdnamefile='namobs.in'
+      LOGICAL :: lexists 
+      REAL(fbdp) :: dobsini,dobsend
+      NAMELIST/namobs/dobsini,dobsend
+      
+      dobsini = 0.0
+      dobsend = 99991231.235959
+
+      INQUIRE(file=cdnamefile, exist=lexists)
+      IF (lexists) THEN
+         OPEN(10,file=cdnamefile)
+         READ(10,namobs)
+         WRITE(*,namobs)
+         CLOSE(10)
+      ENDIF
+      !
+      ! Count number of data points
+      !
+      nmaxlev = 1
+      ii = 0
+      DO ia = 1,nfiles
+         IF (lexists) THEN
+            cl_refdate=fbdata(ia)%cdjuldref(1:8)
+            READ(cl_refdate,'(I8)') irefdate
+            CALL ddatetoymdhms( dobsini, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(ia), &
+               &           krefdate = irefdate )
+            CALL ddatetoymdhms( dobsend, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(ia), &
+            &           krefdate = irefdate )
+            DO ij = 1, fbdata(ia)%nobs
+               IF ( ( fbdata(ia)%ptim(ij) >  djulini(ia) ) .AND. &
+                  & ( fbdata(ia)%ptim(ij) <= djulend(ia) ) ) THEN
+                  ii = ii + 1
+                  nmaxlev = MAX(nmaxlev,fbdata(ia)%nlev)
+               ENDIF
+            ENDDO
+         ELSE
+            nmaxlev = MAX(nmaxlev,fbdata(ia)%nlev)
+            ii = ii + fbdata(ia)%nobs
+         ENDIF
+      ENDDO
+      !
+      ! Merge the input structures into the output structure
+      !
+      ALLOCATE( iset(ii), inum(ii), iindex(ii))
+      ii = 0
+      DO ia = 1,nfiles
+         DO ij = 1, fbdata(ia)%nobs
+            IF (lexists) THEN
+               IF ( ( fbdata(ia)%ptim(ij) >  djulini(ia) ) .AND. &
+                  & ( fbdata(ia)%ptim(ij) <= djulend(ia) ) ) THEN
+                  ii = ii + 1
+                  iset(ii)   = ia
+                  inum(ii)   = ij
+                  iindex(ii) = ii
+               ENDIF
+            ELSE
+               ii = ii + 1
+               iset(ii)   = ia
+               inum(ii)   = ij
+               iindex(ii) = ii
+            ENDIF
+         ENDDO
+      ENDDO
+      WRITE(*,*)'Output number of observations = ',ii
+      WRITE(*,*)'Output number of levels       = ',nmaxlev
+      !
+      ! Prepare fbmerge structure
+      !
+      CALL init_obfbdata( fbmerge )
+      CALL alloc_obfbdata( fbmerge, fbdata(1)%nvar, ii, nmaxlev, &
+         &                 fbdata(1)%nadd, fbdata(1)%next, fbdata(1)%lgrid )
+      CALL merge_obfbdata( nfiles, fbdata, fbmerge, iset, inum, iindex )
+      !
+      ! Write the file
+      !
+      CALL write_obfbdata( TRIM(cdoutfile), fbmerge )
+      !
+      ! Dellocate the data
+      !
+      CALL dealloc_obfbdata( fbmerge )
+
+   END SUBROUTINE conv_fbmerge
+
+#include "ctl_stop.h90"
+
+#include "greg2jul.h90"
+
+!#include "ddatetoymdhms.h90"
+
+END MODULE convmerge
Index: /utils/tools_ticket2413/OBSTOOLS/src/coords.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/coords.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/coords.F90	(revision 12863)
@@ -0,0 +1,1025 @@
+MODULE coords
+
+   IMPLICIT NONE
+
+   INTEGER, PARAMETER     :: nsech = 167
+   CHARACTER(len=20), DIMENSION(nsech)  :: cl_sech = (/ &
+      & 'global              ',  &
+      & 'nstrpac             ',  &
+      & 'sstrpac             ',  &
+      & 'npac                ',  &
+      & 'spac                ',  &
+      & 'trpac               ',  &
+      & 'natl                ',  &
+      & 'satl                ',  &
+      & 'tratl               ',  &
+      & 'nstratl             ',  &
+      & 'sstratl             ',  &
+      & 'neatl               ',  &
+      & 'nwatl               ',  &
+      & 'equa                ',  &
+      & 'nino1               ',  &
+      & 'nino2               ',  &
+      & 'nino12              ',  &
+      & 'nino3               ',  &
+      & 'nino4               ',  &
+      & 'nino34              ',  &
+      & 'ind1                ',  &
+      & 'ind2                ',  &
+      & 'ind3                ',  &
+      & 'eq1                 ',  &
+      & 'eq2                 ',  &
+      & 'eq3                 ',  &
+      & 'eq4                 ',  &
+      & 'neq1                ',  &
+      & 'neq2                ',  &
+      & 'neq3                ',  &
+      & 'neq4                ',  &
+      & 'eqpac               ',  &
+      & 'eqind               ',  &
+      & 'atl1                ',  &
+      & 'atl2                ',  &
+      & 'atl3                ',  &
+      & 'eqatl               ',  &
+      & 'trop                ',  &
+      & 'nxtrp               ',  &
+      & 'sxtrp               ',  &
+      & 'trind               ',  &
+      & 'sind                ',  &
+      & 'nepac               ',  &
+      & 'nwpac               ',  &
+      & 'trepac              ',  &
+      & 'trwpac              ',  &
+      & 'p15n38w             ',  &
+      & 'p12n38w             ',  &
+      & 'p8n38w              ',  &
+      & 'p4n38w              ',  &
+      & 'p0n35w              ',  &
+      & 'p21n23w             ',  &
+      & 'p12n23w             ',  &
+      & 'p4n23w              ',  &
+      & 'p0n23w              ',  &
+      & 'p0n10w              ',  &
+      & 'p0n0w               ',  &
+      & 'p5s10w              ',  &
+      & 'p10s10w             ',  &
+      & 't0n156e             ',  &
+      & 't0n165e             ',  &
+      & 't0n180e             ',  &
+      & 't0n170w             ',  &
+      & 't0n155w             ',  &
+      & 't0n140w             ',  &
+      & 't0n125w             ',  &
+      & 't0n110w             ',  &
+      & 't0n95w              ',  &
+      & 't5n156e             ',  &
+      & 't5s156e             ',  &
+      & 't5n165e             ',  &
+      & 't5n180e             ',  &
+      & 't5n170w             ',  &
+      & 't5n155w             ',  &
+      & 't5n140w             ',  &
+      & 't5n125w             ',  &
+      & 't5n110w             ',  &
+      & 't5n95w              ',  &
+      & 't5s165e             ',  &
+      & 't5s180e             ',  &
+      & 't5s170w             ',  &
+      & 't5s155w             ',  &
+      & 't5s140w             ',  &
+      & 't5s125w             ',  &
+      & 't5s110w             ',  &
+      & 't5s95w              ',  &
+      & 'r8s55e              ',  &
+      & 'r12s55e             ',  &
+      & 'r4s67e              ',  &
+      & 'r8s67e              ',  &
+      & 'r12s67e             ',  &
+      & 'r0n80e              ',  &
+      & 'r4s80e              ',  &
+      & 'r12s80e             ',  &
+      & 'r12n90e             ',  &
+      & 'r8n90e              ',  &
+      & 'r4n90e              ',  &
+      & 'r0n90e              ',  &
+      & 'r5s95e              ',  &
+      & 'r8s95e              ',  &
+      & 'r8s100e             ',  &
+      & 'NE_subtrop_pac      ',  &
+      & 'NW_subtrop_pac      ',  &
+      & 'NE_extratrop_pac    ',  &
+      & 'NW_extratrop_pac    ',  &
+      & 'SE_subtrop_pac      ',  &
+      & 'SW_subtrop_pac      ',  &
+      & 'NE_subtrop_atl      ',  &
+      & 'NW_subtrop_atl      ',  &
+      & 'NE_extratrop_atl    ',  &
+      & 'NW_extratrop_atl    ',  &
+      & 'SE_subtrop_atl      ',  &
+      & 'SW_subtrop_atl      ',  &
+      & 'SE_subtrop_ind      ',  &
+      & 'SW_subtrop_ind      ',  &
+      & 'Southern_ocean_pac  ',  &
+      & 'Southern_ocean_atl  ',  &
+      & 'Southern_ocean_ind  ',  &
+      & 'GLOBAL05            ',  &
+      & 'GLOBAL10            ',  &
+      & 'GLOBAL15            ',  &
+      & 'GLOBAL20            ',  &
+      & 'GLOBAL25            ',  &
+      & 'GLOBAL30            ',  &
+      & 'GLOBAL40            ',  &
+      & 'GLOBAL50            ',  &
+      & 'GLOBAL60            ',  &
+      & 'ARCTIC              ',  &
+      & 'ATL60NA             ',  &
+      & 'ATL50NA             ',  &
+      & 'ATL40NA             ',  &
+      & 'ATL35NA             ',  &
+      & 'ATL30NA             ',  &
+      & 'ATL26NA             ',  &
+      & 'ATL10NA             ',  &
+      & 'ATLEQA              ',  &
+      & 'ATL10SA             ',  &
+      & 'ATL20SA             ',  &
+      & 'ATL30SA             ',  &
+      & 'PAC60NA             ',  &
+      & 'PAC50NA             ',  &
+      & 'PAC40NA             ',  &
+      & 'PAC35NA             ',  &
+      & 'PAC30NA             ',  &
+      & 'PAC20NA             ',  &
+      & 'PAC10NA             ',  &
+      & 'PACEQA              ',  &
+      & 'INP10SA             ',  &
+      & 'PAC20SA             ',  &
+      & 'PAC30SA             ',  &
+      & 'INDEQA              ',  &
+      & 'IND20SA             ',  &
+      & 'IND30SA             ',  &
+      & 'GLB60NA             ',  &
+      & 'GLB50NA             ',  &
+      & 'GLB40NA             ',  &
+      & 'GLB30NA             ',  &
+      & 'GLB20NA             ',  &
+      & 'GLB10NA             ',  &
+      & 'GLBEQA              ',  &
+      & 'GLB10SA             ',  &
+      & 'GLB20SA             ',  &
+      & 'GLB30SA             ',  &
+      & 'GLB40SA             ',  &
+      & 'GLB50SA             ',  &
+      & 'GLB60SA             ',  &
+      & 'npac25              '  &
+      & /)
+
+   ! User defined areas
+   INTEGER :: nboxuser
+   CHARACTER(len=20), DIMENSION(:), ALLOCATABLE  :: cl_boxes_user
+   REAL, DIMENSION(:,:), ALLOCATABLE :: areas
+
+   ! zonal sections
+   INTEGER, PARAMETER     :: nsecz = 50
+   CHARACTER(len=20), DIMENSION(nsecz)  :: cl_secz = (/ &
+      & 'LOMBOK              ',  &
+      & 'BANDA               ',  &
+      & 'MAKASSAR            ',  &
+      & 'SAVU                ',  &
+      & 'MALACCAS            ',  &
+      & 'PHILIPINES          ',  &
+      & 'YUCATAN             ',  &
+      & 'GIN                 ',  &
+      & 'LABRADOR            ',  &
+      & 'ATL60N              ',  &
+      & 'ATL50N              ',  &
+      & 'ATL40N              ',  &
+      & 'ATL35N              ',  &
+      & 'ATL30N              ',  &
+      & 'ATL27N              ',  &
+      & 'ATL26N              ',  &
+      & 'ATL10N              ',  &
+      & 'ATLEQ               ',  &
+      & 'ATL10S              ',  &
+      & 'ATL20S              ',  &
+      & 'ATL30S              ',  &
+      & 'PAC60N              ',  &
+      & 'PAC50N              ',  &
+      & 'PAC40N              ',  &
+      & 'PAC35N              ',  &
+      & 'PAC30N              ',  &
+      & 'PAC25N              ',  &
+      & 'PAC20N              ',  &
+      & 'PAC10N              ',  &
+      & 'PACEQ               ',  &
+      & 'INP10S              ',  &
+      & 'PAC20S              ',  &
+      & 'PAC30S              ',  &
+      & 'INDEQ               ',  &
+      & 'IND20S              ',  &
+      & 'IND30S              ',  &
+      & 'GLB60N              ',  &
+      & 'GLB50N              ',  &
+      & 'GLB40N              ',  &
+      & 'GLB30N              ',  &
+      & 'GLB20N              ',  &
+      & 'GLB10N              ',  &
+      & 'GLBEQ               ',  &
+      & 'GLB10S              ',  &
+      & 'GLB20S              ',  &
+      & 'GLB30S              ',  &
+      & 'GLB40S              ',  &
+      & 'GLB50S              ',  &
+      & 'GLB60S              ',  &
+      & 'SUM-DARWIN          '   &
+      & /)
+
+   ! meridional sections
+   INTEGER, PARAMETER     :: nsecm = 10
+   CHARACTER(len=20), DIMENSION(nsecm)  :: cl_secm = (/ &
+      & 'IT                  ',  &
+      & 'ITA                 ',  &
+      & 'TIMOR               ',  &
+!      & 'OMBAI               ',  &
+!      & 'SUMBA               ',  &
+!      & 'LUZON               ',  &
+      & 'DRAKE               ',  &
+      & 'TORRES              ',  &
+      & 'MED                 ',  &
+      & 'FLORIDA             ',  &
+      & 'ANTILLAS            ',  &
+      & 'GOODHOPE            ', &
+      & 'SOUTHAUS            '   &
+      & /)
+
+CONTAINS
+
+   SUBROUTINE coord_area( reg, area )
+      !-----------------------------------------------------------------------
+      !
+      !                       ROUTINE coord_area
+      !                     **********************
+      !
+      !  Purpose :
+      !  -------
+      !    Define coordinates of different regions 
+      !
+      !   Modifications :
+      !   -------------
+      !
+      !      SEE: /home/rd/ocx/postp/NEWGRIB/regions.txt 
+      !      and  /home/rd/nep/sms/verify/automat/include/regions.h
+      !
+      !      modification     : 04-09 (N. Daget)
+      !      modification     : 04-09 (N. Daget) add new regions
+      IMPLICIT NONE
+      !----------------------------------------------------------------------
+      ! local declarations
+      !----------------------------------------------------------------------
+      !
+      CHARACTER(len=20), INTENT(inout) :: reg
+      REAL, DIMENSION(4), INTENT(out) :: area
+      !
+      reg=TRIM(reg)
+      ! 
+      SELECT CASE (reg)
+      CASE ('global')
+         area = (/0.,360.,-90.,90./)
+      CASE ('nstrpac')
+         area = (/105.,270.,10.,30./)
+      CASE ('sstrpac')
+         area = (/105.,270.,-30.,-10./)
+      CASE ('npac')    
+         area = (/100.,260.,30.,70./)
+      CASE ('spac')
+         area = (/150.,290.,-70.,-30./)
+      CASE ('trpac')   
+         area = (/125.,280.,-30.,30./)
+      CASE ('natl')
+         area = (/290.,15.,30.,70./)
+      CASE ('satl')
+         area = (/290.,20.,-70.,-30./)
+      CASE ('tratl')
+         area = (/280.,20.,-20.,30./)
+      CASE ('nstratl')
+         area = (/280.,20.,5.,28./)
+      CASE ('sstratl')
+         area = (/300.,20.,-20.,5./)
+      CASE ('neatl')
+         area = (/320.,15.,30.,70./)
+      CASE ('nwatl')
+         area = (/260.,320.,30.,70./)
+      CASE ('equa')
+         area = (/0.,360.,-2.,2./)
+      CASE ('nino1')
+         area = (/270.,280.,-10.,-5./)
+      CASE ('nino2')
+         area = (/270.,280.,-5.,0./)
+      CASE ('nino12')
+         area = (/270.,280.,-10.,0./)
+      CASE ('nino3')
+         area = (/210.,270.,-5.,5./)
+      CASE ('nino4')
+         area = (/160.,210.,-5.,5./)
+      CASE ('nino34')
+         area = (/190.,240.,-5.,5./)
+      CASE ('ind1')
+         area = (/50.,70.,-10.,10./)
+      CASE ('ind2')
+         area = (/90.,110.,-10.,0./)
+      CASE ('ind3')
+         area = (/50.,90.,-10.,0./)
+      CASE ('eq1')
+         area = (/230.,270.,-5.,5./)
+      CASE ('eq2')
+         area = (/190.,230.,-5.,5./)
+      CASE ('eq3')
+         area = (/150.,190.,-5.,5./)
+      CASE ('eq4')
+         area = (/120.,150.,-5.,5./)
+      CASE ('neq1')
+         area = (/230.,270.,5.,15./)
+      CASE ('neq2')
+         area = (/190.,230.,5.,15./)
+      CASE ('neq3')
+         area = (/150.,190.,5.,15./)
+      CASE ('neq4')
+         area = (/120.,150.,5.,15./)
+      CASE ('eqpac')
+         area = (/130.,280.,-5.,5./)
+      CASE ('eqind')
+         area = (/40.,120.,-5.,5./)
+      CASE ('atl1')
+         area = (/315.,340.,0.,10./)
+      CASE ('atl2')
+         area = (/0.,10.,-3.,3./)
+      CASE ('atl3')
+         area = (/340.,360.,-3.,3./)
+      CASE ('eqatl')
+         area = (/290.,30.,-5.,5./)
+      CASE ('trop')
+         area = (/0.,360.,-30.,30./)      ! Tropics (second definition)
+      CASE ('nxtrp')
+         area = (/0.,360.,30.,70./)     ! Northern Extratropics
+      CASE ('sxtrp')
+         area = (/0.,360.,-70.,-30./)   ! Southern Extratropics
+      CASE ('trind')
+         area = (/40.,120.,-30.,30./)
+      CASE ('sind')
+         area = (/20.,150.,-70.,-30./)
+      CASE ('nepac')
+         area = (/210.,260.,30.,70./)
+      CASE ('nwpac')
+         area = (/100.,210.,30.,70./)
+      CASE ('trepac')
+         area = (/210.,270.,-30.,30./)
+      CASE ('trwpac')
+         area = (/100.,210.,-30.,30./)
+     ! PIRATA
+      CASE ('p20n38w') 
+         area = (/321.,323.,19.,21./)
+      CASE ('p15n38w') 
+         area = (/321.,323.,14.,16./)
+      CASE ('p12n38w') 
+         area = (/321.,323.,11.,13./)
+      CASE ('p8n38w') 
+         area = (/321.,323.,7.,9./)
+      CASE ('p4n38w') 
+         area = (/321.,323.,3.,5./)
+      CASE ('p0n35w') 
+         area = (/324.,326.,-0.5,0.5/)
+      CASE ('p21n23w') 
+         area = (/336.,338.,20.,22./)
+      CASE ('p12n23w') 
+         area = (/336.,338.,11.,13./)
+      CASE ('p4n23w') 
+         area = (/336.,338.,3.,5./)
+      CASE ('p0n23w') 
+         area = (/336.,338.,-0.5,0.5/)
+      CASE ('p0n10w') 
+         area = (/349.,351.,-0.5,0.5/)
+      CASE ('p0n0w') 
+         area = (/359.,1.,-0.5,0.5/)
+      CASE ('p5s10w') 
+         area = (/349.,351.,-6.,-4./)
+      CASE ('p10s10w') 
+         area = (/349.,351.,-11.,-9./)
+
+      ! TAO
+      CASE ('t0n156e') 
+         area = (/155.,157.,-0.5,0.5/)
+      CASE ('t0n165e') 
+         area = (/164.,166.,-0.5,0.5/)
+      CASE ('t0n180e') 
+         area = (/179.,181.,-0.5,0.5/)
+      CASE ('t0n170w') 
+         area = (/189.,191.,-0.5,0.5/)
+      CASE ('t0n155w') 
+         area = (/204.,206.,-0.5,0.5/)
+      CASE ('t0n140w')
+         area = (/219.,221.,-0.5,0.5/)
+      CASE ('t0n125w')
+         area = (/234.,236.,-0.5,0.5/)
+      CASE ('t0n110w')
+         area = (/249.,251.,-0.5,0.5/)
+      CASE ('t0n95w')
+         area = (/264.,266.,-0.5,0.5/)
+      CASE ('t5n156e')
+         area = (/155.,157.,4.5,5.5/)
+      CASE ('t5n165e')
+         area = (/164.,166.,4.5,5.5/)
+      CASE ('t5n180e')
+         area = (/179.,181.,4.5,5.5/)
+      CASE ('t5n170w')
+         area = (/189.,191.,4.5,5.5/)
+      CASE ('t5n155w') 
+         area = (/204.,206.,4.5,5.5/)
+      CASE ('t5n140w')
+         area = (/219.,221.,4.5,5.5/)
+      CASE ('t5n125w')
+         area = (/234.,236.,4.5,5.5/)
+      CASE ('t5n110w')
+         area = (/249.,251.,4.5,5.5/)
+      CASE ('t5n95w')
+         area = (/264.,266.,4.5,5.5/)
+      CASE ('t5s156e')
+         area = (/155.,157.,-5.5,-5.5/)
+      CASE ('t5s165e')
+         area = (/164.,166.,-5.5,4.5/)
+      CASE ('t5s180e')
+         area = (/179.,181.,-5.5,-4.5/)
+      CASE ('t5s170w')
+         area = (/189.,191.,-5.5,-4.5/)
+      CASE ('t5s155w') 
+         area = (/204.,206.,-5.5,-4.5/)
+      CASE ('t5s140w')
+         area = (/219.,221.,-5.5,-4.5/)
+      CASE ('t5s125w')
+         area = (/234.,236.,-5.5,-4.5/)
+      CASE ('t5s110w')
+         area = (/249.,251.,-5.5,-4.5/)
+      CASE ('t5s95w')
+         area = (/264.,266.,-5.5,-4.5/)
+      !RAMA
+      CASE ('r8s55e')
+         area = (/54.,56.,-8.,-7./)
+      CASE ('r12s55e')
+         area = (/54.,56.,-13.,-11./)
+      CASE ('r4s67e')
+         area = (/66.,68.,-4.5,-3.5/)
+      CASE ('r8s67e')
+         area = (/66.,68.,-9.,-7./)
+      CASE ('r12s67e')
+         area = (/66.,68.,-13.,-11./)
+      CASE ('r0n80e')
+         area = (/79.,81.,-0.5,0.5/)
+      CASE ('r4s80e')
+         area = (/79.,81.,-4.5,-3.5/)
+      CASE ('r8s80e')
+         area = (/79.,81.,-9.,-7./)
+      CASE ('r12s80e')
+         area = (/79.,81.,-13.,-11./)
+      CASE ('r12n90e')
+         area = (/89.,91.,11.,13./)
+      CASE ('r8n90e')
+         area = (/89.,91.,7.,9./)
+      CASE ('r4n90e')
+         area = (/89.,91.,3.5,4.5/)
+      CASE ('r0n90e')
+         area = (/89.,91.,-0.5,0.5/)
+      CASE ('r5s95e')
+         area = (/94.,96.,-5.5,-4.5/)
+      CASE ('r8s95e')
+         area = (/94.,96.,-9.,-7./)
+      CASE ('r8s100e')
+         area = (/99.,101.,-9.,-7./)
+
+
+      ! ENACT
+      CASE ('NE_subtrop_pac')
+         area = (/190.,260.,10.,30./)
+      CASE ('NW_subtrop_pac')
+         area = (/120.,190.,10.,30./)
+      CASE ('NE_extratrop_pac')
+         area = (/190.,250.,30.,60./)
+      CASE ('NW_extratrop_pac')
+         area = (/120.,190.,30.,60./)
+      CASE ('SE_subtrop_pac')
+         area = (/200.,300.,-30.,-10./)
+      CASE ('SW_subtrop_pac')
+         area = (/143.,200.,-30.,-10./)
+      CASE ('NE_subtrop_atl')
+         area = (/320.,355.,10.,30./)
+      CASE ('NW_subtrop_atl')
+         area = (/283.,320.,10.,30./)
+      CASE ('NE_extratrop_atl')
+         area = (/320.,360.,30.,60./)
+      CASE ('NW_extratrop_atl')
+         area = (/285.,320.,30.,60./)
+      CASE ('SE_subtrop_atl')
+         area = (/350.,20.,-30.,-10./)
+      CASE ('SW_subtrop_atl')
+         area = (/300.,350.,-30.,-10./)
+      CASE ('SE_subtrop_ind')
+         area = (/80.,120.,-30.,-10./)
+      CASE ('SW_subtrop_ind')
+         area = (/30.,80.,-30.,-10./)
+      CASE ('Southern_ocean_pac')
+         area = (/130.,290.,-80.,-30./)
+      CASE ('Southern_ocean_atl')
+         area = (/290.,20.,-80.,-30./)
+      CASE ('Southern_ocean_ind')
+         area = (/20.,130.,-80.,-30./)
+      ! Global areas different latitudes
+      CASE ('GLOBAL05')
+         area = (/0.,360.,-5.,5./)
+      CASE ('GLOBAL10')
+         area = (/0.,360.,-10.,10./)
+      CASE ('GLOBAL15')
+         area = (/0.,360.,-15.,15./)
+      CASE ('GLOBAL20')
+         area = (/0.,360.,-20.,20./)
+      CASE ('GLOBAL25')
+         area = (/0.,360.,-25.,25./)
+      CASE ('GLOBAL30')
+         area = (/0.,360.,-30.,30./)
+      CASE ('GLOBAL40')
+         area = (/0.,360.,-40.,40./)
+      CASE ('GLOBAL50')
+         area = (/0.,360.,-50.,50./)
+      CASE ('GLOBAL60')
+         area = (/0.,360.,-60.,60./)
+      CASE ('ARCTIC')
+         area = (/0.,360.,65.,90./)
+      CASE  ('ATL60NA')
+         area=(/260.,9.13,59.,61./) 
+      CASE  ('ATL50NA')
+         area=(/260.,5.,49.,51./) 
+      CASE  ('ATL40NA')
+         area=(/260.,358.,39.,41./) 
+      CASE  ('ATL35NA')
+         area=(/260.,360.,34.,36./) 
+      CASE  ('ATL30NA')
+         area=(/260.,360.,29.,31./) 
+      CASE  ('ATL26NA')
+         area=(/260.,360.,25.,27./) 
+      CASE  ('ATL20NA')
+         area=(/260.,360.,19.,21./) 
+      CASE  ('ATL10NA')
+         area=(/290.,360.,9.,11./) 
+      CASE  ('ATLEQA')
+         area=(/289.,11.,-1.,1./) 
+      CASE  ('ATL10SA')
+         area=(/320.,15.,-11.,-9./) 
+      CASE  ('ATL20SA')
+         area=(/318.,15.,-21.,-19./) 
+      CASE  ('ATL30SA')
+         area=(/310.,20.,-31.,-29./) 
+      CASE  ('PAC60NA')
+         area=(/140.,250.,59.,61./) 
+      CASE  ('PAC50NA')
+         area=(/130.,240.,49.,51./) 
+      CASE  ('PAC40NA')
+         area=(/125.,240.,39.,41./) 
+      CASE  ('PAC35NA')
+         area=(/115.,242.,34.,36./) 
+      CASE  ('PAC30NA')
+         area=(/115.,250.,29.,31./) 
+      CASE  ('PAC20NA')
+         area=(/100.,260.,19.,21./) 
+      CASE  ('PAC10NA')
+         area=(/105.,275.,9.,11./) 
+      CASE  ('PACEQA')
+         area=(/115.,282.,-1.,1./) 
+      CASE  ('INP10SA')
+         area=(/35.,290.,-11.,-9./) 
+      CASE  ('PAC20SA')
+         area=(/140.,292.,-21.,-19./) 
+      CASE  ('PAC30SA')
+         area=(/150.,292.,-31.,-29./) 
+      CASE  ('INDEQA')
+         area=(/40.,115.,-1.,1./) 
+      CASE  ('IND20SA')
+         area=(/30.,130.,-21.,-19./) 
+      CASE  ('IND30SA')
+         area=(/30.,120.,-31.,-29./) 
+      CASE  ('GLB60NA')
+         area=(/166.,9.13,59.,61./) 
+      CASE  ('GLB50NA')
+         area=(/0.,360.,49.,51./) 
+      CASE  ('GLB40NA')
+         area=(/0.,360.,39.,41./) 
+      CASE  ('GLB30NA')
+         area=(/0.,360.,29.,31./) 
+      CASE  ('GLB20NA')
+         area=(/0.,360.,19.,21./) 
+      CASE  ('GLB10NA')
+         area=(/0.,360.,9.,11./) 
+      CASE  ('GLBEQA')
+         area=(/0.,360.,-1.,1./) 
+      CASE  ('GLB10SA')
+         area=(/0.,360.,-11.,-9./) 
+      CASE  ('GLB20SA')
+         area=(/0.,360.,-21.,-19./) 
+      CASE  ('GLB30SA')
+         area=(/0.,360.,-31.,-29./) 
+      CASE  ('GLB40SA')
+         area=(/0.,360.,-41.,-39./) 
+      CASE  ('GLB50SA')
+         area=(/0.,360.,-51.,-49./) 
+      CASE  ('GLB60SA')
+         area=(/0.,360.,-61.,-59./) 
+      CASE ('npac25')    
+         area = (/100.,260.,25.,70./)
+      !Zonal sections
+      ! Measurements of Indonesian Throughflow at 
+      ! http://www.ocean.washington.edu/people/faculty/susanh/spga/spga.htm
+      ! INSTANT obserational program
+
+      CASE ('LOMBOK')
+!         area=(/114.,118.,-8.,-8./)  
+         area=(/114.,120.,-8.,-9./) ! first/last point rather than min,max
+      CASE ('MAKASSAR')
+!         area=(/114.,120.,-3.,-3./) 
+         area=(/114.,121.,-3.,-3./) 
+      CASE ('MALACCAS')
+!         area=(/99.,102.,3.,3./) 
+         area=(/103.,112.,-2.8,-2.8/) 
+      CASE ('BANDA')
+         area=(/122.,140.,-4.,-4./)
+      CASE  ('SAVU')
+!         area=(/122.,124.,-8.8,-8.8/) 
+         area=(/120.,125.,-8.8,-9.4/) 
+      CASE  ('PHILIPINES')
+         area=(/106.,120.,10.985,10.985/) 
+      CASE  ('YUCATAN')
+!         area=(/273.,285.,20.,20./) 
+         area=(/271.,283.,20.,21./) 
+      CASE  ('GIN')
+!         area=(/315.,7.,63.,63./) 
+         area=(/315.,9.8,63.,63./) 
+      CASE  ('LABRADOR')
+!         area=(/290.,315.,61.,61./) 
+         area=(/289.,310.,60.6,63.5/) 
+      CASE  ('ATL60N')
+!         area=(/260.,10.,57.,57./) 
+!         area=(/260.,10.87,57.,57./) 
+!         area=(/260.,11.2,57.,57./) 
+         area=(/260.,9.13,60.,59.925/) 
+      CASE  ('ATL50N')
+         area=(/260.,5.,50.,50./) 
+      CASE  ('ATL40N')
+         area=(/260.,358.,40.,40./) 
+      CASE  ('ATL35N')
+         area=(/260.,360.,35.,35./) 
+      CASE  ('ATL30N')
+         area=(/260.,360.,30.,30./) 
+      CASE  ('ATL27N')
+         area=(/260.,360.,27.,27./) 
+      CASE  ('ATL26N')
+         area=(/260.,360.,26.,26./) 
+      CASE  ('ATL20N')
+         area=(/260.,360.,20.,20./) 
+      CASE  ('ATL10N')
+!         area=(/300.,360.,10.,10./) 
+         area=(/290.,360.,10.,10./) 
+      CASE  ('ATLEQ')
+!         area=(/300.,10.,0.,0./) 
+         area=(/289.,11.,0.,0./) 
+      CASE  ('ATL10S')
+         area=(/320.,15.,-10.,-10./) 
+      CASE  ('ATL20S')
+         area=(/318.,15.,-30.,-30./) 
+      CASE  ('ATL30S')
+         area=(/310.,20.,-30.,-30./) 
+      CASE  ('PAC60N')
+         area=(/140.,250.,60.,60./) 
+      CASE  ('PAC50N')
+         area=(/130.,240.,50.,50./) 
+      CASE  ('PAC40N')
+         area=(/125.,240.,40.,40./) 
+      CASE  ('PAC35N')
+!         area=(/115.,240.,35.,35./) 
+         area=(/115.,242.,35.,35./) 
+      CASE  ('PAC30N')
+         area=(/115.,250.,30.,30./) 
+      CASE  ('PAC25N')
+         area=(/100.,260.,25.,25./) 
+      CASE  ('PAC20N')
+         area=(/100.,260.,20.,20./) 
+      CASE  ('PAC10N')
+!         area=(/98.,275.,10.,10./) 
+         area=(/105.,275.,10.,10./) 
+      CASE  ('PACEQ')
+         area=(/115.,282.,0.,0./) 
+      CASE  ('INP10S')
+         area=(/35.,290.,-10.,-10./) 
+      CASE  ('PAC20S')
+         area=(/140.,292.,-20.,-20./) 
+      CASE  ('PAC30S')
+         area=(/150.,292.,-30.,-30./) 
+      CASE  ('INDEQ')
+         area=(/40.,115.,-0.,-0./) 
+      CASE  ('IND20S')
+         area=(/30.,130.,-20.,-20./) 
+      CASE  ('IND30S')
+         area=(/30.,120.,-30.,-30./) 
+      CASE  ('GLB60N')
+!         area=(/0.,360.,60.,60./) 
+!         area=(/166.,10.,60.5,60./) 
+!         area=(/166.,6.6,60.5,59.7/) 
+         area=(/166.,9.13,60.5,59.925/) 
+      CASE  ('GLB50N')
+         area=(/0.,360.,50.,50./) 
+      CASE  ('GLB40N')
+         area=(/0.,360.,40.,40./) 
+      CASE  ('GLB30N')
+         area=(/0.,360.,30.,30./) 
+      CASE  ('GLB20N')
+         area=(/0.,360.,20.,20./) 
+      CASE  ('GLB10N')
+         area=(/0.,360.,10.,10./) 
+      CASE  ('GLBEQ')
+         area=(/0.,360.,0.,0./) 
+      CASE  ('GLB10S')
+         area=(/0.,360.,-10.,-10./) 
+      CASE  ('GLB20S')
+         area=(/0.,360.,-20.,-20./) 
+      CASE  ('GLB30S')
+         area=(/0.,360.,-30.,-30./) 
+      CASE  ('GLB40S')
+         area=(/0.,360.,-40.,-40./) 
+      CASE  ('GLB50S')
+         area=(/0.,360.,-50.,-50./) 
+      CASE  ('GLB60S')
+         area=(/0.,360.,-60.,-60./) 
+      CASE  ('SUM-DARWIN')
+         area=(/104.,131.,-4.9,-15.3/) 
+
+      !Meridonal sections (for zonal transports)
+      CASE ('IT'   )                    !From Flores to Australia
+!         area=(/114.,114.,-22.,-8.5/)
+         area=(/126.,126.,-8.8,-16./)
+      CASE ('ITA'   )                   !From Sumatra to Australia
+!         area=(/115.,114.,-22.,-3./)
+         area=(/104.,115.,-4.9,-24.7/)
+      CASE ('TIMOR')
+         area=(/124.,124.,-17.,-9./) 
+!      CASE  ('OMBAI')
+!         area=(/124.5,124.5,-9.2,-8.2/) 
+!      CASE  ('SUMBA') 
+!         area=(/120.,120.,-9.3,-8.3/) 
+!      CASE ('LUZON')
+!         area=(/120.5,120.5,17.,23./) 
+      CASE ('DRAKE')
+!         area=(/290.,290.,-75.,-52./) 
+!         area=(/-69.,-64.,-55.2,-65.9/) 
+         area=(/291.,296.,-54.6,-65.9/) 
+      CASE ('TORRES')
+         area=(/143.,143.,-15.,-8./) 
+      CASE ('MED')
+         area=(/356.,356.,32.,40./) 
+      CASE ('FLORIDA')
+!         area=(/279.5,279.5,22.,28./) 
+!         area=(/-81.,-79,26.5,21.9/) 
+         area=(/-82.,-79.,28.2,22./) 
+      CASE ('ANTILLAS')
+!         area=(/290.,290.,10.,18./) 
+         area=(/-72.,-72.,19.1,8.2/) 
+      CASE ('GOODHOPE')
+!         area=(/340.,340.,-80.,-30./) 
+         area=(/23.,44.,-31.7,-68.2/) 
+      CASE ('SOUTHAUS')
+!         area=(/140.,140.,-80.,-30./) 
+         area=(/133.,133.,-30.,-67.5/) 
+      CASE default
+         PRINT*,'area: ', reg, 'is not defined'
+         CALL abort
+      END SELECT
+
+   END SUBROUTINE coord_area
+
+   SUBROUTINE coord_user_init (sec)
+      CHARACTER(len=1), INTENT(IN) :: sec
+      CHARACTER(len=20), DIMENSION(:), ALLOCATABLE  :: cl_boxes
+      INTEGER                            :: nbox
+      CHARACTER(len=32) :: cdnamelist = 'coords.nml'
+      LOGICAL :: lexists, lnodefaults
+      CHARACTER(len=20) :: carea
+      REAL :: lat1,lat2,lon1,lon2,dlat,dlon
+      LOGICAL :: lreg, lstd
+      INTEGER :: nlat,nlon
+      INTEGER :: i,j,k
+      NAMELIST/area/lstd,lreg,carea,lat1,lat2,lon1,lon2,dlat,dlon
+
+      lnodefaults=.TRUE.
+      nboxuser=0
+      SELECT CASE (sec)
+      CASE ('u')
+         nbox=nsecm
+         ALLOCATE(cl_boxes(nbox))
+         cl_boxes(:)=cl_secm(:)
+      CASE ('v')
+         nbox=nsecz
+         ALLOCATE(cl_boxes(nbox))
+         cl_boxes(:)=cl_secz(:)
+      CASE default
+         nbox=nsech
+         ALLOCATE(cl_boxes(nbox))
+         cl_boxes(:)=cl_sech(:)
+      END SELECT
+      INQUIRE(file=cdnamelist,exist=lexists) 
+      IF (lexists) THEN
+         nboxuser=0
+         OPEN(20,file=cdnamelist)
+         DO
+            carea='undefined'
+            lat1=-90
+            lat2=90
+            lon1=0
+            lon2=360
+            dlat=10
+            dlon=10
+            lreg=.FALSE.
+            lstd=.FALSE.
+            READ(20,area,end=100)
+            DO
+               IF (lon1<0) lon1=lon1+360
+               IF (lon1>360) lon1=lon1-360
+               IF ((lon1>=0).AND.(lon1<=360)) EXIT
+            ENDDO
+            DO
+               IF (lon2<0) lon2=lon2+360
+               IF (lon2>360) lon2=lon2-360
+               IF ((lon2>=0).AND.(lon2<=360)) EXIT
+            ENDDO
+            WRITE(*,area)
+            IF (lreg.AND.(TRIM(carea)/='undefined')) THEN
+               WRITE(*,*)'coord_init: please specify either lreg=true '//&
+                  &      'or carea/=undefined'
+               CALL abort
+            ENDIF
+            IF (TRIM(carea)/='undefined') THEN
+               nboxuser=nboxuser+1
+            ENDIF
+            IF (lreg) THEN
+               nlat=NINT((MAX(lat1,lat2)-MIN(lat1,lat2))/dlat)
+               nlon=NINT((MAX(lon1,lon2)-MIN(lon1,lon2))/dlon)
+               nboxuser=nboxuser+nlat*nlon
+            ENDIF
+            IF (lstd) THEN
+               IF (lnodefaults) THEN
+                  nboxuser=nboxuser+nbox
+                  lnodefaults=.FALSE.
+               ENDIF
+            ENDIF
+         END DO
+100      CONTINUE
+         WRITE(*,*)'Total areas = ',nboxuser
+         IF (nboxuser==0) THEN
+            CLOSE(20)
+            WRITE(*,*)'coord_init: no boxes defined!!'
+            CALL abort
+         ENDIF
+         ALLOCATE(cl_boxes_user(nboxuser))
+         ALLOCATE(areas(4,nboxuser))
+         nboxuser=0
+         IF (.NOT.lnodefaults) THEN
+            cl_boxes_user(1:nbox)=cl_boxes(1:nbox)
+            DO i=1,nbox
+               CALL coord_area( cl_boxes_user(i), areas(:,i) )
+            ENDDO
+            nboxuser=nboxuser+nbox
+         ENDIF
+         REWIND(20)
+         WRITE(*,*)'Reading areas'
+         DO
+            carea='undefined'
+            lat1=-90
+            lat2=90
+            lon1=0
+            lon2=360
+            dlat=10
+            dlon=10
+            lreg=.FALSE.
+            lstd=.FALSE.
+            READ(20,area,end=200)
+            DO
+               IF (lon1<0) lon1=lon1+360
+               IF (lon1>360) lon1=lon1-360
+               IF ((lon1>=0).AND.(lon1<=360)) EXIT
+            ENDDO
+            DO
+               IF (lon2<0) lon2=lon2+360
+               IF (lon2>360) lon2=lon2-360
+               IF ((lon2>=0).AND.(lon2<=360)) EXIT
+            ENDDO
+            IF (TRIM(carea)/='undefined') THEN
+               nboxuser=nboxuser+1
+               cl_boxes_user(nboxuser)=carea
+               areas(1,nboxuser)=MIN(lon1,lon2)
+               areas(2,nboxuser)=MAX(lon1,lon2)
+               areas(3,nboxuser)=MIN(lat1,lat2)
+               areas(4,nboxuser)=MAX(lat1,lat2)
+            ENDIF
+            IF (lreg) THEN
+               nlat=NINT((MAX(lat1,lat2)-MIN(lat1,lat2))/dlat)
+               nlon=NINT((MAX(lon1,lon2)-MIN(lon1,lon2))/dlon)
+               k=0
+               DO j=1,nlat
+                  DO i=1,nlon
+                     k=k+1
+                     areas(1,k+nboxuser)=MIN(lon1,lon2)+(i-1)*dlon
+                     areas(2,k+nboxuser)=MIN(lon1,lon2)+i*dlon
+                     areas(3,k+nboxuser)=MIN(lat1,lat2)+(j-1)*dlat
+                     areas(4,k+nboxuser)=MIN(lat1,lat2)+j*dlat
+                     WRITE(cl_boxes_user(k+nboxuser)(1:5),'(I4.4,A1)') &
+                        & NINT(areas(1,k+nboxuser)*10),'e'
+                     WRITE(cl_boxes_user(k+nboxuser)(6:10),'(I4.4,A1)') &
+                        & NINT(areas(2,k+nboxuser)*10),'e'
+                     IF (areas(3,k+nboxuser)<0) THEN
+                        WRITE(cl_boxes_user(k+nboxuser)(11:15),'(I4.4,A1)') &
+                           & -NINT(areas(3,k+nboxuser)*10),'s'
+                     ELSE
+                        WRITE(cl_boxes_user(k+nboxuser)(11:15),'(I4.4,A1)') &
+                           & NINT(areas(3,k+nboxuser)*10),'n'
+                     ENDIF
+                     IF (areas(4,k+nboxuser)<0) THEN
+                        WRITE(cl_boxes_user(k+nboxuser)(16:20),'(I4.4,A1)') &
+                           & -NINT(areas(4,k+nboxuser)*10),'s'
+                     ELSE
+                        WRITE(cl_boxes_user(k+nboxuser)(16:20),'(I4.4,A1)') &
+                           & NINT(areas(4,k+nboxuser)*10),'n'
+                     ENDIF
+                  ENDDO
+               ENDDO
+               nboxuser=nboxuser+nlat*nlon
+            ENDIF
+         END DO
+200      CONTINUE
+         CLOSE(20)
+      ELSE
+         nboxuser=nbox
+         ALLOCATE(cl_boxes_user(nboxuser))
+         ALLOCATE(areas(4,nboxuser))
+         cl_boxes_user(:)=cl_boxes(:)
+         DO i=1,nbox
+            CALL coord_area( cl_boxes_user(i), areas(:,i) )
+         ENDDO
+      ENDIF
+      DO i=1,nboxuser
+         WRITE(*,'(A,4F12.2)')cl_boxes_user(i),areas(:,i)
+         DO j=i+1,nboxuser
+            IF (TRIM(cl_boxes_user(i))==TRIM(cl_boxes_user(j))) THEN
+               WRITE(*,*)'coord_user_init: dublicate boxes'
+               CALL abort
+            ENDIF
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE coord_user_init
+
+   SUBROUTINE coord_area_user( reg, area, ldfail )
+      !-----------------------------------------------------------------------
+      !
+      !                       ROUTINE coord_area_user
+      !                     ****************************
+      !
+      !  Purpose :
+      !  -------
+      !    Get coordinate of different regions
+      !
+      !   Modifications :
+      !   -------------
+      IMPLICIT NONE
+      !----------------------------------------------------------------------
+      ! local declarations
+      !----------------------------------------------------------------------
+      !
+      CHARACTER(len=20), INTENT(inout) :: reg
+      REAL, DIMENSION(4), INTENT(out) :: area
+      LOGICAL, OPTIONAL, INTENT(out) :: ldfail
+      INTEGER :: i
+      LOGICAL :: lnotfound
+      !
+      reg=TRIM(reg)
+
+      lnotfound=.TRUE.
+      DO i=1,nboxuser
+         IF (reg==TRIM(cl_boxes_user(i))) THEN
+            area(:)=areas(:,i)
+            lnotfound=.FALSE.
+            EXIT
+         ENDIF
+      ENDDO
+      IF (PRESENT(ldfail)) THEN
+         ldfail=lnotfound
+      ELSE
+         IF (lnotfound) THEN
+            WRITE(*,*)'coord_area_user: area not found'
+            CALL abort
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE coord_area_user
+
+END MODULE coords
Index: /utils/tools_ticket2413/OBSTOOLS/src/corio2fb.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/corio2fb.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/corio2fb.F90	(revision 12863)
@@ -0,0 +1,90 @@
+PROGRAM corio2fb
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM corio2fb **
+   !!
+   !!  ** Purpose : Convert Coriolis format profiles to feedback format
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !!
+   !!   Usage:
+   !!     corio2fb.exe outputfile inputfile1 inputfile2 ...
+   !!
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE obs_fbm
+   USE obs_prof_io
+   USE convmerge
+   IMPLICIT NONE
+   !
+   ! Command line arguments for output file and input files
+   !
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nargs
+   CHARACTER(len=256) :: cdoutfile
+   CHARACTER(len=256),ALLOCATABLE :: cdinfile(:)
+   !
+   ! Input data
+   !
+   TYPE(obfbdata), POINTER :: coriof(:)
+   INTEGER :: ninfiles,ntotcorio,nmaxlev
+   INTEGER,ALLOCATABLE  :: iset(:),inum(:),iindex(:)
+   !
+   ! Output data
+   !
+   TYPE(obfbdata) :: fbdata
+   !
+   ! Loop variables
+   !
+   INTEGER :: ia,ii,ij
+   !
+   ! Get number of command line arguments
+   !
+   nargs=IARGC()
+   IF (nargs < 1) THEN
+      WRITE(*,'(A)')'Usage:'
+      WRITE(*,'(A)')'corio2fb outputfile inputfile1 inputfile2 ...'
+      CALL abort()
+   ENDIF
+   CALL getarg(1,cdoutfile)
+   !
+   ! Get input data
+   !
+   ALLOCATE( coriof(MAX(nargs-1,1)) )
+   ALLOCATE( cdinfile(nargs-1) )
+   ntotcorio = 0
+   ninfiles  = nargs - 1
+   DO ia=1,ninfiles
+      CALL getarg( ia + 1, cdinfile(ia) )
+      CALL read_coriofile( TRIM(cdinfile(ia)), coriof(ia), 6, .TRUE., .FALSE. )
+      WRITE(*,'(2A)')'File = ',TRIM(cdinfile(ia))
+      WRITE(*,'(A,I9,A)')'has',coriof(ia)%nobs,' profiles'
+      ntotcorio = ntotcorio + coriof(ia)%nobs
+      nmaxlev   = MAX( nmaxlev, coriof(ia)%nlev )
+   ENDDO
+   IF (ninfiles==0) THEN
+      CALL init_obfbdata( coriof(1) )
+      CALL alloc_obfbdata( coriof(1), 2, 0, 1, 0, 1, .FALSE. )
+      coriof(1)%cname(1) = 'POTM'
+      coriof(1)%cname(2) = 'PSAL'
+      coriof(1)%coblong(1) = 'Potential temperature'
+      coriof(1)%coblong(2) = 'Practical salinity'
+      coriof(1)%cobunit(1) = 'Degrees Celsius'
+      coriof(1)%cobunit(2) = 'PSU'
+      coriof(1)%cextname(1) = 'TEMP'
+      coriof(1)%cextlong(1) = 'Insitu temperature'
+      coriof(1)%cextunit(1) = 'Degrees Celsius'
+      coriof(1)%cdjuldref = '19500101000000'
+   ENDIF
+   WRITE(*,'(A,I8)') 'Total profiles : ',ntotcorio
+   !
+   ! Merge and output the data.
+   !
+   CALL conv_fbmerge( TRIM(cdoutfile), ninfiles, coriof )
+   
+END PROGRAM corio2fb
Index: /utils/tools_ticket2413/OBSTOOLS/src/ctl_stop.h90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/ctl_stop.h90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/ctl_stop.h90	(revision 12863)
@@ -0,0 +1,21 @@
+   SUBROUTINE ctl_stop( cerr )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE ctl_stop **
+      !!
+      !!  ** Purpose : Stop execution
+      !!
+      !!  ** Method  : 
+      !!
+      !!  ** Action  :
+      !!
+      !!   History :   (2008-12) K. Mogensen. NEMOVAR version
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*) :: cerr
+
+      WRITE(*,*)'Error:'
+      WRITE(*,*)TRIM(cerr)
+      CALL abort
+
+   END SUBROUTINE ctl_stop
+
Index: /utils/tools_ticket2413/OBSTOOLS/src/date_utils.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/date_utils.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/date_utils.F90	(revision 12863)
@@ -0,0 +1,482 @@
+MODULE date_utils
+
+   USE toolspar_kind
+   IMPLICIT NONE
+
+CONTAINS
+
+   SUBROUTINE add_date(initial_date,hours,final_date)
+
+      ! Add a number of hours to initial_date and return it in final_date
+
+      IMPLICIT NONE
+
+
+      !! Arguments
+      INTEGER,INTENT(in) :: initial_date ! Initial date (YYYYMMDDHH)
+      INTEGER,INTENT(in) :: hours        ! Number of hours to add
+      INTEGER,INTENT(out) :: final_date  ! Final date (YYYYMMDDHH)
+
+      !! Local variables
+
+      INTEGER :: isec,imin,ihours,iyear,imon,iday ! temporary results
+      REAL(dp):: juld
+
+      CALL split_date(initial_date,iyear,imon,iday,ihours)
+
+      CALL greg2jul(0,0,ihours,iday,imon,iyear,juld)
+
+      juld=juld+REAL(hours)/24.0
+
+      CALL jul2greg(isec,imin,ihours,iday,imon,iyear,juld)
+
+      final_date=iyear*1000000+imon*10000+iday*100+ihours
+
+   END SUBROUTINE add_date
+
+
+   SUBROUTINE add_days_to_date(initial_date,days,final_date)
+
+      ! Add a number of days to initial_date and return it in final_date
+
+      IMPLICIT NONE
+
+
+      !! Arguments
+      INTEGER,INTENT(in) :: initial_date ! Initial date (YYYYMMDD)
+      INTEGER,INTENT(in) :: days         ! Number of days to add
+      INTEGER,INTENT(out) :: final_date  ! Final date (YYYYMMDD)
+
+      !! Local variables
+
+      INTEGER :: isec,imin,ihours,iyear,imon,iday ! temporary results
+      REAL(dp):: juld
+
+		! Account for lack of hours in date format (initial_date*100)
+      CALL split_date(initial_date*100,iyear,imon,iday,ihours)
+
+      CALL greg2jul(0,0,ihours,iday,imon,iyear,juld)
+
+      juld=juld+REAL(days)
+
+      CALL jul2greg(isec,imin,ihours,iday,imon,iyear,juld)
+
+      final_date=(iyear*1000000+imon*10000+iday*100+ihours)/100
+
+   END SUBROUTINE add_days_to_date
+
+
+   SUBROUTINE split_date(iyyyymmddhh,iyyyy,imm,idd,ihh)
+
+      ! Splits a date in YYYYMMDDHH format into iyyyy, imm, idd, ihh
+
+      IMPLICIT NONE
+      INTEGER,INTENT(in) :: iyyyymmddhh
+      INTEGER,INTENT(out) :: iyyyy,imm,idd,ihh
+
+      iyyyy=iyyyymmddhh/1000000
+      imm=iyyyymmddhh/10000-iyyyy*100
+      idd=iyyyymmddhh/100-(iyyyy*10000+imm*100)
+      ihh=MOD(iyyyymmddhh,100)
+
+   END SUBROUTINE split_date
+
+   SUBROUTINE jul2greg( ksec, kminut, khour, kday, kmonth, kyear, &
+      &                           prelday )
+
+      IMPLICIT NONE
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE jul2greg  ***
+      !!
+      !! ** Purpose : Take the relative time in days and re-express in terms of
+      !!              seconds, minutes, hours, days, month, year.
+      !!
+      !! ** Method  : Reference date : 19500101
+      !!
+      !! ** Action  :
+      !!
+      !! History
+      !!      ! 06-04  (A. Vidard) Original
+      !!      ! 06-05  (A. Vidard) Reformatted and refdate      
+      !!      ! 06-10  (A. Weaver) Cleanup
+      !!-----------------------------------------------------------------------
+
+      ! * Arguments
+      INTEGER, INTENT(OUT) :: &
+         & ksec,   &
+         & kminut, &
+         & khour,  &
+         & kday,   &
+         & kmonth, &
+         & kyear
+      REAL(KIND=dp), INTENT(IN) :: &
+         & prelday
+
+      !! * Local declarations
+      INTEGER, PARAMETER :: &
+         & jpgreg = 2299161, &
+         & jporef = 2433283, &
+         & jparef = 2415021
+      INTEGER :: &
+         & ijulian, &
+         & ij1,     &
+         & ija,     &
+         & ijb,     &
+         & ijc,     &
+         & ijd,     &
+         & ije,     &
+         & isec,    &
+         & imin,    &
+         & ihou,    &
+         & iday,    &
+         & imon,    &
+         & iyea,    &
+         & iref
+      REAL(KIND=wp) :: &
+         & zday, &
+         & zref
+
+      ! Main computation
+      iref = jporef 
+
+      zday = prelday
+      ksec = NINT( 86400. * MOD( zday, 1.0_wp ) )
+
+      IF ( ksec < 0. ) ksec = 86400. + ksec
+
+      khour  = ksec / 3600
+      kminut = ( ksec - 3600 * khour ) / 60
+      ksec   = MOD( ksec , 60 )
+
+      ijulian = iref + INT( zday )
+      IF ( zday < 0. ) ijulian = ijulian - 1
+
+      ! If input date after 10/15/1582 :
+      IF ( ijulian >= jpgreg ) THEN
+         ij1 = INT( ( DBLE( ijulian - 1867216 ) - 0.25 ) / 36524.25 )
+         ija = ijulian + 1 + ij1 - INT( ( 0.25 * ij1 ) )
+      ELSE
+         ija = ijulian
+      ENDIF
+
+      ijb = ija + 1524
+      ijc = INT( 6680. + ( DBLE ( ijb - 2439870 ) - 122.1 ) / 365.25 )
+      ijd = 365 * ijc + INT( 0.25 * ijc )
+      ije = INT( ( ijb - ijd ) / 30.6001 )
+      kday = ijb - ijd - INT( 30.6001 * ije )
+      kmonth = ije - 1
+      IF ( kmonth > 12 ) kmonth = kmonth - 12
+      kyear = ijc - 4715
+      IF ( kmonth > 2 ) kyear = kyear - 1
+      IF ( kyear <= 0 ) kyear = kyear - 1
+
+   END SUBROUTINE jul2greg
+
+   SUBROUTINE greg2jul( ksec, kmin, khour, kday, kmonth, kyear, pjulian )
+
+      IMPLICIT NONE
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE greg2jul  ***
+      !!
+      !! ** Purpose : Produce the time relative to the current date and time.
+      !!
+      !! ** Method  : The units are days, so hours and minutes transform to
+      !!              fractions of a day. 
+      !!
+      !!              Reference date : 19500101
+      !! ** Action  :
+      !!
+      !! History :
+      !!      ! 06-04  (A. Vidard) Original
+      !!      ! 06-04  (A. Vidard) Reformatted
+      !!      ! 06-10  (A. Weaver) Cleanup
+      !!-----------------------------------------------------------------------
+
+      ! * Arguments
+      INTEGER, INTENT(IN) :: &
+         & ksec,   &
+         & kmin,   &
+         & khour,  & 
+         & kday,   &
+         & kmonth, & 
+         & kyear
+      REAL(KIND=dp), INTENT(OUT) :: &
+         & pjulian
+
+      !! * Local declarations
+      INTEGER, PARAMETER :: &
+         & jpgreg = 15 + 31 * ( 10 + 12 * 1582 ), &  ! Gregorian calendar introduction date
+         & jpjref = 2433283                          ! Julian reference date: 19500101
+      INTEGER :: &
+         & ija,     &
+         & ijy,     &
+         & ijm,     &
+         & ijultmp, &
+         & ijyear
+
+      ! Main computation
+      ijyear = kyear
+      IF ( ijyear < 0 ) ijyear = ijyear + 1
+      IF ( kmonth > 2 ) THEN
+         ijy = ijyear
+         ijm = kmonth + 1
+      ELSE
+         ijy = ijyear  - 1
+         ijm = kmonth + 13
+      ENDIF
+      ijultmp = INT( 365.25 * ijy ) + INT( 30.6001 * ijm ) + kday + 1720995
+      IF ( kday + 31 * ( kmonth + 12 * ijyear ) >= jpgreg ) THEN
+         ija = INT( 0.01 * ijy )
+         ijultmp = ijultmp + 2 - ija + INT( 0.25 * ija )
+      ENDIF
+      pjulian = ( ijultmp - jpjref ) + ( ( 60 * khour + kmin ) * 60 + ksec ) / 86400.
+
+   END SUBROUTINE greg2jul
+
+
+   SUBROUTINE addseconds(iyear,imon,iday,ihour,imin,isec,iaddsec)
+
+      ! Add iaddsecs to the date and return the new date (in place)
+
+      !! Arguments
+
+      INTEGER,intent(inout) :: iyear,imon,iday,ihour,imin,isec,iaddsec
+
+      !! Local variables
+
+      INTEGER :: itotsec,idays,isecs
+      INTEGER :: mday(12) = (/31,28,31,30,31,30,31,31,30,31,30,31/) 
+
+      itotsec=iaddsec+ihour*3600*imin*60+isec
+
+      IF (itotsec<0) THEN
+         WRITE(*,*)'Negative itotsec in addseconds'
+         WRITE(*,*)'This does not work'
+         RETURN
+      ENDIF
+
+      ihour=0
+      imin=0
+      isec=0
+
+      idays=itotsec/86400
+      isecs=itotsec-idays*86400
+      iday=iday+idays
+
+      ! Compute the date
+      DO
+         ! Leap year 
+         mday(2)=28
+         IF (MOD(iyear,4).EQ.0) mday(2)=29
+         IF (MOD(iyear,100).EQ.0) mday(2)=28
+         IF (MOD(iyear,400).EQ.0) mday(2)=29
+         IF (MOD(iyear,4000).EQ.0) mday(2)=28
+
+         IF (iday.GT.mday(imon))THEN
+            iday=iday-mday(imon)
+            imon=imon+1
+            IF(imon.GT.12)THEN
+               imon=1
+               iyear=iyear+1
+            ENDIF
+         ELSE
+            EXIT
+         ENDIF
+
+      ENDDO
+
+      ! Set the time
+      ihour=isecs/3600
+      imin=isecs/60-ihour*60
+      isec=isecs-ihour*3600-imin*60
+
+   END SUBROUTINE addseconds
+
+   INTEGER FUNCTION nextdate(idate)
+
+      ! Return next date.
+      ! Date format is assumed to be YYYYMMDD
+
+      IMPLICIT NONE
+
+      !! Arguments
+
+      INTEGER :: idate ! Initial date
+
+      !! Local variables
+
+      INTEGER :: year,day,mon
+      INTEGER :: mday(12) = (/31,28,31,30,31,30,31,31,30,31,30,31/)
+
+
+      day=MOD(idate,100)
+      mon=MOD((idate-day)/100,100)
+      year=idate/10000
+
+      mday(2)=28
+      IF (MOD(year,4).EQ.0) mday(2)=29
+      IF (MOD(year,100).EQ.0) mday(2)=28
+      IF (MOD(year,400).EQ.0) mday(2)= 29
+      IF (MOD(year,4000).EQ.0) mday(2) = 28
+
+      day=day+1
+      IF (day.GT.mday(mon))THEN
+         day=1
+         mon=mon+1
+         IF(mon.GT.12)THEN
+            mon=1
+            year=year+1
+         ENDIF
+      ENDIF
+      nextdate=year*10000+mon*100+day
+      RETURN
+
+   END FUNCTION nextdate
+
+   INTEGER FUNCTION prevdate(idate)
+
+      ! Return previous date.
+      ! Date format is assumed to be YYYYMMDD
+
+      IMPLICIT NONE
+
+      !! Arguments
+
+      INTEGER :: idate ! Initial date
+
+      !! Local variables
+
+      INTEGER :: year,day,mon
+      INTEGER :: mday(12) = (/31,28,31,30,31,30,31,31,30,31,30,31/)
+
+
+      day=MOD(idate,100)
+      mon=MOD((idate-day)/100,100)
+      year=idate/10000
+
+      mday(2)=28
+      IF (MOD(year,4).EQ.0) mday(2)=29
+      IF (MOD(year,100).EQ.0) mday(2)=28
+      IF (MOD(year,400).EQ.0) mday(2)= 29
+      IF (MOD(year,4000).EQ.0) mday(2) = 28
+
+      day=day-1
+      IF (day.LT.1)THEN
+         mon=mon-1
+         IF(mon.LT.1)THEN
+            mon=12
+            year=year-1
+         ENDIF
+         day=mday(mon)
+      ENDIF
+      prevdate=year*10000+mon*100+day
+      RETURN
+
+   END FUNCTION prevdate
+
+   INTEGER FUNCTION diffdate(idate1,idate2)
+
+      ! Compute difference in days between dates
+      ! Assumes YYYYMMDD format for dates
+
+      IMPLICIT NONE
+
+      !! Argument
+
+      INTEGER :: idate1,idate2    ! Dates to be diffed.
+
+      !! Local variables
+
+      INTEGER :: itdate1,itdate2
+      INTEGER :: it
+
+      itdate1=MIN(idate1,idate2)
+      itdate2=MAX(idate1,idate2)
+
+      IF (itdate1==itdate2) THEN
+         diffdate=0
+         RETURN
+      ENDIF
+      diffdate=0
+      it=itdate1
+      DO 
+         it=nextdate(it)
+         diffdate=diffdate+1
+         IF (it==itdate2) EXIT
+      ENDDO
+      RETURN
+
+   END FUNCTION diffdate
+
+   INTEGER FUNCTION difftime(itime1,itime2)
+
+      ! Compute difference in minutes between times
+      ! Assumes HHMM or HMM or MM or M format for dates
+		!
+		! ORDER MATTERS - itime1 is ealier time
+		! Result is an integer number of minutes
+
+      IMPLICIT NONE
+      INTEGER, INTENT(IN) :: itime1,itime2    ! Times to be diffed.
+      INTEGER :: imin1, imin2, ihr1, ihr2
+
+		ihr1 = (itime1/100)
+		ihr2 = (itime2/100)
+		
+		imin1 = (itime1 - ihr1*100) + (60 * ihr1)
+		imin2 = (itime2 - ihr2*100) + (60 * ihr2)
+		
+		! Assume that itime2 is later, so wrap around midnight if necessary.
+		IF (imin2 < imin1) THEN
+			imin2 = imin2 + 24*60
+		END IF
+		
+		difftime = imin2 - imin1
+		
+   END FUNCTION difftime
+
+
+   INTEGER FUNCTION add_mins_to_time(itime1, imin_add)
+
+      ! Add number of minutes onto given time
+      ! Assumes time in HHMM or HMM or MM or M format
+		!
+		! Result is in HHMM format
+
+      IMPLICIT NONE
+      INTEGER, INTENT(IN) :: itime1,imin_add
+      INTEGER :: imin1, ihr1, imin2, ihr2
+
+		ihr1 = (itime1/100)
+		
+		! itime1 in minutes from previous midnight
+		imin1 = (itime1 - ihr1*100) + (60 * ihr1)
+		
+		imin1 = imin1 + imin_add
+		
+		! Add 1day if time went nagative
+		IF (imin1 < 0) THEN
+			imin1 = imin1 + 24*60
+		END IF
+		
+		! Turn number of minutes back into HHMM
+		ihr2 = imin1/60
+		imin2 = imin1 - ihr2*60
+
+		DO
+			IF (ihr2<0) THEN
+				ihr2 = ihr2 + 24
+			ELSE IF (ihr2>=24) THEN
+				ihr2 = ihr2 - 24
+			END IF
+			IF ((ihr2>=0).OR.(ihr2<24)) EXIT
+		END DO
+
+		add_mins_to_time = ihr2*100 + imin2
+	
+   END FUNCTION add_mins_to_time
+
+
+END MODULE date_utils
Index: /utils/tools_ticket2413/OBSTOOLS/src/ddatetoymdhms.h90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/ddatetoymdhms.h90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/ddatetoymdhms.h90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../src/OCE/OBS/ddatetoymdhms.h90
Index: /utils/tools_ticket2413/OBSTOOLS/src/distance.h90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/distance.h90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/distance.h90	(revision 12863)
@@ -0,0 +1,33 @@
+   REAL FUNCTION distance( plon1, plat1, plon2, plat2 )
+      ! Arggumnts
+      REAL :: plon1,plat1,plat2,plon2
+      ! Local variables
+      REAL :: zplat1,zplon1,zplat2,zplon2
+      REAL :: za1,za2,zb1,zb2,zc1,zc2,zcos1,zcos2
+      REAL, PARAMETER :: zrad = 3.141592653589793/180.0
+      REAL, parameter :: rearth = 6371229
+
+      zplon1 = plon1
+      zplon2 = plon2
+      IF ( zplon1 <  -180 ) zplon1 = zplon1 + 360.0
+      IF ( zplon1 >=  180 ) zplon1 = zplon1 - 360.0
+      IF ( zplon2 <  -180 ) zplon2 = zplon2 + 360.0
+      IF ( zplon2 >=  180 ) zplon2 = zplon2 - 360.0
+
+      zplon1 = zplon1 * zrad
+      zplon2 = zplon2 * zrad
+      zplat1 = plat1  * zrad
+      zplat2 = plat2  * zrad
+      zcos1  = COS( zplat1 )
+      zcos2  = COS( zplat2 )
+      za1    = SIN( zplat1 )
+      za2    = SIN( zplat2 )
+      zb1    = zcos1 * COS( zplon1 )
+      zb2    = zcos2 * COS( zplon2 )
+      zc1    = zcos1 * SIN( zplon1 )
+      zc2    = zcos2 * SIN( zplon2 )
+
+      distance  =  rearth  *  &
+         &  ASIN( SQRT( ABS ( 1.0 - ( za1 * za2 + zb1 * zb2 + zc1 * zc2) ** 2) ) )
+      
+    END FUNCTION distance
Index: /utils/tools_ticket2413/OBSTOOLS/src/dom_oce.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/dom_oce.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/dom_oce.F90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../src/OCE/DOM/dom_oce.F90
Index: /utils/tools_ticket2413/OBSTOOLS/src/enact2fb.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/enact2fb.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/enact2fb.F90	(revision 12863)
@@ -0,0 +1,90 @@
+PROGRAM enact2fb
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM corio2fb **
+   !!
+   !!  ** Purpose : Convert ENACT format profiles to feedback format
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !!
+   !!   Usage:
+   !!     enact2fb.exe outputfile inputfile1 inputfile2 ...
+   !!
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE obs_fbm
+   USE obs_prof_io
+   USE convmerge
+   IMPLICIT NONE
+   !
+   ! Command line arguments for output file and input files
+   !
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nargs
+   CHARACTER(len=256) :: cdoutfile
+   CHARACTER(len=256),ALLOCATABLE :: cdinfile(:)
+   !
+   ! Input data
+   !
+   TYPE(obfbdata), POINTER :: enactf(:)
+   INTEGER :: ninfiles,ntotenact,nmaxlev
+   INTEGER,ALLOCATABLE  :: iset(:),inum(:),iindex(:)
+   !
+   ! Output data
+   !
+   TYPE(obfbdata) :: fbdata
+   !
+   ! Loop variables
+   !
+   INTEGER :: ia,ii,ij
+   !
+   ! Get number of command line arguments
+   !
+   nargs=IARGC()
+   IF (nargs < 1) THEN
+      WRITE(*,'(A)')'Usage:'
+      WRITE(*,'(A)')'enact2fb outputfile inputfile1 inputfile2 ...'
+      CALL abort()
+   ENDIF
+   CALL getarg(1,cdoutfile)
+   !
+   ! Get input data
+   !
+   ALLOCATE( enactf(MAX(nargs-1,1)) )
+   ALLOCATE( cdinfile(nargs-1) )
+   ntotenact = 0
+   ninfiles  = nargs - 1
+   DO ia = 1,ninfiles
+      CALL getarg( ia + 1, cdinfile(ia) )
+      CALL read_enactfile( TRIM(cdinfile(ia)), enactf(ia), 6, .TRUE., .FALSE. )
+      WRITE(*,'(2A)')'File = ',TRIM(cdinfile(ia))
+      WRITE(*,'(A,I9,A)')'has',enactf(ia)%nobs,' profiles'
+      ntotenact = ntotenact + enactf(ia)%nobs
+      nmaxlev   = MAX( nmaxlev, enactf(ia)%nlev )
+   ENDDO
+   IF (ninfiles==0) THEN
+      CALL init_obfbdata( enactf(1) )
+      CALL alloc_obfbdata( enactf(1), 2, 0, 1, 0, 1, .FALSE. )
+      enactf(1)%cname(1) = 'POTM'
+      enactf(1)%cname(2) = 'PSAL'
+      enactf(1)%coblong(1) = 'Potential temperature'
+      enactf(1)%coblong(2) = 'Practical salinity'
+      enactf(1)%cobunit(1) = 'Degrees Celsius'
+      enactf(1)%cobunit(2) = 'PSU'
+      enactf(1)%cextname(1) = 'TEMP'
+      enactf(1)%cextlong(1) = 'Insitu temperature'
+      enactf(1)%cextunit(1) = 'Degrees Celsius'
+      enactf(1)%cdjuldref = '19500101000000'
+   ENDIF
+   WRITE(*,'(A,I8)') 'Total profiles : ',ntotenact
+   !
+   ! Merge and output the data.
+   !
+   CALL conv_fbmerge( TRIM(cdoutfile), ninfiles, enactf )
+
+END PROGRAM enact2fb
Index: /utils/tools_ticket2413/OBSTOOLS/src/fbaccdata.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/fbaccdata.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/fbaccdata.F90	(revision 12863)
@@ -0,0 +1,16 @@
+MODULE fbaccdata
+   USE fbacctype
+   IMPLICIT NONE
+   INTEGER, DIMENSION(:,:,:,:,:), ALLOCATABLE :: inum,inumov,inumbv
+   INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: inuma
+   REAL, DIMENSION(:,:,:,:,:), ALLOCATABLE :: zbias,zrms,zsdev,zomean,zmmean,&
+      & zoemea,zovmea,zbemea,zbvmea
+   REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: zoamean
+   INTEGER, PARAMETER :: maxvars = 10
+   REAL, DIMENSION(maxvars) :: zcheck
+   REAL, DIMENSION(maxvars) :: zhistmax, zhistmin, zhiststep
+   TYPE(histtype), DIMENSION(maxvars) :: hist
+   REAL, DIMENSION(maxvars) :: zxymax, zxymin, zxystep
+   TYPE(xytype), DIMENSION(maxvars) :: xy
+END MODULE fbaccdata
+
Index: /utils/tools_ticket2413/OBSTOOLS/src/fbacctype.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/fbacctype.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/fbacctype.F90	(revision 12863)
@@ -0,0 +1,11 @@
+MODULE fbacctype
+   IMPLICIT NONE
+   TYPE histtype
+      INTEGER :: npoints
+      INTEGER, POINTER, DIMENSION(:,:,:,:,:) :: nhist
+   END TYPE histtype
+   TYPE xytype
+      INTEGER :: npoints
+      INTEGER, POINTER, DIMENSION(:,:,:,:,:,:) :: nxy
+   END TYPE xytype
+END MODULE fbacctype
Index: /utils/tools_ticket2413/OBSTOOLS/src/fbcomb.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/fbcomb.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/fbcomb.F90	(revision 12863)
@@ -0,0 +1,182 @@
+PROGRAM fbcomb
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM fbcomb **
+   !!
+   !!  ** Purpose : Combine MPI decomposed feedback files into one file
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  : 
+   !!
+   !!   Usage:
+   !!     fbcomb.exe outputfile inputfile1 inputfile2 ...
+   !!
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE toolspar_kind
+   USE obs_fbm
+   USE index_sort
+   IMPLICIT NONE
+   !
+   ! Command line arguments for output file and input file
+   !
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nargs
+   CHARACTER(len=256) :: cdoutfile
+   CHARACTER(len=256),ALLOCATABLE :: cdinfile(:)
+   !
+   ! Input data
+   !
+   TYPE(obfbdata),POINTER :: obsdata(:)
+   INTEGER :: ninfiles,ntotobs,nlev
+   !
+   ! Time sorting arrays
+   !
+   REAL(KIND=dp),ALLOCATABLE :: zsort(:,:)
+   INTEGER,ALLOCATABLE  :: iset(:),inum(:),iindex(:)
+   INTEGER :: iwmo
+   !
+   ! Output data
+   !
+   TYPE(obfbdata) :: obsoutdata
+   !
+   ! Loop variables
+   !
+   INTEGER :: ia,iv,ii,ij
+   !
+   ! Get number of command line arguments
+   !
+   nargs = IARGC()
+   IF ( nargs < 2 ) THEN
+      WRITE(*,'(A)')'Usage:'
+      WRITE(*,'(A)')'fbcomb outputfile inputfile1 inputfile2 ...'
+      CALL abort()
+   ENDIF
+   CALL getarg( 1, cdoutfile )
+   !
+   ! Get input data
+   !
+   ALLOCATE( obsdata( nargs - 1 ) )
+   ALLOCATE( cdinfile( nargs - 1 ) )
+   ntotobs = 0
+   ninfiles = nargs - 1
+   DO ia=1, ninfiles
+      CALL getarg( ia+1, cdinfile(ia) )
+      CALL init_obfbdata( obsdata(ia) )
+      CALL read_obfbdata( TRIM(cdinfile(ia)), obsdata(ia) )
+      WRITE(*,'(2A)')'File = ', TRIM(cdinfile(ia))
+      WRITE(*,'(A,I9,A)')'has', obsdata(ia)%nobs, ' observations'
+      ntotobs = ntotobs + obsdata(ia)%nobs
+   ENDDO
+   WRITE(*,'(A,I8)') 'Total obsfiles : ',ntotobs
+   !
+   ! Check that the data is confirming
+   !
+   DO ia=2, ninfiles
+      IF ( obsdata(ia)%cdjuldref /= obsdata(1)%cdjuldref ) THEN
+         WRITE(*,*)'Different julian date reference. Aborting'
+         CALL abort
+      ENDIF
+      IF ( obsdata(ia)%nvar /= obsdata(1)%nvar ) THEN
+         WRITE(*,*)'Different number of variables. Aborting'
+         CALL abort
+      ENDIF
+      IF  (obsdata(ia)%nadd /= obsdata(1)%nadd ) THEN
+         WRITE(*,*)'Different number of additional entries. Aborting'
+         CALL abort
+      ENDIF
+      IF ( obsdata(ia)%next /= obsdata(1)%next ) THEN
+         WRITE(*,*)'Different number of additional variables. Aborting'
+         CALL abort
+      ENDIF
+      IF ( obsdata(ia)%lgrid .NEQV. obsdata(1)%lgrid ) THEN
+         WRITE(*,*)'Inconsistent grid search info. Aborting'
+         CALL abort
+      ENDIF
+      DO iv=1, obsdata(ia)%nvar
+         IF ( obsdata(ia)%cname(iv) /= obsdata(1)%cname(iv) ) THEN
+            WRITE(*,*)'Variable name ', TRIM(obsdata(ia)%cname(iv)), &
+               &      ' is different from ', TRIM(obsdata(1)%cname(iv)), &
+               &      '. Aborting'
+            CALL abort
+         ENDIF
+         IF ( obsdata(1)%lgrid ) THEN
+            IF ( obsdata(ia)%cgrid(iv) /= obsdata(1)%cgrid(iv) ) THEN
+               IF (obsdata(1)%nobs==0) THEN
+                  obsdata(1)%cgrid(iv) = obsdata(ia)%cgrid(iv)
+               ELSE
+                  IF (obsdata(ia)%nobs>0) THEN
+                     WRITE(*,*)'Grid name ', TRIM(obsdata(ia)%cgrid(iv)), &
+                        &      ' is different from ', &
+                        &      TRIM(obsdata(1)%cgrid(iv)), '. Aborting'
+                     CALL abort
+                  ENDIF
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDDO
+      DO iv=1,obsdata(ia)%nadd
+         IF ( obsdata(ia)%caddname(iv) /= obsdata(1)%caddname(iv) ) THEN
+            WRITE(*,*)'Additional name ', TRIM(obsdata(ia)%caddname(iv)), &
+               &      ' is different from ', TRIM(obsdata(1)%caddname(iv)), &
+               &      '. Aborting'
+            CALL abort
+         ENDIF
+      ENDDO
+      DO iv=1,obsdata(ia)%next
+         IF ( obsdata(ia)%cextname(iv) /= obsdata(1)%cextname(iv) ) THEN
+            WRITE(*,*)'Extra name ', TRIM(obsdata(ia)%cextname(iv)), &
+               &      ' is different from ', TRIM(obsdata(1)%cextname(iv)), &
+               &      '. Aborting'
+            CALL abort
+         ENDIF
+      ENDDO
+   ENDDO
+   !
+   ! Construct sorting arrays
+   !
+   ALLOCATE( zsort(5,ntotobs), iset(ntotobs), &
+      & inum(ntotobs), iindex(ntotobs))
+   ii = 0
+   DO ia = 1,ninfiles
+      DO ij = 1,obsdata(ia)%nobs
+         ii = ii+1
+         zsort(1,ii) = obsdata(ia)%ptim(ij)
+         zsort(2,ii) = obsdata(ia)%pphi(ij)
+         zsort(3,ii) = obsdata(ia)%plam(ij)
+         iwmo = TRANSFER( obsdata(ia)%cdwmo(ij)(1:4), iwmo )
+         zsort(4,ii) = iwmo
+         iwmo = TRANSFER( obsdata(ia)%cdwmo(ij)(5:8), iwmo )
+         zsort(5,ii) = iwmo
+         iset(ii) = ia
+         inum(ii) = ij
+      ENDDO
+   ENDDO
+   !
+   ! Get indexes for time sorting.
+   !
+   CALL index_sort_dp_n(zsort,5,iindex,ntotobs)
+   !
+   ! Allocate output data
+   !   
+   nlev = -1
+   DO ia = 1,ninfiles
+      IF ( obsdata(ia)%nlev > nlev ) nlev = obsdata(ia)%nlev
+   ENDDO
+   CALL init_obfbdata( obsoutdata )
+   CALL alloc_obfbdata( obsoutdata, obsdata(1)%nvar, ntotobs, nlev, &
+      &                 obsdata(1)%nadd, obsdata(1)%next, obsdata(1)%lgrid )
+   !
+   ! Copy input data into output data
+   !
+   CALL merge_obfbdata( ninfiles, obsdata, obsoutdata, iset, inum, iindex )
+   !
+   ! Save output data 
+   !
+   CALL write_obfbdata ( TRIM(cdoutfile), obsoutdata )
+   
+END PROGRAM fbcomb
Index: /utils/tools_ticket2413/OBSTOOLS/src/fbgenerate.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/fbgenerate.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/fbgenerate.F90	(revision 12863)
@@ -0,0 +1,327 @@
+PROGRAM fbgenerate
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM fbmatchup **
+   !!
+   !!  ** Purpose : Generate a feedback file of pseudo obs
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  : Read in data from a namelist file and generate a feedback
+   !!               file of pseudo observations
+   !! 
+   !!   Usage: 		For any parameter, if 3 values are given, these will be treated as
+   !!                   bounds (start, stop, step), EXCEPT when only 3 values are expected.
+   !!
+   !!                For spatial coord, date and time
+	!! 						3 values with nlat=3 will be treated as three separate values
+	!! 						3 values with nobs=3 will be treated as three separate values
+	!! 						3 values with nobs>3 will be treated as a start, end and step
+	!! 						Giving a FillValue in one of namelist entries may have unexpected consequences
+	!! 							e.g., discarding rest of list of values
+	!!
+	!! 					For time bounds, start(HHMM), end(HHMM), step(minutes)
+	!!						For date bounds, start(YYYYMMDD), end(YYYYMMDD), step(days)
+   !!
+   !!                To split obs evenly in time, date and time should be given two values 
+   !!                describing the start and end times. 
+   !!
+   !!                Can use logical flag to shuffle timestamps to remove position-time correlation.
+   !!
+   !!                Can use logical flag to add uniformly sampled perturbation (up to defined limit) to positions
+	!!
+	!! 					For obs values, can list either single value for all (x,y,z)
+	!! 					or can specify single profile for all (x,y)
+	!! 					or can specify all values 1 profile after another.
+	!!	 					
+	!! 					In namelist to set vals(nlev,nobs,nvar)
+	!! 						set all obs (for variable 1) at all levels to one value
+	!! 							vals(:,:,1)= 1.0
+	!! 						set all obs (for variable 2) at all levels to one value
+	!! 							vals(:,:,2)= 35.0
+	!! 						set one profile (for variable 1), apply to all	
+	!! 							vals(:,:,1)= 1.0, 2.0, 3.0, 4.0
+	!! 						set all profiles profile (for variable 1)	
+	!! 							vals(:,1,1)= 1.0, 2.0, 3.0, 4.0
+	!! 							vals(:,2,1)= 1.0, 2.0, 3.0, 4.0
+	!! 							vals(:,nobs,1)= 1.0, 2.0, 3.0, 4.0
+   !!     
+   !!
+   !!   Limitations: Uses an allocatable array in a namelist. This is not meant 
+	!!                 to be allowed in F95, but it works when compiled with xlf90_r
+	!!                 (and is allowed in Fortran2003).
+	!!
+	!!                Forces same depth levels on all profiles.
+	!!
+   !!   History :
+   !!        ! 2014    (J. Waters) Initial version
+   !!        ! 2014-02 (R. King)   Adapted for profiles and bounds on vars
+   !!----------------------------------------------------------------------
+   USE obs_fbm
+	USE fbgenerate_coords
+	USE test_fbgenerate
+   IMPLICIT NONE
+   TYPE(obfbdata) :: fbobsdata
+   CHARACTER(len=256) :: filenameout
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nobs, nvar, nlev, ntyp, nadd, next, lgrid, ierr, nlats, nlons
+   INTEGER :: i, j
+   INTEGER :: FillValue_int
+	REAL(KIND=fbdp) :: FillValue_real
+   INTEGER, ALLOCATABLE :: dates(:), times(:)
+   REAL(KIND=fbdp), ALLOCATABLE :: julian_dates(:)
+	REAL(KIND=fbdp) :: phys_spacing, lat_step, current_lat, perturb_limit
+   REAL(KIND=fbdp), ALLOCATABLE :: lats(:), lons(:), deps(:), vals(:,:,:), model_vals(:,:,:) 
+   CHARACTER(LEN=ilenwmo) :: cdwmo, cdtyp
+   CHARACTER(LEN=ilenwmo), ALLOCATABLE :: variable(:)
+	CHARACTER(LEN=ilenlong), ALLOCATABLE :: variable_longname(:)
+	CHARACTER(LEN=ilenunit), ALLOCATABLE :: variable_units(:)
+	LOGICAL, PARAMETER :: test_prog = .FALSE.
+	LOGICAL :: ln_listobs, ln_physpace, ln_gridobs, ln_shuffletimes, ln_perturb_posn
+   REAL(KIND=fbdp), PARAMETER :: earth_radius = 6371.0_fbdp
+   REAL(KIND=fbdp), PARAMETER :: pi = 3.14159_fbdp
+	
+	!!!! set up default values and read in namelist namfbgen.in !!!!!!!!!!!!!!!!!!!!
+   NAMELIST/namfbgeneratesetup/ln_listobs,ln_physpace,ln_gridobs,ln_shuffletimes,ln_perturb_posn,perturb_limit,nobs,nlats,nlons,phys_spacing,nlev,nvar,nadd
+   NAMELIST/namfbgenerate/ntyp,lats,lons,deps,times,dates,vals,model_vals,variable,variable_longname,variable_units,cdwmo,cdtyp
+
+	IF (test_prog) THEN
+		WRITE(*,*) "In test mode:"
+		CALL tester
+	ELSE
+	
+   
+	IF (iargc()/=1) THEN
+      WRITE(*,*)'Usage:'
+      WRITE(*,*)'fbgenerate <output filename>'
+      CALL abort
+   ENDIF
+
+   CALL getarg(1,filenameout)
+	
+   ! set up default values for namfbgeneratesetup
+   ln_listobs=.FALSE.
+   ln_physpace=.FALSE.
+   ln_gridobs=.FALSE.
+   ln_shuffletimes=.FALSE.
+   ln_perturb_posn=.FALSE.
+   nobs=0
+   nlats=0
+   nlons=0
+   phys_spacing =100.0_fbdp
+   nlev=0
+	nvar=0
+
+   ! Read in number of obs and number of depths from namelist (before reading other variables)
+	FillValue_real = 99999.0_fbdp
+	FillValue_int = 99999
+   OPEN(10,file='namfbgen.in')
+   READ(10,namfbgeneratesetup) 
+   CLOSE(10)
+   
+   ! Calculate number of observations
+   IF ((ln_gridobs) .AND. (.NOT.ln_physpace) .AND. (.NOT.ln_listobs)) THEN
+      IF( ( nlats .LE. 0 ) .OR. (nlons .LE. 0) )THEN
+         WRITE(6,*)'ERROR: nlats and nlons must be greater than 0 if ln_gridobs set'
+      ELSE
+         nobs=nlats*nlons
+         WRITE(*,*) "Constructing a grid of lat-lons"
+      ENDIF
+
+   ELSE IF ((.NOT.ln_gridobs) .AND. (ln_physpace) .AND. (.NOT.ln_listobs)) THEN
+      IF ((phys_spacing .LE. 0) .OR.(phys_spacing .GE. earth_radius)) THEN
+         WRITE(6,*)'ERROR: phys_spacing must be greater than 0 and less than 6371km.'
+      ELSE
+        nlats = INT(pi * earth_radius / phys_spacing)
+        IF (MOD(nlats,2)==0) nlats=nlats-1   ! Ensure nlats is odd to have even number around equator.  
+        lat_step = 180.0_fbdp / (nlats-1)
+        nobs=0
+        current_lat=0.0_fbdp
+        ! Sum up number of lons at each latitude
+        DO i=1,(nlats-1)/2
+           current_lat = current_lat + lat_step * (pi/180.0_fbdp)
+           nobs = nobs + INT(2.0_fbdp * pi * earth_radius * cos(current_lat) / phys_spacing) 
+        END DO
+        nobs = nobs * 2 + INT(2.0_fbdp * pi * earth_radius / phys_spacing)
+        WRITE(*,*) "Using a physical seperation of ~", INT(phys_spacing),"km"
+      END IF
+
+   ELSE IF ((.NOT.ln_gridobs) .AND. (.NOT.ln_physpace) .AND. (ln_listobs)) THEN
+      IF( nobs .LE. 0 ) THEN
+         WRITE(6,*)'ERROR: nobs must be greater than 0'
+      ENDIF
+      WRITE(*,*) "Constructing a list of lat-lons"
+   ELSE
+      WRITE(*,*)'ERROR: one (and only one) of the logical flags must be true!'
+      CALL abort 
+   ENDIF
+
+
+   ALLOCATE(dates(nobs),       	&
+	    		times(nobs),       	&
+	    		julian_dates(nobs),  &
+	    		lats(nobs),	       	&
+	    		lons(nobs),	       	&
+	    		deps(nlev),        	&
+	    		variable(nvar),    	&
+	    		variable_longname(nvar),   &
+	    		variable_units(nvar),&
+	    		vals(nlev,nobs,nvar),&
+	    		model_vals(nlev,nobs,nvar),&
+				STAT=ierr          	&
+	    		)
+	IF (ierr /= 0) THEN
+		WRITE(*,*) "Could not allocate observation arrays:"
+		WRITE(*,*) "dates(", nobs, ")"
+		WRITE(*,*) "times(", nobs, ")"
+		WRITE(*,*) "lats(", nobs, ")"
+		WRITE(*,*) "lons(", nobs, ")"
+		WRITE(*,*) "deps(", nlev, ")"
+		WRITE(*,*) "variable(", nvar, ")"
+		WRITE(*,*) "variable_longname(", nvar, ")"
+		WRITE(*,*) "variable_units(", nvar, ")"
+		WRITE(*,*) "vals(", nlev, nobs, nvar, ")"
+		WRITE(*,*) "model_vals(", nlev, nobs, nvar, ")"
+
+		CALL abort
+	END IF			    
+	    
+		 
+   !!!! set up default values and read in namelist namfbgen.in !!!!!!!!!!!!!!!!!!!!
+   ntyp=-1
+   lats(:) = FillValue_real
+   lons(:) = FillValue_real
+   deps(:) = FillValue_real
+   times(:) = FillValue_int
+   dates(:) = FillValue_int
+   vals(:,:,:) = FillValue_real
+   model_vals(:,:,:) = FillValue_real
+   variable=REPEAT('X',ilenwmo)
+   variable_longname=REPEAT('X',ilenwmo)
+   variable_units=REPEAT('X',ilenwmo)
+   cdwmo=REPEAT('X',ilenwmo)  !station identifier
+   cdtyp="90"    !station type
+
+   WRITE(*,*) "Creating a fdbk file with", nobs, "observations"
+   WRITE(*,*) "with", nvar, "variables and",nlev, "depths."
+
+   OPEN(10,file='namfbgen.in')
+   READ(10,namfbgenerate)
+   CLOSE(10)
+	
+	! Use bounds to construct the full arrays of coords and values
+
+   IF (ln_physpace) THEN
+      CALL set_spatial_coords_physpace(lats,lons,nobs,FillValue_real,phys_spacing)
+   ELSE IF (ln_gridobs) THEN
+      CALL set_spatial_coords_grid(lats,lons,nobs,nlats,nlons,FillValue_real)
+   ELSE
+      CALL set_spatial_coords(lats,lons,nobs,FillValue_real)
+   END IF
+   
+   ! Add random perturbation to position if ln_perturb_posn=.TRUE.   
+   IF (ln_perturb_posn) CALL perturb_positions(lats,lons,perturb_limit)
+   
+   CALL set_datetime(dates,times,julian_dates,nobs,FillValue_int)
+   CALL set_depths(deps,nlev,FillValue_real)
+   CALL set_obs_values(vals,nvar,nobs,nlev,FillValue_real)
+   CALL set_obs_values(model_vals,nvar,nobs,nlev,FillValue_real)
+
+
+   !nadd=1	! Hx
+   next=0	! e.g. TEMP 
+	! Add TEMP as extra variable if POTM is defined.
+	DO i=1,nvar
+		IF (variable(i)(1:4) == "POTM") THEN
+		   next=1	! e.g. If set to zero, will not add extra TEMP variable			
+			EXIT
+		END IF
+	END DO
+
+   CALL init_obfbdata(fbobsdata)
+   
+   !!!! Allocate the obfb type !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   
+   CALL alloc_obfbdata( fbobsdata, nvar, nobs, nlev, nadd, next, .FALSE.)
+   
+   !!!! Read data specified in the namelist into obfd type!!!!!!!!!!!!!!!
+	    
+   fbobsdata%cname = variable(:)
+	fbobsdata%coblong = variable_longname(:)
+	fbobsdata%cobunit = variable_units(:)
+   fbobsdata%cdjuldref = "19500101000000"
+   fbobsdata%cdwmo = cdwmo
+   fbobsdata%cdtyp = cdtyp
+	
+   ! Add model counterpart values if nadd=1
+	IF (nadd > 0) THEN
+		IF (nadd /= 1) THEN
+			CALL abort
+			WRITE(*,*) "Not set-up to add more than 1 additional variable."
+		ELSE
+			fbobsdata%caddname = "Hx"
+   		fbobsdata%caddlong(1,:) = "Model interpolated " // variable_longname(:)
+   		fbobsdata%caddunit(1,:) = variable_units(:)
+         fbobsdata%padd(:,:,1,:)=model_vals(:,:,:)
+		END IF
+	END IF
+	
+	! Add TEMP as extra variable if POTM is defined.
+	IF (next==1) THEN
+		fbobsdata%cextname = "TEMP"
+	END IF
+	
+   ! set up pos/time variables
+   fbobsdata%plam(:)=lons(:)
+   fbobsdata%pphi(:)=lats(:)
+	DO i=1,nobs 
+      fbobsdata%pdep(:,i)=deps(:)
+   END DO
+
+   
+   fbobsdata%ptim(:)= julian_dates(:)
+   
+   ! Shuffle the time array to spread the profiles across the time period
+   IF (ln_shuffletimes) CALL shuffle(fbobsdata%ptim)
+
+   ! read in variable data and flags
+   fbobsdata%ivqc(:,:)=1
+   fbobsdata%ivqcf(:,:,:)=1
+   fbobsdata%ivlqc(:,:,:)=1
+   fbobsdata%pob(:,:,:)=vals(:,:,:)
+
+   !set up all QC flags
+   fbobsdata%ioqc(:)=1
+   fbobsdata%ioqcf(:,:)=0
+   fbobsdata%ipqc(:)=1  
+   fbobsdata%ipqcf(:,:)=0 
+   fbobsdata%idqc(:,:)=1		!0
+   fbobsdata%idqcf(:,:,:)=0
+   fbobsdata%itqc(:)=1
+   fbobsdata%kindex(:)=0
+   
+   !!!! Write out the obfb type !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+	
+   CALL write_obfbdata(TRIM(filenameout),fbobsdata)
+
+   DEALLOCATE(dates,       &
+              times,       &
+              julian_dates,&
+	    		  lats,	      &
+	    		  lons,	      &
+	    		  deps,        &
+	    		  variable,    &
+	    		  variable_longname,    &
+	    		  variable_units,       &
+	    		  vals,        &
+	    		  model_vals   &
+	    		  )
+
+	END IF !test prog
+
+
+END PROGRAM fbgenerate
+
+
Index: /utils/tools_ticket2413/OBSTOOLS/src/fbgenerate_coords.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/fbgenerate_coords.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/fbgenerate_coords.F90	(revision 12863)
@@ -0,0 +1,509 @@
+MODULE fbgenerate_coords
+USE obs_fbm
+USE date_utils
+
+CONTAINS
+
+   REAL(KIND=fbdp) FUNCTION fb_dates(timein,datein) 
+      IMPLICIT NONE   
+      INTEGER, INTENT(IN) :: timein 	! Format: HHMM
+		INTEGER, INTENT(IN) :: datein 	! Format: YYYYMMDD
+      INTEGER :: iyea,imon,iday
+      INTEGER :: ihr,imin,isec
+  
+      iyea=datein/10000
+      imon=datein/100-iyea*100
+      iday=datein-iyea*10000-imon*100
+		
+		ihr = timein/100
+		imin = timein - ihr*100
+		isec = 0
+		
+      CALL greg2jul(isec,imin,ihr,iday,imon,iyea,fb_dates)
+   
+   END FUNCTION fb_dates
+
+
+
+	SUBROUTINE set_spatial_coords(lats,lons,n,FillVal)
+	IMPLICIT NONE	
+	INTEGER :: i, j, k, p, nlats, nlons, nlats_in_list, nlons_in_list
+	INTEGER, INTENT(IN) :: n
+	REAL(KIND=fbdp), INTENT(INOUT) :: lats(:), lons(:)
+	REAL(KIND=fbdp) :: FillVal 
+	
+	! A single non-FillVal value should be replicated n times
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	!	unless n is three, in which case treat as list, not bounds.
+	! A full list of n non-FillVals should be left unaltered.
+	
+	!Find number of lats and lons
+	! by finding number of non-FillVal entries in arrays
+	! and expanding bounds if necessary
+	
+	nlats_in_list = last_element(lats,FillVal)
+	nlons_in_list = last_element(lons,FillVal)
+
+   !Expand bounds only if 3 values given and number obs>3
+	IF (nlats_in_list == 1) THEN
+		lats(1:nlats) = lats(1)
+	ELSE IF ((nlats_in_list==3).AND.((n>3))) THEN ! Treat as list of three, not bounds
+		CALL expand_bounds(lats, FillVal)
+	END IF
+
+	IF (nlons_in_list == 1) THEN
+		lons(1:nlons) = lons(1)
+	ELSE IF ((nlons_in_list==3).AND.((n>3))) THEN ! Treat as list of three, not bounds
+		CALL expand_bounds(lons, FillVal)
+	END IF
+
+	nlats = last_element(lats,FillVal)
+	nlons = last_element(lons,FillVal)
+	
+	IF ((n /= nlats) .AND. (n /= nlons)) THEN
+		WRITE(*,*) "ERROR: Number of lat/lons not equal to nobs", nlats, nlons, n
+		CALL abort	
+	END IF
+	
+	END SUBROUTINE set_spatial_coords
+
+
+	SUBROUTINE set_spatial_coords_grid(lats,lons,n,nlats,nlons,FillVal)
+	IMPLICIT NONE	
+	INTEGER :: i, j, k, p, nlats_in_list, nlons_in_list
+	INTEGER, INTENT(IN) :: n, nlats, nlons
+	REAL(KIND=fbdp), INTENT(INOUT) :: lats(:), lons(:)
+	REAL(KIND=fbdp), ALLOCATABLE :: tmp_lats(:), tmp_lons(:)
+	REAL(KIND=fbdp) :: FillVal 
+	
+	! A single non-FillVal value should be replicated n times
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	!	unless n is three, in which case treat as list, not bounds.
+	! A full list of n non-FillVals should be left unaltered.
+	
+	!Find number of lats and lons in list
+	! by finding number of non-FillVal entries in arrays
+	! and then expand bounds if necessary
+	
+	nlats_in_list = last_element(lats,FillVal)
+	nlons_in_list = last_element(lons,FillVal)
+	
+   !Expand bounds only if 3 values given and number lats (or lons) not equal to 3
+	IF (nlats_in_list == 1) THEN
+		lats(1:nlats) = lats(1)
+	ELSE IF ((nlats_in_list==3).AND.((nlats>3))) THEN ! Treat as bounds
+		CALL expand_bounds(lats, FillVal)
+	END IF
+
+	IF (nlons_in_list == 1) THEN
+		lons(1:nlons) = lons(1)
+	ELSE IF ((nlons_in_list==3).AND.((nlons>3))) THEN ! Treat as bounds
+		CALL expand_bounds(lons, FillVal)
+	END IF
+
+	nlats_in_list = last_element(lats,FillVal)
+	nlons_in_list = last_element(lons,FillVal)
+
+
+	IF ((nlats_in_list * nlons_in_list) == n) THEN
+		ALLOCATE(tmp_lons(n))
+		ALLOCATE(tmp_lats(n))
+		k = 0
+		p = 0
+		DO i = 1, nlats
+		   p = p + 1
+			DO j = 1, nlons
+				k = k + 1
+				tmp_lons(k) = lons(j)   
+				tmp_lats(k) = lats(p)   
+			END DO
+		END DO
+		lats(:) = tmp_lats(:)
+		lons(:) = tmp_lons(:)
+		DEALLOCATE(tmp_lons)
+		DEALLOCATE(tmp_lats)
+	ELSE 
+		WRITE(*,*) 
+		WRITE(*,*) "ERROR: Number of lat * lon values not equal to nobs", nlats_in_list, nlons_in_list, n
+		CALL abort	
+	END IF
+	
+	END SUBROUTINE set_spatial_coords_grid
+
+
+	SUBROUTINE set_spatial_coords_physpace(lats,lons,n,FillVal,phys_spacing)
+	IMPLICIT NONE	
+	INTEGER :: i, j, k, nlats, nlons
+	INTEGER, INTENT(IN) :: n
+	REAL(KIND=fbdp), INTENT(INOUT) :: lats(:), lons(:)
+	REAL(KIND=fbdp), ALLOCATABLE :: tmp_lats(:)
+	REAL(KIND=fbdp) :: FillVal 
+   REAL(KIND=fbdp), PARAMETER :: earth_radius = 6371.0_fbdp ! km
+   REAL(KIND=fbdp), PARAMETER :: pi = 3.141592654_fbdp
+	REAL(KIND=fbdp), INTENT(IN) :: phys_spacing
+   REAL(KIND=fbdp) :: lat_step
+	
+	! Use physical spacing to set lats and lons
+
+   nlats = INT(pi * earth_radius / phys_spacing)
+   IF (MOD(nlats,2)==0) nlats=nlats-1   ! Ensure nlats is odd to have even number around equator.  
+      
+   ALLOCATE(tmp_lats(nlats))
+
+   lat_step = 180.0_fbdp / (nlats-1)
+
+   tmp_lats(1) = 0.0_fbdp
+   DO i=1,(nlats-1)/2
+      tmp_lats(i+1) = tmp_lats(i) + lat_step
+      tmp_lats(((nlats-1)/2)+i+1) = tmp_lats(i+1) * (-1.0_fbdp)
+   END DO
+
+   k = 0
+   DO i=1,nlats
+      nlons = INT(2.0_fbdp * pi * earth_radius * cos(tmp_lats(i)* (pi/180.0_fbdp)) / phys_spacing)
+      IF (nlons>0) THEN
+         DO j = 1, nlons
+            k = k + 1
+            lons(k) = REAL(j-1) * 360.0_fbdp / nlons
+            lats(k) = tmp_lats(i)
+         END DO
+      END IF
+   END DO
+   DEALLOCATE(tmp_lats)
+	
+	END SUBROUTINE set_spatial_coords_physpace
+
+
+	SUBROUTINE expand_bounds(array, fillval)
+	!
+	! Checks if there are three entries and expands bounds.
+	!
+	IMPLICIT NONE
+	INTEGER :: i, nentries
+	REAL(KIND=fbdp), INTENT(INOUT) :: array(:)
+	REAL(KIND=fbdp), INTENT(IN) :: fillval
+	REAL(KIND=fbdp) :: nsteps, start, step
+
+	! Find number of elements given in list
+	nentries = last_element(array, fillval)
+
+	IF (nentries==3) THEN 			! Bounds given	
+		nsteps = (array(2) - array(1)) /  array(3) 
+	   IF ((array(2) < array(1)) .AND. (array(3) >= 0.0)) THEN
+		   WRITE(*,*) "Error: if upper bound is less than lower bound, step must be negative.", array
+			CALL abort
+		ELSE IF ( NINT(nsteps)+1 > SIZE(array) ) THEN
+		   WRITE(*,*) "Error: bounds not compatible with length of array.", array
+		   WRITE(*,*) "Error: bounds not compatible with length of array.", nsteps
+			CALL abort
+		END IF
+		start = array(1) 
+		step = array(3)
+		DO i=1,NINT(nsteps)+1
+			array(i) = start + (i-1)*step 	   	
+		END DO
+	END IF
+	
+	END SUBROUTINE expand_bounds
+
+
+
+	INTEGER FUNCTION last_element(array,fillval)
+	!
+	! Returns index of the last non-fill value element in a list
+	! Will return 1, even in first element is the FillValue
+	!
+	IMPLICIT NONE
+	REAL(KIND=fbdp), INTENT(IN) :: array(:), fillval
+	INTEGER :: i
+
+	last_element = 1
+	IF (SIZE(array) > 1) THEN
+		DO i=2, SIZE(array)
+			IF (array(i) /= fillval) THEN 
+				last_element = i
+			END IF
+		END DO
+	END IF
+		
+	END FUNCTION last_element
+
+
+
+	SUBROUTINE set_depths(array,n,FillVal)
+	IMPLICIT NONE	
+	INTEGER :: i
+	INTEGER, INTENT(IN) :: n
+	REAL(KIND=fbdp), INTENT(INOUT) :: array(:)
+	REAL(KIND=fbdp) :: FillVal
+	REAL(KIND=fbdp) :: start, step, nstep
+	! Top bound not necessarily inclusive - will use start, step and number of obs
+	
+	! A single non-FillVal value should be replicated n times
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	!	unless n is three, in which case treat as list, not bounds.
+	! A full list of n non-FillVals should be left unaltered.
+	IF (n==1) THEN
+		array(:) = array(1)
+	ELSE IF ((n > 1) .AND. (array(2)==FillVal)) THEN
+		array(:) = array(1)
+	ELSE IF ((n==2) .AND. (array(2)/=FillVal)) THEN
+		array(:) = array(:)
+	ELSE IF (n==3) THEN ! Treat as list of three, not bounds
+		array(:) = array(:)
+	ELSE IF ((n>=4) .AND. (array(4)==FillVal)) THEN ! Assume start, stop, step
+		nstep = (array(2) - array(1)) /  array(3) 
+	   IF ((array(2) < array(1)) .AND. (array(3) >= 0.0)) THEN
+		   WRITE(*,*) "Error: if upper bound is less than lower bound, step must be negative.", array
+			CALL abort
+		ELSE IF ( ( nstep < (0.99 * real(n-1)) ) .OR. &
+		          ( nstep > (1.01 * real(n-1)) ) ) THEN
+		   WRITE(*,*) "Error: depth bounds not compatible.", array
+		   WRITE(*,*) "Error: depth bounds not compatible.", nstep
+			CALL abort
+		END IF
+		start = array(1) 
+		step = array(3)
+		DO i=1,n
+			array(i) = start + (i-1)*step 	   	
+		END DO
+	END IF
+	
+	END SUBROUTINE set_depths
+
+
+
+
+
+	SUBROUTINE set_datetime(date,time,julian_date,n,FillVal)
+	!
+	! Transform input array from m values describing n dates to a list of n dates.
+	!
+	IMPLICIT NONE	
+	INTEGER :: i
+	INTEGER, INTENT(IN) :: n
+	INTEGER, INTENT(INOUT) :: date(:), time(:)
+	INTEGER :: FillVal
+	REAL(KIND=fbdp), INTENT(INOUT) :: julian_date(:)
+	REAL(KIND=fbdp) :: start, step, finish
+
+   ! Check if user has supplied start and end times to be split amongst number of obs
+   ! (i.e. more than 2 obs, but only 2 dates and 2 times given.)
+   IF ((n>2) .AND. (date(2)/=FillVal) .AND. (date(3)==FillVal) &
+      &      .AND. (time(2)/=FillVal) .AND. (time(3)==FillVal)) THEN
+      
+      !work out JD of each
+      start = fb_dates(time(1),date(1)) 
+      finish = fb_dates(time(2),date(2)) 
+
+      ! use info to calc step
+      step = ( finish - start ) / n
+      ! calc all JDs and put output in dates
+      DO i=1,n 
+	      ! Could make this an elemental function if dateutils were pure funcs
+         julian_date(i)= start + (i-1)*step
+      END DO
+
+   ELSE
+      CALL set_date(date,n,FillVal)
+      CALL set_time(time,n,FillVal)
+      ! Replace dates with JD including time info
+      DO i=1,n 
+	      ! Could make this an elemental function if dateutils were pure funcs
+         julian_date(i)= fb_dates(time(i),date(i))
+      END DO
+   END IF
+
+
+	END SUBROUTINE set_datetime
+
+
+	SUBROUTINE set_date(array,n,FillVal)
+	!
+	! Transform input array from m values describing n dates to a list of n dates.
+	!
+	IMPLICIT NONE	
+	INTEGER :: i
+	INTEGER, INTENT(IN) :: n
+	INTEGER, INTENT(INOUT) :: array(:)
+	INTEGER :: FillVal
+	INTEGER :: start, step, diff
+	! Top bound not necessarily inclusive - will use start, step and number of obs
+	
+	! A single non-FillVal value should be replicated n times
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	!	unless n is three, in which case treat as list, not bounds.
+	! A full list of n non-FillVals should be left unaltered.
+	IF (n==1) THEN
+		array(:) = array(1)
+	ELSE IF ((n > 1) .AND. (array(2)==FillVal)) THEN
+		array(:) = array(1)
+	ELSE IF ((n==2) .AND. (array(2)/=FillVal)) THEN
+		array(:) = array(:)
+	ELSE IF (n==3) THEN ! Treat as list of three, not bounds
+		array(:) = array(:)
+	ELSE IF ((n>=4) .AND. (array(4)==FillVal)) THEN ! Assume start, stop, step
+   	diff = diffdate(array(2),array(1))	! in number of days
+	   IF ((array(2) < array(1)) .AND. (array(3) >= 0)) THEN
+		   WRITE(*,*) "Error: if upper bound is less than lower bound, step must be negative.", array
+			CALL abort
+		ELSE IF ( ( diff / ABS(array(3)) ) /= (n-1) ) THEN
+		   WRITE(*,*) "Error: date bounds not compatible.", array
+			CALL abort
+		END IF
+		start = array(1) 
+		step = array(3)
+		DO i=1,n
+			CALL add_days_to_date(start,(i-1)*step,array(i)) 	   	
+		END DO
+	END IF
+	
+	END SUBROUTINE set_date
+
+
+
+	SUBROUTINE set_time(array,n,FillVal)
+	!
+	! Transform input array from m (m<=n) values describing n times to a list of n times.
+	!
+	IMPLICIT NONE	
+	INTEGER :: i
+	INTEGER, INTENT(IN) :: n
+	INTEGER, INTENT(INOUT) :: array(:)
+	INTEGER :: FillVal
+	INTEGER :: start, step, nstep
+	! Top bound not necessarily inclusive - will use start, step and number of obs
+	
+	! A single non-FillVal value should be replicated n times
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	!	unless n is three, in which case treat as list, not bounds.
+	! A full list of n non-FillVals should be left unaltered.
+	IF (n==1) THEN
+		array(:) = array(1)
+	ELSE IF ((n > 1) .AND. (array(2)==FillVal)) THEN
+		array(:) = array(1)
+	ELSE IF ((n==2) .AND. (array(2)/=FillVal)) THEN
+		array(:) = array(:)
+	ELSE IF (n==3) THEN ! Treat as list of three, not bounds
+		array(:) = array(:)
+	ELSE IF ((n>=4) .AND. (array(4)==FillVal)) THEN ! Assume start, stop, step
+		IF (array(3)<0) nstep = difftime(array(2),array(1)) / ABS(array(3)) 
+		IF (array(3)>=0) nstep = difftime(array(1),array(2)) / ABS(array(3)) 
+		IF ( nstep /= (n-1) ) THEN
+		   WRITE(*,*) "Error: time bounds not compatible.", array
+			CALL abort
+		END IF
+		start = array(1) 
+		step = array(3)
+		DO i=1,n
+			array(i) = add_mins_to_time(start,(i-1)*step) 	   	
+		END DO
+	END IF
+	
+	END SUBROUTINE set_time
+	
+	
+
+	SUBROUTINE set_obs_values(array,p,n,m,FillVal)
+	!
+	! n profiles at m depths
+	!
+	IMPLICIT NONE	
+	INTEGER :: i, j, k
+	INTEGER, INTENT(IN) :: n, m, p
+	REAL(KIND=fbdp), INTENT(INOUT) :: array(:,:,:) 			! (nlevels, nprofiles, nvars) = (m,n,p)
+	REAL(KIND=fbdp) :: FillVal 
+	
+	
+	DO k=1,p
+	   IF ((k > 1) .AND. (array(1,1,k) == FillVal)) THEN  ! set to same values as first variable
+			array(:,:,k) = array(:,:,1)
+		ELSE
+			IF ((n==1).AND.(m==1)) THEN
+				array(:,:,k) = array(1,1,k)
+
+			! If mult depths, but not specified, set all to one value	
+			ELSE IF ((m > 1) .AND. (array(2,1,k) == FillVal)) THEN
+				array(:,:,k) = array(1,1,k)
+
+			! If mult profiles and mult depths and only one value set in first profile	
+			ELSE IF ((n > 1) .AND. (m > 1) .AND. (array(2,1,k) == FillVal)) THEN
+				array(:,:,k) = array(1,1,k)
+				
+			! If mult profiles and mult depths and only one first profile set	
+			ELSE IF ((n > 1) .AND. (m > 1) .AND. (array(1,2,k) == FillVal)) THEN
+				DO j=1,m
+					array(j,:,k) = array(j,1,k)
+				END DO
+				
+			ELSE 
+	   		array(:,:,k) = array(:,:,k)
+			END IF
+		END IF
+	END DO	
+	
+	END SUBROUTINE set_obs_values
+
+
+   ! Unbiased shuffle of array
+   SUBROUTINE shuffle(a)
+   REAL(KIND=fbdp), INTENT(INOUT) :: a(:)
+   INTEGER :: i, randpos
+   REAL(KIND=fbdp) :: r, temp
+
+   CALL random_seed()
+   DO i = SIZE(a), 2, -1
+      CALL random_number(r)
+      randpos = int(r * i) + 1
+      temp = a(randpos)
+      a(randpos) = a(i)
+      a(i) = temp
+   END DO
+   
+   END SUBROUTINE shuffle
+   
+   
+   ! Add a random perturbation to the lats and lons
+   ! Perturbation is sampled from a uniform distribution +/-perturb_limit
+   SUBROUTINE perturb_positions(lats,lons,perturb_limit)
+   INTEGER :: i
+   REAL(KIND=fbdp), INTENT(INOUT) :: lats(:), lons(:)
+   REAL(KIND=fbdp), INTENT(IN) :: perturb_limit
+   REAL(KIND=fbdp) :: randpos, lat_perturb, lon_perturb
+   REAL(KIND=fbdp), PARAMETER :: earth_radius = 6371.0_fbdp
+   REAL(KIND=fbdp), PARAMETER :: pi = 3.141592654_fbdp
+   
+ 	IF ( SIZE(lats) /= SIZE(lons) ) THEN
+		WRITE(*,*) "Error: different number of lat and lon elements", SIZE(lats), SIZE(lons)
+		CALL abort
+	END IF
+
+   CALL random_seed()
+   
+   ! Convert physical sep into a latidue sep in degrees
+   lat_perturb = 360.0_fbdp * perturb_limit / (2.0_fbdp * pi * earth_radius)
+   
+   DO i=1,SIZE(lats)
+   
+      ! Perturb lats first, as lon conversion uses lat
+      CALL random_number(randpos)
+      lats(i) = lats(i) + randpos*lat_perturb
+      IF (lats(i) > 90.0_fbdp) lats(i) = 180.0_fbdp - lats(i) 
+      IF (lats(i) < -90.0_fbdp) lats(i) = (lats(i) + 180.0_fbdp) * (-1.0_fbdp)
+      
+      ! Use lat to convert physical size to delta_longitude   
+      IF (ABS(lats(i)) == 90.0_fbdp) THEN 
+         lon_perturb = 0.0_fbdp
+      ELSE
+         lon_perturb = 360.0_fbdp * perturb_limit / (2.0_fbdp * pi * earth_radius * cos(lats(i)*(pi/180.0_fbdp)))
+      END IF
+      CALL random_number(randpos)
+      lons(i) = lons(i) + randpos*lon_perturb
+      IF (lons(i) >= 360.0_fbdp) lons(i) = lons(i) - 360.0_fbdp 
+      IF (lons(i) < 0.0_fbdp) lons(i) = lons(i) + 360.0_fbdp 
+   
+   END DO
+   
+   END SUBROUTINE perturb_positions
+    
+END MODULE fbgenerate_coords
Index: /utils/tools_ticket2413/OBSTOOLS/src/fbmatchup.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/fbmatchup.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/fbmatchup.F90	(revision 12863)
@@ -0,0 +1,477 @@
+PROGRAM fbmatchup
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM fbmatchup **
+   !!
+   !!  ** Purpose : Find matching obs in feedback files
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !! 
+   !!   Usage:
+   !!     fbmatchup.exe outputfile inputfile1 varname1 inputfile2 varname2 ...
+   !!
+   !!   Optional: 
+   !!     namelist = namfbmatchup.in       to set ldaily820
+   !!
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE toolspar_kind
+   USE obs_fbm
+   USE index_sort
+   IMPLICIT NONE
+   !
+   ! Command line arguments for output file and input file
+   !
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nargs
+   CHARACTER(len=256) :: cdoutfile
+   CHARACTER(len=256),ALLOCATABLE :: cdinfile(:)
+   CHARACTER(len=ilenname),ALLOCATABLE :: cdnames(:)
+   CHARACTER(len=2*ilenname) :: cdtmp
+   LOGICAL :: ldaily820
+   NAMELIST/namfbmatchup/ldaily820
+   !
+   ! Input data
+   !
+   TYPE(obfbdata)         :: obsdatatmp(1)
+   TYPE(obfbdata),POINTER :: obsdata(:)
+   INTEGER :: ninfiles,ntotobs,nlev,nadd,next
+   !
+   ! Time sorting arrays
+   !
+   REAL(KIND=dp),ALLOCATABLE :: zsort(:,:)
+   INTEGER,ALLOCATABLE  :: iset(:),inum(:),iindex(:)
+   !
+   ! Comparison arrays and scalars
+   !
+   REAL(KIND=fbsp), ALLOCATABLE :: zrtim(:),zrphi(:),zrlam(:)
+   INTEGER(KIND=SELECTED_INT_KIND(12)), ALLOCATABLE :: irwmo(:)
+   REAL(KIND=fbsp) :: ztim,zphi,zlam
+   INTEGER(KIND=SELECTED_INT_KIND(12)) :: iwmo
+   LOGICAL, ALLOCATABLE :: ltaken(:)
+   !
+   ! Output data
+   !
+   TYPE(obfbdata) :: obsoutdata
+   !
+   ! Storage for extra to search for unique.
+   !
+   CHARACTER(len=ilenname), ALLOCATABLE :: cexttmp(:)
+   TYPE extout
+      LOGICAL, POINTER, DIMENSION(:) :: luse
+      INTEGER, POINTER, DIMENSION(:) :: ipos
+   END TYPE extout
+   TYPE(extout), POINTER, DIMENSION(:) :: pextinf
+   !
+   ! Loop variables
+   !
+   INTEGER :: ifi,ia,ip,i1,ii,ij,ik1,ik2,iv,ist,iadd,ie,iext
+   LOGICAL :: llfound
+   LOGICAL :: lexists,lnotobs
+   INTEGER :: ityp
+   !
+   ! Get number of command line arguments
+   !
+   nargs = IARGC()
+   IF ( ( MOD(nargs,2) /= 1 ) .OR. ( nargs == 0 )  ) THEN
+      WRITE(*,'(A)')'Usage:'
+      WRITE(*,'(A)')'fbmatchup outputfile inputfile1 varname1 inputfile2 varname2 ...'
+      CALL abort()
+   ENDIF
+   CALL getarg( 1, cdoutfile )
+   !
+   ! Read namelist if present
+   !
+   ldaily820=.FALSE.
+   INQUIRE(file='namfbmatchup.in',exist=lexists)
+   IF (lexists) THEN
+      OPEN(10,file='namfbmatchup.in')
+      READ(10,namfbmatchup)
+      CLOSE(10)
+      WRITE(*,namfbmatchup)
+   ENDIF
+   !
+   ! Get input data
+   !
+   ninfiles = ( nargs -1 ) / 2
+   ALLOCATE( obsdata( ninfiles ) )
+   ALLOCATE( cdinfile( ninfiles ) )
+   ALLOCATE( cdnames( ninfiles ) )
+   ip = 1
+   DO ifi = 1, ninfiles
+      !
+      ! Read the unsorted file
+      !
+      ip = ip + 1
+      CALL getarg( ip, cdinfile(ifi) )
+      ip = ip + 1
+      CALL getarg( ip, cdnames(ifi) )
+      CALL init_obfbdata( obsdatatmp(1) )
+      CALL read_obfbdata( TRIM(cdinfile(ifi)), obsdatatmp(1) )
+      !
+      ! Check if we have fewer levels than in the first file
+      !
+      IF ( ifi > 1 )  THEN
+         IF ( obsdatatmp(1)%nlev > obsdata(1)%nlev ) THEN
+            WRITE(*,*)'Warning. More levels in file than the first file'
+            WRITE(*,*)'Number of levels in current file = ', obsdatatmp(1)%nlev
+            WRITE(*,*)'Number of levels in first file   = ', obsdata(1)%nlev
+            WRITE(*,*)'Only the number of levels in the first'//&
+               &' file will be used'
+         ENDIF
+      ENDIF
+      !
+      ! Check if we have fewer observations than in the first file
+      !
+      IF ( ifi > 1 )  THEN
+         IF ( obsdatatmp(1)%nobs > obsdata(1)%nobs ) THEN
+            WRITE(*,*)'Warning. More obs in file than the first file'
+            WRITE(*,*)'Number of obs in current file = ', obsdatatmp(1)%nobs
+            WRITE(*,*)'Number of obs in first file   = ', obsdata(1)%nobs
+            WRITE(*,*)'Only the observations in the first'//&
+               &' file will be stored'
+         ENDIF
+      ENDIF
+      !
+      ! Check that we have the same number of variables
+      !
+      IF ( ifi > 1 )  THEN
+         IF ( obsdatatmp(1)%nvar /= obsdata(1)%nvar ) THEN
+            WRITE(*,*)'Error. Different number of variables.'
+            WRITE(*,*)'Number of var in current file = ', obsdatatmp(1)%nvar
+            WRITE(*,*)'Number of var in first file   = ', obsdata(1)%nvar
+            CALL abort
+         ENDIF
+      ENDIF
+      !
+      ! Check reference datas
+      !
+      IF ( ifi > 1 )  THEN
+         IF ( obsdatatmp(1)%cdjuldref /= obsdata(1)%cdjuldref ) THEN
+            WRITE(*,*)'Different reference dates'
+            CALL abort
+         ENDIF
+      ENDIF
+      !
+      ! Special fix for daily average MRB data (820) for the first file
+      !
+      IF (ldaily820.AND.(ifi==1)) THEN
+         DO ij = 1,obsdatatmp(1)%nobs
+            READ(obsdatatmp(1)%cdtyp(ij),'(I5)')ityp
+            IF (ityp==820) THEN
+               obsdatatmp(1)%ptim(ij)=INT(obsdatatmp(1)%ptim(ij))+1.0
+            ENDIF
+         ENDDO
+      ENDIF
+      !
+      ! Construct sorting arrays
+      !
+      ALLOCATE( zsort(3,obsdatatmp(1)%nobs), iset(obsdatatmp(1)%nobs), &
+         & inum(obsdatatmp(1)%nobs), iindex(obsdatatmp(1)%nobs))
+      ii = 0
+      DO ij = 1,obsdatatmp(1)%nobs
+         ii = ii+1
+         zsort(1,ii) = obsdatatmp(1)%ptim(ij)
+         zsort(2,ii) = obsdatatmp(1)%pphi(ij)
+         zsort(3,ii) = obsdatatmp(1)%plam(ij)
+         iset(ii) = 1
+         inum(ii) = ij
+      ENDDO
+      !
+      ! Get indexes for time sorting.
+      !
+      CALL index_sort_dp_n(zsort,3,iindex,obsdatatmp(1)%nobs)
+      CALL init_obfbdata( obsdata(ifi) )
+      CALL alloc_obfbdata( obsdata(ifi), &
+         &                 obsdatatmp(1)%nvar, obsdatatmp(1)%nobs, &
+         &                 obsdatatmp(1)%nlev, obsdatatmp(1)%nadd, &
+         &                 obsdatatmp(1)%next, obsdatatmp(1)%lgrid )
+      !
+      ! Copy input data into output data
+      !
+      CALL merge_obfbdata( 1, obsdatatmp, obsdata(ifi), iset, inum, iindex )
+      CALL dealloc_obfbdata( obsdatatmp(1) )
+      
+      WRITE(*,'(2A)')'File = ', TRIM(cdinfile(ifi))
+      WRITE(*,'(A,I9,A)')'has', obsdata(ifi)%nobs, ' observations'
+
+      DEALLOCATE( zsort, iset, inum, iindex )
+
+   ENDDO
+   !
+   ! Prepare output data
+   ! 
+   CALL init_obfbdata( obsoutdata )
+   !
+   ! Count number of additional fields
+   !
+   nadd = 0
+   DO ifi = 1, ninfiles
+      nadd = nadd + obsdata(ifi)%nadd
+   ENDDO
+   !
+   ! Count number of unique extra fields
+   !
+   ! First the maximum to construct list
+   next = 0
+   DO ifi = 1, ninfiles
+      next = next + obsdata(ifi)%next
+   ENDDO
+   ALLOCATE( &
+      & cexttmp(next) &
+      & )
+   ! Setup pextinf structure and search for unique extra fields
+   ALLOCATE( &
+      & pextinf(ninfiles) &
+      & )
+   next = 0
+   DO ifi = 1, ninfiles
+      ALLOCATE( &
+         & pextinf(ifi)%luse(obsdata(ifi)%next), &
+         & pextinf(ifi)%ipos(obsdata(ifi)%next)  &
+         & )
+      DO ie = 1, obsdata(ifi)%next
+         llfound = .FALSE.
+         DO ii = 1, next
+            IF ( cexttmp(ii) == obsdata(ifi)%cextname(ie) ) THEN
+               llfound = .TRUE.
+            ENDIF
+         ENDDO
+         IF (llfound) THEN
+            pextinf(ifi)%luse(ie) = .FALSE.
+            pextinf(ifi)%ipos(ie) = -1
+         ELSE
+            next = next + 1
+            pextinf(ifi)%luse(ie) = .TRUE.
+            pextinf(ifi)%ipos(ie) = next
+            cexttmp(next) = obsdata(ifi)%cextname(ie)
+         ENDIF
+      ENDDO
+   ENDDO
+   !
+   ! Copy the first input data to output data
+   !
+   CALL copy_obfbdata( obsdata(1), obsoutdata, &
+      &                kadd = nadd, kext = next )
+   ALLOCATE( ltaken(obsoutdata%nlev) )
+   iadd = 0
+   DO ifi = 1, ninfiles
+      DO ia = 1, obsdata(ifi)%nadd
+         cdtmp = TRIM(obsdata(ifi)%caddname(ia))//TRIM(cdnames(ifi))
+         obsoutdata%caddname(iadd+ia) = cdtmp(1:ilenname)
+         DO iv = 1, obsdata(ifi)%nvar
+            obsoutdata%caddlong(iadd+ia,iv) = obsdata(ifi)%caddlong(ia,iv)
+            obsoutdata%caddunit(iadd+ia,iv) = obsdata(ifi)%caddunit(ia,iv)
+         ENDDO
+      ENDDO
+      DO ie = 1, obsdata(ifi)%next
+         IF ( pextinf(ifi)%luse(ie) ) THEN
+            obsoutdata%cextname(pextinf(ifi)%ipos(ie)) = &
+               & obsdata(ifi)%cextname(ie)
+            obsoutdata%cextlong(pextinf(ifi)%ipos(ie)) = &
+               & obsdata(ifi)%cextlong(ie)
+            obsoutdata%cextunit(pextinf(ifi)%ipos(ie)) = &
+               & obsdata(ifi)%cextunit(ie)
+         ENDIF
+      ENDDO
+      iadd = iadd + obsdata(ifi)%nadd
+   ENDDO
+   !
+   ! Allocate comparison arrays and file them
+   ! 
+   IF (ilenwmo>8) THEN
+      WRITE(*,*)'Fix fbmatchup to allow string length > 8'
+      CALL abort
+   ENDIF
+   ALLOCATE(zrtim(obsoutdata%nobs),zrphi(obsoutdata%nobs), &
+      &     zrlam(obsoutdata%nobs),irwmo(obsoutdata%nobs))
+   DO i1 = 1, obsoutdata%nobs
+      irwmo(i1) = TRANSFER( obsoutdata%cdwmo(i1), irwmo(i1) )
+      zrtim(i1) = REAL( obsoutdata%ptim(i1), fbsp )
+      zrphi(i1) = REAL( obsoutdata%pphi(i1), fbsp )
+      zrlam(i1) = REAL( obsoutdata%plam(i1), fbsp ) 
+   ENDDO
+   !
+   ! Merge extra data into output data
+   !
+   iadd = obsdata(1)%nadd
+   DO ifi = 2, ninfiles
+      ist = 1
+      DO ii = 1, obsdata(ifi)%nobs
+         IF (MOD(ii,10000)==1) THEN
+            WRITE(*,*)'Handling observation no ',ii,' for file no ',ifi
+         ENDIF
+         llfound = .FALSE.
+         iwmo = TRANSFER( obsdata(ifi)%cdwmo(ii), iwmo )
+         ztim = REAL( obsdata(ifi)%ptim(ii), fbsp )
+         zphi = REAL( obsdata(ifi)%pphi(ii), fbsp )
+         zlam = REAL( obsdata(ifi)%plam(ii), fbsp ) 
+         ! Check if the the same index is the right one.
+         IF ( iwmo == irwmo(ii) ) THEN
+            IF ( ztim == zrtim(ii) ) THEN
+               IF (  zphi == zrphi(ii) ) THEN
+                  IF ( zlam == zrlam(ii) ) THEN
+                     llfound = .TRUE.
+                     i1 = ii
+                  ENDIF
+               ENDIF
+            ENDIF
+         ENDIF
+         ! Search for position in from previous found position
+         ! if not the same index
+         IF (.NOT.llfound) THEN
+            DO i1 = ist, obsoutdata%nobs
+               IF ( iwmo == irwmo(i1) ) THEN
+                  IF ( ztim == zrtim(i1) ) THEN
+                     IF (  zphi == zrphi(i1) ) THEN
+                        IF ( zlam == zrlam(i1) ) THEN
+                           llfound = .TRUE.
+                           EXIT
+                        ENDIF
+                     ENDIF
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDIF
+         ! If not fount try agan from the beginnning
+         IF ( .NOT.llfound ) THEN
+            DO i1 = 1, obsoutdata%nobs
+               IF ( iwmo == irwmo(i1) ) THEN
+                  IF ( ztim == zrtim(i1) ) THEN
+                     IF (  zphi == zrphi(i1) ) THEN
+                        IF ( zlam == zrlam(i1) ) THEN
+                           llfound = .TRUE.
+                           EXIT
+                        ENDIF
+                     ENDIF
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDIF
+         ! If found put the data into the common structure
+         IF (llfound) THEN
+            obsoutdata%ioqc(i1) = & 
+               & MAX( obsoutdata%ioqc(i1), obsdata(ifi)%ioqc(ii) )
+            obsoutdata%ipqc(i1) = &
+               & MAX( obsoutdata%ipqc(i1), obsdata(ifi)%ipqc(ii) )
+            obsoutdata%itqc(i1) = &
+               & MAX( obsoutdata%itqc(i1), obsdata(ifi)%itqc(ii) )
+            obsoutdata%ivqc(i1,:) = &
+               & MAX( obsoutdata%ivqc(i1,:), obsdata(ifi)%ivqc(ii,:) )
+            obsoutdata%ioqcf(:,i1)   = IOR( obsdata(ifi)%ioqcf(:,ii), &
+               &                            obsoutdata%ioqcf(:,i1) )
+            obsoutdata%ipqcf(:,i1)   = IOR( obsdata(ifi)%ipqcf(:,ii), &
+               &                            obsoutdata%ipqcf(:,i1) )
+            obsoutdata%itqcf(:,i1)   = IOR( obsdata(ifi)%itqcf(:,ii), &
+               &                            obsoutdata%itqcf(:,i1) )
+            obsoutdata%ivqcf(:,i1,:) = IOR( obsdata(ifi)%ivqcf(:,ii,:), &
+               &                            obsoutdata%ivqcf(:,i1,:) )
+            llfound = .FALSE.
+            ! Search for levels 
+            ltaken(:) = .FALSE.
+            DO ik1 = 1, obsdata(ifi)%nlev
+               levloop : DO ik2 = 1, obsoutdata%nlev
+                  IF ( REAL( obsdata(ifi)%pdep(ik1,ii), fbsp ) ==  &
+                     & REAL( obsoutdata%pdep(ik2,i1),  fbsp ) ) THEN
+                     lnotobs=.TRUE.
+                     IF (ltaken(ik2)) CYCLE
+                     DO iv = 1, obsdata(ifi)%nvar
+                        IF ( REAL( obsdata(ifi)%pob(ik1,ii,iv), fbsp ) == &
+                           & REAL( obsoutdata%pob(ik2,i1,iv), fbsp ) ) THEN
+                           lnotobs=.FALSE.
+                        ENDIF
+                     ENDDO
+                     IF (lnotobs) CYCLE levloop
+                     ltaken(ik2)=.TRUE.
+                     DO ia = 1, obsdata(ifi)%nadd
+                        obsoutdata%padd(ik2,i1,iadd+ia,:) = &
+                           & obsdata(ifi)%padd(ik1,ii,ia,:)
+                     ENDDO
+                     DO ie = 1, obsdata(ifi)%next
+                        IF ( pextinf(ifi)%luse(ie) ) THEN
+                           obsoutdata%pext(ik2,i1,pextinf(ifi)%ipos(ie)) = &
+                              & obsdata(ifi)%pext(ik1,ii,ie)
+                        ENDIF
+                     ENDDO
+                     obsoutdata%idqc(ik2,i1) = &
+                        & MAX( obsoutdata%idqc(ik2,i1), obsdata(ifi)%idqc(ik1,ii) )
+                     obsoutdata%ivlqc(ik2,i1,:) = &
+                        & MAX( obsoutdata%ivlqc(ik2,i1,:), obsdata(ifi)%ivlqc(ik1,ii,:) )
+                     obsoutdata%idqcf(:,ik2,i1)    = &
+                        &                IOR( obsdata(ifi)%idqcf(:,ik1,ii), &
+                        &                     obsoutdata%idqcf(:,ik2,i1) )
+                     obsoutdata%ivlqcf(:,ik2,i1,:) = &
+                        &                IOR( obsdata(ifi)%ivlqcf(:,ik1,ii,:), &
+                        &                     obsoutdata%ivlqcf(:,ik2,i1,:) )
+                     llfound = .TRUE.
+                     EXIT
+                  ENDIF
+               ENDDO levloop
+               ! Write warning if level not found
+               IF (.NOT.llfound.AND.(obsdata(ifi)%pdep(ik1,ii)/=fbrmdi)) THEN
+                  WRITE(*,*)'Level not found in first file : ',&
+                     &      TRIM( cdinfile(1)  )
+                  WRITE(*,*)'Data file                     : ',&
+                     &      TRIM( cdinfile(ifi) )
+                  WRITE(*,*)'Identifier                    : ',&
+                     &      obsdata(ifi)%cdwmo(ii)
+                  WRITE(*,*)'Julifin date                   : ',&
+                     &      obsdata(ifi)%ptim(ii)
+                  WRITE(*,*)'Latitude                      : ',&
+                     &      obsdata(ifi)%pphi(ii)
+                  WRITE(*,*)'Longitude                     : ',&
+                     &      obsdata(ifi)%plam(ii)
+                  WRITE(*,*)'Depth                         : ',&
+                     &      obsdata(ifi)%pdep(ik1,ii)
+               ENDIF
+            ENDDO
+            ist = i1
+         ELSE
+            ! Write warning if observation not found
+            WRITE(*,*)'Observation not found in first data file : ',&
+               &      TRIM( cdinfile(1)  )
+            WRITE(*,*)'Data file                                : ',&
+               &      TRIM( cdinfile(ifi) )
+            WRITE(*,*)'Identifier                               : ',&
+               &      obsdata(ifi)%cdwmo(ii)
+            WRITE(*,*)'Julifin date                              : ',&
+               &      obsdata(ifi)%ptim(ii)
+            WRITE(*,*)'Latitude                                 : ',&
+               &      obsdata(ifi)%pphi(ii)
+            WRITE(*,*)'Longitude                                : ',&
+               &      obsdata(ifi)%plam(ii)
+            ist = 1
+         ENDIF
+      ENDDO
+      IF (obsdata(ifi)%nobs>0) THEN
+         WRITE(*,*)'Handled last obs. no    ',ii,' for file no ',ifi
+      ENDIF
+      iadd = iadd + obsdata(ifi)%nadd
+   ENDDO
+   !
+   ! Write output file
+   !
+   CALL write_obfbdata( TRIM(cdoutfile), obsoutdata )
+   !
+   ! Deallocate temporary data
+   ! 
+   DEALLOCATE(zrtim,zrphi,zrlam,irwmo )
+   DEALLOCATE( &
+      & cexttmp &
+      & )
+   DO ifi = 1, ninfiles
+      DEALLOCATE( &
+         & pextinf(ifi)%luse, &
+         & pextinf(ifi)%ipos  &
+         & )
+   ENDDO
+   DEALLOCATE( &
+      & pextinf &
+      & )
+
+END PROGRAM fbmatchup
Index: /utils/tools_ticket2413/OBSTOOLS/src/fbprint.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/fbprint.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/fbprint.F90	(revision 12863)
@@ -0,0 +1,536 @@
+PROGRAM fbprint
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM fbprint **
+   !!
+   !!  ** Purpose : Print feedback file contents as text
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !!
+   !!   Usage :
+   !!     fbprint.exe [options] inputfile
+   !!   Options :
+   !!     -b            shorter output
+   !!     -q            QC flags (nqc=1) select observations based on QC flags
+   !!     -Q            QC flags (nqc=2) select observations based on QC flags
+   !!     -B            QC flags (nqc=3) select observations based on QC flags
+   !!     -u            unsorted
+   !!     -s ID         select station ID  
+   !!     -t TYPE       select observation type
+   !!     -v NUM1-NUM2  select variable range to print by number (default all)
+   !!     -a NUM1-NUM2  select additional variable range to print by number (default all)
+   !!     -e NUM1-NUM2  select extra variable range to print by number (default all)
+   !!     -d            output date range
+   !!     -D            print depths
+   !!     -z            use zipped files
+   !! 
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE toolspar_kind 
+   USE obs_fbm
+   USE index_sort
+   USE date_utils
+   USE proftools
+
+   IMPLICIT NONE
+   !
+   ! Command line arguments input file
+   !
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nargs
+   CHARACTER(len=256) :: cdinfile, cdbrief
+   LOGICAL :: lbrief, lqcflags, lstat, ltyp, lsort, ldaterange, lzinp, ldepths
+   CHARACTER(len=ilenwmo) :: cdstat
+   CHARACTER(len=ilentyp) :: cdtyp
+   INTEGER :: nqc
+   INTEGER :: nvar1, nvar2, nadd1, nadd2, next1, next2
+   !
+   ! Input data
+   !
+   TYPE(obfbdata) :: obsdata
+   !
+   ! Loop variables
+   !
+   INTEGER :: ii, iarg, ip
+   !
+   ! Sorting
+   !
+   INTEGER :: iwmo
+   REAL(KIND=dp),ALLOCATABLE :: zsort(:,:)
+   INTEGER,ALLOCATABLE  :: iindex(:)
+   !
+   ! Get number of command line arguments
+   !
+   nargs  = IARGC()
+   lbrief = .FALSE.
+   lstat = .FALSE.
+   ltyp = .FALSE.
+   ldaterange = .FALSE.
+   ldepths = .FALSE.
+   cdstat = 'XXXXXXX'
+   cdtyp = 'XXXX'
+   lsort = .TRUE.
+   nqc = 0
+   nvar1 = -1
+   nvar2 = -1
+   nadd1 = -1
+   nadd2 = -1
+   next1 = -1
+   next2 = -1
+   lzinp = .FALSE.
+   IF ( nargs < 1 ) THEN
+      CALL usage()
+   ENDIF
+   iarg = 1
+   DO
+      IF ( iarg == nargs ) EXIT
+      CALL getarg( iarg, cdbrief )
+      IF ( cdbrief == '-b' ) THEN
+         lbrief = .TRUE.
+         iarg = iarg + 1
+      ELSEIF( cdbrief == '-q' ) THEN
+         lqcflags = .TRUE.
+         nqc=1
+         iarg = iarg + 1
+      ELSEIF( cdbrief == '-Q' ) THEN
+         lqcflags = .TRUE.
+         nqc=2
+         iarg = iarg + 1
+      ELSEIF( cdbrief == '-B' ) THEN
+         lqcflags = .TRUE.
+         nqc=3
+         iarg = iarg + 1
+      ELSEIF( cdbrief == '-u' ) THEN
+         lsort = .FALSE.
+         iarg = iarg + 1
+      ELSEIF ( cdbrief == '-s' ) THEN
+         lstat = .TRUE.
+         CALL getarg( iarg + 1, cdstat )
+         iarg = iarg + 2 
+      ELSEIF ( cdbrief == '-t' ) THEN
+         ltyp = .TRUE.
+         CALL getarg( iarg + 1, cdtyp )
+         iarg = iarg + 2 
+      ELSEIF ( cdbrief == '-v' ) THEN
+         CALL getarg( iarg + 1, cdbrief )
+         ip=INDEX(cdbrief,'-')
+         IF (ip==0) THEN
+            READ(cdbrief,'(I10)') nvar1
+            IF (nvar1==0) THEN
+               nvar2=-1
+            ELSE
+               nvar2 = nvar1
+            ENDIF
+         ELSEIF(ip==1) THEN
+            nvar1=1
+            READ(cdbrief(ip+1:),'(I10)') nvar2
+         ELSE
+            READ(cdbrief(1:ip-1),'(I10)') nvar1
+            READ(cdbrief(ip+1:),'(I10)') nvar2
+         ENDIF
+         iarg = iarg + 2
+      ELSEIF ( cdbrief == '-a' ) THEN
+         CALL getarg( iarg + 1, cdbrief )
+         ip=INDEX(cdbrief,'-')
+         IF (ip==0) THEN
+            READ(cdbrief,'(I10)') nadd1
+            IF (nadd1==0) THEN
+               nadd2=-1
+            ELSE
+               nadd2 = nadd1
+            ENDIF
+         ELSEIF(ip==1) THEN
+            nadd1=1
+            READ(cdbrief(ip+1:),'(I10)') nadd2
+         ELSE
+            READ(cdbrief(1:ip-1),'(I10)') nadd1
+            READ(cdbrief(ip+1:),'(I10)') nadd2
+         ENDIF
+         iarg = iarg + 2
+      ELSEIF ( cdbrief == '-e' ) THEN
+         CALL getarg( iarg + 1, cdbrief )
+         ip=INDEX(cdbrief,'-')
+         IF (ip==0) THEN
+            READ(cdbrief,'(I10)') next1
+            IF (next1==0) THEN
+               next2=-1
+            ELSE
+               next2 = next1
+            ENDIF
+         ELSEIF(ip==1) THEN
+            next1=1
+            READ(cdbrief(ip+1:),'(I10)') next2
+         ELSE
+            READ(cdbrief(1:ip-1),'(I10)') next1
+            READ(cdbrief(ip+1:),'(I10)') next2
+         ENDIF
+         iarg = iarg + 2
+      ELSEIF ( cdbrief == '-d' ) THEN
+         ldaterange=.TRUE.
+         iarg = iarg + 1
+      ELSEIF ( cdbrief == '-D' ) THEN
+         ldepths=.TRUE.
+         iarg = iarg + 1
+      ELSEIF ( cdbrief == '-z' ) THEN
+         lzinp=.TRUE.
+         iarg = iarg + 1
+      ELSE
+         CALL usage
+      ENDIF
+   ENDDO
+   CALL getarg( nargs, cdinfile )
+   !
+   ! Get input data
+   !
+   IF (lzinp) THEN
+#if defined NOSYSTEM
+      WRITE(*,*)'Compressed files need the system subroutine call'
+      CALL abort
+#else
+      CALL system( 'cp '//TRIM(cdinfile)//' fbprint_tmp.nc.gz' )
+      CALL system( 'gzip -df fbprint_tmp.nc.gz' )
+      CALL read_obfbdata( 'fbprint_tmp.nc', obsdata )
+      CALL system( 'rm -f fbprint_tmp.nc' )
+#endif
+   ELSE
+      CALL read_obfbdata( TRIM(cdinfile), obsdata )
+   ENDIF
+   CALL sealsfromargo( obsdata )
+   WRITE(*,'(2A,I9,A,I9,A)')TRIM(cdinfile), ' has ', obsdata%nobs ,&
+      & ' observations and a maximum of ', obsdata%nlev, ' levels'
+   IF (nvar1<0) THEN
+      nvar1 = 1
+      nvar2 = obsdata%nvar
+   ENDIF
+   IF (nadd1<0) THEN
+      nadd1 = 1
+      nadd2 = obsdata%nadd
+   ENDIF
+   IF (next1<0) THEN
+      next1 = 1
+      next2 = obsdata%next
+   ENDIF
+   !
+   ! Sort the data
+   !   
+   ALLOCATE(zsort(5,obsdata%nobs),iindex(obsdata%nobs))
+   IF (lsort) THEN
+      DO ii=1,obsdata%nobs
+         zsort(1,ii)=obsdata%ptim(ii)
+         zsort(2,ii)=obsdata%pphi(ii)
+         zsort(3,ii)=obsdata%plam(ii)
+         iwmo = TRANSFER( obsdata%cdwmo(ii)(1:4), iwmo )
+         zsort(4,ii) = iwmo
+         iwmo = TRANSFER( obsdata%cdwmo(ii)(5:8), iwmo )
+         zsort(5,ii) = iwmo
+      ENDDO
+      CALL index_sort_dp_n(zsort,5,iindex,obsdata%nobs)
+   ELSE
+      DO ii=1,obsdata%nobs
+         iindex(ii)=ii
+      ENDDO
+   ENDIF
+   IF (ldaterange) THEN
+      IF (obsdata%nobs>0) THEN
+         WRITE(*,'(A)')'First observation'
+         CALL print_time(obsdata%ptim(1))
+         WRITE(*,'(A)')'Last observation'
+         CALL print_time(obsdata%ptim(obsdata%nobs))
+      ENDIF
+   ELSE
+      !
+      ! Print the sorted list
+      !   
+      DO ii=1,obsdata%nobs
+         IF (lstat) THEN
+            IF (TRIM(ADJUSTL(cdstat)) /= &
+               &TRIM(ADJUSTL(obsdata%cdwmo(iindex(ii))))) CYCLE
+         ENDIF
+         IF (ltyp) THEN
+            IF (TRIM(ADJUSTL(cdtyp)) /= &
+               &TRIM(ADJUSTL(obsdata%cdtyp(iindex(ii))))) CYCLE
+         ENDIF
+         IF (ldepths) THEN
+            CALL print_depths(obsdata,iindex(ii))
+         ELSE
+            IF (lqcflags) THEN
+               CALL print_obs_qc(obsdata,iindex(ii),nqc,nvar1,nvar2)
+            ELSE
+               CALL print_obs(obsdata,iindex(ii),lbrief,&
+                  &           nvar1,nvar2,nadd1,nadd2,next1,next2)
+            ENDIF
+         ENDIF
+      ENDDO
+
+   ENDIF
+
+CONTAINS
+
+   SUBROUTINE usage
+      WRITE(*,'(A)')'Usage:'
+      WRITE(*,'(A)')'fbprint [options] inputfile'
+      CALL abort()
+   END SUBROUTINE usage
+   
+   SUBROUTINE print_depths(obsdata,iindex)
+      IMPLICIT NONE
+      TYPE(obfbdata) :: obsdata
+      INTEGER :: iindex
+      INTEGER :: kj
+      REAL :: mindep,maxdep
+
+      mindep=10000
+      maxdep=0
+      DO kj=1,obsdata%nlev
+         IF (obsdata%pdep(kj,iindex)<99999.0) THEN
+            IF (obsdata%pdep(kj,iindex)>maxdep) maxdep=obsdata%pdep(kj,iindex)
+            IF (obsdata%pdep(kj,iindex)<mindep) mindep=obsdata%pdep(kj,iindex)
+         ENDIF
+      ENDDO
+      
+      WRITE(*,*)'Fileindex           = ',obsdata%kindex(iindex)
+      WRITE(*,*)'Station identifier  = ',obsdata%cdwmo(iindex)
+      WRITE(*,*)'Station type        = ',obsdata%cdtyp(iindex)
+      WRITE(*,*)'Latitude            = ',obsdata%pphi(iindex)
+      WRITE(*,*)'Longtude            = ',obsdata%plam(iindex)
+      CALL print_time( obsdata%ptim(iindex) )
+      WRITE(*,*)'Position QC         = ',obsdata%ipqc(iindex)
+      WRITE(*,*)'Observation QC      = ',obsdata%ioqc(iindex)
+      WRITE(*,*)'Minimum obs. depth  = ',mindep
+      WRITE(*,*)'Maximum obs. depth  = ',maxdep
+      WRITE(*,*)
+
+   END SUBROUTINE print_depths
+
+   SUBROUTINE print_obs(obsdata,iindex,lshort,&
+      &                 kvar1,kvar2,kadd1,kadd2,kext1,kext2)
+      IMPLICIT NONE
+      TYPE(obfbdata) :: obsdata
+      INTEGER :: iindex
+      LOGICAL :: lshort
+      INTEGER :: kvar1,kvar2,kadd1,kadd2,kext1,kext2
+      INTEGER :: jv,ja,je,jk
+      INTEGER :: kj
+      LOGICAL :: lskip
+      CHARACTER(len=1024) :: cdfmt1,cdfmt2
+      CHARACTER(len=16) :: cdtmp
+
+      WRITE(*,*)'Fileindex           = ',obsdata%kindex(iindex)
+      WRITE(*,*)'Station identifier  = ',obsdata%cdwmo(iindex)
+      WRITE(*,*)'Station type        = ',obsdata%cdtyp(iindex)
+      WRITE(*,*)'Latitude            = ',obsdata%pphi(iindex)
+      WRITE(*,*)'Longtude            = ',obsdata%plam(iindex)
+      CALL print_time( obsdata%ptim(iindex) )
+      WRITE(*,*)'Position QC         = ',obsdata%ipqc(iindex)
+      WRITE(*,*)'Observation QC      = ',obsdata%ioqc(iindex)
+      IF (.NOT.lshort) THEN
+         DO jv = kvar1, kvar2
+            WRITE(*,*)'Variable name       = ',obsdata%cname(jv)
+            WRITE(*,*)'Variable QC         = ',obsdata%ivqc(iindex,jv)
+            IF (obsdata%lgrid) THEN
+               WRITE(*,*)'Grid I              = ',obsdata%iobsi(iindex,jv)
+               WRITE(*,*)'Grid J              = ',obsdata%iobsj(iindex,jv)
+            ENDIF
+         ENDDO
+         cdfmt1='(1X,A8,1X,A8'
+         cdfmt2='(1X,F8.2,1X,I8'
+         DO jv = kvar1, kvar2
+            cdfmt1 = TRIM(cdfmt1)//',1X,A15,1X,A8'
+            cdfmt2 = TRIM(cdfmt2)//',1X,E15.9,1X,I8'
+            IF (kadd2-kadd1+1>0) THEN
+               WRITE(cdtmp,'(I10)')kadd2-kadd1+1
+               cdfmt1 = TRIM(cdfmt1)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,A15)'
+               cdfmt2 = TRIM(cdfmt2)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,E15.9)'
+            ENDIF
+            IF (obsdata%lgrid) THEN
+               cdfmt1 = TRIM(cdfmt1)//',1X,A10'
+               cdfmt2 = TRIM(cdfmt2)//',1X,I10'
+            ENDIF
+         ENDDO
+         IF (kext2-kext1+1>0) THEN
+            WRITE(cdtmp,'(I10)')kext2-kext1+1
+            cdfmt1 = TRIM(cdfmt1)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,A15)'
+            cdfmt2 = TRIM(cdfmt2)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,E15.9)'
+         ENDIF
+         cdfmt1=TRIM(cdfmt1)//')'
+         cdfmt2=TRIM(cdfmt2)//')'
+         IF (obsdata%lgrid) THEN
+            WRITE(*,FMT=cdfmt1)&
+               & 'DEPTH', 'DEP_QC', &
+               & (TRIM(obsdata%cname(jv))//'_OBS', &
+               & TRIM(obsdata%cname(jv))//'_QC' , &
+               & (TRIM(obsdata%cname(jv))//'_'//TRIM(obsdata%caddname(ja)),&
+               & ja = kadd1, kadd2 ), &
+               & TRIM(obsdata%cname(jv))//'_K' , &
+               & jv = kvar1, kvar2 ), &
+               & ( TRIM(obsdata%cextname(ja)),&
+               & ja = kext1, kext2 )
+            DO kj=1,obsdata%nlev
+               IF (obsdata%pdep(kj,iindex)<99999.0) THEN
+                  WRITE (*,FMT=cdfmt2) &
+                     & obsdata%pdep(kj,iindex),   &
+                     & obsdata%idqc(kj,iindex),   &
+                     & ( obsdata%pob(kj,iindex,jv), obsdata%ivlqc(kj,iindex,jv), &
+                     & ( obsdata%padd(kj,iindex,ja,jv) , ja = kadd1, kadd2 ), &
+                     & obsdata%iobsk(kj,iindex,jv), &
+                     & jv = kvar1, kvar2 ), &
+                     & ( obsdata%pext(kj,iindex,ja), ja = kext1, kext2 )
+               ENDIF
+            ENDDO
+         ELSE
+            cdfmt1=TRIM(cdfmt1)//')'
+            cdfmt2=TRIM(cdfmt2)//')'
+            WRITE(*,FMT=cdfmt1)&
+               & 'DEPTH', 'DEP_QC', &
+               & (TRIM(obsdata%cname(jv))//'_OBS', &
+               & TRIM(obsdata%cname(jv))//'_QC' , &
+               & (TRIM(obsdata%cname(jv))//TRIM(obsdata%caddname(ja)),&
+               & ja = kadd1, kadd2 ), &
+               & jv = kvar1, kvar2 ), &
+               & ( TRIM(obsdata%cextname(ja)),&
+               & ja = kext1, kext2 )
+            DO kj=1,obsdata%nlev
+               IF (obsdata%pdep(kj,iindex)<99999.0) THEN
+                  WRITE (*,FMT=cdfmt2) &
+                     & obsdata%pdep(kj,iindex),   &
+                     & obsdata%idqc(kj,iindex),   &
+                     & ( obsdata%pob(kj,iindex,jv), obsdata%ivlqc(kj,iindex,jv), &
+                     & ( obsdata%padd(kj,iindex,ja,jv) , ja = kadd1, kadd2 ), &
+                     & jv = kvar1, kvar2 ), &
+                     & ( obsdata%pext(kj,iindex,ja), ja = kext1, kext2 )
+               ENDIF
+            ENDDO
+         ENDIF
+      ENDIF
+      WRITE(*,*)
+   END SUBROUTINE print_obs
+   
+   SUBROUTINE print_obs_qc(obsdata,iindex,kqc,kvar1,kvar2)
+      IMPLICIT NONE
+      TYPE(obfbdata) :: obsdata
+      INTEGER :: iindex
+      LOGICAL :: lqc
+      INTEGER :: kqc
+      INTEGER :: kvar1,kvar2
+      INTEGER :: jv,ja,je,jk
+      INTEGER :: kj
+      LOGICAL :: lskip
+      CHARACTER(len=1024) :: cdfmt1,cdfmt2
+      CHARACTER(len=16) :: cdtmp
+      INTEGER :: iqcf
+      
+      IF (kqc==2) THEN
+         lskip=.TRUE.
+         IF (obsdata%ipqc(iindex)>1) lskip=.FALSE.
+         IF (obsdata%ioqc(iindex)>1) lskip=.FALSE.
+         DO jv = kvar1, kvar2
+            IF (obsdata%ivqc(iindex,jv)>1) lskip=.FALSE.
+         ENDDO
+         DO kj=1,obsdata%nlev
+            IF (obsdata%pdep(kj,iindex)<99999.0) THEN
+               IF (obsdata%idqc(kj,iindex)>1) lskip=.FALSE.
+               DO jv = kvar1, kvar2
+                  IF (obsdata%ivlqc(kj,iindex,jv)>1) lskip=.FALSE.
+               ENDDO
+            ENDIF
+         ENDDO
+         IF (lskip) RETURN
+      ELSEIF (kqc==3) THEN
+         lskip=.TRUE.
+         DO kj=1,obsdata%nlev
+            IF (obsdata%pdep(kj,iindex)<99999.0) THEN
+               iqcf=0
+               DO jv = kvar1, kvar2
+                  IF (obsdata%ivlqc(kj,iindex,jv)>1) iqcf=iqcf+1
+                  IF (iqcf==obsdata%nvar) lskip=.FALSE.
+               ENDDO
+            ENDIF
+         ENDDO
+         IF (lskip) RETURN
+      ENDIF
+      WRITE(*,*)'Fileindex           = ',obsdata%kindex(iindex)
+      WRITE(*,*)'Station identifier  = ',obsdata%cdwmo(iindex)
+      WRITE(*,*)'Station type        = ',obsdata%cdtyp(iindex)
+      WRITE(*,*)'Latitude            = ',obsdata%pphi(iindex)
+      WRITE(*,*)'Longtude            = ',obsdata%plam(iindex)
+      CALL print_time( obsdata%ptim(iindex) )
+      WRITE(*,*)'Position QC         = ',obsdata%ipqc(iindex)
+      WRITE(*,*)'Position QC flags   = ',obsdata%ipqcf(:,iindex)
+      WRITE(*,*)'Observation QC      = ',obsdata%ioqc(iindex)
+      WRITE(*,*)'Observation QC flags= ',obsdata%ioqcf(:,iindex)
+      DO jv = kvar1, kvar2
+         WRITE(*,*)'Variable name       = ',obsdata%cname(jv)
+         WRITE(*,*)'Variable QC         = ',obsdata%ivqc(iindex,jv)
+         WRITE(*,*)'Variable QC flags   = ',obsdata%ivqcf(:,iindex,jv)
+      ENDDO
+      cdfmt1='(1X,A8,1X,A8'
+      cdfmt2='(1X,F8.2,1X,I8'
+      WRITE(cdtmp,'(I10)')obsdata%nqcf
+      cdfmt1 = TRIM(cdfmt1)//',1X,A18'
+      cdfmt2 = TRIM(cdfmt2)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(I9)'
+      DO jv = kvar1, kvar2
+         cdfmt1 = TRIM(cdfmt1)//',1X,A15,1X,A8'
+         cdfmt2 = TRIM(cdfmt2)//',1X,E15.9,1X,I8'
+         WRITE(cdtmp,'(I10)')obsdata%nqcf
+         cdfmt1 = TRIM(cdfmt1)//',1X,A18'
+         cdfmt2 = TRIM(cdfmt2)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(I9)'
+      ENDDO
+      IF (obsdata%next>0) THEN
+         WRITE(cdtmp,'(I10)')obsdata%next
+         cdfmt1 = TRIM(cdfmt1)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,A15)'
+         cdfmt2 = TRIM(cdfmt2)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,E15.9)'
+      ENDIF
+      cdfmt1=TRIM(cdfmt1)//')'
+      cdfmt2=TRIM(cdfmt2)//')'
+      WRITE(*,FMT=cdfmt1)&
+         & 'DEPTH', 'DEP_QC', 'DEP_QC_FLAGS', &
+         & (TRIM(obsdata%cname(jv))//'_OBS', &
+         & TRIM(obsdata%cname(jv))//'_QC' , &
+         & TRIM(obsdata%cname(jv))//'_QC_FLAGS',&
+         & jv = kvar1, kvar2 ), &
+         & ( TRIM(obsdata%cextname(ja)),&
+         & ja = 1, obsdata%next )
+      DO kj=1,obsdata%nlev
+         IF (kqc>=2)  THEN
+            lskip=.TRUE.
+            IF (obsdata%idqc(kj,iindex)>1) lskip=.FALSE.
+            DO jv = kvar1, kvar2
+               IF (obsdata%ivlqc(kj,iindex,jv)>1) lskip=.FALSE.
+            ENDDO
+            IF (lskip) CYCLE
+         ENDIF
+         IF (obsdata%pdep(kj,iindex)<99999.0) THEN
+            WRITE (*,FMT=cdfmt2) &
+               & obsdata%pdep(kj,iindex),   &
+               & obsdata%idqc(kj,iindex),   &
+               & ( obsdata%idqcf(ja,kj,iindex), ja = 1, obsdata%nqcf ), &
+               & ( obsdata%pob(kj,iindex,jv), obsdata%ivlqc(kj,iindex,jv), &
+               & ( obsdata%ivlqcf(ja,kj,iindex,jv) , ja=1, obsdata%nqcf ), &
+               & jv = kvar1, kvar2 ), &
+               & ( obsdata%pext(kj,iindex,ja), ja=1, obsdata%next )
+         ENDIF
+      ENDDO
+      WRITE(*,*)
+      
+   END SUBROUTINE print_obs_qc
+
+   SUBROUTINE print_time(ptim)
+      IMPLICIT NONE
+      REAL(fbdp) :: ptim
+      INTEGER:: iyr,imon,iday,ihou,imin,isec      
+      WRITE(*,*)'Julian date         = ',ptim
+      CALL jul2greg(isec,imin,ihou,iday,imon,iyr,ptim)
+      WRITE(*,'(1X,A,I4,2I2.2)') &
+         &      'Gregorian date      = ',iyr,imon,iday
+      WRITE(*,'(1X,A,I2.2,A1,I2.2,A1,I2.2)') &
+         &      'Time                = ',ihou,':',imin,':',isec
+   END  SUBROUTINE print_time
+
+END PROGRAM fbprint
+
+   
Index: /utils/tools_ticket2413/OBSTOOLS/src/fbsel.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/fbsel.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/fbsel.F90	(revision 12863)
@@ -0,0 +1,260 @@
+PROGRAM fbsel
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM fbsel **
+   !!
+   !!  ** Purpose : Select or subsample observations
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !!
+   !!   Usage:
+   !!     fbsel.exe <input filename> <output filename>
+   !!
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE obs_fbm
+   USE date_utils
+   IMPLICIT NONE
+   TYPE(obfbdata) :: fbdatain,fbdataout
+   CHARACTER(len=256) :: filenamein,filenameout,filenametmp,cnameout
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER,PARAMETER :: maxtyp=1023
+   INTEGER,PARAMETER :: maxdates=20
+   INTEGER :: nqc,ntyp,ndates,ninidate(maxdates),nenddate(maxdates)
+   LOGICAL :: lsplitqc,lsplittyp,lsplitstat
+   INTEGER :: iqc,ityp,idate,istat
+   REAL :: maxlat,minlat,maxlon,minlon
+   CHARACTER(len=ilenwmo) :: cdwmo,cdwmobeg,cdwmoend
+   CHARACTER(len=ilenwmo), DIMENSION(:), POINTER :: clstatids
+   INTEGER :: nstat
+   NAMELIST/namsel/nqc,ntyp,ndates,ninidate,nenddate,lsplitqc,lsplittyp, &
+      &            lsplitstat,maxlat,minlat,maxlon,minlon,cdwmo,&
+      &            cdwmobeg,cdwmoend
+
+   IF (iargc()/=2) THEN
+      WRITE(*,*)'Usage:'
+      WRITE(*,*)'fbsel <input filename> <output filename>'
+      CALL abort
+   ENDIF
+
+   CALL getarg(1,filenamein)
+   CALL getarg(2,filenameout)
+   
+   nqc=-1
+   ntyp=-1
+   ndates=1
+   ninidate=19500101
+   nenddate=21000101
+
+   lsplitqc=.FALSE.
+   lsplittyp=.FALSE.
+   lsplitstat=.FALSE.
+   cdwmo=REPEAT('X',ilenwmo)
+   cdwmobeg=cdwmo
+   cdwmoend=cdwmo
+   maxlat=1e+38
+   minlat=-1e+38
+   maxlon=1e+38
+   minlon=-1e+38
+   OPEN(10,file='namsel.in')
+   READ(10,namsel)
+   CLOSE(10)
+   IF (cdwmobeg==REPEAT('X',ilenwmo)) cdwmobeg=cdwmo
+   IF (cdwmoend==REPEAT('X',ilenwmo)) cdwmoend=cdwmo
+   WRITE(*,namsel)
+
+   CALL init_obfbdata(fbdatain)
+   CALL init_obfbdata(fbdataout)
+
+   WRITE(*,*)'Reading file : ',TRIM(filenamein)
+   CALL read_obfbdata(TRIM(filenamein),fbdatain)
+   WRITE(*,*)'Number of observations before selection = ',fbdatain%nobs
+   DO idate=1,ndates
+      IF (ndates==1) THEN
+         cnameout=filenameout
+      ELSE
+         WRITE(cnameout,'(I2.2,2A)')idate,'_',TRIM(filenameout)
+      ENDIF
+      IF (lsplitqc) THEN
+         DO iqc=1,3
+            CALL fb_sel(fbdatain,fbdataout,iqc,ntyp, &
+               &        ninidate(idate),nenddate(idate), &
+               &        maxlat,minlat,maxlon,minlon,cdwmobeg,cdwmoend)
+            WRITE(filenametmp,'(A,I2.2,A,A)')'qc_',iqc,'_',TRIM(cnameout)
+            IF (fbdataout%nobs>0) THEN
+               WRITE(*,*)'QC selected = ',iqc
+               WRITE(*,*)'Number of observations selected = ',fbdataout%nobs
+               WRITE(*,*)'Writing file : ',TRIM(filenametmp)
+               CALL write_obfbdata(TRIM(filenametmp),fbdataout)
+            ENDIF
+            CALL dealloc_obfbdata(fbdataout)
+         ENDDO
+      ELSEIF (lsplittyp) THEN
+         DO ityp=0,maxtyp
+            CALL fb_sel(fbdatain,fbdataout,nqc,ityp, &
+               &        ninidate(idate),nenddate(idate), &
+               &        maxlat,minlat,maxlon,minlon,cdwmobeg,cdwmoend)
+            WRITE(filenametmp,'(A,I4.4,A,A)')'typ_',ityp,'_',TRIM(cnameout)
+            IF (fbdataout%nobs>0) THEN
+               WRITE(*,*)'Type = ',ityp
+               WRITE(*,*)'Number of observations selected = ',fbdataout%nobs
+               WRITE(*,*)'Writing file : ',TRIM(filenametmp)
+               CALL write_obfbdata(TRIM(filenametmp),fbdataout)
+            ENDIF
+            CALL dealloc_obfbdata(fbdataout)
+         ENDDO
+      ELSEIF (lsplitstat) THEN
+         CALL fb_sel_uniqueids(fbdatain,clstatids,nstat)
+         DO istat=1,nstat
+            CALL fb_sel(fbdatain,fbdataout,nqc,ntyp, &
+               &        ninidate(idate),nenddate(idate), &
+               &        maxlat,minlat,maxlon,minlon,clstatids(istat),clstatids(istat))
+            WRITE(filenametmp,'(4A)')'statid_', &
+               & TRIM(clstatids(istat)),'_',TRIM(cnameout)
+            IF (fbdataout%nobs>0) THEN
+               WRITE(*,*)'Station = ',clstatids(istat)
+               WRITE(*,*)'Number of observations selected = ',fbdataout%nobs
+               WRITE(*,*)'Writing file : ',TRIM(filenametmp)
+               CALL write_obfbdata(TRIM(filenametmp),fbdataout)
+            ENDIF
+            CALL dealloc_obfbdata(fbdataout)
+         ENDDO
+      ELSE
+         CALL fb_sel(fbdatain,fbdataout,nqc,ntyp, & 
+            &        ninidate(idate),nenddate(idate), &
+            &        maxlat,minlat,maxlon,minlon,cdwmobeg,cdwmoend)
+         WRITE(*,*)'Number of observations selected = ',fbdataout%nobs
+         WRITE(*,*)'Writing file : ',TRIM(cnameout)
+         CALL write_obfbdata(TRIM(cnameout),fbdataout)
+         CALL dealloc_obfbdata(fbdataout)
+      ENDIF
+   ENDDO
+
+CONTAINS
+
+   SUBROUTINE fb_sel(fbdatain,fbdataout,nqc,ntyp,ninidate,nenddate,&
+      &              maxlat,minlat,maxlon,minlon,cdwmobeg,cdwmoend)
+      TYPE(obfbdata) :: fbdatain,fbdataout
+      INTEGER :: nqc,ntyp,ninidate,nenddate
+      REAL :: maxlat,minlat,maxlon,minlon
+      CHARACTER(len=ilenwmo) :: cdwmobeg,cdwmoend
+      INTEGER :: jobs
+      INTEGER :: iqc,ityp
+      LOGICAL :: llvalid(fbdatain%nobs)
+      INTEGER :: iyea,imon,iday
+      REAL(KIND=dp) :: zjini,zjend
+      LOGICAL :: lcheckwmo
+
+      lcheckwmo=(cdwmobeg/=REPEAT('X',ilenwmo)).OR.&
+         &      (cdwmoend/=REPEAT('X',ilenwmo))
+      iyea=ninidate/10000
+      imon=ninidate/100-iyea*100
+      iday=ninidate-iyea*10000-imon*100
+      CALL greg2jul(0,0,0,iday,imon,iyea,zjini)
+      iyea=nenddate/10000
+      imon=nenddate/100-iyea*100
+      iday=nenddate-iyea*10000-imon*100
+      CALL greg2jul(0,0,0,iday,imon,iyea,zjend)
+      DO jobs = 1, fbdatain%nobs
+         llvalid(jobs)=.TRUE.
+         IF (nqc/=-1) THEN
+            CALL check_prof(fbdatain,jobs,iqc)
+            llvalid(jobs)=(iqc==nqc).AND.llvalid(jobs)
+         ENDIF
+         IF (ntyp/=-1) THEN
+            READ(fbdatain%cdtyp(jobs),'(I4)')ityp
+            llvalid(jobs)=(ityp==ntyp).AND.llvalid(jobs)
+         ENDIF
+         IF (ninidate/=-1) THEN
+            llvalid(jobs)=(fbdatain%ptim(jobs)>zjini).AND.llvalid(jobs)
+         ENDIF
+         IF (nenddate/=-1) THEN
+            llvalid(jobs)=(fbdatain%ptim(jobs)<=zjend).AND.llvalid(jobs)
+         ENDIF
+         llvalid(jobs)=(fbdatain%pphi(jobs)<=maxlat).AND.       &
+            &          (fbdatain%pphi(jobs)>=minlat).AND.       &
+            &          (((fbdatain%plam(jobs)<=maxlon).AND.     &
+            &            (fbdatain%plam(jobs)>=minlon)).OR.     &
+            &           ((fbdatain%plam(jobs)+360<=maxlon).AND. &
+            &            (fbdatain%plam(jobs)+360>=minlon)).OR. &
+            &           ((fbdatain%plam(jobs)-360<=maxlon).AND. &
+            &            (fbdatain%plam(jobs)-360>=minlon))).AND.llvalid(jobs) 
+         IF (lcheckwmo) THEN
+            llvalid(jobs)=LGE(TRIM(fbdatain%cdwmo(jobs)),TRIM(cdwmobeg)) &
+               &    .AND. LLE(TRIM(fbdatain%cdwmo(jobs)),TRIM(cdwmoend)) &
+               &    .AND. llvalid(jobs)
+         ENDIF
+         ! Add more checks here...
+      ENDDO
+
+      CALL subsamp_obfbdata(fbdatain,fbdataout,llvalid)
+
+   END SUBROUTINE fb_sel
+
+   SUBROUTINE fb_sel_uniqueids(fbdatain,clstatids,nstat)
+      TYPE(obfbdata) :: fbdatain
+      CHARACTER(len=ilenwmo), DIMENSION(:), POINTER :: clstatids
+      INTEGER :: nstat
+      INTEGER :: jobs,kobs
+      LOGICAL, DIMENSION(fbdatain%nobs) :: lunique
+
+      lunique(:)=.TRUE.
+      DO jobs=1,fbdatain%nobs
+         IF (.NOT.lunique(jobs)) CYCLE
+         DO kobs=jobs+1,fbdatain%nobs
+            IF (.NOT.lunique(kobs)) CYCLE
+            IF (fbdatain%cdwmo(jobs)==fbdatain%cdwmo(kobs)) THEN
+               lunique(kobs)=.FALSE.
+            ENDIF
+         ENDDO
+      ENDDO
+      nstat=COUNT(lunique)
+      ALLOCATE(clstatids(nstat))
+      kobs=0
+      DO jobs=1,fbdatain%nobs
+         IF (lunique(jobs)) THEN
+            kobs=kobs+1
+            clstatids(kobs)=fbdatain%cdwmo(jobs)
+         ENDIF
+      ENDDO
+      WRITE(*,*)'Unique station ids'
+      DO jobs=1,nstat
+         WRITE(*,'(I5,1X,A)')jobs,clstatids(jobs)
+      ENDDO
+
+   END SUBROUTINE fb_sel_uniqueids
+   
+   SUBROUTINE check_prof(fbdata,iobs,iqc)
+      
+      TYPE(obfbdata) :: fbdata
+      INTEGER :: iobs,iqc
+      INTEGER :: i,ivar
+      
+      LOGICAL :: lpart,lfull
+
+      lpart=.false.
+      lfull=.true.
+      DO ivar=1,fbdata%nvar
+         DO i=1,fbdata%nlev
+            IF ((fbdata%ivlqc(i,iobs,ivar)>2).AND.&
+               &(fbdata%ivlqc(i,iobs,ivar)<9)) lpart = .TRUE.
+            IF (fbdata%ivlqc(i,iobs,ivar)<=2) lfull = .FALSE.
+         ENDDO
+      ENDDO
+
+      IF(lfull) THEN
+         iqc=3
+      ELSEIF (lpart) then
+         iqc=2
+      ELSE
+         iqc=1
+      ENDIF
+
+   END SUBROUTINE check_prof
+
+END PROGRAM fbsel
Index: /utils/tools_ticket2413/OBSTOOLS/src/fbstat.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/fbstat.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/fbstat.F90	(revision 12863)
@@ -0,0 +1,1335 @@
+PROGRAM fbstat
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM fbstat **
+   !!
+   !!  ** Purpose : Output feedback file summary info/statistics
+   !!         into a number of .dat files for different areas
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !!
+   !!   Usage:
+   !!     fbstat.exe [-nmlev] <filenames>
+   !!   Optional:
+   !!     namelist = namfbstat.in
+   !!
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE obs_fbm
+   USE fbaccdata
+   USE coords
+   USE omonainfo
+   USE fbstatncio
+   USE proftools
+   IMPLICIT NONE
+   TYPE(obfbdata) :: fbdata
+   CHARACTER(len=256) :: filename,outfilename
+   INTEGER :: jfile,jbox,jlev,jfirst,jvar,jadd,ji,ja,jt,jboxl
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   REAL,DIMENSION(:),ALLOCATABLE :: zlev
+   INTEGER :: nmlev, nfiles
+   LOGICAL :: lexists,lomona,ltext,lnetcdf,lzinp
+   REAL, ALLOCATABLE, DIMENSION(:,:,:) :: zdat3d
+   REAL, ALLOCATABLE, DIMENSION(:,:) :: zdat2d
+   INTEGER,DIMENSION(1) :: itime
+   INTEGER :: inidate,icurdate,loopno,ityp,iloopno
+   INTEGER :: nvar,nadd,noberr,nbgerr
+   CHARACTER(len=4) :: expver
+   CHARACTER(len=20) :: cltyp
+   CHARACTER(len=128) :: cdfmthead,cdfmtbody
+   LOGICAL :: lnear,linner,linnerp,linnerini,lpassive,lhistogram,lfound
+   LOGICAL :: lxyplot,lrmmean
+   INTEGER :: nqc,nqco
+   REAL :: rlspc,rlmax
+   CHARACTER(len=ilenname), DIMENSION(:), ALLOCATABLE :: cname,caddname,&
+      & cobename,cbgename
+   INTEGER, PARAMETER :: nmaxareas = 20
+   CHARACTER(len=20), DIMENSION(nmaxareas) :: carea
+   LOGICAL, DIMENSION(:), ALLOCATABLE :: lskipbox
+   INTEGER, parameter :: maxtyp = 10
+   CHARACTER(len=ilentyp), DIMENSION(maxtyp) :: ctyp
+   INTEGER :: ntyp,nboxuserl,ipdcst
+   REAL :: mindcst
+   NAMELIST/namfbstat/ltext,lomona,lnetcdf,nmlev,inidate,icurdate,loopno,&
+      &               expver,lnear,linner,lpassive,lhistogram,&
+      &               zhistmax,zhistmin,zhiststep,zcheck,carea,nmlev,&
+      &               nqc,nqco, &
+      &               rlspc,rlmax,ntyp,ctyp,&
+      &               lxyplot,zxymin,zxymax,zxystep,lzinp,lrmmean,mindcst
+
+   ltext=.TRUE.
+   lnetcdf=.TRUE.
+   lomona=.FALSE.
+   nmlev=31
+   inidate=19010101
+   icurdate=19010116
+   loopno=0
+   expver='test'
+   lnear=.TRUE.
+   linner=.FALSE.
+   lpassive=.FALSE.
+   lhistogram=.FALSE.
+   zhistmin(:)=-10.0
+   zhistmax(:)=10.0
+   zhiststep(:)=0.1
+   zcheck(:)=1000.0
+   nqc=2
+   nqco=2
+   carea(:)='all'
+   rlmax=5000.0
+   rlspc=-0.1
+   ntyp=1
+   ctyp(:)='all'
+   lxyplot=.FALSE.
+   zxymin(:)=-5.0
+   zxymax(:)=45.0
+   zxystep(:)=0.5
+   lzinp=.FALSE.
+   lrmmean=.FALSE.
+   mindcst=-1.0
+
+   INQUIRE(file='namfbstat.in',exist=lexists)
+   IF (lexists) THEN
+      OPEN(10,file='namfbstat.in')
+      READ(10,namfbstat)
+      CLOSE(10)
+      WRITE(*,namfbstat)
+   ENDIF
+   mindcst=mindcst*1000.0 !From km to m.
+   IF (iargc()==0) THEN
+      WRITE(*,*)'Usage:'
+      WRITE(*,*)'fbstat [-nmlev] <filenames>'
+      CALL abort
+   ENDIF
+   jfirst=1
+   DO ji=1,2
+      CALL getarg(jfirst,filename)
+      IF (filename=='-42') THEN
+         nmlev=42
+         jfirst=jfirst+1
+      ELSEIF(filename=='-31') THEN
+         nmlev=31
+         jfirst=jfirst+1
+      ELSEIF(filename=='-1') THEN
+         nmlev=1
+         lnear=.TRUE.
+         jfirst=jfirst+1
+      ELSEIF(filename=='-q') THEN
+         jfirst=jfirst+1
+         CALL getarg(jfirst,filename)
+         READ(filename,'(I4)')nqc
+         IF ((nqc<0).OR.(nqc>4)) THEN
+            WRITE(*,*)'Quality control option (-q) should be 1 to 4'
+            CALL abort
+         ENDIF
+         jfirst=jfirst+1
+      ENDIF
+   END DO
+   nfiles=iargc()
+
+   CALL coord_user_init('o')
+
+   ALLOCATE(lskipbox(nboxuser))
+   lskipbox(:)=.FALSE.
+
+   IF (carea(1)/='all') THEN
+      IF (lomona) THEN
+         WRITE(*,*)'For omona files carea(1) has to be all'
+         CALL abort
+      ENDIF
+      lskipbox(:)=.TRUE.
+      DO ji=1,nmaxareas
+         IF (carea(ji)/='all') THEN
+            lfound=.FALSE.
+            DO jbox=1,nboxuser
+               IF (TRIM(carea(ji))==TRIM(cl_boxes_user(jbox))) THEN
+                  lskipbox(jbox)=.FALSE.
+                  lfound=.TRUE.
+               ENDIF
+            ENDDO
+            IF (.NOT.lfound) THEN
+               WRITE(*,*)'Area ',TRIM(carea(ji)),' not found'
+               CALL abort
+            ENDIF
+         ENDIF
+      ENDDO
+      nboxuserl=0
+      DO ji=1,nboxuser
+         WRITE(*,*)'Area ',TRIM(cl_boxes_user(ji)),' is set to ',lskipbox(ji)
+         IF (.NOT.lskipbox(ji)) nboxuserl=nboxuserl+1
+      ENDDO
+      WRITE(*,*)'Total areas for statistics = ',nboxuserl
+      IF (lomona.AND.(nboxuserl/=nboxuser)) THEN
+         WRITE(*,*)'Omona files only possible if all areas'
+         CALL abort
+      ENDIF
+   ELSE
+      nboxuserl=nboxuser
+   ENDIF
+
+   IF (rlspc>0.0) THEN
+      lnear=.TRUE.
+      nmlev=rlmax/rlspc+1
+      ALLOCATE(zlev(nmlev))
+      DO ji=1,nmlev
+         zlev(ji)=(ji-1)*rlspc
+      ENDDO
+   ELSE
+      IF (.NOT.lnear) nmlev=nmlev-1
+      ALLOCATE(&
+         & zlev(nmlev) &
+         & )
+      IF(lnear) THEN
+         CALL getlevs(nmlev,zlev)
+      ELSE
+         CALL getlevsmean(nmlev,zlev)
+      ENDIF
+   ENDIF
+
+   DO jfile=jfirst, nfiles
+      CALL getarg(jfile,filename)
+      WRITE(*,*)'Handling file : ',TRIM(filename)
+      CALL flush(6)
+      IF (lzinp) THEN
+#if defined NOSYSTEM
+         WRITE(*,*)'Compressed files need the system subroutine call'
+         CALL abort
+#else
+         CALL system('cp '//TRIM(filename)//' fbstat_tmp.nc.gz')
+         CALL system('gzip -df fbstat_tmp.nc.gz')
+         CALL read_obfbdata('fbstat_tmp.nc',fbdata)
+         CALL system('rm -f fbstat_tmp.nc')
+#endif
+      ELSE
+         CALL read_obfbdata(TRIM(filename),fbdata)
+      ENDIF
+      CALL sealsfromargo( fbdata )
+      IF (jfile==jfirst) THEN
+         nvar=fbdata%nvar
+         nadd=0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:2)=='Hx') nadd=nadd+1
+         ENDDO
+         noberr=0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:3)=='OBE') noberr=noberr+1
+         ENDDO
+         nbgerr=0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:3)=='BGE') nbgerr=nbgerr+1
+         ENDDO
+         IF (lhistogram) THEN
+            IF (nvar>maxvars) THEN
+               WRITE(*,*)'fbstat.F90: Increase maxvars to ',nvar
+               WRITE(*,*)'if you want histograms'
+               CALL abort
+            ENDIF
+            DO jvar = 1, nvar
+               hist(jvar)%npoints=(zhistmax(jvar)-zhistmin(jvar))&
+                  &              /zhiststep(jvar)+1
+               WRITE(*,*)'Number of points in histogram      = ',&
+                  &  hist(jvar)%npoints
+               WRITE(*,*)'Size of histogram array (elements) = ',&
+                  &  hist(jvar)%npoints*nmlev*nboxuserl*nadd
+               ALLOCATE(&
+                  & hist(jvar)%nhist(hist(jvar)%npoints,nmlev,nboxuserl,nadd,ntyp) &
+                  & )
+               hist(jvar)%nhist(:,:,:,:,:)=0
+            ENDDO
+         ENDIF
+         ipdcst=0
+         IF (mindcst>0) THEN
+            DO ja= 1, fbdata%next
+               IF (TRIM(fbdata%cextname(ja))=='DCST') THEN
+                  ipdcst=ja
+                  EXIT 
+               ENDIF
+            ENDDO
+            IF (ipdcst==0) THEN
+               WRITE(*,*)'Distance to coast not found in file, but mindcst>0'
+               WRITE(*,*)'Extra variables:'
+               DO ja= 1, fbdata%next
+                  WRITE(*,*)ja,TRIM(fbdata%cextname(ja))
+               ENDDO
+               CALL abort
+            ENDIF
+         ENDIF
+         IF (lxyplot) THEN
+            IF (nvar>maxvars) THEN
+               WRITE(*,*)'fbstat.F90: Increase maxvars to ',nvar
+               WRITE(*,*)'if you want xyplots'
+               CALL abort
+            ENDIF
+            DO jvar = 1, nvar
+               xy(jvar)%npoints=(zxymax(jvar)-zxymin(jvar))&
+                  &              /zxystep(jvar)+1
+               WRITE(*,*)'Number of points in x and y for xyplots = ',&
+                  &  xy(jvar)%npoints
+               WRITE(*,*)'Size of xyplot array (elements)         = ',&
+                  &  xy(jvar)%npoints*xy(jvar)%npoints*nmlev*nboxuserl*nadd
+               ALLOCATE(&
+                  & xy(jvar)%nxy(xy(jvar)%npoints,xy(jvar)%npoints,&
+                  &              nmlev,nboxuserl,nadd,ntyp) &
+                  & )
+               xy(jvar)%nxy(:,:,:,:,:,:)=0
+            ENDDO
+         ENDIF
+         ALLOCATE(&
+            & inum(nmlev,nboxuserl,nadd,nvar,ntyp),  &
+            & inumov(nmlev,nboxuserl,noberr,nvar,ntyp),  &
+            & inumbv(nmlev,nboxuserl,nbgerr,nvar,ntyp),  &
+            & inuma(nmlev,nboxuserl,nvar,ntyp),      &
+            & zbias(nmlev,nboxuserl,nadd,nvar,ntyp), &
+            & zrms(nmlev,nboxuserl,nadd,nvar,ntyp),  &
+            & zsdev(nmlev,nboxuserl,nadd,nvar,ntyp), &
+            & zomean(nmlev,nboxuserl,nadd,nvar,ntyp),&
+            & zmmean(nmlev,nboxuserl,nadd,nvar,ntyp),&
+            & zoemea(nmlev,nboxuserl,noberr,nvar,ntyp),&
+            & zovmea(nmlev,nboxuserl,noberr,nvar,ntyp),&
+            & zbemea(nmlev,nboxuserl,nbgerr,nvar,ntyp),&
+            & zbvmea(nmlev,nboxuserl,nbgerr,nvar,ntyp),&
+            & zoamean(nmlev,nboxuserl,nvar,ntyp),    &
+            & cname(nvar),                           &
+            & caddname(nadd),                        &
+            & cobename(noberr),                      &
+            & cbgename(nbgerr)                       &
+            & )
+         DO jvar = 1, nvar
+            cname(jvar) = fbdata%cname(jvar)
+         END DO
+         jadd = 0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:2)=='Hx') THEN
+               jadd=jadd+1
+               caddname(jadd) = fbdata%caddname(ja)
+            ENDIF
+         END DO
+         jadd = 0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:3)=='OBE') THEN
+               jadd=jadd+1
+               cobename(jadd) = fbdata%caddname(ja)
+            ENDIF
+         END DO
+         jadd = 0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:3)=='BGE') THEN
+               jadd=jadd+1
+               cbgename(jadd) = fbdata%caddname(ja)
+            ENDIF
+         END DO
+         IF (nadd>0) THEN
+            inum(:,:,:,:,:)=0
+            zbias(:,:,:,:,:)=0.0
+            zrms(:,:,:,:,:)=0.0
+            zsdev(:,:,:,:,:)=0.0
+            zomean(:,:,:,:,:)=0.0 
+            zmmean(:,:,:,:,:)=0.0
+         ENDIF
+         IF (noberr>0) THEN
+            inumov(:,:,:,:,:)=0
+            zoemea(:,:,:,:,:)=0
+            zovmea(:,:,:,:,:)=0
+         ENDIF
+         IF (nbgerr>0) THEN
+            inumbv(:,:,:,:,:)=0
+            zbemea(:,:,:,:,:)=0
+            zbvmea(:,:,:,:,:)=0
+         ENDIF
+         inuma(:,:,:,:)=0
+         zoamean(:,:,:,:)=0.0
+      ELSE
+         IF (fbdata%nvar/=nvar) THEN
+            WRITE(*,*)'Different number of nvar ',fbdata%nvar,' in ',&
+               & TRIM(filename)
+            CALL abort
+         ENDIF
+         jadd = 0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:2)=='Hx') THEN
+               jadd=jadd+1
+            ENDIF
+         END DO
+         IF (jadd/=nadd) THEN
+            WRITE(*,*)'Different number of nadd ',jadd,' in ',&
+               & TRIM(filename)
+            CALL abort
+         ENDIF
+         jadd = 0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:3)=='OBE') THEN
+               jadd=jadd+1
+            ENDIF
+         END DO
+         IF (jadd/=noberr) THEN
+            WRITE(*,*)'Different number of noberr ',jadd,' in ',&
+               & TRIM(filename)
+            CALL abort
+         ENDIF
+         jadd = 0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:3)=='BGE') THEN
+               jadd=jadd+1
+            ENDIF
+         END DO
+         IF (jadd/=nbgerr) THEN
+            WRITE(*,*)'Different number of nbgerr ',jadd,' in ',&
+               & TRIM(filename)
+            CALL abort
+         ENDIF
+         IF (ipdcst>0) THEN
+            IF (ipdcst>fbdata%next) THEN
+               WRITE(*,*)'Distrance to coast in file not compatible with first file'
+               CALL abort
+            ENDIF
+            IF (TRIM(fbdata%cextname(ipdcst))/='DCST') THEN
+               WRITE(*,*)'Distrance to coast in file not compatible with first file'
+               CALL abort
+            ENDIF
+         ENDIF
+      ENDIF
+      IF (lrmmean) THEN
+         CALL fb_rmmean(fbdata)
+      ENDIF
+      CALL fb_stat(fbdata,lskipbox,nmlev,zlev,lnear,nqc,nqco,&
+         &         lhistogram,lxyplot,ntyp,ctyp,ipdcst,mindcst)
+      CALL dealloc_obfbdata(fbdata)
+   ENDDO
+
+   DO jt=1,ntyp
+      DO jvar=1,nvar
+         DO jadd=1,nadd
+            jboxl=0
+            DO jbox=1,nboxuser
+               IF (lskipbox(jbox)) CYCLE
+               jboxl=jboxl+1
+               DO jlev = 1, nmlev
+                  IF ( inum(jlev,jboxl,jadd,jvar,jt) > 0 ) THEN
+                     zbias(jlev,jboxl,jadd,jvar,jt) = &
+                        & zbias(jlev,jboxl,jadd,jvar,jt)/inum(jlev,jboxl,jadd,jvar,jt)
+                     zrms(jlev,jboxl,jadd,jvar,jt) = &
+                        & SQRT(zrms(jlev,jboxl,jadd,jvar,jt)/inum(jlev,jboxl,jadd,jvar,jt))
+                     zsdev(jlev,jboxl,jadd,jvar,jt) = &
+                        & SQRT(MAX(zrms(jlev,jboxl,jadd,jvar,jt)**2-zbias(jlev,jboxl,jadd,jvar,jt)**2,0.0))
+                     zomean(jlev,jboxl,jadd,jvar,jt) = &
+                        & zomean(jlev,jboxl,jadd,jvar,jt)/inum(jlev,jboxl,jadd,jvar,jt)
+                     zmmean(jlev,jboxl,jadd,jvar,jt) = &
+                        & zmmean(jlev,jboxl,jadd,jvar,jt)/inum(jlev,jboxl,jadd,jvar,jt)
+                  ELSE
+                     zbias(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                     zrms(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                     zsdev(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                     zomean(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                     zmmean(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDDO
+         DO jadd=1,noberr
+            jboxl=0
+            DO jbox=1,nboxuser
+               IF (lskipbox(jbox)) CYCLE
+               jboxl=jboxl+1
+               DO jlev = 1, nmlev
+                  IF ( inumov(jlev,jboxl,jadd,jvar,jt) > 0 ) THEN
+                     zoemea(jlev,jboxl,jadd,jvar,jt) = &
+                        & zoemea(jlev,jboxl,jadd,jvar,jt)/inumov(jlev,jboxl,jadd,jvar,jt)
+                     zovmea(jlev,jboxl,jadd,jvar,jt) = &
+                        & zovmea(jlev,jboxl,jadd,jvar,jt)/inumov(jlev,jboxl,jadd,jvar,jt)
+                  ELSE
+                     zoemea(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                     zovmea(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDDO
+         DO jadd=1,nbgerr
+            jboxl=0
+            DO jbox=1,nboxuser
+               IF (lskipbox(jbox)) CYCLE
+               jboxl=jboxl+1
+               DO jlev = 1, nmlev
+                  IF ( inumbv(jlev,jboxl,jadd,jvar,jt) > 0 ) THEN
+                     zbemea(jlev,jboxl,jadd,jvar,jt) = &
+                        & zbemea(jlev,jboxl,jadd,jvar,jt)/inumbv(jlev,jboxl,jadd,jvar,jt)
+                     zbvmea(jlev,jboxl,jadd,jvar,jt) = &
+                        & zbvmea(jlev,jboxl,jadd,jvar,jt)/inumbv(jlev,jboxl,jadd,jvar,jt)
+                  ELSE
+                     zbemea(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                     zbvmea(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDDO
+      ENDDO
+   ENDDO
+   DO jt=1,ntyp
+      DO jvar=1,nvar
+         jboxl=0
+         DO jbox=1,nboxuser
+            IF (lskipbox(jbox)) CYCLE
+            jboxl=jboxl+1
+            DO jlev = 1, nmlev
+               IF ( inuma(jlev,jboxl,jvar,jt) > 0 ) THEN
+                  zoamean(jlev,jboxl,jvar,jt) = &
+                     & zoamean(jlev,jboxl,jvar,jt)/inuma(jlev,jboxl,jvar,jt)
+               ELSE
+                  zoamean(jlev,jboxl,jvar,jt) = fbrmdi
+               ENDIF
+            ENDDO
+         ENDDO
+      ENDDO
+   ENDDO
+
+   IF (ltext) THEN
+
+      DO jt=1,ntyp
+         DO jvar=1,nvar
+            DO jadd=1,nadd
+               jboxl=0
+               DO jbox=1,nboxuser
+                  IF (lskipbox(jbox)) CYCLE
+                  jboxl=jboxl+1
+                  WRITE(filename,'(7A)')TRIM(cname(jvar)),&
+                     &                  TRIM(caddname(jadd)),'_',&
+                     &                  TRIM(cl_boxes_user(jbox)),'_',&
+                     &                  TRIM(ADJUSTL(ctyp(jt))),'.dat'
+                  OPEN(10,file=TRIM(filename))
+                  DO jlev = 1, nmlev
+                     WRITE(10,'(F16.7,2I12,5F17.10)') zlev(jlev), &
+                        & jlev, inum(jlev,jboxl,jadd,jvar,jt), &
+                        & zbias(jlev,jboxl,jadd,jvar,jt), &
+                        & zrms(jlev,jboxl,jadd,jvar,jt), &
+                        & zsdev(jlev,jboxl,jadd,jvar,jt), &
+                        & zomean(jlev,jboxl,jadd,jvar,jt), &
+                        & zmmean(jlev,jboxl,jadd,jvar,jt)
+                  ENDDO
+                  CLOSE(10)
+               ENDDO
+            ENDDO
+            DO jadd=1,noberr
+               jboxl=0
+               DO jbox=1,nboxuser
+                  IF (lskipbox(jbox)) CYCLE
+                  jboxl=jboxl+1
+                  WRITE(filename,'(7A)')TRIM(cname(jvar)),&
+                     &                  TRIM(cobename(jadd)),'_',&
+                     &                  TRIM(cl_boxes_user(jbox)),'_',&
+                     &                  TRIM(ADJUSTL(ctyp(jt))),'.dat'
+                  OPEN(10,file=TRIM(filename))
+                  DO jlev = 1, nmlev
+                     WRITE(10,'(F16.7,2I12,5F17.10)') zlev(jlev), &
+                        & jlev, inumov(jlev,jboxl,jadd,jvar,jt), &
+                        & zoemea(jlev,jboxl,jadd,jvar,jt), &
+                        & zovmea(jlev,jboxl,jadd,jvar,jt)
+                  ENDDO
+                  CLOSE(10)
+               ENDDO
+            ENDDO
+            DO jadd=1,nbgerr
+               jboxl=0
+               DO jbox=1,nboxuser
+                  IF (lskipbox(jbox)) CYCLE
+                  jboxl=jboxl+1
+                  WRITE(filename,'(7A)')TRIM(cname(jvar)),&
+                     &                  TRIM(cbgename(jadd)),'_',&
+                     &                  TRIM(cl_boxes_user(jbox)),'_',&
+                     &                  TRIM(ADJUSTL(ctyp(jt))),'.dat'
+                  OPEN(10,file=TRIM(filename))
+                  DO jlev = 1, nmlev
+                     WRITE(10,'(F16.7,2I12,5F17.10)') zlev(jlev), &
+                        & jlev, inumbv(jlev,jboxl,jadd,jvar,jt), &
+                        & zbemea(jlev,jboxl,jadd,jvar,jt), &
+                        & zbvmea(jlev,jboxl,jadd,jvar,jt)
+                  ENDDO
+                  CLOSE(10)
+               ENDDO
+            ENDDO
+         ENDDO
+      ENDDO
+
+      DO jt=1,ntyp
+         DO jvar=1,nvar
+            jboxl=0
+            DO jbox=1,nboxuser
+               IF (lskipbox(jbox)) CYCLE
+               jboxl=jboxl+1
+               WRITE(filename,'(7A)')TRIM(cname(jvar)),'_',&
+                  &                  TRIM(cl_boxes_user(jbox)),'_',&
+                  &                  TRIM(ADJUSTL(ctyp(jt))),'.dat'
+               OPEN(10,file=TRIM(filename))
+               DO jlev = 1, nmlev
+                  WRITE(10,'(F16.7,2I12,F17.10)') zlev(jlev), &
+                     & jlev, inuma(jlev,jboxl,jvar,jt), &
+                     & zoamean(jlev,jboxl,jvar,jt)
+               ENDDO
+               CLOSE(10)
+            ENDDO
+         ENDDO
+      ENDDO
+
+      IF (lhistogram) THEN
+         DO jt=1,ntyp
+            DO jvar=1,nvar
+               DO jadd=1,nadd
+                  jboxl=0
+                  DO jbox=1,nboxuser
+                     IF (lskipbox(jbox)) CYCLE
+                     jboxl=jboxl+1
+                     WRITE(filename,'(7A)')TRIM(cname(jvar)),&
+                        &                  TRIM(caddname(jadd)),'_',&
+                        &                  TRIM(cl_boxes_user(jbox)),'_',&
+                        &                  TRIM(ADJUSTL(ctyp(jt))),&
+                        &                  '_histogram.dat'
+                     OPEN(10,file=TRIM(filename))
+                     WRITE(10,'(A10,1000F10.2)')'#',(zlev(jlev),jlev=1,nmlev)
+                     DO ji=1,hist(jvar)%npoints
+                        WRITE(10,'(F10.2,1000I10)') &
+                           & zhistmin(jvar)+(ji-1)*zhiststep(jvar), &
+                           & (hist(jvar)%nhist(ji,jlev,jboxl,jadd,jt),jlev=1,nmlev)
+                     ENDDO
+                     CLOSE(10)
+                  ENDDO
+               ENDDO
+            ENDDO
+         ENDDO
+      ENDIF
+      
+   ENDIF
+
+   IF (lnetcdf) THEN
+
+      IF (nadd>0) THEN
+         DO jt=1,ntyp
+            WRITE(outfilename,'(3A)')'fbstat_',TRIM(ADJUSTL(ctyp(jt))),'.nc'
+            CALL fbstat_ncwrite(TRIM(outfilename),&
+               & nvar,cname,nadd,caddname,noberr,cobename,nbgerr,cbgename,&
+               & nboxuser,nboxuserl,20,cl_boxes_user,lskipbox,nmlev,zlev,&
+               & inum(:,:,:,:,jt),zbias(:,:,:,:,jt),zrms(:,:,:,:,jt), &
+               & zsdev(:,:,:,:,jt),zomean(:,:,:,:,jt),zmmean(:,:,:,:,jt),&
+               & inuma(:,:,:,jt),zoamean(:,:,:,jt), &
+               & inumov(:,:,:,:,jt),zoemea(:,:,:,:,jt),zovmea(:,:,:,:,jt), &
+               & inumbv(:,:,:,:,jt),zbemea(:,:,:,:,jt),zbvmea(:,:,:,:,jt) )
+            IF (lhistogram) THEN
+               WRITE(outfilename,'(3A)')'fbstat_hist_',TRIM(ADJUSTL(ctyp(jt))),'.nc'
+               CALL fbstat_ncwrite_hist(TRIM(outfilename),&
+                  & nvar,cname,nadd,caddname,&
+                  & nboxuser,20,cl_boxes_user,lskipbox,nmlev,zlev,&
+                  & hist,zhistmin,zhiststep,jt)
+            ENDIF
+            IF (lxyplot) THEN
+               WRITE(outfilename,'(3A)')'fbstat_xyplot_',TRIM(ADJUSTL(ctyp(jt))),'.nc'
+               CALL fbstat_ncwrite_xy(TRIM(outfilename),&
+                  & nvar,cname,nadd,caddname,&
+                  & nboxuser,20,cl_boxes_user,lskipbox,nmlev,zlev,&
+                  & xy,zxymin,zxystep,jt)
+            ENDIF
+         ENDDO
+      ENDIF
+   ENDIF
+
+   IF (lomona) THEN
+
+      IF (ntyp>1) THEN
+         WRITE(*,*)'Omona file only supported for the first type which is : ',TRIM(ctyp(1))
+      ENDIF
+      IF (nmlev>1) THEN
+         ALLOCATE(zdat3d(nmlev,nboxuser,1))
+      ELSE
+         ALLOCATE(zdat2d(nboxuser,1))
+      ENDIF
+
+      cl_expnam=expver
+      WRITE(cl_date,'(I8.8)')inidate
+      i_dp = nmlev
+      itime=icurdate
+      linnerp=.TRUE.
+      iloopno = loopno
+      linnerini = linner
+      i_fill=0
+
+      DO jt=1,ntyp
+         DO jvar = 1, nvar
+            linner = linnerini
+            loopno = iloopno
+            SELECT CASE (TRIM(cname(jvar)))
+            CASE('POTM')
+               cl_var = 'votemper'
+            CASE('PSAL')
+               cl_var='vosaline'
+            CASE('SLA')
+               cl_var='sossheig'
+            CASE('SST')
+               cl_var='sosstsst'
+            CASE('UVEL')
+               cl_var='vozocrtx'
+            CASE('VVEL')
+               cl_var='vomecrty'
+            END SELECT
+            DO jadd = 1, nadd
+               linner = (caddname(jadd)(1:3)=='Hxa').OR.linner
+               IF (lpassive) THEN
+                  ityp=145
+               ELSE
+                  IF (linner) THEN
+                     linnerp=.TRUE.
+                     ityp=144
+                     IF (jadd>1) loopno=loopno+1
+                  ELSE
+                     ityp=142
+                     IF (.NOT.linnerp) THEN
+                        IF (jadd>1) loopno=loopno+1
+                     ENDIF
+                  ENDIF
+               ENDIF
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zbias(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zbias(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+               IF (lpassive) THEN
+                  ityp=245
+               ELSE
+                  IF (linner) THEN
+                     ityp=244
+                  ELSE
+                     ityp=242
+                  ENDIF
+               ENDIF
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zrms(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zrms(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+               IF (lpassive) THEN
+                  ityp=345
+               ELSE
+                  IF (linner) THEN
+                     ityp=344
+                  ELSE
+                     ityp=342
+                  ENDIF
+               ENDIF
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+               & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zsdev(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zsdev(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+               IF (lpassive) THEN
+                  ityp=445
+               ELSE
+                  IF (linner) THEN
+                     ityp=444
+                  ELSE
+                     ityp=442
+                  ENDIF
+               ENDIF
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = inum(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = inum(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+               IF (lpassive) THEN
+                  ityp=545
+               ELSE
+                  IF (linner) THEN
+                     ityp=544
+                  ELSE
+                     ityp=542
+                  ENDIF
+               ENDIF
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zomean(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zomean(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+               IF (lpassive) THEN
+                  ityp=645
+               ELSE
+                  IF (linner) THEN
+                     ityp=644
+                  ELSE
+                     ityp=642
+                  ENDIF
+               ENDIF
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zmmean(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zmmean(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+               linner=.FALSE.
+            ENDDO
+            loopno = iloopno
+            DO jadd = 1, noberr
+               linner = .TRUE.
+               ityp = 139
+               IF (jadd>1) loopno=loopno+1
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zoemea(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zoemea(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+               ityp = 239
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zovmea(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zovmea(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+            ENDDO
+            loopno = iloopno
+            DO jadd = 1, nbgerr
+               linner = .TRUE.
+               ityp = 141
+               IF (jadd>1) loopno=loopno+1
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zbemea(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zbemea(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+               ityp = 241
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zbvmea(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zbvmea(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+            ENDDO
+            IF (lpassive) THEN
+               ityp=745
+            ELSE
+               ityp=742
+            ENDIF
+            WRITE(cltyp,'(I3.3,A1,A)')ityp,'_',&
+               & TRIM(ADJUSTL(ctyp(jt)))
+            CALL obs_variable_att(cltyp)
+            IF (nmlev>1) THEN
+               zdat3d(:,:,1) = inuma(:,:,jvar,jt)
+               i_fill=0
+               CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                  &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+            ELSE
+               zdat2d(:,1) = inuma(1,:,jvar,jt)
+               i_fill=0
+               CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                  &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+            ENDIF
+            IF (lpassive) THEN
+               ityp=845
+            ELSE
+               ityp=842
+            ENDIF
+            WRITE(cltyp,'(I3.3,A1,A)')ityp,'_',&
+               & TRIM(ADJUSTL(ctyp(jt)))
+            CALL obs_variable_att(cltyp)
+            IF (nmlev>1) THEN
+               zdat3d(:,:,1) = zoamean(:,:,jvar,jt)
+               i_fill=0
+               CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                  &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+            ELSE
+               zdat2d(:,1) = zoamean(1,:,jvar,jt)
+               i_fill=0
+               CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                  &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+            ENDIF
+         ENDDO
+      ENDDO
+
+      IF (nmlev>1) THEN
+         DEALLOCATE(zdat3d)
+      ELSE
+         DEALLOCATE(zdat2d)
+      ENDIF
+      
+   ENDIF
+
+CONTAINS
+
+   SUBROUTINE fb_stat(fbdata,lskipbox,nmlev,zlev,lnear,kqc,kqco,lhist,lxyplot,&
+      &               ntyp,ctyp,ipdcst,mindcst)
+      USE fbaccdata
+      USE coords
+      TYPE(obfbdata) :: fbdata
+      LOGICAL, DIMENSION(nboxuser) :: lskipbox
+      INTEGER :: nmlev
+      REAL :: zlev(nmlev)
+      LOGICAL :: lnear
+      INTEGER :: kqc,kqco
+      LOGICAL :: lhist,lxyplot
+      INTEGER :: ntyp
+      CHARACTER(len=ilentyp), DIMENSION(ntyp) :: ctyp
+      INTEGER :: ipdcst
+      REAL :: mindcst
+      INTEGER, DIMENSION(nboxuser) :: jlboxnum
+      INTEGER :: jlev, jobs, jvar, klev,jlev2,ih,ja,jadd,jbox,jt,ix,iy,jboxl
+      REAL :: zarea(4),zlat,zlon,zdiff,zdiff2,zvar
+      
+      jboxl=0
+      jlboxnum=-1
+      DO jbox = 1, nboxuser
+         IF (lskipbox(jbox)) CYCLE
+         jboxl=jboxl+1
+         jlboxnum(jbox)=jboxl
+      ENDDO
+
+      !$omp parallel do default(shared) private(jlev,jobs,jvar,klev,jlev2,ih,ja,jadd,jbox,jt,ix,iy,jboxl,zarea,zlat,zlon,zdiff,zdiff2)
+      DO jbox = 1, nboxuser
+         IF (lskipbox(jbox)) CYCLE
+         jboxl=jlboxnum(jbox)
+         CALL coord_area_user(cl_boxes_user(jbox),zarea)
+         DO jobs = 1, fbdata%nobs
+            ! Reject observations with observation, position or time flag rejections
+            IF (fbdata%ioqc(jobs)>kqco) CYCLE
+            IF (fbdata%ipqc(jobs)>kqco) CYCLE
+            IF (fbdata%itqc(jobs)>kqco) CYCLE
+            zlat = fbdata%pphi(jobs)
+            zlon = fbdata%plam(jobs)
+            IF (zlon<0) zlon=zlon+360
+            IF (zlon>360) zlon=zlon-360
+            IF ( ( zlat .GE. zarea(3) ) .AND. &
+               & ( zlat .LE. zarea(4) ) .AND. &
+               & ( ( ( zlon .GE. zarea(1) ) .AND. &
+               &     ( zlon .LE. zarea(2) ) ) .OR. &
+               &   ( ( zarea(2) .LE. zarea(1) ) .AND. &
+               &     ( zlon .GE. zarea(1) ) .AND. &
+               &     ( zlon .LE. 360        ) ) .OR. &
+               &   ( ( zarea(2)   .LE. zarea(1) ) .AND. &
+               &     ( zlon .GE. 0          ) .AND. &
+               &     ( zlon .LE. zarea(2) ) ) ) ) THEN
+            
+               DO jlev = 1, fbdata%nlev
+                  IF (ipdcst>0) THEN
+                     IF (fbdata%pext(jlev,jobs,ipdcst)==fbrmdi) CYCLE
+                     IF (fbdata%pext(jlev,jobs,ipdcst)<mindcst) CYCLE
+                  ENDIF
+                  DO jvar = 1, fbdata%nvar
+                     IF (nmlev==1) THEN
+                        klev=1
+                     ELSE
+                        IF (lnear) THEN
+                           zdiff=ABS(fbdata%pdep(jlev,jobs)-zlev(1))
+                           klev=1
+                           DO jlev2=2,nmlev
+                              zdiff2=ABS(fbdata%pdep(jlev,jobs)-zlev(jlev2))
+                              IF (zdiff2<zdiff) THEN
+                                 klev=jlev2
+                                 zdiff=zdiff2
+                              ENDIF
+                           ENDDO
+                        ELSE
+                           klev = fbdata%iobsk(jlev,jobs,jvar)-1
+                        ENDIF
+                        IF ( klev > nmlev ) THEN
+                           DO ja = 1, fbdata%nadd
+                              IF ( fbdata%caddname(ja)(1:2) /= 'Hx' ) CYCLE
+                              IF ( ABS(fbdata%padd(jlev,jobs,ja,jvar))<9000 ) THEN
+                                 WRITE(*,*)'Error in fb_stat'
+                                 WRITE(*,*)'Increase nmlev to at least ',klev
+                                 klev=nmlev
+                                 CALL abort
+                              ENDIF
+                           ENDDO
+                        ENDIF
+                     ENDIF
+                     IF (( klev > 0 ).AND. &
+                        &(ABS(fbdata%pob(jlev,jobs,jvar)) < 9000 )) THEN
+                        DO jt=1,ntyp
+                           IF (TRIM(ADJUSTL(ctyp(jt)))/='all') THEN
+                              IF (TRIM(ADJUSTL(ctyp(jt)))/=TRIM(ADJUSTL(fbdata%cdtyp(jobs)))) CYCLE
+                           ENDIF
+                           inuma(klev,jboxl,jvar,jt) = inuma(klev,jboxl,jvar,jt) + 1
+                           zoamean(klev,jboxl,jvar,jt) = zoamean(klev,jboxl,jvar,jt) + &
+                              & fbdata%pob(jlev,jobs,jvar)
+                        ENDDO
+                     ENDIF
+                     IF ( fbdata%ivlqc(jlev,jobs,jvar) < 0 ) CYCLE 
+                     IF ( fbdata%ivlqc(jlev,jobs,jvar) > kqc ) CYCLE 
+                     IF (( klev > 0 ).AND. &
+                        &(ABS(fbdata%pob(jlev,jobs,jvar)) < 9000 )) THEN
+                        jadd = 0
+                        DO ja = 1, fbdata%nadd
+                           IF ( fbdata%caddname(ja)(1:2) /= 'Hx' ) CYCLE
+                           jadd = jadd + 1
+                           IF ( ABS(fbdata%padd(jlev,jobs,ja,jvar)) < 9000 ) THEN
+                              zdiff = ( fbdata%padd(jlev,jobs,ja,jvar) - &
+                                 &      fbdata%pob(jlev,jobs,jvar) )
+                              DO jt=1,ntyp
+                                 IF (TRIM(ADJUSTL(ctyp(jt)))/='all') THEN
+                                    IF (TRIM(ADJUSTL(ctyp(jt)))/=TRIM(ADJUSTL(fbdata%cdtyp(jobs)))) CYCLE
+                                 ENDIF
+                                 inum(klev,jboxl,jadd,jvar,jt) = inum(klev,jboxl,jadd,jvar,jt) + 1
+                                 zbias(klev,jboxl,jadd,jvar,jt) = zbias(klev,jboxl,jadd,jvar,jt) + &
+                                    & zdiff
+                                 zrms(klev,jboxl,jadd,jvar,jt) = zrms(klev,jboxl,jadd,jvar,jt) + &
+                                    & zdiff * zdiff
+                                 zomean(klev,jboxl,jadd,jvar,jt) = zomean(klev,jboxl,jadd,jvar,jt) + &
+                                    & fbdata%pob(jlev,jobs,jvar)
+                                 zmmean(klev,jboxl,jadd,jvar,jt) = zmmean(klev,jboxl,jadd,jvar,jt) + &
+                                    & fbdata%padd(jlev,jobs,ja,jvar)
+                              ENDDO
+                              IF (ABS(zdiff)>zcheck(jvar)) THEN
+                                 WRITE(*,*)'Departure outside check range ',&
+                                    & TRIM(fbdata%cname(jvar)),' entry ',&
+                                    & fbdata%caddname(jadd)
+                                 WRITE(*,*)'Depar = ',zdiff
+                                 WRITE(*,*)'Check = ',zcheck(jvar)
+                                 WRITE(*,*)'Id    = ',fbdata%cdwmo(jobs)
+                                 WRITE(*,*)'Lat   = ',fbdata%pphi(jobs)
+                                 WRITE(*,*)'Lon   = ',fbdata%plam(jobs)
+                                 WRITE(*,*)'Tim   = ',fbdata%ptim(jobs)
+                                 WRITE(*,*)'Depth = ',fbdata%pdep(jlev,jobs)
+                                 WRITE(*,*)'Obs   = ',fbdata%pob(jlev,jobs,jvar)
+                                 WRITE(*,*)'Var   = ',fbdata%padd(jlev,jobs,ja,jvar)
+                                 WRITE(*,*)'QC    = ',fbdata%ivlqc(jlev,jobs,jvar)
+                                 WRITE(*,*)'QCflag= ',fbdata%ivlqcf(:,jlev,jobs,jvar)
+                              ENDIF
+                              IF (lhist) THEN
+                                 ih=NINT((zdiff-zhistmin(jvar))/zhiststep(jvar))+1
+                                 IF ((ih>=1).AND.(ih<=hist(jvar)%npoints)) THEN
+                                    DO jt=1,ntyp
+                                       IF (TRIM(ADJUSTL(ctyp(jt)))/='all') THEN
+                                          IF (TRIM(ADJUSTL(ctyp(jt)))/=TRIM(ADJUSTL(fbdata%cdtyp(jobs)))) CYCLE
+                                       ENDIF
+                                       hist(jvar)%nhist(ih,klev,jboxl,jadd,jt) = &
+                                          hist(jvar)%nhist(ih,klev,jboxl,jadd,jt) +1
+                                    ENDDO
+                                 ELSE
+                                    WRITE(*,*)'Histogram value outside range for ',&
+                                       & TRIM(fbdata%cname(jvar)),' entry ',&
+                                       & fbdata%caddname(jadd)
+                                    WRITE(*,*)'Value = ',zdiff
+                                    WRITE(*,*)'Range = ',zhistmin(jvar),zhistmax(jvar)
+                                    WRITE(*,*)'Step  = ',zhiststep(jvar)
+                                    WRITE(*,*)'Index = ',ih
+                                    WRITE(*,*)'Id    = ',TRIM(fbdata%cdwmo(jobs))
+                                    WRITE(*,*)'Typ   = ',TRIM(fbdata%cdtyp(jobs))
+                                    WRITE(*,*)'Lat   = ',fbdata%pphi(jobs)
+                                    WRITE(*,*)'Lon   = ',fbdata%plam(jobs)
+                                    WRITE(*,*)'Tim   = ',fbdata%ptim(jobs)
+                                    WRITE(*,*)'Depth = ',fbdata%pdep(jlev,jobs)
+                                    WRITE(*,*)'Obs   = ',fbdata%pob(jlev,jobs,jvar)
+                                    WRITE(*,*)'Var   = ',fbdata%padd(jlev,jobs,jadd,jvar)
+                                    WRITE(*,*)'QC    = ',fbdata%ivlqc(jlev,jobs,jvar)
+                                    WRITE(*,*)'QCflag= ',fbdata%ivlqcf(:,jlev,jobs,jvar)
+                                 ENDIF
+                              ENDIF
+                              IF (lxyplot) THEN
+                                 ix=NINT((fbdata%pob(jlev,jobs,jvar)-zxymin(jvar))/&
+                                    &    zxystep(jvar))+1
+                                 iy=NINT((fbdata%padd(jlev,jobs,ja,jvar)-zxymin(jvar))/&
+                                    &    zxystep(jvar))+1
+                                 IF ((ix>=1).AND.(ix<=xy(jvar)%npoints).AND. &
+                                    &(iy>=1).AND.(iy<=xy(jvar)%npoints)) THEN
+                                    DO jt=1,ntyp
+                                       IF (TRIM(ADJUSTL(ctyp(jt)))/='all') THEN
+                                          IF (TRIM(ADJUSTL(ctyp(jt)))/=TRIM(ADJUSTL(fbdata%cdtyp(jobs)))) CYCLE
+                                       ENDIF
+                                       xy(jvar)%nxy(ix,iy,klev,jboxl,jadd,jt) = &
+                                          xy(jvar)%nxy(ix,iy,klev,jboxl,jadd,jt) +1
+                                    ENDDO
+                                 ELSE
+                                    WRITE(*,*)'xy plot values outside range for ',&
+                                       & TRIM(fbdata%cname(jvar)),' entry ',&
+                                       & fbdata%caddname(jadd)
+                                    WRITE(*,*)'Obs   = ',fbdata%pob(jlev,jobs,jvar)
+                                    WRITE(*,*)'Model = ',fbdata%padd(jlev,jobs,ja,jvar)
+                                    WRITE(*,*)'Range = ',zxymin(jvar),zxymax(jvar)
+                                    WRITE(*,*)'Step  = ',zxystep(jvar)
+                                    WRITE(*,*)'Index = ',ih
+                                    WRITE(*,*)'Id    = ',TRIM(fbdata%cdwmo(jobs))
+                                    WRITE(*,*)'Typ   = ',TRIM(fbdata%cdtyp(jobs))
+                                    WRITE(*,*)'Lat   = ',fbdata%pphi(jobs)
+                                    WRITE(*,*)'Lon   = ',fbdata%plam(jobs)
+                                    WRITE(*,*)'Tim   = ',fbdata%ptim(jobs)
+                                    WRITE(*,*)'Depth = ',fbdata%pdep(jlev,jobs)
+                                    WRITE(*,*)'Obs   = ',fbdata%pob(jlev,jobs,jvar)
+                                    WRITE(*,*)'Var   = ',fbdata%padd(jlev,jobs,jadd,jvar)
+                                    WRITE(*,*)'QC    = ',fbdata%ivlqc(jlev,jobs,jvar)
+                                    WRITE(*,*)'QCflag= ',fbdata%ivlqcf(:,jlev,jobs,jvar)
+                                 ENDIF
+                              ENDIF
+                           ENDIF
+                        ENDDO
+                        jadd = 0
+                        DO ja = 1, fbdata%nadd
+                           IF ( fbdata%caddname(ja)(1:3) /= 'OBE' ) CYCLE
+                           jadd = jadd + 1
+                           IF ( ABS(fbdata%padd(jlev,jobs,ja,jvar)) < 9000 ) THEN
+                              zvar = fbdata%padd(jlev,jobs,ja,jvar)*fbdata%padd(jlev,jobs,ja,jvar)
+                              DO jt=1,ntyp
+                                 IF (TRIM(ADJUSTL(ctyp(jt)))/='all') THEN
+                                    IF (TRIM(ADJUSTL(ctyp(jt)))/=TRIM(ADJUSTL(fbdata%cdtyp(jobs)))) CYCLE
+                                 ENDIF
+                                 inumov(klev,jboxl,jadd,jvar,jt) = inumov(klev,jboxl,jadd,jvar,jt) + 1
+                                 zoemea(klev,jboxl,jadd,jvar,jt) = zoemea(klev,jboxl,jadd,jvar,jt) + &
+                                    & fbdata%padd(jlev,jobs,ja,jvar)                                 
+                                 zovmea(klev,jboxl,jadd,jvar,jt) = zovmea(klev,jboxl,jadd,jvar,jt) + zvar
+                              ENDDO
+                           ENDIF
+                        ENDDO
+                        jadd = 0
+                        DO ja = 1, fbdata%nadd
+                           IF ( fbdata%caddname(ja)(1:3) /= 'BGE' ) CYCLE
+                           jadd = jadd + 1
+                           IF ( ABS(fbdata%padd(jlev,jobs,ja,jvar)) < 9000 ) THEN
+                              zvar = fbdata%padd(jlev,jobs,ja,jvar)*fbdata%padd(jlev,jobs,ja,jvar)
+                              DO jt=1,ntyp
+                                 IF (TRIM(ADJUSTL(ctyp(jt)))/='all') THEN
+                                    IF (TRIM(ADJUSTL(ctyp(jt)))/=TRIM(ADJUSTL(fbdata%cdtyp(jobs)))) CYCLE
+                                 ENDIF
+                                 inumbv(klev,jboxl,jadd,jvar,jt) = inumbv(klev,jboxl,jadd,jvar,jt) + 1
+                                 zbemea(klev,jboxl,jadd,jvar,jt) = zbemea(klev,jboxl,jadd,jvar,jt) + &
+                                    & fbdata%padd(jlev,jobs,ja,jvar)
+                                 zbvmea(klev,jboxl,jadd,jvar,jt) = zbvmea(klev,jboxl,jadd,jvar,jt) + zvar
+                              ENDDO
+                           ENDIF
+                        ENDDO
+                     ENDIF
+                  ENDDO
+               ENDDO
+            ENDIF
+         ENDDO
+      ENDDO
+      !$omp end parallel do
+      
+   END SUBROUTINE fb_stat
+
+   SUBROUTINE fb_rmmean(fbdata)
+      TYPE(obfbdata) :: fbdata
+      INTEGER :: jadd,jmean
+
+      jmean=0
+      DO jadd=1,fbdata%nadd
+         IF (fbdata%caddname(jadd)(1:4)=='MEAN') THEN
+            jmean=jadd
+            EXIT
+         ENDIF
+      ENDDO
+      IF (jmean==0) THEN
+         WRITE(*,*)'Warning: MEAN additional variable not found'
+         RETURN
+      ENDIF
+      IF (fbdata%nobs>0) THEN
+         DO jadd=1,fbdata%nadd 
+            IF (fbdata%caddname(jadd)(1:2)=='Hx') THEN
+               fbdata%padd(:,:,jadd,:)=fbdata%padd(:,:,jadd,:)&
+                  &                   +fbdata%padd(:,:,jmean,:)
+            ENDIF
+         ENDDO
+      ENDIF
+
+   END SUBROUTINE fb_rmmean
+
+   SUBROUTINE getlevsmean(nmlev,zlev)
+      IMPLICIT NONE
+      INTEGER :: nmlev
+      REAL,DIMENSION(nmlev) :: zlev
+      REAL,DIMENSION(nmlev+1) :: ztmp
+      INTEGER :: i
+
+      zlev(:)=9999.9
+      CALL getlevs(nmlev+1,ztmp)
+      DO i=1,nmlev
+         zlev(i)=0.5*(ztmp(i)+ztmp(i+1))
+      ENDDO
+
+   END SUBROUTINE getlevsmean
+
+   SUBROUTINE getlevs(nmlev,zlev)
+      IMPLICIT NONE
+      INTEGER :: nmlev
+      REAL,DIMENSION(nmlev) :: zlev
+      
+      zlev(:)=9999.9
+
+      IF (nmlev==42) THEN
+         zlev(1)=5.02159
+         zlev(2)=15.07854
+         zlev(3)=25.16046
+         zlev(4)=35.27829
+         zlev(5)=45.44776
+         zlev(6)=55.69149
+         zlev(7)=66.04198
+         zlev(8)=76.54591
+         zlev(9)=87.27029
+         zlev(10)=98.31118
+         zlev(11)=109.8062
+         zlev(12)=121.9519
+         zlev(13)=135.0285
+         zlev(14)=149.4337
+         zlev(15)=165.7285
+         zlev(16)=184.6975
+         zlev(17)=207.4254
+         zlev(18)=235.3862
+         zlev(19)=270.5341
+         zlev(20)=315.3741
+         zlev(21)=372.9655
+         zlev(22)=446.8009
+         zlev(23)=540.5022
+         zlev(24)=657.3229
+         zlev(25)=799.5496
+         zlev(26)=967.9958
+         zlev(27)=1161.806
+         zlev(28)=1378.661
+         zlev(29)=1615.291
+         zlev(30)=1868.071
+         zlev(31)=2133.517
+         zlev(32)=2408.583
+         zlev(33)=2690.780
+         zlev(34)=2978.166
+         zlev(35)=3269.278
+         zlev(36)=3563.041
+         zlev(37)=3858.676
+         zlev(38)=4155.628
+         zlev(39)=4453.502
+         zlev(40)=4752.021
+         zlev(41)=5050.990
+         zlev(42)=5350.272
+      ELSEIF (nmlev==31) THEN
+         zlev(1)=4.999938
+         zlev(2)=15.00029
+         zlev(3)=25.00176
+         zlev(4)=35.00541
+         zlev(5)=45.01332
+         zlev(6)=55.0295
+         zlev(7)=65.06181
+         zlev(8)=75.12551
+         zlev(9)=85.25037
+         zlev(10)=95.49429
+         zlev(11)=105.9699
+         zlev(12)=116.8962
+         zlev(13)=128.6979
+         zlev(14)=142.1953
+         zlev(15)=158.9606
+         zlev(16)=181.9628
+         zlev(17)=216.6479
+         zlev(18)=272.4767
+         zlev(19)=364.303
+         zlev(20)=511.5348
+         zlev(21)=732.2009
+         zlev(22)=1033.217
+         zlev(23)=1405.698
+         zlev(24)=1830.885
+         zlev(25)=2289.768
+         zlev(26)=2768.242
+         zlev(27)=3257.479
+         zlev(28)=3752.442
+         zlev(29)=4250.401
+         zlev(30)=4749.913
+         zlev(31)=5250.227
+      ELSEIF (nmlev==1) THEN
+         zlev(1)=0.0
+      ELSE
+         WRITE(*,*) 'Unknown number of levels'
+         CALL abort
+      ENDIF
+
+   END SUBROUTINE getlevs
+
+END PROGRAM fbstat
Index: /utils/tools_ticket2413/OBSTOOLS/src/fbstatncio.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/fbstatncio.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/fbstatncio.F90	(revision 12863)
@@ -0,0 +1,995 @@
+#define MYFILE 'fbstatncio.F90'
+MODULE fbstatncio
+
+   USE fbacctype
+   USE nctools
+   IMPLICIT NONE
+
+   REAL, PARAMETER :: fbstncmiss = 99999.
+
+   TYPE fbstatnctype
+      INTEGER :: nlev,nbox,nadd
+      CHARACTER(len=20), POINTER, DIMENSION(:) :: area
+      CHARACTER(len=32), POINTER, DIMENSION(:) :: name
+      REAL, POINTER, DIMENSION(:) :: dep
+      REAL, POINTER, DIMENSION(:,:,:) :: val
+      INTEGER, POINTER, DIMENSION(:,:) :: cnt
+   END TYPE fbstatnctype
+
+   TYPE fbstathistnctype
+      INTEGER :: nlev,nbox,npoints
+      CHARACTER(len=20), POINTER, DIMENSION(:) :: area
+      REAL, POINTER, DIMENSION(:) :: dep,val
+      INTEGER, POINTER, DIMENSION(:,:,:) :: nhist
+   END TYPE fbstathistnctype
+
+   TYPE fbstatxynctype
+      INTEGER :: nlev,nbox,npoints
+      CHARACTER(len=20), POINTER, DIMENSION(:) :: area
+      REAL, POINTER, DIMENSION(:) :: dep,val
+      INTEGER, POINTER, DIMENSION(:,:,:,:) :: nxy
+   END TYPE fbstatxynctype
+
+CONTAINS
+
+   SUBROUTINE fbstat_ncwrite(cdfilename,nvar,cdvar,nadd,cdadd,&
+      & nobe,cdobe,nbge,cdbge,&
+      & nbox,nboxl,lenboxname,cdboxnam,lskipbox,nlev,pdep,&
+      & knum,pbias,prms,pstd,pomean,pmmean,knuma,poamean, &
+      & knumo,poerr,povar,knumb,pberr,pbvar)
+      ! Arguments
+      CHARACTER(len=*) :: cdfilename                ! Netcdf filename
+      INTEGER :: nvar                               ! Number of variables 
+      CHARACTER(len=*), DIMENSION(nvar) :: cdvar    ! Name of variables 
+      INTEGER :: nadd                               ! Number of additional data
+      CHARACTER(len=*), DIMENSION(nadd) :: cdadd    ! Name of entries
+      INTEGER :: nobe                               ! Number of obs errors
+      CHARACTER(len=*), DIMENSION(nadd) :: cdobe    ! Name of obs erors
+      INTEGER :: nbge                               ! Number of bg errors
+      CHARACTER(len=*), DIMENSION(nadd) :: cdbge    ! Name of bg erors
+      INTEGER :: nbox                               ! Total number of boxes
+      INTEGER :: nboxl                              ! Actual number of boxes
+      INTEGER :: lenboxname                         ! Length of box names
+      CHARACTER(len=lenboxname), DIMENSION(nbox) :: &
+         & cdboxnam                                 ! Name of boxes
+      LOGICAL, DIMENSION(nbox) :: lskipbox          ! Boxes to skip
+      INTEGER :: nlev                               ! Number of levels
+      REAL,DIMENSION(nlev) :: pdep                  ! Depth of levels
+      INTEGER, DIMENSION(nlev,nboxl,nadd,nvar) :: & ! Output data
+         & knum
+      REAL, DIMENSION(nlev,nboxl,nadd,nvar) :: &    ! Output data
+         & pbias, prms, pstd, pomean, pmmean
+      INTEGER, DIMENSION(nlev,nboxl,nvar) :: &      ! Output data
+         & knuma
+      REAL, DIMENSION(nlev,nboxl,nvar) :: &         ! Output data
+         & poamean
+      INTEGER, DIMENSION(nlev,nboxl,nobe,nvar) :: & ! Output data
+         & knumo
+      REAL, DIMENSION(nlev,nboxl,nobe,nvar) :: &    ! Output data
+         & poerr,povar
+      INTEGER, DIMENSION(nlev,nboxl,nbge,nvar) :: & ! Output data
+         & knumb
+      REAL, DIMENSION(nlev,nboxl,nbge,nvar) :: &    ! Output data
+         & pberr,pbvar
+      ! Local variables
+      INTEGER :: jadd,jvar,incvar,iv,jbox,ip
+      CHARACTER(len=50) :: cncvarbase
+      CHARACTER(len=60), ALLOCATABLE, DIMENSION(:) :: cncvar
+      ! netcdf stuff
+      INTEGER :: ncid,idlev,idbox,idlbox,idimdep(1),idimbox(2),idimids(2)
+      INTEGER :: idvbox,idvlev
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: idvar
+      INTEGER :: inoboxes
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: ztmp
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: itmp
+      CHARACTER(len=lenboxname), DIMENSION(:), ALLOCATABLE :: &
+         & clboxnam                                 ! Name of boxes
+
+      ! Open netCDF files.
+
+      CALL nchdlerr(nf90_create(TRIM(cdfilename),nf90_clobber,ncid),&
+         &          __LINE__,MYFILE)
+
+      ! Create dimensions
+
+      inoboxes=nbox-COUNT(lskipbox)
+      ALLOCATE(ztmp(nlev,inoboxes),itmp(nlev,inoboxes),clboxnam(inoboxes))
+
+      CALL nchdlerr(nf90_def_dim(ncid,"depth",nlev,idlev),__LINE__,MYFILE)
+
+      CALL nchdlerr(nf90_def_dim(ncid,"box",inoboxes,idbox),&
+         &          __LINE__,MYFILE)
+
+      CALL nchdlerr(nf90_def_dim(ncid,"len",lenboxname,idlbox),__LINE__,MYFILE)
+
+      ! Box variable name
+
+      idimbox(1)=idlbox
+      idimbox(2)=idbox
+      CALL nchdlerr(nf90_def_var(ncid,'box',nf90_char,idimbox,idvbox),&
+         &          __LINE__,MYFILE)
+
+      ! Depths
+
+      idimdep(1)=idlev
+      CALL nchdlerr(nf90_def_var(ncid,'depth',nf90_float,idimdep,idvlev),&
+         &          __LINE__,MYFILE)
+
+      ! Setup variables names
+
+      idimids(1)=idlev
+      idimids(2)=idbox
+      incvar=(nadd*6+nobe*3+nbge*3+2)*nvar
+      ALLOCATE(cncvar(incvar),idvar(incvar))
+      iv=0
+      DO jvar=1,nvar
+         DO jadd=1,nadd
+            WRITE(cncvarbase,'(3A)')TRIM(cdvar(jvar)),'_',TRIM(cdadd(jadd))
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_bias'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_rms'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_std'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_omean'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_mmean'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_count'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_int,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+         ENDDO
+         DO jadd=1,nobe
+            WRITE(cncvarbase,'(3A)')TRIM(cdvar(jvar)),'_',TRIM(cdobe(jadd))
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_meanerr'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_meanvar'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_count'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_int,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+         ENDDO
+         DO jadd=1,nbge
+            WRITE(cncvarbase,'(3A)')TRIM(cdvar(jvar)),'_',TRIM(cdbge(jadd))
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_meanerr'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_meanvar'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_count'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_int,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+         ENDDO
+         WRITE(cncvarbase,'(A)')TRIM(cdvar(jvar))
+         iv=iv+1
+         cncvar(iv)=TRIM(cncvarbase)//'_omean'
+         CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+            &                       idimids,idvar(iv)),__LINE__,MYFILE)
+         CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+            &          __LINE__,MYFILE)
+         iv=iv+1
+         cncvar(iv)=TRIM(cncvarbase)//'_count'
+         CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_int,&
+            &                       idimids,idvar(iv)),__LINE__,MYFILE)
+         CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+            &          __LINE__,MYFILE)
+      ENDDO
+      CALL nchdlerr(nf90_enddef(ncid),__LINE__,MYFILE)
+      
+      ! Write box names
+      
+      ip=0
+      DO jbox=1,nbox
+         IF (.NOT.lskipbox(jbox)) THEN
+            ip=ip+1
+            clboxnam(ip)=cdboxnam(jbox)
+         ENDIF
+      ENDDO
+      CALL nchdlerr(nf90_put_var(ncid,idvbox,clboxnam),&
+         &          __LINE__,MYFILE)
+
+      ! Write levels
+
+      CALL nchdlerr(nf90_put_var(ncid,idvlev,pdep),&
+         &          __LINE__,MYFILE)
+
+      ! Write the output data
+
+      iv=0
+      DO jvar=1,nvar
+         DO jadd=1,nadd
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=pbias(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=prms(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=pstd(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=pomean(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=pmmean(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  itmp(:,ip)=knum(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),&
+               &          __LINE__,MYFILE)
+         ENDDO
+         DO jadd=1,nobe
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=poerr(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=povar(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  itmp(:,ip)=knumo(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),&
+               &          __LINE__,MYFILE)
+         ENDDO
+         DO jadd=1,nbge
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=pberr(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=pbvar(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  itmp(:,ip)=knumb(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),&
+               &          __LINE__,MYFILE)
+         ENDDO
+         iv=iv+1
+         ip=0
+         DO jbox=1,nbox
+            IF (.NOT.lskipbox(jbox)) THEN
+               ip=ip+1
+               ztmp(:,ip)=poamean(:,ip,jvar)
+            ENDIF
+         ENDDO
+         CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+            &          __LINE__,MYFILE)
+         iv=iv+1
+         ip=0
+         DO jbox=1,nbox
+            IF (.NOT.lskipbox(jbox)) THEN
+               ip=ip+1
+               itmp(:,ip)=knuma(:,ip,jvar)
+            ENDIF
+         ENDDO
+         CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),&
+               &          __LINE__,MYFILE)
+      ENDDO
+      
+      ! Close the file
+
+      CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE)
+
+      DEALLOCATE(cncvar,idvar,ztmp,itmp,clboxnam)
+
+   END SUBROUTINE fbstat_ncwrite
+
+   SUBROUTINE fbstat_ncwrite_hist(cdfilename,nvar,cdvar,nadd,cdadd,&
+      & nbox,lenboxname,cdboxnam,lskipbox,nlev,pdep,&
+      & zhist,zhistmin,zhiststep,ntyp)
+      ! Arguments
+      CHARACTER(len=*) :: cdfilename                ! Netcdf filename
+      INTEGER :: nvar                               ! Number of variables 
+      CHARACTER(len=*), DIMENSION(nvar) :: cdvar    ! Name of variables 
+      INTEGER :: nadd                               ! Number of addiables 
+      CHARACTER(len=*), DIMENSION(nadd) :: cdadd    ! Name of entries
+      INTEGER :: nbox                               ! Number of boxes
+      INTEGER :: lenboxname                         ! Length of box names
+      CHARACTER(len=lenboxname), dimension(nbox) :: &
+         & cdboxnam                                 ! Name of boxes
+      LOGICAL, DIMENSION(nbox) :: lskipbox          ! Boxes to skip
+      INTEGER :: nlev                               ! Number of levels
+      REAL,DIMENSION(nlev) :: pdep                  ! Depth of levels
+      TYPE(histtype), DIMENSION(nvar) :: zhist      ! Histogram data
+      REAL, DIMENSION(nvar) :: &
+         & zhistmin,zhiststep                       ! Histogram info
+      integer :: ntyp                               ! Type to write
+      ! Local variables
+      INTEGER :: jadd,jvar,incvar,ji,iv,ip,jbox
+      CHARACTER(len=50) :: cncvarbase
+      CHARACTER(len=60), ALLOCATABLE, DIMENSION(:) :: cncvar
+      ! netcdf stuff
+      INTEGER :: ncid,idlev,idbox,idlbox,idimhist(nvar),&
+         & idimdep(1),idimbox(2),idimids(2),idimval(1),idimcnt(3)
+      INTEGER :: idvbox,idvlev
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: idvar
+      CHARACTER(len=40) :: cdhdimname
+      REAL, ALLOCATABLE, DIMENSION(:) :: zhval
+      INTEGER :: inoboxes
+      INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: itmp
+      CHARACTER(len=lenboxname), DIMENSION(:), ALLOCATABLE :: &
+         & clboxnam                                 ! Name of boxes
+
+      ! Open netCDF files.
+
+      CALL nchdlerr(nf90_create(TRIM(cdfilename),nf90_clobber,ncid),&
+         &          __LINE__,MYFILE)
+
+      ! Create dimensions
+
+      inoboxes=nbox-COUNT(lskipbox) 
+      ALLOCATE(clboxnam(inoboxes))
+
+      CALL nchdlerr(nf90_def_dim(ncid,"depth",nlev,idlev),__LINE__,MYFILE)
+
+      CALL nchdlerr(nf90_def_dim(ncid,"box",inoboxes,idbox),&
+         &          __LINE__,MYFILE)
+
+      CALL nchdlerr(nf90_def_dim(ncid,"len",lenboxname,idlbox),__LINE__,MYFILE)
+      
+      DO jvar=1,nvar
+         WRITE(cdhdimname,'(A,A)')'hist',TRIM(cdvar(jvar))
+         CALL nchdlerr(nf90_def_dim(ncid,TRIM(cdhdimname),&
+            &                       zhist(jvar)%npoints,idimhist(jvar)),&
+            & __LINE__,MYFILE)
+      ENDDO
+
+      ! Box variable name
+
+      idimbox(1)=idlbox
+      idimbox(2)=idbox
+      CALL nchdlerr(nf90_def_var(ncid,'box',nf90_char,idimbox,idvbox),&
+         &          __LINE__,MYFILE)
+
+      ! Depths
+
+      idimdep(1)=idlev
+      CALL nchdlerr(nf90_def_var(ncid,'depth',nf90_float,idimdep,idvlev),&
+         &          __LINE__,MYFILE)
+
+      ! Histogram values and depths
+
+      incvar=nvar+nadd*nvar
+      ALLOCATE(cncvar(incvar),idvar(incvar))
+      iv=0
+      DO jvar=1,nvar
+         iv=iv+1
+         WRITE(cncvar(iv),'(A,A)')TRIM(cdvar(jvar)),'_val'
+         idimval(1)=idimhist(jvar)
+         CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),&
+            &                       nf90_float,idimval,idvar(iv)),&
+            &          __LINE__,MYFILE)
+         DO jadd=1,nadd
+            iv=iv+1
+            WRITE(cncvar(iv),'(A,A,A)')TRIM(cdvar(jvar)),&
+               &                       TRIM(cdadd(jadd)),'_count'
+            idimcnt(1)=idimhist(jvar)
+            idimcnt(2)=idlev
+            idimcnt(3)=idbox
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),&
+               &                       nf90_int,idimcnt,idvar(iv)),&
+               &          __LINE__,MYFILE)
+         ENDDO
+      ENDDO
+      CALL nchdlerr(nf90_enddef(ncid),__LINE__,MYFILE)
+      
+      ! Write box names
+
+      ip=0
+      DO jbox=1,nbox
+         IF (.NOT.lskipbox(jbox)) THEN
+            ip=ip+1
+            clboxnam(ip)=cdboxnam(jbox)
+         ENDIF
+      ENDDO
+      CALL nchdlerr(nf90_put_var(ncid,idvbox,clboxnam),&
+         &          __LINE__,MYFILE)
+
+      ! Write levels
+
+      CALL nchdlerr(nf90_put_var(ncid,idvlev,pdep),&
+         &          __LINE__,MYFILE)
+
+      iv=0
+      DO jvar=1,nvar
+         iv=iv+1
+         ALLOCATE(zhval(zhist(jvar)%npoints))
+         DO ji=1,zhist(jvar)%npoints
+            zhval(ji)=(ji-1)*zhiststep(jvar)+zhistmin(jvar)
+         ENDDO
+         CALL nchdlerr(nf90_put_var(ncid,idvar(iv),zhval),&
+            &          __LINE__,MYFILE)
+         DEALLOCATE(zhval)
+         DO jadd=1,nadd
+            iv=iv+1
+            ALLOCATE(itmp(zhist(jvar)%npoints,nlev,inoboxes))
+            ip=0
+            DO jbox=1,nbox
+               IF(.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  itmp(:,:,ip)=zhist(jvar)%nhist(:,:,ip,jadd,ntyp)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),&
+               &          __LINE__,MYFILE)
+            DEALLOCATE(itmp)
+         ENDDO
+      ENDDO
+
+      ! Close the file
+
+      CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE)
+      
+      DEALLOCATE(cncvar,idvar,clboxnam)
+
+   END SUBROUTINE fbstat_ncwrite_hist
+
+   SUBROUTINE fbstat_ncwrite_xy(cdfilename,nvar,cdvar,nadd,cdadd,&
+      & nbox,lenboxname,cdboxnam,lskipbox,nlev,pdep,&
+      & zxy,zxymin,zxystep,ntyp)
+      ! Arguments
+      CHARACTER(len=*) :: cdfilename                ! Netcdf filename
+      INTEGER :: nvar                               ! Number of variables 
+      CHARACTER(len=*), DIMENSION(nvar) :: cdvar    ! Name of variables 
+      INTEGER :: nadd                               ! Number of addiables 
+      CHARACTER(len=*), DIMENSION(nadd) :: cdadd    ! Name of entries
+      INTEGER :: nbox                               ! Number of boxes
+      INTEGER :: lenboxname                         ! Length of box names
+      CHARACTER(len=lenboxname), dimension(nbox) :: &
+         & cdboxnam                                 ! Name of boxes
+      LOGICAL, DIMENSION(nbox) :: lskipbox          ! Boxes to skip
+      INTEGER :: nlev                               ! Number of levels
+      REAL,DIMENSION(nlev) :: pdep                  ! Depth of levels
+      TYPE(xytype), DIMENSION(nvar) :: zxy          ! xyplot data
+      REAL, DIMENSION(nvar) :: &
+         & zxymin,zxystep                           ! xyplot info
+      integer :: ntyp                               ! Type to write
+      ! Local variables
+      INTEGER :: jadd,jvar,incvar,ji,iv,ip,jbox
+      CHARACTER(len=50) :: cncvarbase
+      CHARACTER(len=60), ALLOCATABLE, DIMENSION(:) :: cncvar
+      ! netcdf stuff
+      INTEGER :: ncid,idlev,idbox,idlbox,idimxy(nvar),&
+         & idimdep(1),idimbox(2),idimids(2),idimval(1),idimcnt(4)
+      INTEGER :: idvbox,idvlev
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: idvar
+      CHARACTER(len=40) :: cdhdimname
+      REAL, ALLOCATABLE, DIMENSION(:) :: zhval
+      INTEGER :: inoboxes
+      INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:) :: itmp
+      CHARACTER(len=lenboxname), DIMENSION(:), ALLOCATABLE :: &
+         & clboxnam                                 ! Name of boxes
+
+      ! Open netCDF files.
+
+      CALL nchdlerr(nf90_create(TRIM(cdfilename),nf90_clobber,ncid),&
+         &          __LINE__,MYFILE)
+
+      ! Create dimensions
+
+      inoboxes=nbox-COUNT(lskipbox) 
+      ALLOCATE(clboxnam(inoboxes))
+
+      CALL nchdlerr(nf90_def_dim(ncid,"depth",nlev,idlev),__LINE__,MYFILE)
+
+      CALL nchdlerr(nf90_def_dim(ncid,"box",inoboxes,idbox),&
+         &          __LINE__,MYFILE)
+
+      CALL nchdlerr(nf90_def_dim(ncid,"len",lenboxname,idlbox),__LINE__,MYFILE)
+      
+      DO jvar=1,nvar
+         WRITE(cdhdimname,'(A,A)')'xy',TRIM(cdvar(jvar))
+         CALL nchdlerr(nf90_def_dim(ncid,TRIM(cdhdimname),&
+            &                       zxy(jvar)%npoints,idimxy(jvar)),&
+            & __LINE__,MYFILE)
+      ENDDO
+
+      ! Box variable name
+
+      idimbox(1)=idlbox
+      idimbox(2)=idbox
+      CALL nchdlerr(nf90_def_var(ncid,'box',nf90_char,idimbox,idvbox),&
+         &          __LINE__,MYFILE)
+
+      ! Depths
+
+      idimdep(1)=idlev
+      CALL nchdlerr(nf90_def_var(ncid,'depth',nf90_float,idimdep,idvlev),&
+         &          __LINE__,MYFILE)
+
+      ! Histogram values and depths
+
+      incvar=nvar+nadd*nvar
+      ALLOCATE(cncvar(incvar),idvar(incvar))
+      iv=0
+      DO jvar=1,nvar
+         iv=iv+1
+         WRITE(cncvar(iv),'(A,A)')TRIM(cdvar(jvar)),'_val'
+         idimval(1)=idimxy(jvar)
+         CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),&
+            &                       nf90_float,idimval,idvar(iv)),&
+            &          __LINE__,MYFILE)
+         DO jadd=1,nadd
+            iv=iv+1
+            WRITE(cncvar(iv),'(A,A,A)')TRIM(cdvar(jvar)),&
+               &                       TRIM(cdadd(jadd)),'_count'
+            idimcnt(1)=idimxy(jvar)
+            idimcnt(2)=idimxy(jvar)
+            idimcnt(3)=idlev
+            idimcnt(4)=idbox
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),&
+               &                       nf90_int,idimcnt,idvar(iv)),&
+               &          __LINE__,MYFILE)
+         ENDDO
+      ENDDO
+      CALL nchdlerr(nf90_enddef(ncid),__LINE__,MYFILE)
+      
+      ! Write box names
+
+      ip=0
+      DO jbox=1,nbox
+         IF (.NOT.lskipbox(jbox)) THEN
+            ip=ip+1
+            clboxnam(ip)=cdboxnam(jbox)
+         ENDIF
+      ENDDO
+      CALL nchdlerr(nf90_put_var(ncid,idvbox,clboxnam),&
+         &          __LINE__,MYFILE)
+
+      ! Write levels
+
+      CALL nchdlerr(nf90_put_var(ncid,idvlev,pdep),&
+         &          __LINE__,MYFILE)
+
+      iv=0
+      DO jvar=1,nvar
+         iv=iv+1
+         ALLOCATE(zhval(zxy(jvar)%npoints))
+         DO ji=1,zxy(jvar)%npoints
+            zhval(ji)=(ji-1)*zxystep(jvar)+zxymin(jvar)
+         ENDDO
+         CALL nchdlerr(nf90_put_var(ncid,idvar(iv),zhval),&
+            &          __LINE__,MYFILE)
+         DEALLOCATE(zhval)
+         DO jadd=1,nadd
+            iv=iv+1
+            ALLOCATE(itmp(zxy(jvar)%npoints,zxy(jvar)%npoints,nlev,inoboxes))
+            ip=0
+            DO jbox=1,nbox
+               IF(.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  itmp(:,:,:,ip)=zxy(jvar)%nxy(:,:,:,ip,jadd,ntyp)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),&
+               &          __LINE__,MYFILE)
+            DEALLOCATE(itmp)
+         ENDDO
+      ENDDO
+
+      ! Close the file
+
+      CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE)
+      
+      DEALLOCATE(cncvar,idvar,clboxnam)
+
+   END SUBROUTINE fbstat_ncwrite_xy
+
+   SUBROUTINE fbstat_ncread(cdfilename,cdvar,sdata)
+      ! Arguments
+      CHARACTER(len=*) :: cdfilename                ! Netcdf filename
+      CHARACTER(len=*) :: cdvar                     ! Name of variables 
+      TYPE(fbstatnctype) :: sdata                 ! Data to be filled
+      ! Local variables
+      INTEGER :: nbox,nlev,nadd,nvar
+      INTEGER :: ncid,dimid,varid,i,icntpos
+      CHARACTER(len=128) :: cdname,tmpname
+
+      ! Open the file and get the dimensions
+
+      CALL nchdlerr(nf90_open(cdfilename,nf90_nowrite,ncid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inq_dimid(ncid,'box',dimid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
+         &                      len=nbox),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inq_dimid(ncid,'depth',dimid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
+         &                      len=nlev),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire(ncid,nVariables=nvar),__LINE__,MYFILE)
+
+      ! Count the number of variables and find the "count" position
+
+      nadd=0
+      icntpos=0
+      DO i=1,nvar
+         CALL nchdlerr(nf90_inquire_variable(ncid,i,name=cdname),&
+            &          __LINE__,MYFILE)
+         IF (TRIM(cdvar)//'_count'==TRIM(cdname)) THEN
+            icntpos=i
+         ELSE
+            IF (TRIM(cdvar)==cdname(1:LEN_TRIM(cdvar))) THEN
+               tmpname=cdname(LEN_TRIM(cdvar)+2:)
+               IF (INDEX(tmpname,'_')==0) THEN
+                  nadd=nadd+1
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDDO
+
+      ! Allocate the data structure
+
+      CALL fbstat_ncread_alloc(sdata,nlev,nbox,nadd)
+
+      ! Get the box names in files
+
+      CALL nchdlerr(nf90_inq_varid(ncid,'box',varid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%area),__LINE__,MYFILE)
+      
+      ! Get the depths
+      
+      CALL nchdlerr(nf90_inq_varid(ncid,'depth',varid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%dep),__LINE__,MYFILE)
+
+      nadd=0
+      DO i=1,nvar
+         CALL nchdlerr(nf90_inquire_variable(ncid,i,name=cdname),&
+            &          __LINE__,MYFILE)
+         IF (i==icntpos) THEN
+            CALL nchdlerr(nf90_get_var(ncid,i,sdata%cnt),__LINE__,MYFILE)
+         ELSE
+            IF (TRIM(cdvar)==cdname(1:LEN_TRIM(cdvar))) THEN
+               tmpname=cdname(LEN_TRIM(cdvar)+2:)
+               IF (INDEX(tmpname,'_')==0) THEN
+                  nadd=nadd+1
+                  sdata%name(nadd)=tmpname(1:MAX(LEN_TRIM(tmpname),32))
+                  CALL nchdlerr(nf90_get_var(ncid,i,sdata%val(:,:,nadd)),&
+                     &                       __LINE__,MYFILE)
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDDO
+
+      CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE)
+
+   END SUBROUTINE fbstat_ncread
+
+   SUBROUTINE fbstat_ncread_alloc(sdata,nlev,nbox,nadd)
+      ! Arguments
+      TYPE(fbstatnctype) :: sdata    ! Data to be allocated
+      INTEGER :: nlev,nbox,nadd
+      ! Local variables
+
+      sdata%nlev=nlev
+      sdata%nbox=nbox
+      sdata%nadd=nadd
+      ALLOCATE( &
+         & sdata%area(nbox), &
+         & sdata%dep(nlev), &
+         & sdata%name(nadd), &
+         & sdata%val(nlev,nbox,nadd), &
+         & sdata%cnt(nlev,nbox) &
+         )
+      
+   END SUBROUTINE fbstat_ncread_alloc
+
+   SUBROUTINE fbstat_ncread_dealloc(sdata)
+      ! Arguments
+      TYPE(fbstatnctype) :: sdata    ! Data to be deallocated
+      ! Local variables
+
+      sdata%nlev=0
+      sdata%nbox=0
+      sdata%nadd=0
+      DEALLOCATE( &
+         & sdata%area, &
+         & sdata%dep, &
+         & sdata%name, &
+         & sdata%val, &
+         & sdata%cnt &
+         )
+      
+   END SUBROUTINE fbstat_ncread_dealloc
+
+   SUBROUTINE fbstat_ncread_hist(cdfilename,cdvar,cdext,sdata)
+      ! Arguments
+      CHARACTER(len=*) :: cdfilename                ! Netcdf filename
+      CHARACTER(len=*) :: cdvar                     ! Name of variables 
+      CHARACTER(len=*) :: cdext                     ! Name of extras
+      TYPE(fbstathistnctype) :: sdata               ! Data to be filled
+      ! Local variables
+      INTEGER :: nbox,nlev,npoints
+      INTEGER :: ncid,dimid,varid
+
+      ! Open the file and get the dimensions
+
+      CALL nchdlerr(nf90_open(cdfilename,nf90_nowrite,ncid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inq_dimid(ncid,'box',dimid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
+         &                      len=nbox),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inq_dimid(ncid,'depth',dimid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
+         &                      len=nlev),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inq_dimid(ncid,'hist'//TRIM(cdvar),dimid),&
+         &                                __LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
+         &                      len=npoints),__LINE__,MYFILE)
+
+      ! Allocate the data structure
+
+      CALL fbstat_ncread_hist_alloc(sdata,npoints,nlev,nbox)
+
+      ! Get the box names in files
+
+      CALL nchdlerr(nf90_inq_varid(ncid,'box',varid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%area),__LINE__,MYFILE)
+      
+      ! Get the depths
+      
+      CALL nchdlerr(nf90_inq_varid(ncid,'depth',varid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%dep),__LINE__,MYFILE)
+
+      ! Get values
+
+      CALL nchdlerr(nf90_inq_varid(ncid,TRIM(cdvar)//'_val',varid),&
+         &          __LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%val),__LINE__,MYFILE)
+
+      ! Get histograms
+
+      CALL nchdlerr(nf90_inq_varid(ncid,&
+         &                         TRIM(cdvar)//TRIM(cdext)//'_count',varid),&
+         &          __LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%nhist),__LINE__,MYFILE)
+
+      CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE)
+
+   END SUBROUTINE fbstat_ncread_hist
+
+   SUBROUTINE fbstat_ncread_hist_alloc(sdata,npoints,nlev,nbox)
+      ! Arguments
+      TYPE(fbstathistnctype) :: sdata    ! Data to be allocated
+      INTEGER :: npoints,nlev,nbox
+      ! Local variables
+
+      sdata%nlev=nlev
+      sdata%nbox=nbox
+      sdata%npoints=npoints
+      ALLOCATE( &
+         & sdata%area(nbox), &
+         & sdata%dep(nlev), &
+         & sdata%val(npoints), &
+         & sdata%nhist(npoints,nlev,nbox) &
+         & )
+      
+   END SUBROUTINE fbstat_ncread_hist_alloc
+
+   SUBROUTINE fbstat_ncread_hist_dealloc(sdata)
+      ! Arguments
+      TYPE(fbstathistnctype) :: sdata    ! Data to be deallocated
+      ! Local variables
+
+      sdata%nlev=0
+      sdata%nbox=0
+      sdata%npoints=0
+      DEALLOCATE( &
+         & sdata%area, &
+         & sdata%dep, &
+         & sdata%val, &
+         & sdata%nhist &
+         & )
+      
+   END SUBROUTINE fbstat_ncread_hist_dealloc
+
+   SUBROUTINE fbstat_ncread_xy(cdfilename,cdvar,cdext,sdata)
+      ! Arguments
+      CHARACTER(len=*) :: cdfilename                ! Netcdf filename
+      CHARACTER(len=*) :: cdvar                     ! Name of variables 
+      CHARACTER(len=*) :: cdext                     ! Name of extras
+      TYPE(fbstatxynctype) :: sdata                 ! Data to be filled
+      ! Local variables
+      INTEGER :: nbox,nlev,npoints
+      INTEGER :: ncid,dimid,varid
+
+      ! Open the file and get the dimensions
+
+      CALL nchdlerr(nf90_open(cdfilename,nf90_nowrite,ncid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inq_dimid(ncid,'box',dimid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
+         &                      len=nbox),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inq_dimid(ncid,'depth',dimid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
+         &                      len=nlev),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inq_dimid(ncid,'xy'//TRIM(cdvar),dimid),&
+         &                                __LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
+         &                      len=npoints),__LINE__,MYFILE)
+
+      ! Allocate the data structure
+
+      CALL fbstat_ncread_xy_alloc(sdata,npoints,nlev,nbox)
+
+      ! Get the box names in files
+
+      CALL nchdlerr(nf90_inq_varid(ncid,'box',varid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%area),__LINE__,MYFILE)
+      
+      ! Get the depths
+      
+      CALL nchdlerr(nf90_inq_varid(ncid,'depth',varid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%dep),__LINE__,MYFILE)
+
+      ! Get values
+
+      CALL nchdlerr(nf90_inq_varid(ncid,TRIM(cdvar)//'_val',varid),&
+         &          __LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%val),__LINE__,MYFILE)
+
+      ! Get xyograms
+
+      CALL nchdlerr(nf90_inq_varid(ncid,&
+         &                         TRIM(cdvar)//TRIM(cdext)//'_count',varid),&
+         &          __LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%nxy),__LINE__,MYFILE)
+
+      CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE)
+
+   END SUBROUTINE fbstat_ncread_xy
+
+   SUBROUTINE fbstat_ncread_xy_alloc(sdata,npoints,nlev,nbox)
+      ! Arguments
+      TYPE(fbstatxynctype) :: sdata    ! Data to be allocated
+      INTEGER :: npoints,nlev,nbox
+      ! Local variables
+
+      sdata%nlev=nlev
+      sdata%nbox=nbox
+      sdata%npoints=npoints
+      ALLOCATE( &
+         & sdata%area(nbox), &
+         & sdata%dep(nlev), &
+         & sdata%val(npoints), &
+         & sdata%nxy(npoints,npoints,nlev,nbox) &
+         & )
+      
+   END SUBROUTINE fbstat_ncread_xy_alloc
+
+   SUBROUTINE fbstat_ncread_xy_dealloc(sdata)
+      ! Arguments
+      TYPE(fbstatxynctype) :: sdata    ! Data to be deallocated
+      ! Local variables
+
+      sdata%nlev=0
+      sdata%nbox=0
+      sdata%npoints=0
+      DEALLOCATE( &
+         & sdata%area, &
+         & sdata%dep, &
+         & sdata%val, &
+         & sdata%nxy &
+         & )
+      
+   END SUBROUTINE fbstat_ncread_xy_dealloc
+
+END MODULE fbstatncio
Index: /utils/tools_ticket2413/OBSTOOLS/src/fbthin.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/fbthin.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/fbthin.F90	(revision 12863)
@@ -0,0 +1,164 @@
+PROGRAM fbthin
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM fbthin **
+   !!
+   !!  ** Purpose : Thin the data to 1 degree resolution
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !!
+   !!   Usage:
+   !!     fbthin.exe inputfile outputfile
+   !!
+   !!   Required:
+   !!     namelist = namthin.in
+   !!
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE obs_fbm
+   IMPLICIT NONE
+   !
+   ! Command line arguments for output file and input file
+   !
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nargs
+   CHARACTER(len=256) :: cdoutfile
+   CHARACTER(len=256) :: cdinfile
+   CHARACTER(len=256) :: cdtmp
+   INTEGER :: nout,ninn,nadd,next,i,j,k
+   LOGICAL :: lgrid
+   !
+   ! Feedback data
+   !
+   TYPE(obfbdata) :: fbdatain
+   !
+   ! Get number of command line arguments
+   !
+   nargs=IARGC()
+   IF ((nargs /= 2)) THEN
+      WRITE(*,'(A)')'Usage:'
+      WRITE(*,'(A)')'fbthin inputfile outputfile'
+      CALL abort()
+   ENDIF
+   CALL getarg(1,cdinfile)
+   CALL getarg(2,cdoutfile)
+   !
+   ! Initialize feedback data
+   !
+   CALL init_obfbdata( fbdatain )
+   !
+   ! Read the file
+   !
+   CALL read_obfbdata( TRIM(cdinfile), fbdatain )
+   !
+   ! Do the thining
+   !
+   CALL fb_thin( fbdatain )
+   !
+   ! Write the file
+   !
+   CALL write_obfbdata( TRIM(cdoutfile), fbdatain )
+
+CONTAINS
+   
+   SUBROUTINE fb_thin( fbdata )
+      !
+      ! Observation thinning 
+      !
+      IMPLICIT NONE
+      TYPE(obfbdata) :: fbdata
+      ! Namelist parameters
+      INTEGER, PARAMETER :: nmaxtypes = 10
+      CHARACTER(len=ilentyp), DIMENSION(nmaxtypes) :: thintypes
+      REAL, DIMENSION(nmaxtypes) :: thindists, thindtime
+      ! Local variables
+      NAMELIST/namthin/thintypes, thindists, thindtime
+      INTEGER :: it,ii,ij,iv,iobs,irej
+      REAL :: zdist
+
+      ! Get namelist
+      thintypes(:) = 'XXXX'
+      ! Distance in km
+      thindists(:) = 100.0
+      ! Time difference in days
+      thindtime(:) = 0.99999999
+      OPEN(10,file='namthin.in')
+      READ(10,namthin)
+      CLOSE(10)
+      WRITE(*,namthin)
+      
+      ! Convert to meters
+      thindists(:) = thindists(:) * 1000.0
+
+      DO it = 1, nmaxtypes
+
+         IF ( TRIM(thintypes(it)) == 'XXXX' ) CYCLE
+
+         iobs = 0 
+         irej = 0
+
+         master_loop: DO ii= 1, fbdata%nobs 
+            
+            IF ( TRIM(ADJUSTL(thintypes(it))) /= 'all' ) THEN
+               IF ( TRIM(ADJUSTL(fbdata%cdtyp(ii))) /= &
+                  & TRIM(ADJUSTL(thintypes(it))) ) CYCLE
+            ENDIF
+            
+            iobs = iobs + 1
+
+            ! Skip data with missing lon and lat and observation flag rejected.
+
+            IF (fbdata%plam(ii)==fbrmdi) CYCLE
+            IF (fbdata%pphi(ii)==fbrmdi) CYCLE
+            IF (fbdata%ioqc(ii)>2) CYCLE
+            
+            DO ij=ii+1, fbdata%nobs
+
+               ! Skip data with missing lon and lat and observation flag rejected.
+               
+               IF (fbdata%plam(ij)==fbrmdi) CYCLE
+               IF (fbdata%pphi(ij)==fbrmdi) CYCLE
+               IF (fbdata%ioqc(ij)>2) CYCLE
+               
+               ! Skip different type unless thintypes is 'all'
+
+               IF ( TRIM(ADJUSTL(thintypes(it))) /= 'all' ) THEN
+                  IF ( TRIM(ADJUSTL(fbdata%cdtyp(ij))) /= &
+                     & TRIM(ADJUSTL(thintypes(it))) ) CYCLE
+               ENDIF
+
+               IF ( ABS( fbdata%ptim(ij) - fbdata%ptim(ii) ) &
+                  & >= thindtime(it) ) CYCLE
+
+               zdist = distance( fbdata%plam(ii), fbdata%pphi(ii), &
+                  &              fbdata%plam(ij), fbdata%pphi(ij) )
+
+               IF ( zdist < thindists(it) ) THEN
+
+                  irej = irej + 1
+                  fbdata%ioqc(ij)    = 4
+                  fbdata%ioqcf(2,ij) = fbdata%ioqcf(2,ij) + 32
+
+               ENDIF
+            ENDDO
+            
+         ENDDO master_loop
+
+         WRITE(*,*)'For type                = ',TRIM(thintypes(it))
+         WRITE(*,*)'Observations considered = ',iobs
+         WRITE(*,*)'Observations rejected   = ',irej
+
+      ENDDO
+
+
+     
+   END SUBROUTINE fb_thin
+
+#include "distance.h90"
+
+END PROGRAM fbthin
Index: /utils/tools_ticket2413/OBSTOOLS/src/greg2jul.h90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/greg2jul.h90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/greg2jul.h90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../src/OCE/OBS/greg2jul.h90
Index: /utils/tools_ticket2413/OBSTOOLS/src/grt_cir_dis.h90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/grt_cir_dis.h90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/grt_cir_dis.h90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../src/OCE/OBS/grt_cir_dis.h90
Index: /utils/tools_ticket2413/OBSTOOLS/src/grt_cir_dis_saa.h90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/grt_cir_dis_saa.h90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/grt_cir_dis_saa.h90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../src/OCE/OBS/grt_cir_dis_saa.h90
Index: /utils/tools_ticket2413/OBSTOOLS/src/in_out_manager.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/in_out_manager.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/in_out_manager.F90	(revision 12863)
@@ -0,0 +1,131 @@
+MODULE in_out_manager   
+   !!======================================================================
+   !!                       ***  MODULE  in_out_manager  ***
+   !! Ocean physics:  vertical mixing coefficient compute from the tke 
+   !!                 turbulent closure parameterization
+   !!=====================================================================
+   !! History :   1.0  !  2002-06  (G. Madec)   original code
+   !!             2.0  !  2006-07  (S. Masson)  iom, add ctl_stop, ctl_warn
+   !!             3.0  !  2008-06  (G. Madec)   add ctmp4 to ctmp10
+   !!             3.2  !  2009-08  (S. MAsson)  add new ctl_opn
+   !!             3.3  !  2010-10  (A. Coward)  add NetCDF4 usage
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   USE par_oce       ! ocean parameter
+!   USE lib_print     ! formated print library
+!   USE nc4interface  ! NetCDF4 interface
+
+   IMPLICIT NONE
+   PUBLIC
+
+   !!----------------------------------------------------------------------
+   !!                   namrun namelist parameters
+   !!----------------------------------------------------------------------
+   CHARACTER(lc) ::   cn_exp        = "exp0"      !: experiment name used for output filename
+   CHARACTER(lc) ::   cn_ocerst_in  = "restart"   !: suffix of ocean restart name (input)
+   CHARACTER(lc) ::   cn_ocerst_out = "restart"   !: suffix of ocean restart name (output)
+   LOGICAL       ::   ln_rstart     = .FALSE.     !: start from (F) rest or (T) a restart file
+   INTEGER       ::   nn_no         = 0           !: job number
+   INTEGER       ::   nn_rstctl     = 0           !: control of the time step (0, 1 or 2)
+   INTEGER       ::   nn_rstssh     = 0           !: hand made initilization of ssh or not (1/0)
+   INTEGER       ::   nn_it000      = 1           !: index of the first time step
+   INTEGER       ::   nn_itend      = 10          !: index of the last time step
+   INTEGER       ::   nn_date0      = 961115      !: initial calendar date aammjj
+   INTEGER       ::   nn_leapy      = 0           !: Leap year calendar flag (0/1 or 30)
+   INTEGER       ::   nn_istate     = 0           !: initial state output flag (0/1)
+   INTEGER       ::   nn_write      =   10        !: model standard output frequency
+   INTEGER       ::   nn_stock      =   10        !: restart file frequency
+   LOGICAL       ::   ln_mskland    = .FALSE.     !: mask land points in NetCDF outputs (costly: + ~15%)
+   LOGICAL       ::   ln_clobber    = .FALSE.     !: clobber (overwrite) an existing file
+   INTEGER       ::   nn_chunksz    = 0           !: chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
+#if defined key_netcdf4
+   !!----------------------------------------------------------------------
+   !!                   namnc4 namelist parameters                         (key_netcdf4)
+   !!----------------------------------------------------------------------
+   ! The following four values determine the partitioning of the output fields
+   ! into netcdf4 chunks. They are unrelated to the nn_chunk_sz setting which is
+   ! for runtime optimisation. The individual netcdf4 chunks can be optionally 
+   ! gzipped (recommended) leading to significant reductions in I/O volumes 
+   !                                   !!!**  variables only used with iom_nf90 routines and key_netcdf4 **
+   INTEGER ::   nn_nchunks_i = 1        !: number of chunks required in the i-dimension 
+   INTEGER ::   nn_nchunks_j = 1        !: number of chunks required in the j-dimension 
+   INTEGER ::   nn_nchunks_k = 1        !: number of chunks required in the k-dimension 
+   INTEGER ::   nn_nchunks_t = 1        !: number of chunks required in the t-dimension 
+   LOGICAL ::   ln_nc4zip    = .TRUE.   !: netcdf4 usage: (T) chunk and compress output using the HDF5 sublayers of netcdf4
+   !                                    !                 (F) ignore chunking request and use the netcdf4 library 
+   !                                    !                     to produce netcdf3-compatible files 
+#endif
+!$AGRIF_DO_NOT_TREAT
+!   TYPE(snc4_ctl)     :: snc4set        !: netcdf4 chunking control structure (always needed for decision making)
+!$AGRIF_END_DO_NOT_TREAT
+
+
+   !! conversion of DOCTOR norm namelist name into model name
+   !! (this should disappear in a near futur)
+
+   CHARACTER(lc) ::   cexper                      !: experiment name used for output filename
+   INTEGER       ::   no                          !: job number
+   INTEGER       ::   nrstdt                      !: control of the time step (0, 1 or 2)
+   INTEGER       ::   nit000                      !: index of the first time step
+   INTEGER       ::   nitend                      !: index of the last time step
+   INTEGER       ::   ndate0                      !: initial calendar date aammjj
+   INTEGER       ::   nleapy                      !: Leap year calendar flag (0/1 or 30)
+   INTEGER       ::   ninist                      !: initial state output flag (0/1)
+   INTEGER       ::   nwrite                      !: model standard output frequency
+   INTEGER       ::   nstock                      !: restart file frequency
+
+   !!----------------------------------------------------------------------
+   !! was in restart but moved here because of the OFF line... better solution should be found...
+   !!----------------------------------------------------------------------
+   INTEGER ::   nitrst   !: time step at which restart file should be written
+
+   !!----------------------------------------------------------------------
+   !!                    output monitoring
+   !!----------------------------------------------------------------------
+   LOGICAL ::   ln_ctl     = .FALSE.   !: run control for debugging
+   INTEGER ::   nn_print     =    0    !: level of print (0 no print)
+   INTEGER ::   nn_ictls     =    0    !: Start i indice for the SUM control
+   INTEGER ::   nn_ictle     =    0    !: End   i indice for the SUM control
+   INTEGER ::   nn_jctls     =    0    !: Start j indice for the SUM control
+   INTEGER ::   nn_jctle     =    0    !: End   j indice for the SUM control
+   INTEGER ::   nn_isplt     =    1    !: number of processors following i
+   INTEGER ::   nn_jsplt     =    1    !: number of processors following j
+   INTEGER ::   nn_bench     =    0    !: benchmark parameter (0/1)
+   INTEGER ::   nn_bit_cmp   =    0    !: bit reproducibility  (0/1)
+
+   !                                          
+   INTEGER ::   nprint, nictls, nictle, njctls, njctle, isplt, jsplt, nbench    !: OLD namelist names
+
+   INTEGER ::   ijsplt     =    1      !: nb of local domain = nb of processors
+
+   !!----------------------------------------------------------------------
+   !!                        logical units
+   !!----------------------------------------------------------------------
+   INTEGER ::   numstp     =   -1      !: logical unit for time step
+   INTEGER ::   numout     =    6      !: logical unit for output print
+   INTEGER ::   numnam     =   -1      !: logical unit for namelist
+   INTEGER ::   numnam_ice =   -1      !: logical unit for ice namelist
+   INTEGER ::   numevo_ice =   -1      !: logical unit for ice variables (temp. evolution)
+   INTEGER ::   numsol     =   -1      !: logical unit for solver statistics
+
+   !!----------------------------------------------------------------------
+   !!                          Run control  
+   !!----------------------------------------------------------------------
+   INTEGER       ::   nstop = 0             !: error flag (=number of reason for a premature stop run)
+   INTEGER       ::   nwarn = 0             !: warning flag (=number of warning found during the run)
+   CHARACTER(lc) ::   ctmp1, ctmp2, ctmp3   !: temporary characters 1 to 3
+   CHARACTER(lc) ::   ctmp4, ctmp5, ctmp6   !: temporary characters 4 to 6
+   CHARACTER(lc) ::   ctmp7, ctmp8, ctmp9   !: temporary characters 7 to 9
+   CHARACTER(lc) ::   ctmp10                !: temporary character 10
+   CHARACTER(lc) ::   cform_err = "(/,' ===>>> : E R R O R',     /,'         ===========',/)"       !:
+   CHARACTER(lc) ::   cform_war = "(/,' ===>>> : W A R N I N G', /,'         ===============',/)"   !:
+   LOGICAL       ::   lwp      = .FALSE.    !: boolean : true on the 1st processor only
+   LOGICAL       ::   lsp_area = .TRUE.     !: to make a control print over a specific area
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: in_out_manager.F90 2715 2011-03-30 15:58:35Z rblod $
+   !! Software governed by the CeCILL licence     (./LICENSE)
+   !!=====================================================================
+END MODULE in_out_manager
Index: /utils/tools_ticket2413/OBSTOOLS/src/index_sort.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/index_sort.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/index_sort.F90	(revision 12863)
@@ -0,0 +1,361 @@
+MODULE index_sort
+
+CONTAINS
+
+   LOGICAL FUNCTION lessn(a,b,n)
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE lessn  ***
+      !!          
+      !! ** Purpose : Compare two array and return true if the first
+      !!              element of array "a" different from the corresponding 
+      !!              array "b" element is less than the this element
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! References : 
+      !!
+      !! History :
+      !!        !  08-02  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      USE toolspar_kind
+      IMPLICIT NONE
+      INTEGER :: n
+      REAL(KIND=dp), DIMENSION(n) :: a,b
+      INTEGER :: i,j
+
+      DO i=1,n
+         IF (a(i)/=b(i)) THEN
+            IF (a(i)<b(i)) THEN
+               lessn=.TRUE.
+            ELSE
+               lessn=.FALSE.
+            ENDIF
+            EXIT
+         ENDIF
+      ENDDO
+
+   END FUNCTION lessn
+
+   SUBROUTINE  index_sort_dp_n(pval, n, kindx, kvals)
+      USE toolspar_kind
+      IMPLICIT NONE
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE index_sort  ***
+      !!          
+      !! ** Purpose : Get indicies for ascending order for a
+      !!              double precision array 2D
+      !!
+      !! ** Method  : Heapsort with call to lessn for comparision
+      !!
+      !! ** Action  : 
+      !!
+      !! References : http://en.wikipedia.org/wiki/Heapsort
+      !!
+      !! History :
+      !!        !  08-02  (K. Mogensen)  Original code based on index_sort_dp
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(IN) :: &
+         & n                               ! Number of keys
+      INTEGER, INTENT(IN) :: &
+         & kvals                           ! Number of values
+      REAL(KIND=dp),DIMENSION(n,kvals),INTENT(IN) :: &
+         & pval                            ! Array to be sorted
+      INTEGER,DIMENSION(kvals),INTENT(INOUT) :: &
+         & kindx                           ! Indicies for ordering
+      !! * Local variables
+      INTEGER :: ji, jj, jt, jn, jparent, jchild
+
+      DO ji = 1, kvals
+         kindx(ji) = ji
+      END DO
+
+      IF (kvals > 1) THEN
+
+         ji = kvals/2 + 1
+         jn = kvals
+
+         main_loop : DO
+
+            IF ( ji > 1 ) THEN
+               ji = ji-1
+               jt = kindx(ji)
+            ELSE
+               jt = kindx(jn)
+               kindx(jn) = kindx(1)
+               jn = jn-1
+               IF ( jn == 1 ) THEN
+                  kindx(1) = jt
+                  EXIT main_loop
+               ENDIF
+            ENDIF
+
+            jparent = ji
+            jchild =  2*ji
+
+            inner_loop : DO
+               IF ( jchild > jn ) EXIT inner_loop
+               IF ( jchild < jn ) THEN
+                  IF ( lessn(pval(:,kindx(jchild)),pval(:,kindx(jchild+1)),n) ) THEN
+                     jchild = jchild+1
+                  ENDIF
+               ENDIF
+               IF  ( lessn(pval(:,jt),pval(:,kindx(jchild)),n) ) THEN
+                  kindx(jparent) = kindx(jchild)
+                  jparent = jchild
+                  jchild = jchild*2
+               ELSE 
+                  jchild = jn + 1 
+               ENDIF
+            ENDDO inner_loop
+
+            kindx(jparent) = jt
+
+         END DO  main_loop
+      ENDIF
+
+   END SUBROUTINE index_sort_dp_n
+
+   SUBROUTINE  index_sort_dp(pval, kindx, kvals)
+      USE toolspar_kind
+      IMPLICIT NONE
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE index_sort  ***
+      !!          
+      !! ** Purpose : Get indicies for ascending order for a
+      !!              double precision array
+      !!
+      !! ** Method  : Heapsort
+      !!
+      !! ** Action  : 
+      !!
+      !! References : http://en.wikipedia.org/wiki/Heapsort
+      !!
+      !! History :
+      !!        !  06-05  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      REAL(KIND=dp),DIMENSION(*),INTENT(IN) :: &
+         & pval                            ! Array to be sorted
+      INTEGER,DIMENSION(*),INTENT(INOUT) :: &
+         & kindx                           ! Indicies for ordering
+      INTEGER, INTENT(IN) :: &
+         & kvals                           ! Number of values
+
+      !! * Local variables
+      INTEGER :: ji, jj, jt, jn, jparent, jchild
+
+      DO ji = 1, kvals
+         kindx(ji) = ji
+      END DO
+
+      IF (kvals > 1) THEN
+
+         ji = kvals/2 + 1
+         jn = kvals
+
+         main_loop : DO
+
+            IF ( ji > 1 ) THEN
+               ji = ji-1
+               jt = kindx(ji)
+            ELSE
+               jt = kindx(jn)
+               kindx(jn) = kindx(1)
+               jn = jn-1
+               IF ( jn == 1 ) THEN
+                  kindx(1) = jt
+                  EXIT main_loop
+               ENDIF
+            ENDIF
+
+            jparent = ji
+            jchild =  2*ji
+
+            inner_loop : DO
+               IF ( jchild > jn ) EXIT inner_loop
+               IF ( jchild < jn ) THEN
+                  IF ( pval(kindx(jchild)) <  pval(kindx(jchild+1)) ) THEN
+                     jchild = jchild+1
+                  ENDIF
+               ENDIF
+               IF  ( pval(jt) < pval(kindx(jchild))) THEN
+                  kindx(jparent) = kindx(jchild)
+                  jparent = jchild
+                  jchild = jchild*2
+               ELSE 
+                  jchild = jn + 1 
+               ENDIF
+            ENDDO inner_loop
+
+            kindx(jparent) = jt
+
+         END DO  main_loop
+
+      ENDIF
+   END SUBROUTINE index_sort_dp
+
+   SUBROUTINE  index_sort_int(kval, kindx, kvals)
+      USE toolspar_kind
+      IMPLICIT NONE
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE index_sort  ***
+      !!          
+      !! ** Purpose : Get indicies for ascending order for an
+      !!              integer array
+      !!
+      !! ** Method  : Heapsort
+      !!
+      !! ** Action  : 
+      !!
+      !! References : http://en.wikipedia.org/wiki/Heapsort
+      !!
+      !! History :
+      !!        !  06-05  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER,DIMENSION(*),INTENT(IN) :: &
+         & kval                            ! Array to be sorted
+      INTEGER,DIMENSION(*),INTENT(INOUT) :: &
+         & kindx                           ! Indicies for ordering
+      INTEGER, INTENT(IN) :: &
+         & kvals                           ! Number of values
+
+      !! * Local variables
+      INTEGER :: ji, jj, jt, jn, jparent, jchild
+
+      DO ji = 1, kvals
+         kindx(ji) = ji
+      END DO
+
+      IF (kvals > 1 ) THEN
+
+         ji = kvals/2 + 1
+         jn = kvals
+
+         main_loop : DO
+
+            IF ( ji > 1 ) THEN
+               ji = ji-1
+               jt = kindx(ji)
+            ELSE
+               jt = kindx(jn)
+               kindx(jn) = kindx(1)
+               jn = jn-1
+               IF ( jn == 1 ) THEN
+                  kindx(1) = jt
+                  EXIT main_loop
+               ENDIF
+            ENDIF
+
+            jparent = ji
+            jchild =  2*ji
+
+            inner_loop : DO
+               IF ( jchild > jn ) EXIT inner_loop
+               IF ( jchild < jn ) THEN
+                  IF ( kval(kindx(jchild)) <  kval(kindx(jchild+1)) ) THEN
+                     jchild = jchild+1
+                  ENDIF
+               ENDIF
+               IF  ( kval(jt) < kval(kindx(jchild))) THEN
+                  kindx(jparent) = kindx(jchild)
+                  jparent = jchild
+                  jchild = jchild*2
+               ELSE 
+                  jchild = jn + 1 
+               ENDIF
+            ENDDO inner_loop
+
+            kindx(jparent) = jt
+
+         END DO  main_loop
+
+      ENDIF
+
+   END SUBROUTINE index_sort_int
+
+   SUBROUTINE  index_sort_string(cdval, kindx, kvals)
+      USE toolspar_kind
+      IMPLICIT NONE
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE index_sort  ***
+      !!          
+      !! ** Purpose : Get indicies for ascending order for an
+      !!              integer array
+      !!
+      !! ** Method  : Heapsort
+      !!
+      !! ** Action  : 
+      !!
+      !! References : http://en.wikipedia.org/wiki/Heapsort
+      !!
+      !! History :
+      !!        !  06-05  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(len=*),DIMENSION(*),INTENT(IN) :: &
+         & cdval                            ! Array to be sorted
+      INTEGER,DIMENSION(*),INTENT(INOUT) :: &
+         & kindx                           ! Indicies for ordering
+      INTEGER, INTENT(IN) :: &
+         & kvals                           ! Number of values
+
+      !! * Local variables
+      INTEGER :: ji, jj, jt, jn, jparent, jchild
+
+      DO ji = 1, kvals
+         kindx(ji) = ji
+      END DO
+
+      IF (kvals > 1 ) THEN
+
+         ji = kvals/2 + 1
+         jn = kvals
+
+         main_loop : DO
+
+            IF ( ji > 1 ) THEN
+               ji = ji-1
+               jt = kindx(ji)
+            ELSE
+               jt = kindx(jn)
+               kindx(jn) = kindx(1)
+               jn = jn-1
+               IF ( jn == 1 ) THEN
+                  kindx(1) = jt
+                  EXIT main_loop
+               ENDIF
+            ENDIF
+
+            jparent = ji
+            jchild =  2*ji
+
+            inner_loop : DO
+               IF ( jchild > jn ) EXIT inner_loop
+               IF ( jchild < jn ) THEN
+                  IF ( cdval(kindx(jchild)) <  cdval(kindx(jchild+1)) ) THEN
+                     jchild = jchild+1
+                  ENDIF
+               ENDIF
+               IF  ( cdval(jt) < cdval(kindx(jchild))) THEN
+                  kindx(jparent) = kindx(jchild)
+                  jparent = jchild
+                  jchild = jchild*2
+               ELSE 
+                  jchild = jn + 1 
+               ENDIF
+            ENDDO inner_loop
+
+            kindx(jparent) = jt
+
+         END DO  main_loop
+
+      ENDIF
+
+   END SUBROUTINE index_sort_string
+
+END MODULE index_sort
Index: /utils/tools_ticket2413/OBSTOOLS/src/ioncdf.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/ioncdf.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/ioncdf.F90	(revision 12863)
@@ -0,0 +1,4315 @@
+#define __MYFILE__ 'ioncdf.F90'
+MODULE ioncdf
+   !!======================================================================
+   !!                       ***  MODULE  ioncdf  ***
+   !! Input/Output: manage netcdf inputs/outputs
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   ioncdf     : manage netcdf inputs/outputs
+   !!       put_map      : write a 2d/3d map 
+   !!       put_scalar   : write a scalar
+   !!       test_var     : test if variable exists
+   !!       get_nb_dim   : get dimension number of a variable
+   !!       get_dim_val  : get dimensions values of a variable
+   !!       get_var      : read a 1d/2d/3d/4d array 
+   !!       put_coord    : write coordinates
+   !!       create_map   : create map netcdf file
+   !!       put_att      : write CF attributes
+   !!       get_var_info : get CF attributes
+   !!  Original    : Nicolas Daget
+   !!  Modified      : MAB (nf90)
+   !!---------------------------------------------------------------------
+   !! * Modules used
+   USE toolspar_kind
+   USE netcdf
+   USE nctools
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC :: put_coord, put_map, get_var, test_var, put_scalar, get_nb_dim, &
+             get_dim_val, get_scalar
+
+   !! * Substitutions
+
+   !! * Interface
+   INTERFACE put_coord
+     MODULE PROCEDURE put_coord_r, put_coord_d
+   END INTERFACE
+
+   INTERFACE put_map
+     MODULE PROCEDURE put_map_2d_r, put_map_3d_r, put_map_2d_d, put_map_3d_d
+   END INTERFACE
+
+   INTERFACE put_scalar
+     MODULE PROCEDURE put_scalar_i,  put_scalar_r,  put_scalar_d
+   END INTERFACE
+
+   INTERFACE get_var
+     MODULE PROCEDURE get_var_1d_r, get_var_2d_r, get_var_3d_r, get_var_4d_r, &
+                      get_var_1d_d, get_var_2d_d, get_var_3d_d, get_var_4d_d, &
+                      get_var_1d_i, get_var_2d_i, get_var_3d_i, get_var_4d_i
+   END INTERFACE
+
+   INTERFACE get_scalar
+     MODULE PROCEDURE get_scalar_i,  get_scalar_r,  get_scalar_d
+   END INTERFACE
+
+CONTAINS
+
+   SUBROUTINE test_var ( cd_filename, cd_var, k_test )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE test_var  ***
+      !!
+      !! ** Purpose :  test if cd_var exists
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)               :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)     :: &
+         cd_var                                        ! variable name
+      INTEGER, INTENT(out)                        :: &
+         k_test                                        ! test if variable exists
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id                           ! file and variable identifier
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ),&
+         & __LINE__,__MYFILE__)
+      k_test = nf90_inq_varid( i_file_id, cd_var, i_var_id )
+      CALL nchdlerr( nf90_close( i_file_id ),&
+         & __LINE__,__MYFILE__)
+
+      IF ( k_test .EQ. nf90_noerr  ) THEN
+         k_test = 1
+      ELSE
+         k_test = 0
+      ENDIF
+
+   END SUBROUTINE test_var
+   SUBROUTINE get_nb_dim ( cd_filename, cd_var, k_nb_dim )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_nb_dim  ***
+      !!
+      !! ** Purpose :  Get dimension number of variable
+      !!
+      !! ** Method  : use netcdf fortran library
+      !!
+      !! ** Action : - get dimension number of variables
+      !!
+      !! Reference :
+      !!
+      !! History :
+      !!    06-06  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)               :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)     :: &
+         cd_var                                        ! variable name
+      INTEGER, INTENT(out)                        :: &
+         k_nb_dim                                      ! c$dimension number of variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id                           ! file and variable identifier
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr(nf90_inquire_variable( i_file_id, i_var_id, ndims=k_nb_dim ),&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_close( i_file_id ),&
+         & __LINE__,__MYFILE__) 
+   END SUBROUTINE get_nb_dim
+
+   SUBROUTINE get_dim_val ( cd_filename, cd_var, k_dim )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_dim_val  ***
+      !!
+      !! ** Purpose :  Get dimensions values of a variable
+      !!
+      !! ** Method  : use netcdf fortran library
+      !!
+      !! ** Action : - get dimensions values of a variable
+      !!
+      !! Reference :
+      !!
+      !! History :
+      !!    06-06  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)               :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)     :: &
+         cd_var                                        ! variable name
+      INTEGER, DIMENSION(:), INTENT(out)          :: &
+         k_dim                                         ! dimensions values of a variable
+
+      !! * local declarations
+      INTEGER, DIMENSION(1) :: i_nbdim                 ! dimensions of the variable
+      INTEGER               ::                       &
+         i_file_id, i_var_id,                        & ! file and variable identifier
+         ii                                     ! counter
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr(nf90_inquire_variable( i_file_id, i_var_id, dimids=k_dim ) ,&
+         & __LINE__,__MYFILE__)
+      i_nbdim = SHAPE( k_dim )
+      DO ii =  1, i_nbdim(1)
+         CALL nchdlerr( nf90_inquire_dimension( i_file_id, k_dim(ii), len=k_dim(ii) ),__LINE__,__MYFILE__ )
+      ENDDO
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE get_dim_val
+
+   !!======================================================================
+
+   SUBROUTINE get_scalar_i ( cd_filename, cd_var, k_var )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_scalar_i  ***
+      !!
+      !! ** Purpose :  read integer scalar in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library
+      !!
+      !! ** Action : - get variable informations
+      !!             - read variable
+      !!
+      !! Reference :
+      !!
+      !! History :
+      !!    06-09  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_var                                        ! variable name
+      INTEGER, INTENT(out)                     :: &
+         k_var                                         ! variable to read in netcdf file
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type                                        ! external data type for this variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr(nf90_open( cd_filename, nf90_nowrite, i_file_id ),&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr(nf90_inquire_variable( i_file_id, i_var_id,xtype=i_type,ndims=i_ndims),&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 4 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_INT : 4'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      IF ( i_ndims .NE. 1 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 1'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, k_var ),&
+         & __LINE__,__MYFILE__ )
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE get_scalar_i
+
+   SUBROUTINE get_scalar_r ( cd_filename, cd_var, p_var )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_scalar_r  ***
+      !!
+      !! ** Purpose :  read real scalar in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library
+      !!
+      !! ** Action : - get variable informations
+      !!             - read variable
+      !!
+      !! Reference :
+      !!
+      !! History :
+      !!    06-09  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_var                                        ! variable name
+      REAL(KIND=sp), INTENT(out)                        :: &
+         p_var                                         ! variable to read in netcdf file
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type                                        ! external data type for this variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type,ndims=i_ndims ),&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 5 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_FLOAT : 5'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      IF ( i_ndims .NE. 1 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 1'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, p_var ) ,__LINE__,__MYFILE__ )
+
+      CALL nchdlerr( nf90_close( i_file_id ),__LINE__,__MYFILE__  )
+
+   END SUBROUTINE get_scalar_r
+
+   SUBROUTINE get_scalar_d ( cd_filename, cd_var, dd_var )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_scalar_d  ***
+      !!
+      !! ** Purpose :  read double scalar in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library
+      !!
+      !! ** Action : - get variable informations
+      !!             - read variable
+      !!
+      !! Reference :
+      !!
+      !! History :
+      !!    06-09  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_var                                        ! variable name
+      REAL(KIND=dp), INTENT(out)            :: &
+         dd_var                                        ! variable to read in netcdf file
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type                                        ! external data type for this variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ),__LINE__,__MYFILE__ )
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type,ndims=i_ndims),__LINE__,__MYFILE__ )
+      IF ( i_type .NE. 6 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_DOUBLE : 6'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      IF ( i_ndims .NE. 1 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 1'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, dd_var ),__LINE__,__MYFILE__ )
+
+      CALL nchdlerr( nf90_close( i_file_id ),__LINE__,__MYFILE__ )
+
+   END SUBROUTINE get_scalar_d
+
+   !!======================================================================
+
+   SUBROUTINE put_scalar_i ( cd_filename, k_var, cd_var, cd_longname )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_scalar_i  ***
+      !!
+      !! ** Purpose :  write an integer scalar in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename,                             &    ! filename
+         cd_var                                        ! variable name
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_longname                                   ! variable longname
+      INTEGER, INTENT(in)                      :: &
+        k_var                                          ! variable to write in netcdf file
+
+      !! * local declarations
+      LOGICAL               :: llexist                 ! test
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_dim_id,                                 &   ! dimension identifier
+         i_var_exist, i_dim_exist                      ! tests 
+      INTEGER, DIMENSION(1) ::                     &
+         i_dim                                          ! netcdf information 
+      !!----------------------------------------------------------------------
+
+      !
+      ! Open or create file
+      ! -------------------
+      INQUIRE( FILE=cd_filename, EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         CALL nchdlerr( nf90_create( cd_filename, nf90_clobber, i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ELSE
+         CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      i_dim_exist =  nf90_inq_dimid( i_file_id, 'scalar', i_dim_id ) 
+      IF ( i_dim_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_dim( i_file_id, 'scalar', 1, i_dim_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      i_dim(1) = i_dim_id
+
+      !
+      ! Define variable or find it
+      ! --------------------------
+      i_var_exist = nf90_inq_varid( i_file_id, cd_var, i_var_id )
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var( i_file_id, cd_var, nf90_int, i_dim, i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', TRIM(cd_var) ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(cd_longname) ) THEN
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', TRIM(cd_longname) ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      ! Put variable(s)
+      ! --------------
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, k_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE put_scalar_i
+
+   SUBROUTINE put_scalar_r ( cd_filename, p_var, cd_var, cd_longname )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_scalar_r  ***
+      !!
+      !! ** Purpose :  write an real scalar in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename,                             &    ! filename
+         cd_var                                        ! variable name
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_longname                                   ! variable longname
+      REAL(KIND=sp), INTENT(in)                         :: &
+        p_var                                          ! variable to write in netcdf file
+
+      !! * local declarations
+      LOGICAL               :: llexist                 ! test
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_dim_id,                                 &   ! dimension identifier
+         i_var_exist, i_dim_exist                      ! tests 
+      INTEGER, DIMENSION(1) ::                     &
+         i_dim                                          ! netcdf information 
+      !!----------------------------------------------------------------------
+
+      !
+      ! Open or create file
+      ! -------------------
+      INQUIRE( FILE=cd_filename, EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         CALL nchdlerr( nf90_create( cd_filename, nf90_clobber, i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ELSE
+         CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      i_dim_exist =  nf90_inq_dimid( i_file_id, 'scalar', i_dim_id ) 
+      IF ( i_dim_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_dim( i_file_id, 'scalar', 1, i_dim_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      i_dim(1) = i_dim_id
+
+      !
+      ! Define variable or find it
+      ! --------------------------
+      i_var_exist = nf90_inq_varid( i_file_id, cd_var, i_var_id )
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var( i_file_id, cd_var, nf90_real, i_dim, i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', TRIM(cd_var) ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(cd_longname) ) THEN
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', TRIM(cd_longname) ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      ! Put variable(s)
+      ! --------------
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, p_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE put_scalar_r
+
+   SUBROUTINE put_scalar_d ( cd_filename, dd_var, cd_var, cd_longname )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_scalar_d  ***
+      !!
+      !! ** Purpose :  write an integer scalar in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename,                             &    ! filename
+         cd_var                                        ! variable name
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_longname                                   ! variable longname
+      REAL(KIND=dp), INTENT(in)             :: &
+        dd_var                                         ! variable to write in netcdf file
+
+      !! * local declarations
+      LOGICAL               :: llexist                 ! test
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_dim_id,                                 &   ! dimension identifier
+         i_var_exist, i_dim_exist                      ! tests 
+      INTEGER, DIMENSION(1) ::                     &
+         i_dim                                          ! netcdf information 
+      !!----------------------------------------------------------------------
+
+      !
+      ! Open or create file
+      ! -------------------
+      INQUIRE( FILE=cd_filename, EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         CALL nchdlerr( nf90_create( cd_filename, nf90_clobber, i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ELSE
+         CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      i_dim_exist =  nf90_inq_dimid( i_file_id, 'scalar', i_dim_id ) 
+      IF ( i_dim_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_dim( i_file_id, 'double', 1, i_dim_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      i_dim(1) = i_dim_id
+
+      !
+      ! Define variable or find it
+      ! --------------------------
+      i_var_exist = nf90_inq_varid( i_file_id, cd_var, i_var_id )
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var( i_file_id, cd_var, nf90_double, i_dim, i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', TRIM(cd_var) ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(cd_longname) ) THEN
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', TRIM(cd_longname) ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      ! Put variable(s)
+      ! --------------
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, dd_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE put_scalar_d
+
+   !!======================================================================
+
+   SUBROUTINE put_map_2d_r ( cd_filename, p_var, p_missing, cd_var, k_code, k_time, reftime, leadtime, time_bnd, cd_descr )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_map_2d_r  ***
+      !!
+      !! ** Purpose :  write 2d map of reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      INTEGER, OPTIONAL, INTENT(in)            :: &
+        k_code,                                   &    ! CF code
+        k_time,                                   &    ! time of the variable
+        leadtime                                       ! leadtime of the variable
+      INTEGER, DIMENSION(:), OPTIONAL, INTENT(in) :: &
+        time_bnd                                       ! time_bnd
+      REAL(KIND=sp), OPTIONAL, INTENT(in)               :: &
+        p_missing,                                &    ! missing value of the variable
+        reftime                                        ! reftime of the variable
+      REAL(KIND=sp), DIMENSION(:,:), INTENT(in)         :: &
+        p_var                                          ! variable to write in netcdf file
+      CHARACTER(len=80), DIMENSION(6), OPTIONAL, INTENT(in)   :: &
+         cd_descr                                               ! description of file contents
+
+      !! * local declarations
+      LOGICAL               :: llexist                 ! test
+      CHARACTER(len=80)     :: cl_var                  ! new variable name
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_dim_x_id, i_dim_y_id, i_time_id,        &   ! dimension identifier
+         i_reftime_id, i_leadtime_id,              &   ! dimension identifier
+         i_time_bnd_id, i_dim_id,                  &   ! dimension identifier
+         i_var_exist, i_pos, ii                        ! test and temporary variable
+      INTEGER, DIMENSION(1) :: i_time_bnd              ! dimensions of the variable
+      INTEGER, DIMENSION(2) :: i_dimxy, i_len          ! dimensions of the variable
+      INTEGER, DIMENSION(3) ::                     &
+         i_tab_start, i_tab_count, i_dim               ! netcdf information 
+      INTEGER, DIMENSION(:), ALLOCATABLE        :: &
+         i_time                                        ! time
+      REAL                  ::                     &
+         z_min, z_max, z_min_old, z_max_old            ! Minima and maxima of variable
+      !!----------------------------------------------------------------------
+
+      ! Read dimensions and compute min and max
+      ! ---------------------------------------
+      i_dimxy = SHAPE( p_var)
+      i_tab_start(1) = 1
+      i_tab_count(1) = i_dimxy(1)
+      i_tab_start(2) = 1
+      i_tab_count(2) = i_dimxy(2)
+      i_tab_count(3) = 1
+
+      IF ( PRESENT(p_missing) ) THEN
+         z_min = MINVAL(p_var, mask = p_var .NE. p_missing )
+         z_max = MAXVAL(p_var, mask = p_var .NE. p_missing )
+      ELSE
+         z_min = MINVAL(p_var )
+         z_max = MAXVAL(p_var )
+      ENDIF
+
+      ! Define the name of the variable
+      ! -------------------------------
+      cl_var = "var"
+      IF ( PRESENT(cd_var) ) cl_var = cd_var
+      IF ( PRESENT(k_code) ) CALL get_var_info( k_code, cl_var )
+
+      !
+      ! Open or create file
+      ! -------------------
+      INQUIRE( FILE=cd_filename, EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         IF ( PRESENT( cd_descr ) ) THEN
+            CALL create_map ( cd_filename, i_dimxy, cd_descr=cd_descr )
+         ELSE
+            CALL create_map ( cd_filename, i_dimxy )
+         ENDIF
+      ENDIF
+
+      CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'x', i_dim_x_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'y', i_dim_y_id ) ,&
+         & __LINE__,__MYFILE__)
+      i_dim(1) = i_dim_x_id
+      i_dim(2) = i_dim_y_id
+      i_dim(3) = i_time_id
+
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(1), len=i_len(1) ),__LINE__,__MYFILE__ )
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( (i_len(1) .NE. i_dimxy(1)) .OR. (i_len(2) .NE. i_dimxy(2)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cl_var
+         WRITE(*,*)'shape of array = ',i_dimxy
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Define variable or find it
+      ! --------------------------
+      i_var_exist = nf90_inq_varid( i_file_id, cl_var, i_var_id )
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var( i_file_id, cl_var, nf90_real, i_dim, i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(k_code) ) CALL put_att( i_file_id, i_var_id, k_code )
+         IF ( PRESENT(p_missing) )   &
+           & CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', p_missing ) ,&
+           & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,&
+            & __LINE__,__MYFILE__)
+         i_var_exist = nf90_inq_varid( i_file_id, 'time', i_time_id )
+         IF ( i_var_exist .NE. 0 ) THEN
+            CALL nchdlerr( nf90_def_var( i_file_id, 'time', nf90_int, i_dim(3), i_time_id ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         IF ( PRESENT(reftime) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'reftime', i_reftime_id )
+            IF ( i_var_exist .NE. 0 ) THEN
+               CALL nchdlerr( nf90_def_var( i_file_id, 'reftime', nf90_real, i_dim(3), i_reftime_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'units', 'days since 1950-01-01 00:00:00' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'standard_name', 'forecast_reference_time' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'long_name', 'forecast reference time' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         IF ( PRESENT(leadtime) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'leadtime', i_leadtime_id )
+            IF ( i_var_exist .NE. 0 ) THEN
+               CALL nchdlerr( nf90_def_var( i_file_id, 'leadtime', nf90_int, i_dim(3), i_leadtime_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'units', 'days' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'standard_name', 'forecast_period' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'long_name', &
+                  &         'Time elapsed since the start of the forecast' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'bounds', 'time_bnd' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         IF ( PRESENT(time_bnd) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'time_bnd', i_time_bnd_id )
+            IF ( i_var_exist .NE. 0 ) THEN 
+               i_time_bnd=SHAPE(time_bnd)
+               CALL nchdlerr( nf90_def_dim( i_file_id, 'time_bnd', i_time_bnd(1) , i_dim_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_def_var( i_file_id, 'time_bnd', nf90_int, (/i_dim_id, i_dim(3)/), i_time_bnd_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_time_bnd_id, 'units', 'days' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         i_tab_start(3) = 1
+         i_pos = 1
+      ELSE
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_min', z_min_old ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_max', z_max_old ) ,&
+            & __LINE__,__MYFILE__)
+         z_min = MIN( z_min, z_min_old )
+         z_max = MAX( z_max, z_max_old )
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_time_id, len=i_pos ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_inq_varid( i_file_id, 'time', i_time_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(reftime) ) THEN
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'reftime', i_reftime_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         IF ( PRESENT(leadtime) ) THEN
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'leadtime', i_leadtime_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         IF ( PRESENT(time_bnd) ) THEN
+            i_time_bnd=SHAPE(time_bnd)
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'time_bnd', i_time_bnd_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         ALLOCATE( i_time(i_pos) )
+         CALL nchdlerr( nf90_get_var( i_file_id, i_time_id, i_time ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(k_time) ) THEN
+            DO ii =  1, i_pos 
+               IF ( k_time .EQ. i_time(ii) ) THEN
+                  i_pos = ii - 1
+                  EXIT
+               ENDIF
+            ENDDO
+         ENDIF
+         DEALLOCATE( i_time )
+         i_pos = i_pos + 1
+         i_tab_start(3) = i_pos 
+      ENDIF
+
+      ! Put variable(s)
+      ! --------------
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, p_var, &
+         & start=i_tab_start, count=i_tab_count ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( PRESENT(k_time) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_id, (/k_time/), &
+            & start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ELSE
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_id, (/i_pos/), &
+            & start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(reftime) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_reftime_id, (/reftime/), &
+            & start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(leadtime) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_leadtime_id, (/leadtime/), &
+            & start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(time_bnd) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_bnd_id, time_bnd, &
+                                    start=(/1,i_tab_start(3)/), count=(/i_time_bnd(1),i_tab_count(3)/) ) ,&
+                                    & __LINE__,__MYFILE__)
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE put_map_2d_r
+
+   SUBROUTINE put_map_2d_d ( cd_filename, dd_var, dd_missing, cd_var, k_code, k_time, reftime, leadtime, time_bnd, cd_descr )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_map_2d_d  ***
+      !!
+      !! ** Purpose :  write 2d map of reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      INTEGER, OPTIONAL, INTENT(in)            :: &
+        k_code,                                   &    ! CF code
+        k_time,                                   &    ! time of the variable
+        leadtime                                       ! leadtime of the variable
+      INTEGER, DIMENSION(:), OPTIONAL, INTENT(in) :: &
+        time_bnd                                       ! time_bnd
+      REAL(KIND=dp), OPTIONAL, INTENT(in)      :: &
+        dd_missing,                               &    ! missing value of the variable
+        reftime                                        ! reftime of the variable
+      REAL(KIND=dp), DIMENSION(:,:), INTENT(in)  :: &
+        dd_var                                         ! variable to write in netcdf file
+      CHARACTER(len=80), DIMENSION(6), OPTIONAL, INTENT(in)   :: &
+         cd_descr                                               ! description of file contents
+
+      !! * local declarations
+      LOGICAL               :: llexist                 ! test
+      CHARACTER(len=80)     :: cl_var                  ! new variable name
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_dim_x_id, i_dim_y_id, i_time_id,        &   ! dimension identifier
+         i_reftime_id, i_leadtime_id,              &   ! dimension identifier
+         i_time_bnd_id, i_dim_id,                  &   ! dimension identifier
+         i_var_exist, i_pos, ii                        ! test and temporary variable
+      INTEGER, DIMENSION(1) :: i_time_bnd              ! dimensions of the variable
+      INTEGER, DIMENSION(2) :: i_dimxy, i_len          ! dimensions of the variable
+      INTEGER, DIMENSION(3) ::                     &
+         i_tab_start, i_tab_count, i_dim               ! netcdf information 
+      INTEGER, DIMENSION(:), ALLOCATABLE        :: &
+         i_time                                        ! time
+      REAL(KIND=dp)      ::                     &
+         dl_min, dl_max, dl_min_old, dl_max_old        ! Minima and maxima of variable
+      !!----------------------------------------------------------------------
+
+      ! Read dimensions and compute min and max
+      ! ---------------------------------------
+      i_dimxy = SHAPE( dd_var)
+      i_tab_start(1) = 1
+      i_tab_count(1) = i_dimxy(1)
+      i_tab_start(2) = 1
+      i_tab_count(2) = i_dimxy(2)
+      i_tab_count(3) = 1
+
+      IF ( PRESENT(dd_missing) ) THEN
+         dl_min = MINVAL( dd_var, mask = dd_var .NE. dd_missing )
+         dl_max = MAXVAL( dd_var, mask = dd_var .NE. dd_missing )
+      ELSE
+         dl_min = MINVAL( dd_var )
+         dl_max = MAXVAL( dd_var )
+      ENDIF
+
+      ! Define the name of the variable
+      ! -------------------------------
+      cl_var = "var"
+      IF ( PRESENT(cd_var) ) cl_var = cd_var
+      IF ( PRESENT(k_code) ) CALL get_var_info( k_code, cl_var )
+
+      !
+      ! Open or create file
+      ! -------------------
+      INQUIRE( FILE=cd_filename, EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         IF ( PRESENT( cd_descr ) ) THEN
+            CALL create_map ( cd_filename, i_dimxy, cd_descr=cd_descr )
+         ELSE
+            CALL create_map ( cd_filename, i_dimxy )
+         ENDIF
+      ENDIF
+
+      CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'x', i_dim_x_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'y', i_dim_y_id ) ,&
+         & __LINE__,__MYFILE__)
+      i_dim(1) = i_dim_x_id
+      i_dim(2) = i_dim_y_id
+      i_dim(3) = i_time_id
+
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( (i_len(1) .NE. i_dimxy(1)) .OR. (i_len(2) .NE. i_dimxy(2)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cl_var
+         WRITE(*,*)'shape of array = ',i_dimxy
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Define variable or find it
+      ! --------------------------
+      i_var_exist = nf90_inq_varid( i_file_id, cl_var, i_var_id )
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var( i_file_id, cl_var, nf90_double, i_dim, i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(k_code) ) CALL put_att( i_file_id, i_var_id, k_code )
+         IF ( PRESENT(dd_missing) )   &
+            & CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', dd_missing ),__LINE__,__MYFILE__ )
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', dl_min ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', dl_max ) ,&
+            & __LINE__,__MYFILE__)
+         i_var_exist = nf90_inq_varid( i_file_id, 'time', i_time_id )
+         IF ( i_var_exist .NE. 0 ) THEN
+            CALL nchdlerr( nf90_def_var( i_file_id, 'time', nf90_int, i_dim(3), i_time_id ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         IF ( PRESENT(reftime) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'reftime', i_reftime_id )
+            IF ( i_var_exist .NE. 0 ) THEN
+               CALL nchdlerr( nf90_def_var( i_file_id, 'reftime', nf90_double, i_dim(3), i_reftime_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'units', 'days since 1950-01-01 00:00:00' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'standard_name', 'forecast_reference_time' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'long_name', 'forecast reference time' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         IF ( PRESENT(leadtime) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'leadtime', i_leadtime_id )
+            IF ( i_var_exist .NE. 0 ) THEN
+               CALL nchdlerr( nf90_def_var( i_file_id, 'leadtime', nf90_int, i_dim(3), i_leadtime_id ),__LINE__,__MYFILE__ )
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'units', 'days' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'standard_name', 'forecast_period' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'long_name', &
+                  & 'Time elapsed since the start of the forecast' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'bounds', 'time_bnd' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         IF ( PRESENT(time_bnd) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'time_bnd', i_time_bnd_id )
+            IF ( i_var_exist .NE. 0 ) THEN 
+               i_time_bnd=SHAPE(time_bnd)
+               CALL nchdlerr( nf90_def_dim( i_file_id, 'time_bnd', i_time_bnd(1) , i_dim_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_def_var( i_file_id, 'time_bnd', nf90_int, (/i_dim_id, i_dim(3)/), i_time_bnd_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_time_bnd_id, 'units', 'days' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         i_tab_start(3) = 1
+         i_pos = 1
+      ELSE
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_min', dl_min_old ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_max', dl_max_old ) ,&
+            & __LINE__,__MYFILE__)
+         dl_min = MIN( dl_min, dl_min_old )
+         dl_max = MAX( dl_max, dl_max_old )
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', dl_min ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', dl_max ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_time_id, len=i_pos ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_inq_varid( i_file_id, 'time', i_time_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(reftime) ) THEN
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'reftime', i_reftime_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         IF ( PRESENT(leadtime) ) THEN
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'leadtime', i_leadtime_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         IF ( PRESENT(time_bnd) ) THEN
+            i_time_bnd=SHAPE(time_bnd)
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'time_bnd', i_time_bnd_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         ALLOCATE( i_time(i_pos) )
+         CALL nchdlerr( nf90_get_var( i_file_id, i_time_id, i_time ) ,&
+            & __LINE__,__MYFILE__)
+         DO ii =  1, i_pos 
+            IF ( k_time .EQ. i_time(ii) ) THEN
+               i_pos = ii - 1
+               EXIT
+            ENDIF
+         ENDDO
+         DEALLOCATE( i_time )
+         i_pos = i_pos + 1
+         i_tab_start(3) = i_pos 
+      ENDIF
+
+      ! Put variable(s)
+      ! --------------
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, dd_var, &
+         & start=i_tab_start, count=i_tab_count ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( PRESENT(k_time) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_id, (/k_time/), &
+            & start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ELSE
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_id, (/i_pos/), &
+            & start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(reftime) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_reftime_id, (/reftime/), &
+            & start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(leadtime) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_leadtime_id, (/leadtime/), &
+            & start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(time_bnd) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_bnd_id, time_bnd, &
+            & start=(/1,i_tab_start(3)/), count=(/i_time_bnd(1),i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE put_map_2d_d
+
+   SUBROUTINE put_map_3d_r ( cd_filename, p_var, p_missing, cd_var, k_code, k_time, reftime, leadtime, time_bnd, cd_descr )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_map_3d_r  ***
+      !!
+      !! ** Purpose :  write 3d map of reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      INTEGER, OPTIONAL, INTENT(in)            :: &
+        k_code,                                   &    ! CF code
+        k_time,                                   &    ! time of the variable
+        leadtime                                       ! leadtime of the variable
+      INTEGER, DIMENSION(:), OPTIONAL, INTENT(in) :: &
+        time_bnd                                       ! time_bnd
+      REAL(KIND=sp), OPTIONAL, INTENT(in)               :: &
+        p_missing,                                &    ! missing value of the variable
+        reftime                                        ! reftime of the variable
+      REAL(KIND=sp), DIMENSION(:,:,:), INTENT(in)       :: &
+        p_var                                          ! variable to write in netcdf file
+      CHARACTER(len=80), DIMENSION(6), OPTIONAL, INTENT(in)   :: &
+         cd_descr                                               ! description of file contents
+
+      !! * local declarations
+      LOGICAL               :: llexist                 ! test
+      CHARACTER(len=80)     :: cl_var                  ! new variable name
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_dim_x_id, i_dim_y_id,                   &   ! dimension identifiers
+         i_dim_z_id, i_time_id,                    &   ! dimension identifiers
+         i_reftime_id, i_leadtime_id,              &   ! dimension identifier
+         i_time_bnd_id, i_dim_id,                  &   ! dimension identifier
+         i_var_exist, i_pos, ii                        ! test and temporary variable
+      INTEGER, DIMENSION(1) :: i_time_bnd              ! dimensions of the variable
+      INTEGER, DIMENSION(3) :: i_dimxy, i_len          ! dimensions of the variable
+      INTEGER, DIMENSION(4) ::                     &
+         i_tab_start, i_tab_count, i_dim               ! netcdf information 
+      INTEGER, DIMENSION(:), ALLOCATABLE        :: &
+         i_time                                        ! time
+      REAL                  ::                     &
+         z_min, z_max, z_min_old, z_max_old            ! Minima and maxima of variable
+      !!----------------------------------------------------------------------
+
+      ! Read dimensions and compute min and max
+      ! ---------------------------------------
+      i_dimxy = SHAPE( p_var)
+      i_tab_start(1) = 1
+      i_tab_count(1) = i_dimxy(1)
+      i_tab_start(2) = 1
+      i_tab_count(2) = i_dimxy(2)
+      i_tab_start(3) = 1
+      i_tab_count(3) = i_dimxy(3)
+      i_tab_count(4) = 1
+
+      IF ( PRESENT(p_missing) ) THEN
+         z_min = MINVAL(p_var, mask = p_var .NE. p_missing )
+         z_max = MAXVAL(p_var, mask = p_var .NE. p_missing )
+      ELSE
+         z_min = MINVAL(p_var )
+         z_max = MAXVAL(p_var )
+      ENDIF
+
+      ! Define the name of the variable
+      ! -------------------------------
+      cl_var = "var"
+      IF ( PRESENT(cd_var) ) cl_var = cd_var
+      IF ( PRESENT(k_code) ) CALL get_var_info( k_code, cl_var )
+
+      !
+      ! Open or create file
+      ! -------------------
+      INQUIRE( FILE=cd_filename, EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         IF ( PRESENT( cd_descr ) ) THEN
+            CALL create_map ( cd_filename, i_dimxy, cd_descr=cd_descr )
+         ELSE
+            CALL create_map ( cd_filename, i_dimxy )
+         ENDIF
+      ENDIF
+
+      CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'x', i_dim_x_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'y', i_dim_y_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'z', i_dim_z_id ) ,&
+         & __LINE__,__MYFILE__)
+      i_dim(1) = i_dim_x_id
+      i_dim(2) = i_dim_y_id
+      i_dim(3) = i_dim_z_id
+      i_dim(4) = i_time_id
+
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(3), len=i_len(3) ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( (i_len(1) .NE. i_dimxy(1)) .OR. (i_len(2) .NE. i_dimxy(2)) .OR.  &
+           (i_len(3) .NE. i_dimxy(3)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cl_var
+         WRITE(*,*)'shape of array = ',i_dimxy
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Define variable or find it
+      ! --------------------------
+      i_var_exist = nf90_inq_varid( i_file_id, cl_var, i_var_id )
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var( i_file_id, cl_var, nf90_real, i_dim, i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(k_code) ) CALL put_att( i_file_id, i_var_id, k_code )
+         IF ( PRESENT(p_missing) )   &
+           & CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', p_missing ) ,&
+           & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,&
+            & __LINE__,__MYFILE__)
+         i_var_exist = nf90_inq_varid( i_file_id, 'time', i_time_id )
+         IF ( i_var_exist .NE. 0 ) THEN
+            CALL nchdlerr( nf90_def_var( i_file_id, 'time', nf90_int, i_dim(4), i_time_id ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         IF ( PRESENT(reftime) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'reftime', i_reftime_id )
+            IF ( i_var_exist .NE. 0 ) THEN
+               CALL nchdlerr( nf90_def_var( i_file_id, 'reftime', nf90_real, i_dim(4), i_reftime_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'units', 'days since 1950-01-01 00:00:00' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'standard_name', 'forecast_reference_time' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'long_name', 'forecast reference time' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         IF ( PRESENT(leadtime) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'leadtime', i_leadtime_id )
+            IF ( i_var_exist .NE. 0 ) THEN
+               CALL nchdlerr( nf90_def_var( i_file_id, 'leadtime', nf90_int, i_dim(4), i_leadtime_id ),__LINE__,__MYFILE__ )
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'units', 'days' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'standard_name', 'forecast_period' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'long_name', &
+                  & 'Time elapsed since the start of the forecast' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'bounds', 'time_bnd' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         IF ( PRESENT(time_bnd) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'time_bnd', i_time_bnd_id )
+            IF ( i_var_exist .NE. 0 ) THEN 
+               i_time_bnd=SHAPE(time_bnd)
+               CALL nchdlerr( nf90_def_dim( i_file_id, 'time_bnd', i_time_bnd(1) , i_dim_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_def_var( i_file_id, 'time_bnd', nf90_int, (/i_dim_id, i_dim(4)/), i_time_bnd_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_time_bnd_id, 'units', 'days' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         i_tab_start(4) = 1
+         i_pos = 1
+      ELSE
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_min', z_min_old ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_max', z_max_old ) ,&
+            & __LINE__,__MYFILE__)
+         z_min = MIN( z_min, z_min_old )
+         z_max = MAX( z_max, z_max_old )
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_time_id, len=i_pos ),__LINE__,__MYFILE__ )
+         CALL nchdlerr( nf90_inq_varid( i_file_id, 'time', i_time_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(reftime) ) THEN
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'reftime', i_reftime_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         IF ( PRESENT(leadtime) ) THEN
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'leadtime', i_leadtime_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         IF ( PRESENT(time_bnd) ) THEN
+            i_time_bnd=SHAPE(time_bnd)
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'time_bnd', i_time_bnd_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         ALLOCATE( i_time(i_pos) )
+         CALL nchdlerr( nf90_get_var( i_file_id, i_time_id, i_time ) ,&
+            & __LINE__,__MYFILE__)
+         DO ii =  1, i_pos 
+            IF ( k_time .EQ. i_time(ii) ) THEN
+               i_pos = ii - 1
+               EXIT
+            ENDIF
+         ENDDO
+         DEALLOCATE( i_time )
+         i_pos = i_pos + 1
+         i_tab_start(4) = i_pos 
+      ENDIF
+
+      ! Put variable(s)
+      ! --------------
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, p_var, &
+         & start=i_tab_start, count=i_tab_count ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( PRESENT(k_time) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_id, (/k_time/), &
+            & start=(/i_tab_start(4)/), count=(/i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ELSE
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_id, (/i_pos/), &
+            & start=(/i_tab_start(4)/), count=(/i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(reftime) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_reftime_id, (/reftime/), &
+            & start=(/i_tab_start(4)/), count=(/i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(leadtime) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_leadtime_id, (/leadtime/), &
+            & start=(/i_tab_start(4)/), count=(/i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(time_bnd) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_bnd_id, time_bnd, &
+            start=(/1,i_tab_start(4)/), count=(/i_time_bnd(1),i_tab_count(4)/) ),__LINE__,__MYFILE__ )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE put_map_3d_r
+
+   SUBROUTINE put_map_3d_d ( cd_filename, dd_var, dd_missing, cd_var, k_code, k_time, reftime, leadtime, time_bnd, cd_descr )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_map_3d_d  ***
+      !!
+      !! ** Purpose :  write 3d map of reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      INTEGER, OPTIONAL, INTENT(in)            :: &
+        k_code,                                   &    ! CF code
+        k_time,                                   &    ! time of the variable
+        leadtime                                       ! leadtime of the variable
+      INTEGER, DIMENSION(:), OPTIONAL, INTENT(in) :: &
+        time_bnd                                       ! time_bnd
+      REAL(KIND=dp), OPTIONAL, INTENT(in)      :: &
+        dd_missing,                               &    ! missing value of the variable
+        reftime                                        ! reftime of the variable
+      REAL(KIND=dp), DIMENSION(:,:,:), INTENT(in)  :: &
+        dd_var                                         ! variable to write in netcdf file
+      CHARACTER(len=80), DIMENSION(6), OPTIONAL, INTENT(in)   :: &
+         cd_descr                                               ! description of file contents
+
+      !! * local declarations
+      LOGICAL               :: llexist                 ! test
+      CHARACTER(len=80)     :: cl_var                  ! new variable name
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_dim_x_id, i_dim_y_id,                   &   ! dimension identifiers
+         i_dim_z_id, i_time_id,                    &   ! dimension identifiers
+         i_reftime_id, i_leadtime_id,              &   ! dimension identifier
+         i_time_bnd_id, i_dim_id,                  &   ! dimension identifier
+         i_var_exist, i_pos, ii                        ! test and temporary variable
+      INTEGER, DIMENSION(1) :: i_time_bnd              ! dimensions of the variable
+      INTEGER, DIMENSION(3) :: i_dimxy, i_len          ! dimensions of the variable
+      INTEGER, DIMENSION(4) ::                     &
+         i_tab_start, i_tab_count, i_dim               ! netcdf information 
+      INTEGER, DIMENSION(:), ALLOCATABLE        :: &
+         i_time                                        ! time
+      REAL(KIND=dp)      ::                     &
+         dl_min, dl_max, dl_min_old, dl_max_old        ! Minima and maxima of variable
+      !!----------------------------------------------------------------------
+
+      ! Read dimensions and compute min and max
+      ! ---------------------------------------
+      i_dimxy = SHAPE( dd_var)
+      i_tab_start(1) = 1
+      i_tab_count(1) = i_dimxy(1)
+      i_tab_start(2) = 1
+      i_tab_count(2) = i_dimxy(2)
+      i_tab_start(3) = 1
+      i_tab_count(3) = i_dimxy(3)
+      i_tab_count(4) = 1
+
+      IF ( PRESENT(dd_missing) ) THEN
+         dl_min = MINVAL(dd_var, mask = dd_var .NE. dd_missing )
+         dl_max = MAXVAL(dd_var, mask = dd_var .NE. dd_missing )
+      ELSE
+         dl_min = MINVAL(dd_var )
+         dl_max = MAXVAL(dd_var )
+      ENDIF
+
+      ! Define the name of the variable
+      ! -------------------------------
+      cl_var = "var"
+      IF ( PRESENT(cd_var) ) cl_var = cd_var
+      IF ( PRESENT(k_code) ) CALL get_var_info( k_code, cl_var )
+
+      !
+      ! Open or create file
+      ! -------------------
+      INQUIRE( FILE=cd_filename, EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         IF ( PRESENT( cd_descr ) ) THEN
+            CALL create_map ( cd_filename, i_dimxy, cd_descr=cd_descr )
+         ELSE
+            CALL create_map ( cd_filename, i_dimxy )
+         ENDIF
+      ENDIF
+
+      CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'x', i_dim_x_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'y', i_dim_y_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'z', i_dim_z_id ) ,&
+         & __LINE__,__MYFILE__)
+      i_dim(1) = i_dim_x_id
+      i_dim(2) = i_dim_y_id
+      i_dim(3) = i_dim_z_id
+      i_dim(4) = i_time_id
+
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(3), len=i_len(3) ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( (i_len(1) .NE. i_dimxy(1)) .OR. (i_len(2) .NE. i_dimxy(2)) .OR.  &
+           (i_len(3) .NE. i_dimxy(3)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cl_var
+         WRITE(*,*)'shape of array = ',i_dimxy
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      ! Define variable or find it
+      ! --------------------------
+      i_var_exist = nf90_inq_varid( i_file_id, cl_var, i_var_id )
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var( i_file_id, cl_var, nf90_double, i_dim, i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(k_code) ) CALL put_att( i_file_id, i_var_id, k_code )
+         IF ( PRESENT(dd_missing) )   &
+           & CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', dd_missing ) ,&
+           & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', dl_min ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', dl_max ) ,&
+            & __LINE__,__MYFILE__)
+         i_var_exist = nf90_inq_varid( i_file_id, 'time', i_time_id )
+         IF ( i_var_exist .NE. 0 ) THEN
+            CALL nchdlerr( nf90_def_var( i_file_id, 'time', nf90_int, i_dim(4), i_time_id ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         IF ( PRESENT(reftime) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'reftime', i_reftime_id )
+            IF ( i_var_exist .NE. 0 ) THEN
+               CALL nchdlerr( nf90_def_var( i_file_id, 'reftime', nf90_double, i_dim(4), i_reftime_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'units', 'days since 1950-01-01 00:00:00' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'standard_name', 'forecast_reference_time' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'long_name', 'forecast reference time' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         IF ( PRESENT(leadtime) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'leadtime', i_leadtime_id )
+            IF ( i_var_exist .NE. 0 ) THEN
+               CALL nchdlerr( nf90_def_var( i_file_id, 'leadtime', nf90_int, i_dim(4), i_leadtime_id ),__LINE__,__MYFILE__ )
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'units', 'days' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'standard_name', 'forecast_period' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'long_name', &
+                  & 'Time elapsed since the start of the forecast' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'bounds', 'time_bnd' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         IF ( PRESENT(time_bnd) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'time_bnd', i_time_bnd_id )
+            IF ( i_var_exist .NE. 0 ) THEN 
+               i_time_bnd=SHAPE(time_bnd)
+               CALL nchdlerr( nf90_def_dim( i_file_id, 'time_bnd', i_time_bnd(1) , i_dim_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_def_var( i_file_id, 'time_bnd', nf90_int, (/i_dim_id, i_dim(4)/), i_time_bnd_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_time_bnd_id, 'units', 'days' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         i_tab_start(4) = 1
+         i_pos = 1
+      ELSE
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_min', dl_min_old ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_max', dl_max_old ) ,&
+            & __LINE__,__MYFILE__)
+         dl_min = MIN( dl_min, dl_min_old )
+         dl_max = MAX( dl_max, dl_max_old )
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', dl_min ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', dl_max ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_time_id, len=i_pos ),__LINE__,__MYFILE__ )
+         CALL nchdlerr( nf90_inq_varid( i_file_id, 'time', i_time_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(reftime) ) THEN
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'reftime', i_reftime_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         IF ( PRESENT(leadtime) ) THEN
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'leadtime', i_leadtime_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         IF ( PRESENT(time_bnd) ) THEN
+            i_time_bnd=SHAPE(time_bnd)
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'time_bnd', i_time_bnd_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         ALLOCATE( i_time(i_pos) )
+         CALL nchdlerr( nf90_get_var( i_file_id, i_time_id, i_time ) ,&
+            & __LINE__,__MYFILE__)
+         DO ii =  1, i_pos 
+            IF ( k_time .EQ. i_time(ii) ) THEN
+               i_pos = ii - 1
+               EXIT
+            ENDIF
+         ENDDO
+         DEALLOCATE( i_time )
+         i_pos = i_pos + 1
+         i_tab_start(4) = i_pos 
+      ENDIF
+
+      ! Put variable(s)
+      ! --------------
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, dd_var, &
+         & start=i_tab_start, count=i_tab_count ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( PRESENT(k_time) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_id, (/k_time/), &
+            & start=(/i_tab_start(4)/), count=(/i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ELSE
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_id, (/i_pos/), &
+            & start=(/i_tab_start(4)/), count=(/i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(reftime) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_reftime_id, (/reftime/), &
+            & start=(/i_tab_start(4)/), count=(/i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(leadtime) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_leadtime_id, (/leadtime/), &
+            & start=(/i_tab_start(4)/), count=(/i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(time_bnd) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_bnd_id, time_bnd, &
+            & start=(/1,i_tab_start(4)/), count=(/i_time_bnd(1),i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE put_map_3d_d
+
+   !!======================================================================
+
+   SUBROUTINE get_var_1d_i ( cd_filename, cd_var, k_var, k_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_1d_i  ***
+      !!
+      !! ** Purpose :  read 1d map of integers in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      INTEGER, DIMENSION(:), INTENT(out)       :: &
+        k_var                                          ! variable to read in netcdf file
+      INTEGER, OPTIONAL, INTENT(out)           :: &
+        k_missing                                      ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(1) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      INTEGER               :: i_missing2              ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 4 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_INT : 4'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 1 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 1'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(k_var)
+      IF ( i_len(1) .NE. i_shape(1) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(k_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, k_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', i_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', i_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_missing2 = MAXVAL(k_var)
+      ENDIF
+
+      IF ( PRESENT(k_missing) ) THEN
+         k_missing = i_missing2
+      ELSE
+         WHERE(k_var .EQ. i_missing2) k_var = 0.0
+         WHERE((k_var .GT. 0.) .EQV. (k_var .LE. 0.)) k_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_1d_i
+
+   SUBROUTINE get_var_2d_i ( cd_filename, cd_var, k_var, k_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_2d_i  ***
+      !!
+      !! ** Purpose :  read 2d map of integers in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      INTEGER, DIMENSION(:,:), INTENT(out)        :: &
+        k_var                                          ! variable to read in netcdf file
+      INTEGER, OPTIONAL, INTENT(out)              :: &
+        k_missing                                      ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(2) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      INTEGER                  :: i_missing2              ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 4 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_INT : 4'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 2 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 2'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(k_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(k_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, k_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', i_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', i_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_missing2 = MAXVAL(k_var)
+      ENDIF
+
+      IF ( PRESENT(k_missing) ) THEN
+         k_missing = i_missing2
+      ELSE
+         WHERE(k_var .EQ. i_missing2) k_var = 0.0
+         WHERE((k_var .GT. 0.) .EQV. (k_var .LE. 0.)) k_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_2d_i
+
+   SUBROUTINE get_var_3d_i ( cd_filename, cd_var, k_var, k_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_3d_i  ***
+      !!
+      !! ** Purpose :  read 3d map of integers in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      INTEGER, DIMENSION(:,:,:), INTENT(out)      :: &
+        k_var                                          ! variable to read in netcdf file
+      INTEGER, OPTIONAL, INTENT(out)              :: &
+        k_missing                                      ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(3) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      INTEGER                  :: i_missing2              ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 4 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_INT : 4'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 3 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 3'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(3), len=i_len(3) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(k_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) &
+          .OR. (i_len(3) .NE. i_shape(3)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(k_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, k_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', i_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', i_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+            i_missing2 = MAXVAL(k_var)
+      ENDIF
+
+      IF ( PRESENT(k_missing) ) THEN
+         k_missing = i_missing2
+      ELSE
+         WHERE(k_var .EQ. i_missing2) k_var = 0.0
+         WHERE((k_var .GT. 0.) .EQV. (k_var .LE. 0.)) k_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_3d_i
+
+   SUBROUTINE get_var_4d_i ( cd_filename, cd_var, k_var, k_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_4d_i  ***
+      !!
+      !! ** Purpose :  read 4d map of integers in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      INTEGER, DIMENSION(:,:,:,:), INTENT(out)    :: &
+        k_var                                          ! variable to read in netcdf file
+      INTEGER, OPTIONAL, INTENT(out)              :: &
+        k_missing                                      ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(4) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      INTEGER                  :: i_missing2              ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 4 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_INT : 4'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 4 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 4'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(3), len=i_len(3) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(4), len=i_len(4) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(k_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) &
+          .OR. (i_len(3) .NE. i_shape(3)) .OR. (i_len(4) .NE. i_shape(4)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(k_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, k_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', i_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', i_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_missing2 = MAXVAL(k_var)
+      ENDIF
+
+      IF ( PRESENT(k_missing) ) THEN
+         k_missing = i_missing2
+      ELSE
+         WHERE(k_var .EQ. i_missing2) k_var = 0.0
+         WHERE((k_var .GT. 0.) .EQV. (k_var .LE. 0.)) k_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_4d_i
+
+   SUBROUTINE get_var_1d_r ( cd_filename, cd_var, p_var, p_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_1d_r  ***
+      !!
+      !! ** Purpose :  read 1d map of reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      REAL(KIND=sp), DIMENSION(:), INTENT(out)          :: &
+        p_var                                          ! variable to read in netcdf file
+      REAL(KIND=sp), OPTIONAL, INTENT(out)              :: &
+        p_missing                                      ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(1) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      REAL                  :: z_missing2              ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ),__LINE__,__MYFILE__ )
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 5 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_FLOAT : 5'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 1 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 1'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(p_var)
+      IF ( i_len(1) .NE. i_shape(1) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(p_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, p_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', z_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', z_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         z_missing2 = MAXVAL(p_var)
+      ENDIF
+
+      IF ( PRESENT(p_missing) ) THEN
+         p_missing = z_missing2
+      ELSE
+         WHERE(p_var .EQ. z_missing2) p_var = 0.0
+         WHERE((p_var .GT. 0.) .EQV. (p_var .LE. 0.)) p_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_1d_r
+
+   SUBROUTINE get_var_2d_r ( cd_filename, cd_var, p_var, p_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_2d_r  ***
+      !!
+      !! ** Purpose :  read 2d map of reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      REAL(KIND=sp), DIMENSION(:,:), INTENT(out)        :: &
+        p_var                                          ! variable to read in netcdf file
+      REAL(KIND=sp), OPTIONAL, INTENT(out)              :: &
+        p_missing                                      ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(2) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      REAL                  :: z_missing2              ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 5 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_FLOAT : 5'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 2 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 2'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(p_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(p_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, p_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', z_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', z_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         z_missing2 = MAXVAL(p_var)
+      ENDIF
+
+      IF ( PRESENT(p_missing) ) THEN
+         p_missing = z_missing2
+      ELSE
+         WHERE(p_var .EQ. z_missing2) p_var = 0.0
+         WHERE((p_var .GT. 0.) .EQV. (p_var .LE. 0.)) p_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_2d_r
+
+   SUBROUTINE get_var_3d_r ( cd_filename, cd_var, p_var, p_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_3d_r  ***
+      !!
+      !! ** Purpose :  read 3d map of reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      REAL(KIND=sp), DIMENSION(:,:,:), INTENT(out)      :: &
+        p_var                                          ! variable to read in netcdf file
+      REAL(KIND=sp), OPTIONAL, INTENT(out)              :: &
+        p_missing                                      ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(3) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      REAL                  :: z_missing2              ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 5 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_FLOAT : 5'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 3 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 3'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(3), len=i_len(3) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(p_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) &
+          .OR. (i_len(3) .NE. i_shape(3)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(p_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, p_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', z_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', z_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+            z_missing2 = MAXVAL(p_var)
+      ENDIF
+
+      IF ( PRESENT(p_missing) ) THEN
+         p_missing = z_missing2
+      ELSE
+         WHERE(p_var .EQ. z_missing2) p_var = 0.0
+         WHERE((p_var .GT. 0.) .EQV. (p_var .LE. 0.)) p_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_3d_r
+
+   SUBROUTINE get_var_4d_r ( cd_filename, cd_var, p_var, p_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_4d_r  ***
+      !!
+      !! ** Purpose :  read 4d map of reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      REAL(KIND=sp), DIMENSION(:,:,:,:), INTENT(out)    :: &
+        p_var                                          ! variable to read in netcdf file
+      REAL(KIND=sp), OPTIONAL, INTENT(out)              :: &
+        p_missing                                      ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(4) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      REAL                  :: z_missing2              ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 5 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_FLOAT : 5'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 4 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 4'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(3), len=i_len(3) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(4), len=i_len(4) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(p_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) &
+          .OR. (i_len(3) .NE. i_shape(3)) .OR. (i_len(4) .NE. i_shape(4)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(p_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, p_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', z_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', z_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         z_missing2 = MAXVAL(p_var)
+      ENDIF
+
+      IF ( PRESENT(p_missing) ) THEN
+         p_missing = z_missing2
+      ELSE
+         WHERE(p_var .EQ. z_missing2) p_var = 0.0
+         WHERE((p_var .GT. 0.) .EQV. (p_var .LE. 0.)) p_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_4d_r
+
+   SUBROUTINE get_var_1d_d ( cd_filename, cd_var, dd_var, dd_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_1d_d  ***
+      !!
+      !! ** Purpose :  read 1d map of real(kind=dp) reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)               :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)     :: &
+         cd_var                                        ! variable name
+      REAL(KIND=dp), DIMENSION(:), INTENT(out) :: &
+         dd_var                                        ! variable to read in netcdf file
+      REAL(KIND=dp), OPTIONAL, INTENT(out)     :: &
+         dd_missing                                    ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(1) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      REAL(KIND=dp)      :: dl_missing2             ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. NF90_DOUBLE ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF90_DOUBLE : 6'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 1 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 1'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(dd_var)
+      IF ( i_len(1) .NE. i_shape(1) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(dd_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, dd_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', dl_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', dl_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         dl_missing2 = MAXVAL(dd_var)
+      ENDIF
+
+      IF ( PRESENT(dd_missing) ) THEN
+         dd_missing = dl_missing2
+      ELSE
+         WHERE(dd_var .EQ. dl_missing2) dd_var = 0.0
+         WHERE((dd_var .GT. 0.) .EQV. (dd_var .LE. 0.)) dd_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_1d_d
+
+   SUBROUTINE get_var_2d_d ( cd_filename, cd_var, dd_var, dd_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_2d_d  ***
+      !!
+      !! ** Purpose :  read 2d map of real(kind=dp) reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)               :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)     :: &
+         cd_var                                        ! variable name
+      REAL(KIND=dp), DIMENSION(:,:), INTENT(out) :: &
+         dd_var                                        ! variable to read in netcdf file
+      REAL(KIND=dp), OPTIONAL, INTENT(out)     :: &
+         dd_missing                                    ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(2) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      REAL(KIND=dp)      :: dl_missing2             ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. NF90_DOUBLE ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF90_DOUBLE : 6'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 2 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 2'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(dd_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(dd_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, dd_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', dl_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', dl_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         dl_missing2 = MAXVAL(dd_var)
+      ENDIF
+
+      IF ( PRESENT(dd_missing) ) THEN
+         dd_missing = dl_missing2
+      ELSE
+         WHERE(dd_var .EQ. dl_missing2) dd_var = 0.0
+         WHERE((dd_var .GT. 0.) .EQV. (dd_var .LE. 0.)) dd_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_2d_d
+
+   SUBROUTINE get_var_3d_d ( cd_filename, cd_var, dd_var, dd_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_3d_d  ***
+      !!
+      !! ** Purpose :  read 3d map of real(kind=dp) reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)               :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)     :: &
+         cd_var                                        ! variable name
+      REAL(KIND=dp), DIMENSION(:,:,:), INTENT(out) :: &
+         dd_var                                        ! variable to read in netcdf file
+      REAL(KIND=dp), OPTIONAL, INTENT(out)     :: &
+         dd_missing                                    ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(3) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      REAL(KIND=dp)      :: dl_missing2             ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. NF90_DOUBLE ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF90_DOUBLE : 6'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 3 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 3'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(3), len=i_len(3) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(dd_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) &
+          .OR. (i_len(3) .NE. i_shape(3)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(dd_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, dd_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', dl_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', dl_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+            dl_missing2 = MAXVAL(dd_var)
+      ENDIF
+
+      IF ( PRESENT(dd_missing) ) THEN
+         dd_missing = dl_missing2
+      ELSE
+         WHERE(dd_var .EQ. dl_missing2) dd_var = 0.0
+         WHERE((dd_var .GT. 0.) .EQV. (dd_var .LE. 0.)) dd_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_3d_d
+
+   SUBROUTINE get_var_4d_d ( cd_filename, cd_var, dd_var, dd_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_4d_d  ***
+      !!
+      !! ** Purpose :  read 4d map of real(kind=dp) reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)               :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)     :: &
+         cd_var                                        ! variable name
+      REAL(KIND=dp), DIMENSION(:,:,:,:), INTENT(out) :: &
+         dd_var                                        ! variable to read in netcdf file
+      REAL(KIND=dp), OPTIONAL, INTENT(out)     :: &
+         dd_missing                                    ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(4) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      REAL(KIND=dp)      :: dl_missing2             ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. NF90_DOUBLE ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF90_DOUBLE : 6'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 4 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 4'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(3), len=i_len(3) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(4), len=i_len(4) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(dd_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) &
+          .OR. (i_len(3) .NE. i_shape(3)) .OR. (i_len(4) .NE. i_shape(4)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(dd_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, dd_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', dl_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', dl_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         dl_missing2 = MAXVAL(dd_var)
+      ENDIF
+
+      IF ( PRESENT(dd_missing) ) THEN
+         dd_missing = dl_missing2
+      ELSE
+         WHERE(dd_var .EQ. dl_missing2) dd_var = 0.0
+         WHERE((dd_var .GT. 0.) .EQV. (dd_var .LE. 0.)) dd_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_4d_d
+
+   !!======================================================================
+
+   SUBROUTINE put_coord_r ( cd_filename, p_lon, p_lat, p_dep, cd_descr )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_coord_r  ***
+      !!
+      !! ** Purpose :  write coordinates as reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                    ! filename
+      REAL(KIND=sp), DIMENSION(:,:), INTENT(in)         :: &
+         p_lon, p_lat                                   ! longitude and latitude
+      REAL(KIND=sp), DIMENSION(:), OPTIONAL, INTENT(in) :: &
+         p_dep                                          ! depth
+      CHARACTER(len=80), DIMENSION(6), OPTIONAL, INTENT(in)   :: &
+         cd_descr                                               ! description of file contents
+
+      !! * local declarations
+      LOGICAL               :: llexist                  ! test
+      INTEGER               ::                    &
+         i_file_id, i_var_id,                     &     ! file and variable identifiers
+         i_dim_x_id, i_dim_y_id, i_dim_z_id,      &     ! dimension identifiers
+         i_var_exist                                    ! test
+      INTEGER, DIMENSION(2) :: i_dimxy                  ! dimensions of longitude and latitude
+      INTEGER, DIMENSION(1) :: i_dimz                   ! dimension of depth
+      INTEGER, DIMENSION(3) :: i_dim                    ! dimensions for netcdf file
+      REAL                  ::                     &
+         z_minx, z_maxx, z_miny, z_maxy, z_minz, z_maxz ! minima and maxima
+      !!----------------------------------------------------------------------
+
+      ! Read dimensions and compute min and max
+      ! ---------------------------------------
+      i_dimxy = SHAPE( p_lon ) 
+      z_minx = MINVAL( p_lon )
+      z_maxx = MAXVAL( p_lon )
+      z_miny = MINVAL( p_lat )
+      z_maxy = MAXVAL( p_lat )
+
+      IF ( PRESENT( p_dep ) ) THEN
+         i_dimz = SHAPE(  p_dep )
+         z_minz = MINVAL( p_dep )
+         z_maxz = MAXVAL( p_dep )
+      ENDIF
+   
+      ! Open or create netcdf file
+      ! --------------------------
+      INQUIRE( FILE=TRIM(cd_filename), EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         IF ( PRESENT( p_dep ) ) THEN
+            IF ( PRESENT( cd_descr ) ) THEN
+               CALL create_map ( cd_filename, i_dimxy, i_dimz, cd_descr=cd_descr )
+            ELSE
+               CALL create_map ( cd_filename, i_dimxy, i_dimz )
+            ENDIF
+         ELSE
+            IF ( PRESENT( cd_descr ) ) THEN
+               CALL create_map ( cd_filename, i_dimxy, cd_descr=cd_descr )
+            ELSE
+               CALL create_map ( cd_filename, i_dimxy )
+            ENDIF
+         ENDIF
+      ENDIF
+
+      CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      ! Add longitude, latitude and depth
+      ! --------------------------------- 
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'x', i_dim_x_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'y', i_dim_y_id ) ,&
+         & __LINE__,__MYFILE__)
+      i_dim(1) = i_dim_x_id
+      i_dim(2) = i_dim_y_id
+      IF ( PRESENT( p_dep ) ) THEN
+         i_var_exist = nf90_inq_dimid( i_file_id, 'z', i_dim_z_id ) 
+         IF ( i_var_exist .NE. 0 ) THEN
+            CALL nchdlerr( nf90_redef( i_file_id ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_def_dim( i_file_id, 'z', i_dimz(1), i_dim_z_id ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         CALL nchdlerr( nf90_inq_dimid( i_file_id, 'z', i_dim_z_id ) ,&
+            & __LINE__,__MYFILE__)
+         i_dim(3) = i_dim_z_id
+      ENDIF
+
+      i_var_exist = nf90_inq_varid( i_file_id, "longitude", i_var_id )
+      CALL nchdlerr( nf90_redef( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_def_var( i_file_id, "longitude", nf90_real, (/i_dim(1),i_dim(2)/), i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'data_type', 'float' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', 'longitude' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', 'longitude' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units', 'degrees_east' ),__LINE__,__MYFILE__ )
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'axis', 'Y' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'positive', 'east' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', 9.e+19 ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_minx ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_maxx ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, p_lon) ,&
+         & __LINE__,__MYFILE__)
+
+      i_var_exist = nf90_inq_varid( i_file_id, "latitude", i_var_id )
+      CALL nchdlerr( nf90_redef( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_def_var( i_file_id, "latitude", nf90_real, (/i_dim(1),i_dim(2)/), i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'data_type', 'float' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', 'latitude' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', 'latitude' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units', 'degrees_north' ),__LINE__,__MYFILE__ )
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'axis', 'X' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'positive', 'north' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', 9.e+19 ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_miny ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_maxy ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, p_lat),__LINE__,__MYFILE__ )
+
+      IF ( PRESENT( p_dep ) ) THEN
+         i_var_exist = nf90_inq_varid( i_file_id, "depth", i_var_id )
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( i_var_exist .NE. 0 ) THEN
+            CALL nchdlerr( nf90_def_var( i_file_id, "depth", nf90_real, i_dim(3), i_var_id ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'data_type', 'float' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', 'depth' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', 'depth below the surface') ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units', 'm' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'unit_long', 'meter' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'axis', 'Z' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'positive', 'down' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', 9.e+19 ),__LINE__,__MYFILE__ )
+         ENDIF
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_minz ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_maxz ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, p_dep) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE put_coord_r
+ 
+   SUBROUTINE put_coord_d ( cd_filename, dd_lon, dd_lat, dd_dep, cd_descr )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_coord_d  ***
+      !!
+      !! ** Purpose :  write coordinates as real(kind=dp) in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)                        :: &
+         cd_filename                                            ! filename
+      REAL(KIND=dp), DIMENSION(:,:), INTENT(in)         :: &
+         dd_lon, dd_lat                                         ! longitude and latitude
+      REAL(KIND=dp), DIMENSION(:), OPTIONAL, INTENT(in) :: &
+         dd_dep                                                 ! depth
+      CHARACTER(len=80), DIMENSION(6), OPTIONAL, INTENT(in)   :: &
+         cd_descr                                               ! description of file contents
+
+      !! * local declarations
+      LOGICAL               :: llexist                  ! test
+      INTEGER               ::                    &
+         i_file_id, i_var_id,                     &     ! file and variable identifiers
+         i_dim_x_id, i_dim_y_id, i_dim_z_id,      &     ! dimension identifiers
+         i_var_exist                                    ! test
+      INTEGER, DIMENSION(2) :: i_dimxy                  ! dimensions of longitude and latitude
+      INTEGER, DIMENSION(1) :: i_dimz                   ! dimension of depth
+      INTEGER, DIMENSION(3) :: i_dim                    ! dimensions for netcdf file
+      REAL(KIND=dp)      ::                     &
+         dl_minx, dl_maxx, dl_miny, dl_maxy,       &
+         dl_minz, dl_maxz,                         &    ! minima and maxima
+         dl_missing                                     ! missing value
+      !!----------------------------------------------------------------------
+
+      ! Read dimensions and compute min and max
+      ! ---------------------------------------
+      i_dimxy = SHAPE( dd_lon ) 
+      dl_minx = MINVAL( dd_lon )
+      dl_maxx = MAXVAL( dd_lon )
+      dl_miny = MINVAL( dd_lat )
+      dl_maxy = MAXVAL( dd_lat )
+
+      IF ( PRESENT( dd_dep ) ) THEN
+         i_dimz = SHAPE( dd_dep )
+         dl_minz = MINVAL(dd_dep)
+         dl_maxz = MAXVAL(dd_dep)
+      ENDIF
+
+      ! Open or create netcdf file
+      ! --------------------------
+      INQUIRE( FILE=TRIM(cd_filename), EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         IF ( PRESENT( dd_dep ) ) THEN
+            IF ( PRESENT( cd_descr ) ) THEN
+               CALL create_map ( cd_filename, i_dimxy, i_dimz, cd_descr=cd_descr )
+            ELSE
+               CALL create_map ( cd_filename, i_dimxy, i_dimz )
+            ENDIF
+         ELSE
+            IF ( PRESENT( cd_descr ) ) THEN
+               CALL create_map ( cd_filename, i_dimxy, cd_descr=cd_descr )
+            ELSE
+               CALL create_map ( cd_filename, i_dimxy )
+            ENDIF
+         ENDIF
+      ENDIF
+
+      CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      ! Add longitude, latitude and depth
+      ! --------------------------------- 
+      dl_missing = 9.e+19_8
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'x', i_dim_x_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'y', i_dim_y_id ) ,&
+         & __LINE__,__MYFILE__)
+      i_dim(1) = i_dim_x_id
+      i_dim(2) = i_dim_y_id
+      IF ( PRESENT( dd_dep ) ) THEN
+         i_var_exist = nf90_inq_dimid( i_file_id, 'z', i_dim_z_id )
+         IF ( i_var_exist .NE. 0 ) THEN
+            CALL nchdlerr( nf90_redef( i_file_id ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_def_dim( i_file_id, 'z', i_dimz(1), i_dim_z_id ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         i_dim(3) = i_dim_z_id
+      ENDIF
+
+      i_var_exist = nf90_inq_varid( i_file_id, "longitude", i_var_id )
+      CALL nchdlerr( nf90_redef( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_def_var( i_file_id, "longitude", nf90_double, (/i_dim(1),i_dim(2)/), i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'data_type', 'float' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', 'longitude' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', 'longitude' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units', 'degrees_east' ),__LINE__,__MYFILE__ )
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'axis', 'Y' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'positive', 'east' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', dl_missing ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', dl_minx ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', dl_maxx ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, dd_lon) ,&
+         & __LINE__,__MYFILE__)
+
+      i_var_exist = nf90_inq_varid( i_file_id, "latitude", i_var_id )
+      CALL nchdlerr( nf90_redef( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_def_var( i_file_id, "latitude", nf90_double, (/i_dim(1),i_dim(2)/), i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'data_type', 'float' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', 'latitude' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', 'latitude' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units', 'degrees_north' ),__LINE__,__MYFILE__ )
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'axis', 'X' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'positive', 'north' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', dl_missing ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', dl_miny ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', dl_maxy ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, dd_lat),__LINE__,__MYFILE__ )
+
+      IF ( PRESENT( dd_dep ) ) THEN
+         i_var_exist = nf90_inq_varid( i_file_id, "depth", i_var_id )
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( i_var_exist .NE. 0 ) THEN
+            CALL nchdlerr( nf90_def_var( i_file_id, "depth", nf90_double, i_dim(3), i_var_id ),__LINE__,__MYFILE__ )
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'data_type', 'float' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', 'depth' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', 'depth below the surface'),__LINE__,__MYFILE__ )
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units', 'm' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'unit_long', 'meter' ),__LINE__,__MYFILE__ )
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'axis', 'Z' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'positive', 'down' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', dl_missing ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', dl_minz ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', dl_maxz ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, dd_dep) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+!
+   END SUBROUTINE put_coord_d
+
+   !!======================================================================
+
+   SUBROUTINE create_map ( cd_filename, k_dimxy, k_dimz, cd_descr )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE create_map  ***
+      !!
+      !! ** Purpose :  create netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - define dimension of the netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)                 :: &
+         cd_filename                                            ! filename
+      INTEGER, DIMENSION(:), INTENT(in)             :: k_dimxy  ! dimensions of longitude and latitude
+      INTEGER, DIMENSION(1), OPTIONAL, INTENT(in)   :: k_dimz   ! dimension of depth
+      CHARACTER(len=80), DIMENSION(6), OPTIONAL, INTENT(in)   :: &
+         cd_descr                                               ! description of file contents
+
+      !! * local declarations
+      INTEGER               ::                    &
+         i_file_id, i_dim_id                            ! file and dimension identifiers
+      INTEGER, DIMENSION(1) :: i_dim                    ! dimension of k_dimxy
+      !!----------------------------------------------------------------------
+
+      i_dim = SHAPE(k_dimxy)
+
+      ! Create file
+      ! -----------
+      CALL nchdlerr( nf90_create( cd_filename, nf90_clobber, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      ! Define dimensions
+      ! -----------------
+      CALL nchdlerr( nf90_def_dim( i_file_id, 'x', k_dimxy(1), i_dim_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_def_dim( i_file_id, 'y', k_dimxy(2), i_dim_id ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( PRESENT(k_dimz) ) THEN
+         CALL nchdlerr( nf90_def_dim( i_file_id, 'z', k_dimz(1), i_dim_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( i_dim(1) .EQ. 3 ) THEN
+         CALL nchdlerr( nf90_def_dim( i_file_id, 'z', k_dimxy(3), i_dim_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      CALL nchdlerr( nf90_def_dim( i_file_id, 'time', nf90_unlimited, i_dim_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( PRESENT( cd_descr ) ) THEN
+         CALL nchdlerr( nf90_put_att( i_file_id, nf90_global, "title", cd_descr(1) ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, nf90_global, "institution", cd_descr(2) ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, nf90_global, "source", cd_descr(3) ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, nf90_global, "history", cd_descr(4) ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, nf90_global, "references", cd_descr(5) ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, nf90_global, "comment", cd_descr(6) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE create_map
+
+   !!======================================================================
+
+   SUBROUTINE put_att( k_file_id, k_var_id, k_code )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_att  ***
+      !!
+      !! ** Purpose :  write CF attributes
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - write CF attributes
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      INTEGER, INTENT(in)      :: k_file_id, k_var_id,  &       ! file and variable identifiers
+                                  k_code                        ! CF identifier
+
+      !! * local declarations
+      CHARACTER(len=80)        ::                       &
+         cl_name, cl_longname,                          &       ! names of variable
+         cl_unit, cl_longunit                                   ! units of variable
+      !!----------------------------------------------------------------------
+
+      ! Get variable attributes and write them
+      ! --------------------------------------
+      CALL get_var_info( k_code, cl_name, cl_longname, cl_unit, cl_longunit )
+
+      CALL nchdlerr( nf90_put_att( k_file_id, k_var_id, 'standard_name', TRIM(cl_name) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( k_file_id, k_var_id, 'long_name', TRIM(cl_longname) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( k_file_id, k_var_id, 'units', TRIM(cl_unit) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( k_file_id, k_var_id, 'unit_long', TRIM(cl_longunit) ),__LINE__,__MYFILE__ )
+
+   END SUBROUTINE put_att
+
+   !!======================================================================
+
+   SUBROUTINE get_var_info( k_code, cd_name, cd_longname, cd_unit, cd_longunit )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_att  ***
+      !!
+      !! ** Purpose :  get CF attributes
+      !!
+      !! ** Method  : outofcore database
+      !!       
+      !! ** Action : - find iCF attributes
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(out)           :: cd_name       ! name of variable
+      CHARACTER(len=80), OPTIONAL, INTENT(out) ::       &
+         cd_longname, cd_unit, cd_longunit                      ! name and units of variable
+      INTEGER, INTENT(in)                      :: k_code        ! CF identifier
+
+      !! * local declarations
+      !!----------------------------------------------------------------------
+
+      ! Get CF attributes
+      ! -----------------
+      SELECT CASE ( k_code )
+         CASE (129)
+            cd_name="sea_water_potential_temperature"
+            IF ( PRESENT(cd_longname) ) cd_longname="Potential temperature ref to surface K"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_Celcius"
+         CASE (130)
+            cd_name="sea_water_salinity"
+            IF ( PRESENT(cd_longname) ) cd_longname="sea water salinity"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (131)
+            cd_name="sea_water_x_velocity"
+            IF ( PRESENT(cd_longname) ) cd_longname="U zonal current m/s"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (132)
+            cd_name="sea_water_y_velocity"
+            IF ( PRESENT(cd_longname) ) cd_longname="V meridional current m/s"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (133)
+            cd_name="upward_sea_water_velocity"
+            IF ( PRESENT(cd_longname) ) cd_longname="W vertical current m/s"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (134)
+            cd_name="mst"
+            IF ( PRESENT(cd_longname) ) cd_longname="Modulus of strain rate tensor"
+            IF ( PRESENT(cd_unit) ) cd_unit="s-1"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="per_second"
+         CASE (135)
+            cd_name="vvs"
+            IF ( PRESENT(cd_longname) ) cd_longname="Vertical viscosity"
+            IF ( PRESENT(cd_unit) ) cd_unit="m^2/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="square_meter_per_second"
+         CASE (136)
+            cd_name="vdf"
+            IF ( PRESENT(cd_longname) ) cd_longname="Vertical diffusivity"
+            IF ( PRESENT(cd_unit) ) cd_unit="m^2/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="square_meter_per_second"
+         CASE (137)
+            cd_name="depth"
+            IF ( PRESENT(cd_longname) ) cd_longname="depth"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (138)
+            cd_name="sea_water_sigma_theta"
+            IF ( PRESENT(cd_longname) ) cd_longname="Sigma theta"
+            IF ( PRESENT(cd_unit) ) cd_unit="kgm3"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="kilogramme cubicmeter"
+         CASE (139)
+            cd_name="richardson_number"
+            IF ( PRESENT(cd_longname) ) cd_longname="Richardson number"
+            IF ( PRESENT(cd_unit) ) cd_unit=""
+            IF ( PRESENT(cd_longunit) ) cd_longunit=""
+         CASE (140)
+            cd_name="UV"
+            IF ( PRESENT(cd_longname) ) cd_longname="UV product"
+            IF ( PRESENT(cd_unit) ) cd_unit="m**2 s**-2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="m**2 s**-2"
+         CASE (141)
+            cd_name="UT"
+            IF ( PRESENT(cd_longname) ) cd_longname="UT product"
+            IF ( PRESENT(cd_unit) ) cd_unit="m s**-1 degC"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="m s**-1 degC"
+         CASE (142)
+            cd_name="VT"
+            IF ( PRESENT(cd_longname) ) cd_longname="VT product"
+            IF ( PRESENT(cd_unit) ) cd_unit="m s**-1 degC"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="m s**-1 degC"
+         CASE (143)
+            cd_name="UU"
+            IF ( PRESENT(cd_longname) ) cd_longname="UU product"
+            IF ( PRESENT(cd_unit) ) cd_unit="m**2 s**-2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="m**2 s**-2"
+         CASE (144)
+            cd_name="VV"
+            IF ( PRESENT(cd_longname) ) cd_longname="VV product"
+            IF ( PRESENT(cd_unit) ) cd_unit="m**2 s**-2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="m**2 s**-2"
+         CASE (145)
+            cd_name="sea_surface_height_above_geoid"
+            IF ( PRESENT(cd_longname) ) cd_longname="sea_surface_height_above_geoid"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (146)
+            cd_name="sea_floor_topography"
+            IF ( PRESENT(cd_longname) ) cd_longname="Sea floor topography"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (147)
+            cd_name="ocean_barotropic_streamfunction"
+            IF ( PRESENT(cd_longname) ) cd_longname="Barotropic Stream Function"
+            IF ( PRESENT(cd_unit) ) cd_unit="m3/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="cubic_meter_per_second"
+         CASE (148)
+            cd_name="ocean_mixed_layer_thickness"
+            IF ( PRESENT(cd_longname) ) cd_longname="depth of the ocean mixed layer from the surface"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (149)
+            cd_name="sea_water_bottom_pressure"
+            IF ( PRESENT(cd_longname) ) cd_longname="sea_water_bottom_pressure"
+            IF ( PRESENT(cd_unit) ) cd_unit="Pa"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="Pascal"
+         CASE (153)
+            cd_name="surface_downward_eastward_stress"
+            IF ( PRESENT(cd_longname) ) cd_longname="U-Stress"
+            IF ( PRESENT(cd_unit) ) cd_unit="Pa"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="Pascal"
+         CASE (154)
+            cd_name="surface_downward_northward_stress"
+            IF ( PRESENT(cd_longname) ) cd_longname="V-Stress"
+            IF ( PRESENT(cd_unit) ) cd_unit="Pa"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="Pascal"
+         CASE (156)
+            cd_name="turbulent_kinetic_energy_input"
+            IF ( PRESENT(cd_longname) ) cd_longname="turbulent kinetic energy input"
+            IF ( PRESENT(cd_unit) ) cd_unit="W.m^2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="watt_per_square_meter"
+         CASE (157)
+            cd_name="absorbed_solar_radiation"
+            IF ( PRESENT(cd_longname) ) cd_longname="Absorbed solar radiation"
+            IF ( PRESENT(cd_unit) ) cd_unit="W.m^2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="watt_per_square_meter"
+         CASE (158)
+            cd_name="surface_downward_water_flux"
+            IF ( PRESENT(cd_longname) ) cd_longname="Precipitation minus Evaporation"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (159)
+            cd_name="sea_surface_temperature"
+            IF ( PRESENT(cd_longname) ) cd_longname="specified sea surface temperature"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_Celcius"
+         CASE (160)
+            cd_name="surface_downward_heat_flux_in_sea_water"
+            IF ( PRESENT(cd_longname) ) cd_longname="Specified Surface Heat flux"
+            IF ( PRESENT(cd_unit) ) cd_unit="W.m^2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="watt_per_square_meter"
+         CASE (161)
+            cd_name="diagnosed_sst_error"
+            IF ( PRESENT(cd_longname) ) cd_longname="diagnosed sea surface temperature error"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (162)
+            cd_name="surface_downward_heat_flux_in_sea_water"
+            IF ( PRESENT(cd_longname) ) cd_longname="Heat flux Correction"
+            IF ( PRESENT(cd_unit) ) cd_unit="W.m^2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="watt_per_square_meter"
+         CASE (163)
+            cd_name="d20_isotherm_depth"
+            IF ( PRESENT(cd_longname) ) cd_longname="depth of the D20 isotherm"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (164)
+            cd_name="ocean_integral_of_sea_water_temperature_wrt_depth"
+            IF ( PRESENT(cd_longname) ) cd_longname="averaged temperature over the fisrt 300m"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (167)
+            cd_name="barotropic_eastward_sea_water_velocity"
+            IF ( PRESENT(cd_longname) ) cd_longname="integral of U dz"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (168)
+            cd_name="barotropic_northward_sea_water_velocity"
+            IF ( PRESENT(cd_longname) ) cd_longname="integral of V dz"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (169)
+            cd_name="product_of_eastward_sea_water_velocity_and_temperature"
+            IF ( PRESENT(cd_longname) ) cd_longname="integral of Tudz"
+            IF ( PRESENT(cd_unit) ) cd_unit="Km/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="Kelvin_meter_per_second"
+         CASE (170)
+            cd_name="product_of_northward_sea_water_velocity_and_temperature"
+            IF ( PRESENT(cd_longname) ) cd_longname="integral of Tvdz"
+            IF ( PRESENT(cd_unit) ) cd_unit="Km/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="Kelvin_meter_per_second"
+         CASE (171)
+            cd_name="velocity_maximum"
+            IF ( PRESENT(cd_longname) ) cd_longname="velocity maximum"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (172)
+            cd_name="depth_of_maximum_velocity"
+            IF ( PRESENT(cd_longname) ) cd_longname="depth of maximum velocity"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (173)
+            cd_name="salinity_maximum"
+            IF ( PRESENT(cd_longname) ) cd_longname="salinity maximum"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (174)
+            cd_name="depth_of_maximum_salinity"
+            IF ( PRESENT(cd_longname) ) cd_longname="depth of maximum salinity"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (175)
+            cd_name="ocean_integral_of_sea_water_salinity_wrt_depth"
+            IF ( PRESENT(cd_longname) ) cd_longname="averaged salinity over the fisrt 300m"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (179)
+            cd_name="potential_temperature_analysis_error"
+            IF ( PRESENT(cd_longname) ) cd_longname="Potential temperature analysis error"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (180)
+            cd_name="background_potential_temperature"
+            IF ( PRESENT(cd_longname) ) cd_longname="background potential temperature"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (181)
+            cd_name="analysed_potential_temperature"
+            IF ( PRESENT(cd_longname) ) cd_longname="Analysed potential temperature"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (182)
+            cd_name="potential_temperature_background_error"
+            IF ( PRESENT(cd_longname) ) cd_longname="Potential temperature background error"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (183)
+            cd_name="analysed_salinity_from_soft"
+            IF ( PRESENT(cd_longname) ) cd_longname="analysed salinity from S(T) balance operator"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (184)
+            cd_name="sea_water_salinity_increment"
+            IF ( PRESENT(cd_longname) ) cd_longname="salinity increment"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (185)
+            cd_name="temperature_bias"
+            IF ( PRESENT(cd_longname) ) cd_longname="bias in temperature"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (186)
+            cd_name="salinity_bias"
+            IF ( PRESENT(cd_longname) ) cd_longname="bias in salinity"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (187)
+            cd_name="eastward_sea_water_velocity_increment_from_balance"
+            IF ( PRESENT(cd_longname) ) cd_longname="eastward sea water velocity increment from balance operator"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (188)
+            cd_name="northward_sea_water_velocity_increment_from_balance"
+            IF ( PRESENT(cd_longname) ) cd_longname="northward sea water velocity increment from balance operator"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (190)
+            cd_name="sea_water_salinity_increment_from_soft"
+            IF ( PRESENT(cd_longname) ) cd_longname="sea water salinity increment from soft"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (191)
+            cd_name="sea_water_salinity_analysis_error"
+            IF ( PRESENT(cd_longname) ) cd_longname="sea water salinity analysis error"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (192)
+            cd_name="sea_water_background_salinity"
+            IF ( PRESENT(cd_longname) ) cd_longname="sea water background salinity"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (193)
+            cd_name="sea_water_analysed_salinity"
+            IF ( PRESENT(cd_longname) ) cd_longname="sea water analysed salinity"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (194)
+            cd_name="sea_water_salinity_background_error"
+            IF ( PRESENT(cd_longname) ) cd_longname="sea water salinity background error"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (500)
+            cd_name="bcksta_bal_S"
+            IF ( PRESENT(cd_longname) ) cd_longname="balanced part of S"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (501)
+            cd_name="bcksta_unbal_S"
+            IF ( PRESENT(cd_longname) ) cd_longname="unbalanced part of S"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (502)
+            cd_name="bcksta_bal_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="balanced part of u"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (503)
+            cd_name="bcksta_unbal_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="unbalanced part of u"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (504)
+            cd_name="bcksta_bal_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="balanced part of v"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (505)
+            cd_name="bcksta_unbal_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="unbalanced part of v"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (506)
+            cd_name="bcksta_bal_e"
+            IF ( PRESENT(cd_longname) ) cd_longname="balanced part of SSH"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (507)
+            cd_name="bcksta_unbal_e"
+            IF ( PRESENT(cd_longname) ) cd_longname="unbalanced part of SSH"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (510)
+            cd_name="increm_tot_T"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for total part of T"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (511)
+            cd_name="increm_tot_S"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for total part of S"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (512)
+            cd_name="increm_bal_S"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for balanced part of S"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (513)
+            cd_name="increm_unbal_S"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for unbalanced part of S"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (514)
+            cd_name="increm_tot_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for total part of U"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (515)
+            cd_name="increm_bal_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for balanced part of U"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (516)
+            cd_name="increm_unbal_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for unbalanced part of U"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (517)
+            cd_name="increm_tot_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for total part of V"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (518)
+            cd_name="increm_bal_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for balanced part of V"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (519)
+            cd_name="increm_unbal_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for unbalanced part of V"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (520)
+            cd_name="increm_tot_e"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for total part of SSH"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (521)
+            cd_name="increm_bal_e"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for balanced part of SSH"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (522)
+            cd_name="increm_unbal_e"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for unbalanced part of SSH"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (530)
+            cd_name="pbudct"
+            IF ( PRESENT(cd_longname) ) cd_longname="distance between coastline and model u-points"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (531)
+            cd_name="pbvdct"
+            IF ( PRESENT(cd_longname) ) cd_longname="distance between coastline and model v-points"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (532)
+            cd_name="pbtdct"
+            IF ( PRESENT(cd_longname) ) cd_longname="distance between coastline and model t-points"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (533)
+            cd_name="pbfdct"
+            IF ( PRESENT(cd_longname) ) cd_longname="distance between coastline and model f-points"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (540)
+            cd_name="bckenw_wetjc"
+            IF ( PRESENT(cd_longname) ) cd_longname="energy T weighting coefficient for Jc term"
+            IF ( PRESENT(cd_unit) ) cd_unit="m^2/s^2/C^2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="square_meter_per_square_second_per_square_degre_celcius"
+         CASE (541)
+            cd_name="bckenw_wesjc"
+            IF ( PRESENT(cd_longname) ) cd_longname="energy S weighting coefficient for Jc term"
+            IF ( PRESENT(cd_unit) ) cd_unit="m^2/s^2/PSU^2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="square_meter_per_square_second_per_square_practical_salinity_scale"
+         CASE (550)
+            cd_name="bckesd_ana_t"
+            IF ( PRESENT(cd_longname) ) cd_longname="standard deviations for total part of T"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (551)
+            cd_name="bckesd_ana_s"
+            IF ( PRESENT(cd_longname) ) cd_longname="standard deviations for unbalanced part of S"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (552)
+            cd_name="bckesd_ana_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="standard deviations for unbalanced part of u"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (553)
+            cd_name="bckesd_ana_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="standard deviations for unbalanced part of V"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (554)
+            cd_name="bckesd_ana_e"
+            IF ( PRESENT(cd_longname) ) cd_longname="standard deviations for unbalanced part of SSH"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (560)
+            cd_name="bckesd_mod_t"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for temperature"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (561)
+            cd_name="bckesd_mod_s"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for salinity"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (562)
+            cd_name="bckesd_mod_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for u-velocity"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (563)
+            cd_name="bckesd_mod_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for v-velocity"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (564)
+            cd_name="bckesd_mod_e"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for SSH"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (565)
+            cd_name="bckesd_modf_t"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for temperature at final time"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (566)
+            cd_name="bckesd_modf_s"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for salinity at final time"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (567)
+            cd_name="bckesd_modf_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for u-velocity at final time"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (568)
+            cd_name="bckesd_modf_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for v-velocity at final time"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (569)
+            cd_name="bckesd_modf_e"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for SSH at final time"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (570)
+            cd_name="bcksal_dSdT"
+            IF ( PRESENT(cd_longname) ) cd_longname="dS/dT coefficient for the salinity balance"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU/C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale_per_degree_celcius"
+         CASE (571)
+            cd_name="bcksal_dTdz"
+            IF ( PRESENT(cd_longname) ) cd_longname="dT/dz for the background"
+            IF ( PRESENT(cd_unit) ) cd_unit="C/m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius_per_meter"
+         CASE (572)
+            cd_name="bcksal_dSdz"
+            IF ( PRESENT(cd_longname) ) cd_longname="dS/dz for the background"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU/m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale_per_meter"
+         CASE (575)
+            cd_name="bckssh_alpha"
+            IF ( PRESENT(cd_longname) ) cd_longname="Thermal expansion coefficient for the SSH balance"
+            IF ( PRESENT(cd_unit) ) cd_unit=""
+            IF ( PRESENT(cd_longunit) ) cd_longunit=""
+         CASE (576)
+            cd_name="bckssh_beta"
+            IF ( PRESENT(cd_longname) ) cd_longname="Saline expansion coefficient for the SSH balance"
+            IF ( PRESENT(cd_unit) ) cd_unit=""
+            IF ( PRESENT(cd_longunit) ) cd_longunit=""
+         CASE (580)
+            cd_name="filnot"
+            IF ( PRESENT(cd_longname) ) cd_longname="filter normalization factor at T-points"
+            IF ( PRESENT(cd_unit) ) cd_unit="m^(3/2)"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="square_root_of_cube_meter"
+         CASE (581)
+            cd_name="filnou"
+            IF ( PRESENT(cd_longname) ) cd_longname="filter normalization factor at u-points"
+            IF ( PRESENT(cd_unit) ) cd_unit="m^(3/2)"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="square_root_of_cube_meter"
+         CASE (582)
+            cd_name="filnov"
+            IF ( PRESENT(cd_longname) ) cd_longname="filter normalization factor at v-points"
+            IF ( PRESENT(cd_unit) ) cd_unit="m^(3/2)"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="square_root_of_cube_meter"
+         CASE (583)
+            cd_name="filnoe"
+            IF ( PRESENT(cd_longname) ) cd_longname="filter normalization factor at eta-points"
+            IF ( PRESENT(cd_unit) ) cd_unit="m^(3/2)"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="square_root_of_cube_meter"
+         CASE (590)
+            cd_name="bckint"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment to background temperature"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (591)
+            cd_name="bckins"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment to background salinity"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity"
+         CASE (592)
+            cd_name="bckinu"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment to background u-velocity"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (593)
+            cd_name="bckinv"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment to background v-velocity"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (594)
+            cd_name="bckineta"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment to background SSH"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (610)
+            cd_name="tangent_T"
+            IF ( PRESENT(cd_longname) ) cd_longname="tangent potential temperature field"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (611)
+            cd_name="tangent_S"
+            IF ( PRESENT(cd_longname) ) cd_longname="tangent salinity field"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (612)
+            cd_name="tangent_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="tangent U zonal current"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (613)
+            cd_name="tangent_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="tangent V meridional current"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (614)
+            cd_name="tangent_w"
+            IF ( PRESENT(cd_longname) ) cd_longname="tangent W vertical current"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (615)
+            cd_name="tangent_SSH"
+            IF ( PRESENT(cd_longname) ) cd_longname="tangent sea surface height above geoid"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (616)
+            cd_name="tangent BSF"
+            IF ( PRESENT(cd_longname) ) cd_longname="tangent barotropic stream function"
+            IF ( PRESENT(cd_unit) ) cd_unit="m3/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="cubic_meter_per_second"
+         CASE (620)
+            cd_name="d28_isotherm_depth"
+            IF ( PRESENT(cd_longname) ) cd_longname="depth of the D28 isotherm"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (621)
+            cd_name="ocean_mixed_layer_thickness_bn2_criterion"
+            IF ( PRESENT(cd_longname) ) cd_longname="depth of the ocean mixed layer from the surface with bn2 citerion"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (622)
+            cd_name="thermocline_depth"
+            IF ( PRESENT(cd_longname) ) cd_longname="depth of the strongest vertical temperature gradient"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (623)
+            cd_name="heat_content_of_first_300m"
+            IF ( PRESENT(cd_longname) ) cd_longname="heat content of first 300 m"
+            IF ( PRESENT(cd_unit) ) cd_unit="J"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="joules"
+         CASE (624)
+            cd_name="turbocline_depth"
+            IF ( PRESENT(cd_longname) ) cd_longname="turbocline depth"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (625)
+            cd_name="U-energy_transport"
+            IF ( PRESENT(cd_longname) ) cd_longname="U-energy transport"
+            IF ( PRESENT(cd_unit) ) cd_unit="J/s/m^2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="joules_per_second_per_square_meter"
+         CASE (626)
+            cd_name="V-energy_transport"
+            IF ( PRESENT(cd_longname) ) cd_longname="V-energy transport"
+            IF ( PRESENT(cd_unit) ) cd_unit="J/s/m^2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="joules_per_second_per_square_meter"
+         CASE default
+            cd_name="varname"
+            IF ( PRESENT(cd_longname) ) cd_longname="long_varname"
+            IF ( PRESENT(cd_unit) ) cd_unit="varunit"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="long_varunit"
+      END SELECT
+
+   END SUBROUTINE get_var_info
+
+END MODULE ioncdf
Index: /utils/tools_ticket2413/OBSTOOLS/src/lbc_nfd_ext_generic.h90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/lbc_nfd_ext_generic.h90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/lbc_nfd_ext_generic.h90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../src/OCE/LBC/lbc_nfd_ext_generic.h90
Index: /utils/tools_ticket2413/OBSTOOLS/src/lbc_nfd_generic.h90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/lbc_nfd_generic.h90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/lbc_nfd_generic.h90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../src/OCE/LBC/lbc_nfd_generic.h90
Index: /utils/tools_ticket2413/OBSTOOLS/src/lbc_nfd_nogather_generic.h90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/lbc_nfd_nogather_generic.h90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/lbc_nfd_nogather_generic.h90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../src/OCE/LBC/lbc_nfd_nogather_generic.h90
Index: /utils/tools_ticket2413/OBSTOOLS/src/lbcnfd.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/lbcnfd.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/lbcnfd.F90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../src/OCE/LBC/lbcnfd.F90
Index: /utils/tools_ticket2413/OBSTOOLS/src/lib_mpp.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/lib_mpp.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/lib_mpp.F90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../src/OCE/LBC/lib_mpp.F90
Index: /utils/tools_ticket2413/OBSTOOLS/src/mpp_allreduce_generic.h90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/mpp_allreduce_generic.h90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/mpp_allreduce_generic.h90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../src/OCE/LBC/mpp_allreduce_generic.h90
Index: /utils/tools_ticket2413/OBSTOOLS/src/mpp_bdy_generic.h90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/mpp_bdy_generic.h90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/mpp_bdy_generic.h90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../src/OCE/LBC/mpp_bdy_generic.h90
Index: /utils/tools_ticket2413/OBSTOOLS/src/mpp_lnk_generic.h90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/mpp_lnk_generic.h90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/mpp_lnk_generic.h90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../src/OCE/LBC/mpp_lnk_generic.h90
Index: /utils/tools_ticket2413/OBSTOOLS/src/mpp_loc_generic.h90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/mpp_loc_generic.h90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/mpp_loc_generic.h90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../src/OCE/LBC/mpp_loc_generic.h90
Index: /utils/tools_ticket2413/OBSTOOLS/src/mpp_nfd_generic.h90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/mpp_nfd_generic.h90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/mpp_nfd_generic.h90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../src/OCE/LBC/mpp_nfd_generic.h90
Index: /utils/tools_ticket2413/OBSTOOLS/src/nctools.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/nctools.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/nctools.F90	(revision 12863)
@@ -0,0 +1,40 @@
+#define __MYFILE__ 'nctools.F90'
+MODULE nctools
+
+   ! Utility subroutines for netCDF access
+   ! Modified    : MAB (nf90, handle_error, LINE&FILE)
+   ! Modifled    : KSM (new shorter name)
+
+   USE netcdf
+
+   PUBLIC ldebug_netcdf, nchdlerr
+   LOGICAL :: ldebug_netcdf = .FALSE.  ! Debug switch for netcdf
+
+CONTAINS
+
+   SUBROUTINE nchdlerr(status,lineno,filename)
+      
+      ! Error handler for netCDF access
+      IMPLICIT NONE
+
+
+      INTEGER :: status ! netCDF return status
+      INTEGER :: lineno ! Line number (usually obtained from 
+                        !  preprocessing __LINE__,__MYFILE__)
+      CHARACTER(len=*),OPTIONAL :: filename
+
+      IF (status/=nf90_noerr) THEN
+         WRITE(*,*)'Netcdf error, code ',status
+         IF (PRESENT(filename)) THEN
+            WRITE(*,*)'In file ',filename,' in line ',lineno
+         ELSE
+            WRITE(*,*)'In line ',lineno
+         END IF
+         WRITE(*,'(2A)')' Error message : ',nf90_strerror(status)
+         CALL abort
+      ENDIF
+
+   END SUBROUTINE nchdlerr
+
+!----------------------------------------------------------------------
+END MODULE nctools
Index: /utils/tools_ticket2413/OBSTOOLS/src/obs_const.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/obs_const.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/obs_const.F90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../src/OCE/OBS/obs_const.F90
Index: /utils/tools_ticket2413/OBSTOOLS/src/obs_conv.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/obs_conv.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/obs_conv.F90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../src/OCE/OBS/obs_conv.F90
Index: /utils/tools_ticket2413/OBSTOOLS/src/obs_conv_functions.h90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/obs_conv_functions.h90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/obs_conv_functions.h90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../src/OCE/OBS/obs_conv_functions.h90
Index: /utils/tools_ticket2413/OBSTOOLS/src/obs_fbm.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/obs_fbm.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/obs_fbm.F90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../src/OCE/OBS/obs_fbm.F90
Index: /utils/tools_ticket2413/OBSTOOLS/src/obs_prof_io.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/obs_prof_io.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/obs_prof_io.F90	(revision 12863)
@@ -0,0 +1,32 @@
+MODULE obs_prof_io
+   !!======================================================================
+   !!                       ***  MODULE obs_prof_io  ***
+   !! Observation operators : I/O for ENACT and Coriolis files
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_enactfile    :  Read a obfbdata structure from an ENACT file.
+   !!   read_coriofile    :  Read a obfbdata structure from an Coriolis file.
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   USE obs_conv
+   USE netcdf
+   IMPLICIT NONE
+
+   INTEGER, PARAMETER :: imaxlev = 10000
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: obs_prof_io.F90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (./LICENSE)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obsprof_io.h90"
+
+END MODULE obs_prof_io
Index: /utils/tools_ticket2413/OBSTOOLS/src/obs_seaice_io.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/obs_seaice_io.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/obs_seaice_io.F90	(revision 12863)
@@ -0,0 +1,30 @@
+MODULE obs_seaice_io
+   !!======================================================================
+   !!                       ***  MODULE obs_seaice_io  ***
+   !! Observation operators : I/O for GHRSEAICE files
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_seaicefile    :  Read a obfbdata structure from an GHRSEAICE file
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   USE julian
+   USE netcdf
+
+   IMPLICIT NONE
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: obs_seaice_io.F90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (./LICENSE)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obsseaice_io.h90"
+
+END MODULE obs_seaice_io
Index: /utils/tools_ticket2413/OBSTOOLS/src/obs_sla_io.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/obs_sla_io.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/obs_sla_io.F90	(revision 12863)
@@ -0,0 +1,30 @@
+MODULE obs_sla_io
+   !!======================================================================
+   !!                       ***  MODULE obs_sla_io  ***
+   !! Observation operators : I/O for AVISO SLA files
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_enactfile    :  Read a obfbdata structure from an AVISO SLA file
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   use obs_sla_types
+   USE netcdf
+
+   IMPLICIT NONE
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: obs_sla_io.F90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (./LICENSE)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obssla_io.h90"
+
+END MODULE obs_sla_io
Index: /utils/tools_ticket2413/OBSTOOLS/src/obs_sla_types.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/obs_sla_types.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/obs_sla_types.F90	(revision 12863)
@@ -0,0 +1,19 @@
+MODULE obs_sla_types
+   !!======================================================================
+   !!                       ***  MODULE obs_sla_type  ***
+   !! Observation operators : Satellite identifiers for SLA data
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: obs_sla_types.F90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (./LICENSE)
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+
+#include "obssla_types.h90"
+
+END MODULE obs_sla_types
Index: /utils/tools_ticket2413/OBSTOOLS/src/obs_sst_io.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/obs_sst_io.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/obs_sst_io.F90	(revision 12863)
@@ -0,0 +1,30 @@
+MODULE obs_sst_io
+   !!======================================================================
+   !!                       ***  MODULE obs_sst_io  ***
+   !! Observation operators : I/O for GHRSST files
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_sstfile    :  Read a obfbdata structure from an GHRSST file
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   USE julian
+   USE netcdf
+
+   IMPLICIT NONE
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: obs_sst_io.F90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (./LICENSE)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obssst_io.h90"
+
+END MODULE obs_sst_io
Index: /utils/tools_ticket2413/OBSTOOLS/src/obs_utils.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/obs_utils.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/obs_utils.F90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../src/OCE/OBS/obs_utils.F90
Index: /utils/tools_ticket2413/OBSTOOLS/src/obs_vel_io.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/obs_vel_io.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/obs_vel_io.F90	(revision 12863)
@@ -0,0 +1,32 @@
+MODULE obs_vel_io
+   !!======================================================================
+   !!                       ***  MODULE obs_vel_io  ***
+   !! Observation operators : I/O for TAO velocity data
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version based on obs_read_taovel
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_taofile    :  Read a obfbdata structure from an TAO velocity file.
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   USE obs_conv
+   USE in_out_manager
+   USE netcdf
+   IMPLICIT NONE
+
+   INTEGER, PARAMETER :: imaxlev = 10000
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: obs_vel_io.F90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (./LICENSE)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obsvel_io.h90"
+
+END MODULE obs_vel_io
Index: /utils/tools_ticket2413/OBSTOOLS/src/obsprof_io.h90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/obsprof_io.h90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/obsprof_io.h90	(revision 12863)
@@ -0,0 +1,834 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: obsprof_io.h90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (./LICENSE)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE read_enactfile( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_enactfile **
+      !!
+      !! ** Purpose : Read from file the profile ENACT observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      INTEGER :: iobs                ! Number of observations
+      INTEGER :: ilev                      ! Number of levels
+      INTEGER :: i_file_id
+      INTEGER :: i_obs_id
+      INTEGER :: i_lev_id
+      INTEGER :: i_phi_id
+      INTEGER :: i_lam_id
+      INTEGER :: i_depth_id
+      INTEGER :: i_var_id
+      INTEGER :: i_pl_num_id
+      INTEGER :: i_reference_date_time_id
+      INTEGER :: i_format_version_id
+      INTEGER :: i_juld_id
+      INTEGER :: i_data_type_id
+      INTEGER :: i_wmo_inst_type_id
+      INTEGER :: i_qc_var_id
+      INTEGER :: i_dc_ref_id
+      INTEGER :: i_qc_flag_id
+      CHARACTER(LEN=40) :: cl_fld_lam
+      CHARACTER(LEN=40) :: cl_fld_phi
+      CHARACTER(LEN=40) :: cl_fld_depth 
+      CHARACTER(LEN=40) :: cl_fld_var_tp
+      CHARACTER(LEN=40) :: cl_fld_var_s
+      CHARACTER(LEN=40) :: cl_fld_var_ti
+      CHARACTER(LEN=40) :: cl_fld_var_juld_qc
+      CHARACTER(LEN=40) :: cl_fld_var_pos_qc
+      CHARACTER(LEN=40) :: cl_fld_var_depth_qc 
+      CHARACTER(LEN=40) :: cl_fld_var_qc_t
+      CHARACTER(LEN=40) :: cl_fld_var_qc_s
+      CHARACTER(LEN=40) :: cl_fld_var_prof_qc_t
+      CHARACTER(LEN=40) :: cl_fld_var_prof_qc_s
+      CHARACTER(LEN=40) :: cl_fld_reference_date_time
+      CHARACTER(LEN=40) :: cl_fld_juld
+      CHARACTER(LEN=40) :: cl_fld_data_type
+      CHARACTER(LEN=40) :: cl_fld_pl_num
+      CHARACTER(LEN=40) :: cl_fld_format_version
+      CHARACTER(LEN=40) :: cl_fld_wmo_inst_type
+      CHARACTER(LEN=40) :: cl_fld_qc_flags_profiles
+      CHARACTER(LEN=40) :: cl_fld_qc_flags_levels
+
+      CHARACTER(LEN=14), PARAMETER :: cl_name = 'read_enactfile'
+      CHARACTER(LEN=16)            :: cl_data_type = ''
+      CHARACTER(LEN=4 )            :: cl_format_version = ''
+      INTEGER, DIMENSION(1) :: istart1, icount1
+      INTEGER, DIMENSION(2) :: istart2, icount2
+      CHARACTER(len=imaxlev) :: clqc
+      CHARACTER(len=1) :: cqc
+      INTEGER :: ji, jk
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: iqc1
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iqc2
+
+      !-----------------------------------------------------------------------
+      ! Initialization
+      !-----------------------------------------------------------------------
+
+      cl_fld_lam                 = 'LONGITUDE'
+      cl_fld_phi                 = 'LATITUDE'
+      cl_fld_depth               = 'DEPH_CORRECTED'
+      cl_fld_reference_date_time = 'REFERENCE_DATE_TIME'
+      cl_fld_juld                = 'JULD'
+      cl_fld_data_type           = 'DATA_TYPE'
+      cl_fld_format_version      = 'FORMAT_VERSION'
+      cl_fld_wmo_inst_type       = 'WMO_INST_TYPE'
+      cl_fld_pl_num              = 'PLATFORM_NUMBER'
+
+      cl_fld_var_qc_t            = 'POTM_CORRECTED_QC'
+      cl_fld_var_prof_qc_t       = 'PROFILE_POTM_QC'
+      cl_fld_var_tp              = 'POTM_CORRECTED'
+      cl_fld_var_qc_s            = 'PSAL_CORRECTED_QC'
+      cl_fld_var_prof_qc_s       = 'PROFILE_PSAL_QC'
+      cl_fld_var_s               = 'PSAL_CORRECTED'
+      cl_fld_var_depth_qc        = 'DEPH_CORRECTED_QC'
+      cl_fld_var_juld_qc         = 'JULD_QC'
+      cl_fld_var_pos_qc          = 'POSITION_QC'
+      cl_fld_var_ti              = 'TEMP'
+      cl_fld_qc_flags_profiles   = 'QC_FLAGS_PROFILES'
+      cl_fld_qc_flags_levels     = 'QC_FLAGS_LEVELS'
+
+      icount1(1) = 1 
+
+      !-----------------------------------------------------------------------
+      ! Open file
+      !-----------------------------------------------------------------------
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+            &      i_file_id ),           cl_name, __LINE__ )
+
+      !-----------------------------------------------------------------------
+      ! Read the heading of the file
+      !-----------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_data_type,      &
+         &         i_data_type_id ),      cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_data_type_id,        &
+         &         cl_data_type ),        cl_name, __LINE__ )
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_format_version, &
+         &         i_format_version_id ), cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_format_version_id,   &
+         &         cl_format_version ),   cl_name, __LINE__ )
+      
+      CALL str_c_to_for( cl_data_type )
+      CALL str_c_to_for( cl_format_version )
+      
+      IF(ldwp)WRITE(kunit,*)
+      IF(ldwp)WRITE(kunit,*) ' read_enactfile :' 
+      IF(ldwp)WRITE(kunit,*) ' ~~~~~~~~~~~~~~~~'
+      IF(ldwp)WRITE(kunit,*) '               Data type           = ', &
+         &                TRIM( ADJUSTL( cl_data_type ) )
+      IF(ldwp)WRITE(kunit,*) '               Format version      = ',  &
+         &                TRIM( ADJUSTL( cl_format_version ) )
+      
+      IF ( ( ( INDEX( cl_data_type,"ENACT v1.0" ) == 1 ) .OR.   &
+         &   ( INDEX( cl_data_type,"ENACT v1.4" ) == 1 ) .OR.   &
+         &   ( INDEX( cl_data_type,"ENACT v1.5" ) == 1 ) .OR.   &
+         &   ( INDEX( cl_data_type,"ENSEMBLES EN3 v1" ) == 1 )      ) &
+         &   .AND.                                              &
+         &   ( INDEX( cl_format_version,"2.0"   ) == 1 ) ) THEN
+         IF(ldwp)WRITE(kunit,*)'               Valid input file'
+      ELSE
+         CALL fatal_error( 'Invalid input file', __LINE__ )
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Read the number of observations and levels to allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'N_PROF', i_obs_id ),         &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_obs_id, len = iobs ),     &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'N_LEVELS', i_lev_id ),     &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_lev_id, len = ilev ), &
+         &         cl_name, __LINE__ )
+      IF(ldwp)WRITE(kunit,*) '               No. of data records = ', iobs
+      IF(ldwp)WRITE(kunit,*) '               No. of levels       = ', ilev
+      IF(ldwp)WRITE(kunit,*) 
+      IF (ilev > imaxlev) THEN
+         CALL fatal_error( 'Increase imaxlev in obs_prof_io.F90', __LINE__ )
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 2, iobs, ilev, 0, 1, ldgrid )
+      inpfile%cname(1) = 'POTM'
+      inpfile%cname(2) = 'PSAL'
+      inpfile%coblong(1) = 'Potential temperature'
+      inpfile%coblong(2) = 'Practical salinity'
+      inpfile%cobunit(1) = 'Degrees Celsius'
+      inpfile%cobunit(2) = 'PSU'
+      inpfile%cextname(1) = 'TEMP'
+      inpfile%cextlong(1) = 'Insitu temperature'
+      inpfile%cextunit(1) = 'Degrees Celsius'
+
+      !---------------------------------------------------------------------
+      ! Read the QC atributes
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_t, i_qc_var_id ),                         &
+         &         cl_name, __LINE__ )        
+      istart2(1) = 1
+      icount2(2) = 1
+      icount2(1) = ilev
+      DO ji = 1, iobs 
+         istart2(2) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                   &
+            &                         start = istart2, count = icount2),                              &
+            &         cl_name, __LINE__ )
+         DO jk = 1, ilev
+            inpfile%ivlqc(jk,ji,1) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+         END DO
+      END DO
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_s, i_qc_var_id ),                         &
+         &         cl_name, __LINE__ )
+      DO ji = 1, iobs
+         istart2(2) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                   &
+            &                         start = istart2, count = icount2),                              &
+            &         cl_name, __LINE__ )
+         DO jk = 1, ilev
+            inpfile%ivlqc(jk,ji,2) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+         END DO
+      END DO
+      ! No depth QC in files
+      DO ji = 1, iobs
+         DO jk = 1, ilev
+            inpfile%idqc(jk,ji)  = 1
+            inpfile%idqcf(:,jk,ji) = 0
+         END DO
+      END DO
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_t, i_qc_var_id ),                    &
+         &         cl_name,  __LINE__ )
+      DO ji = 1,iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ivqc(ji,1) = IACHAR( cqc ) - IACHAR( '0' )
+      END DO
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_s, i_qc_var_id ),                    & 
+         &         cl_name, __LINE__ ) 
+      DO ji = 1,iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ivqc(ji,2) = IACHAR( cqc ) - IACHAR( '0' )
+      END DO
+!!      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_juld_qc, i_qc_var_id ),                       &
+!!         &         cl_name, __LINE__ ) 
+!!      !DO ji = 1,iobs
+!!         istart1(1) = ji
+!!         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+!!            &                         start = istart1, count = icount1),                              &
+!!            &         cl_name, __LINE__ )
+!!         inpfile%itqc(ji)    = IACHAR( cqc ) - IACHAR( '0' )
+!!         inpfile%itqcf(:,ji) = 0
+!!      END DO
+      ! Since the flags are not set in the ENACT files we reset them to 0
+      inpfile%itqc(:)    = 1      
+      inpfile%itqcf(:,:) = 0
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_pos_qc, i_qc_var_id ),                       &
+         &         cl_name, __LINE__ ) 
+      DO ji = 1,iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ipqc(ji)    = IACHAR( cqc ) - IACHAR( '0' )
+         inpfile%ipqcf(:,ji) = 0
+      END DO
+      DO ji = 1,iobs
+         inpfile%ioqc(ji) = MIN( inpfile%ivqc(ji,1), inpfile%ivqc(ji,2) )
+      END DO
+      IF ( nf90_inq_varid( i_file_id, cl_fld_qc_flags_profiles, i_qc_flag_id ) == nf90_noerr ) THEN
+         ALLOCATE( &
+            & iqc1(iobs) &
+            & )
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_flag_id, iqc1 ),                                &
+            &         cl_name, __LINE__ )
+         DO ji = 1,iobs
+            inpfile%ioqcf(1,ji)   = iqc1(ji)
+            inpfile%ivqcf(1,ji,:) = iqc1(ji)
+            inpfile%ioqcf(2,ji)   = 0
+            inpfile%ivqcf(2,ji,:) = 0
+         END DO
+         DEALLOCATE( &
+            & iqc1 &
+            & )
+      ELSE
+         IF(ldwp) WRITE(kunit,*)'No QC profile flags in file'
+         inpfile%ioqcf(:,:)   = 0
+         inpfile%ivqcf(:,:,:) = 0
+      ENDIF
+      IF ( nf90_inq_varid( i_file_id, cl_fld_qc_flags_levels, i_qc_flag_id ) == nf90_noerr ) THEN
+         ALLOCATE( &
+            & iqc2(ilev,iobs) &
+            & )
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_flag_id, iqc2 ),                                &
+            &         cl_name, __LINE__ )
+         DO ji = 1,iobs
+            DO jk = 1,ilev
+               inpfile%ivlqcf(1,jk,ji,:) = iqc2(jk,ji)
+               inpfile%ivlqcf(2,jk,ji,:) = 0
+            END DO
+         END DO
+         DEALLOCATE( &
+            & iqc2 &
+            & )
+      ELSE
+         IF(ldwp) WRITE(kunit,*)'No QC level flags in file'
+         inpfile%ivlqcf(:,:,:,:) = 0
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Read the time/position variables 
+      !---------------------------------------------------------------------
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_juld, i_juld_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_juld_id, inpfile%ptim ),                              &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_depth, i_depth_id ),                             &
+            &         cl_name, __LINE__ )         
+      CALL chkerr( nf90_get_var  ( i_file_id, i_depth_id, inpfile%pdep ),                             &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_phi, i_phi_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_phi_id, inpfile%pphi ),                               &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_lam, i_lam_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_lam_id, inpfile%plam ),                               &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_reference_date_time, i_reference_date_time_id ), &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_reference_date_time_id, inpfile%cdjuldref ),          &
+         &         cl_name, __LINE__ )
+      
+      !---------------------------------------------------------------------
+      ! Read the platform information
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_wmo_inst_type, i_wmo_inst_type_id ),             &
+         &         cl_name, __LINE__ )          
+      CALL chkerr( nf90_get_var  ( i_file_id, i_wmo_inst_type_id, inpfile%cdtyp ),                    &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pl_num, i_pl_num_id ),                           &
+         &         cl_name, __LINE__ )         
+      CALL chkerr( nf90_get_var  ( i_file_id, i_pl_num_id, inpfile%cdwmo ),                           &
+         &         cl_name, __LINE__ )         
+
+      !---------------------------------------------------------------------
+      ! Read the variables
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_tp, i_var_id ),                              &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pob(:,:,1) ),                         &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_s, i_var_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pob(:,:,2) ),                         &
+         &         cl_name, __LINE__ )
+ 
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_ti, i_var_id ),                              &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pext(:,:,1) ),                        &
+         &         cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Close file
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_close( i_file_id ),           cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Set file indexes
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         inpfile%kindex(ji) = ji
+      END DO
+
+   END SUBROUTINE read_enactfile
+
+   SUBROUTINE read_coriofile( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_coriofile **
+      !!
+      !! ** Purpose : Read from file the profile CORIO observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output enactfile structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      INTEGER  :: &
+         & iobs, &
+         & ilev
+      !! * Local declarations
+      INTEGER :: &
+         & i_file_id,                &
+         & i_obs_id,                 &
+         & i_lev_id,                 &
+         & i_phi_id,                 & 
+         & i_lam_id,                 &
+         & i_depth_id,               &
+         & i_pres_id,                &
+         & i_var_id,                 &
+         & i_pl_num_id,              &
+         & i_format_version_id,      &
+         & i_juld_id,                &
+         & i_data_type_id,           &
+         & i_wmo_inst_type_id,       &
+         & i_qc_var_id,              &
+         & i_dc_ref_id
+      CHARACTER(LEN=40) :: & 
+         & cl_fld_lam,                 &
+         & cl_fld_phi,                 &
+         & cl_fld_depth,               & 
+         & cl_fld_depth_qc,            & 
+         & cl_fld_pres,                & 
+         & cl_fld_pres_qc,             & 
+         & cl_fld_var_t,               &
+         & cl_fld_var_s,               &
+         & cl_fld_var_ti,              &
+         & cl_fld_var_pos_qc,          &
+         & cl_fld_var_qc_t,            &
+         & cl_fld_var_qc_s,            &
+         & cl_fld_var_prof_qc_t,       &
+         & cl_fld_var_prof_qc_s,       &
+         & cl_fld_dc_ref,              &
+         & cl_fld_juld,                &
+         & cl_fld_pl_num,              &
+         & cl_fld_wmo_inst_type
+      CHARACTER(LEN=14), PARAMETER :: &
+         & cl_name = 'read_coriofile'
+      CHARACTER(LEN=4 )            :: &
+         & cl_format_version = ''
+      INTEGER, DIMENSION(1) :: &
+         & istart1, icount1
+      INTEGER, DIMENSION(2) :: &
+         & istart2, icount2
+      CHARACTER(len=imaxlev) :: &
+         & clqc
+      CHARACTER(len=1) :: &
+         & cqc
+      CHARACTER(len=256) :: &
+         & cdjulref
+      INTEGER :: &
+         & ji, jk
+      INTEGER :: &
+         & iformat
+      LOGICAL :: & 
+         & lsal
+      REAL(fbdp), DIMENSION(:,:), ALLOCATABLE :: &
+         & zpres
+      INTEGER, DIMENSION(:,:), ALLOCATABLE :: &
+         & ipresqc
+      CHARACTER(len=256) :: &
+         & cerr
+      !-----------------------------------------------------------------------
+      ! Initialization
+      !-----------------------------------------------------------------------
+
+      icount1(1) = 1 
+      lsal = .TRUE.
+
+      !-----------------------------------------------------------------------
+      ! Open file
+      !-----------------------------------------------------------------------
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+            &      i_file_id ),           cl_name, __LINE__ )
+
+      !-----------------------------------------------------------------------
+      ! Check format and set variables accordingly
+      !-----------------------------------------------------------------------
+
+      IF ( ( nf90_inq_dimid( i_file_id, 'N_PROF', i_obs_id ) == nf90_noerr ) .AND. &
+         & ( nf90_inq_dimid( i_file_id, 'N_LEVELS', i_lev_id ) == nf90_noerr ) ) THEN
+         iformat = 1
+      ELSEIF ( ( nf90_inq_dimid( i_file_id, 'mN_PROF', i_obs_id ) == nf90_noerr ) .AND. &
+         & ( nf90_inq_dimid( i_file_id, 'mN_ZLEV', i_lev_id ) == nf90_noerr ) ) THEN
+         iformat = 2
+      ELSE
+         WRITE(cerr,'(2A)')'Invalid data format in ',cl_name
+         CALL fatal_error( cerr, __LINE__ )
+      ENDIF
+      IF ( iformat == 1 ) THEN
+         cl_fld_lam                 = 'LONGITUDE'
+         cl_fld_phi                 = 'LATITUDE'  
+         cl_fld_depth               = 'DEPH'
+         cl_fld_depth_qc            = 'DEPH_QC'
+         cl_fld_pres                = 'PRES'
+         cl_fld_pres_qc             = 'PRES_QC'
+         cl_fld_juld                = 'JULD'
+         cl_fld_wmo_inst_type       = 'WMO_INST_TYPE'
+         cl_fld_dc_ref              = 'DC_REFERENCE'
+         cl_fld_pl_num              = 'PLATFORM_NUMBER'
+         cl_fld_var_qc_t            = 'TEMP_QC'
+         cl_fld_var_prof_qc_t       = 'PROFILE_TEMP_QC'
+         cl_fld_var_t               = 'TEMP'
+         cl_fld_var_qc_s            = 'PSAL_QC'
+         cl_fld_var_prof_qc_s       = 'PROFILE_PSAL_QC'
+         cl_fld_var_s               = 'PSAL'
+         cl_fld_var_pos_qc          = 'POSITION_QC'
+      ELSEIF ( iformat==2 ) THEN
+         cl_fld_lam                 = 'LONGITUDE'
+         cl_fld_phi                 = 'LATITUDE'  
+         cl_fld_depth               = 'DEPH'
+         cl_fld_depth_qc            = 'QC_DEPH'
+         cl_fld_pres                = 'PRES'
+         cl_fld_pres_qc             = 'QC_PRES'
+         cl_fld_juld                = 'JULD'
+         cl_fld_wmo_inst_type       = 'INST_TYPE'
+         cl_fld_dc_ref              = 'REFERENCE'
+         cl_fld_pl_num              = 'PLATFORM_NUMBER'
+         cl_fld_var_qc_t            = 'QC_TEMP'
+         cl_fld_var_prof_qc_t       = 'Q_PROFILE_TEMP'
+         cl_fld_var_t               = 'TEMP'
+         cl_fld_var_qc_s            = 'QC_PSAL'
+         cl_fld_var_prof_qc_s       = 'Q_PROFILE_PSAL'
+         cl_fld_var_s               = 'PSAL'
+         cl_fld_var_pos_qc          = 'Q_POSITION'
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Read the heading of the file
+      !-----------------------------------------------------------------------
+
+      IF(ldwp)WRITE(kunit,*)
+      IF(ldwp)WRITE(kunit,*) ' read_coriofile :' 
+      IF(ldwp)WRITE(kunit,*) ' ~~~~~~~~~~~~~~~~'
+      IF(ldwp)WRITE(kunit,*) '               Format version      = ', iformat
+
+      !---------------------------------------------------------------------
+      ! Read the number of observations and levels to allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_obs_id, len = iobs ), &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_lev_id, len = ilev ), &
+         &         cl_name, __LINE__ )
+      IF(ldwp)WRITE(kunit,*) '               No. of data records = ', iobs
+      IF(ldwp)WRITE(kunit,*) '               No. of levels       = ', ilev
+      IF(ldwp)WRITE(kunit,*) 
+      IF (ilev > imaxlev) THEN
+         CALL fatal_error( 'Increase imaxlev in obs_prof_io.F90', __LINE__ )
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 2, iobs, ilev, 0, 1, ldgrid )
+      inpfile%cname(1) = 'POTM'
+      inpfile%cname(2) = 'PSAL'
+      inpfile%coblong(1) = 'Potential temperature'
+      inpfile%coblong(2) = 'Practical salinity'
+      inpfile%cobunit(1) = 'Degrees Celsius'
+      inpfile%cobunit(2) = 'PSU'
+      inpfile%cextname(1) = 'TEMP'
+      inpfile%cextlong(1) = 'Insitu temperature'
+      inpfile%cextunit(1) = 'Degrees Celsius'
+      ALLOCATE( &
+         & zpres(ilev,iobs),  &
+         & ipresqc(ilev,iobs) &
+         & )
+      !---------------------------------------------------------------------
+      ! Get julian data reference (iformat==2)
+      !---------------------------------------------------------------------
+
+      IF (iformat==2) THEN
+         CALL chkerr ( nf90_get_att( i_file_id, nf90_global, &
+            &                        "Reference_date_time", cdjulref ), &
+            &         cl_name, __LINE__ )
+         inpfile%cdjuldref = cdjulref(7:10)//cdjulref(4:5)// &
+            & cdjulref(1:2)//cdjulref(12:13)//cdjulref(15:16)//cdjulref(18:19)
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Read the QC attributes
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_t, i_qc_var_id ),                                &
+         &         cl_name, __LINE__ )
+      istart2(1) = 1
+      icount2(2) = 1
+      icount2(1) = ilev
+      DO ji = 1, iobs 
+         istart2(2) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                   &
+            &                         start = istart2, count = icount2),                              &
+            &         cl_name, __LINE__ )
+         DO jk = 1, ilev
+            inpfile%ivlqc(jk,ji,1) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+         END DO
+      END DO
+      IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_s, i_qc_var_id ) == nf90_noerr ) THEN
+         DO ji = 1, iobs
+            istart2(2) = ji
+            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                &
+               &                         start = istart2, count = icount2),                           &
+               &         cl_name, __LINE__ )
+            DO jk = 1, ilev
+               inpfile%ivlqc(jk,ji,2) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+            END DO
+         END DO
+      ELSE
+         inpfile%ivlqc(:,:,2) = 4
+         inpfile%pob(:,:,2) = fbrmdi
+         lsal = .FALSE.
+      ENDIF
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_t, i_qc_var_id ),                    &
+         &         cl_name,  __LINE__ )
+      DO ji = 1,iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ivqc(ji,1) = IACHAR( cqc ) - IACHAR( '0' )
+      END DO
+      IF (lsal) THEN
+         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_s, i_qc_var_id ),                 & 
+            &         cl_name, __LINE__ ) 
+         DO ji = 1,iobs
+            istart1(1) = ji
+            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                 &
+               &                         start = istart1, count = icount1),                           &
+               &         cl_name, __LINE__ )
+            inpfile%ivqc(ji,2) = IACHAR( cqc ) - IACHAR( '0' )
+         END DO
+      ELSE
+         inpfile%ivqc(:,2) = 4
+      ENDIF
+      DO ji = 1,iobs
+         inpfile%ioqc(ji) = MIN( inpfile%ivqc(ji,1), inpfile%ivqc(ji,2) )
+      END DO
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_pos_qc, i_qc_var_id ),                       &
+         &         cl_name, __LINE__ ) 
+      DO ji = 1, iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ipqc(ji)  = IACHAR( cqc ) - IACHAR( '0' )
+      END DO
+      
+      !---------------------------------------------------------------------
+      ! Read the time/position variables 
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_juld, i_juld_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_juld_id, inpfile%ptim ),                              &
+         &         cl_name, __LINE__ )
+      IF (iformat==1) THEN
+         CALL chkerr ( nf90_get_att( i_file_id, i_juld_id, &
+            &                        "units", cdjulref ), &
+            &         cl_name, __LINE__ )
+         inpfile%cdjuldref = cdjulref(12:15)//cdjulref(17:18)// &
+            & cdjulref(20:21)//cdjulref(23:24)//cdjulref(26:27)//&
+            & cdjulref(29:30)
+      ENDIF
+      
+      IF ( nf90_inq_varid( i_file_id, cl_fld_depth, i_depth_id ) == nf90_noerr ) THEN
+         CALL chkerr( nf90_get_var  ( i_file_id, i_depth_id, inpfile%pdep ),                          &
+            &         cl_name, __LINE__ )
+         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_depth_qc, i_qc_var_id ),                      & 
+            &         cl_name, __LINE__ ) 
+         DO ji = 1, iobs
+            istart2(2) = ji
+            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                &
+               &                         start = istart2, count = icount2),                           &
+               &         cl_name, __LINE__ )
+            DO jk = 1, ilev
+               inpfile%idqc(jk,ji) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+            END DO
+         END DO
+      ELSE
+         inpfile%pdep(:,:) = fbrmdi
+         inpfile%idqc(:,:) = 4
+      ENDIF
+
+      IF ( nf90_inq_varid( i_file_id, cl_fld_pres, i_pres_id ) == nf90_noerr ) THEN
+         CALL chkerr( nf90_get_var  ( i_file_id, i_pres_id, zpres ),                                  &
+            &         cl_name, __LINE__ )
+         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pres_qc, i_qc_var_id ),                       & 
+            &         cl_name, __LINE__ ) 
+         DO ji = 1, iobs
+            istart2(2) = ji
+            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                &
+               &                         start = istart2, count = icount2),                           &
+               &         cl_name, __LINE__ )
+            DO jk = 1, ilev
+               ipresqc(jk,ji) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+            END DO
+         END DO
+      ELSE
+         zpres(:,:) = fbrmdi
+         ipresqc(:,:) = 4
+      ENDIF
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_phi, i_phi_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_phi_id, inpfile%pphi ),                               &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_lam, i_lam_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_lam_id, inpfile%plam ),                               &
+         &         cl_name, __LINE__ )
+      
+      !---------------------------------------------------------------------
+      ! Read the platform information
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_wmo_inst_type, i_wmo_inst_type_id ),             &
+         &         cl_name, __LINE__ )          
+      CALL chkerr( nf90_get_var  ( i_file_id, i_wmo_inst_type_id, inpfile%cdtyp ),                    &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pl_num, i_pl_num_id ),                           &
+         &         cl_name, __LINE__ )         
+      CALL chkerr( nf90_get_var  ( i_file_id, i_pl_num_id, inpfile%cdwmo ),                           &
+         &         cl_name, __LINE__ )         
+
+      
+      !---------------------------------------------------------------------
+      ! Read the variables
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_t, i_var_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pext(:,:,1) ),                        &
+         &         cl_name, __LINE__ )
+
+      IF (lsal) THEN      
+         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_s, i_var_id ),                            &
+            &         cl_name, __LINE__ )
+         CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pob(:,:,2) ),                      &
+            &         cl_name, __LINE__ )
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Close file
+      !---------------------------------------------------------------------
+         
+      CALL chkerr( nf90_close( i_file_id ),           cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Set file indexes
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         inpfile%kindex(ji) = ji
+      END DO
+      
+      !---------------------------------------------------------------------
+      !  Coriolis data conversion from insitu to potential temperature
+      !---------------------------------------------------------------------
+      !---------------------------------------------------------------------
+      !  Convert pressure to depth if depth not present
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         IF ( inpfile%pphi(ji) < 9999.0 ) THEN
+            DO jk = 1, inpfile%nlev
+               IF ( inpfile%pdep(jk,ji) >= 9999.0 ) THEN
+                  IF ( zpres(jk,ji) < 9999.0 ) THEN
+                     inpfile%pdep(jk,ji) = &
+                        & p_to_dep( REAL(zpres(jk,ji),wp), REAL(inpfile%pphi(ji),wp) )
+                     inpfile%idqc(jk,ji) = ipresqc(jk,ji)
+                  ENDIF
+               ENDIF
+            END DO
+         ENDIF
+      END DO
+      
+      !---------------------------------------------------------------------
+      !  Convert depth to pressure if pressure not present
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         IF ( inpfile%pphi(ji) < 9999.0 ) THEN
+            DO jk = 1, inpfile%nlev
+               IF ( zpres(jk,ji) >= 9999.0 ) THEN
+                  IF ( inpfile%pdep(jk,ji) < 9999.0 ) THEN
+                     zpres(jk,ji) = dep_to_p( REAL(inpfile%pdep(jk,ji),wp), &
+                        &                            REAL(inpfile%pphi(ji),wp) )
+                     ipresqc(jk,ji) = inpfile%idqc(jk,ji)
+                  ENDIF
+               ENDIF
+            END DO
+         ENDIF
+      END DO
+      
+      !---------------------------------------------------------------------
+      !  Convert insitu temperature to potential temperature if
+      !  salinity, insitu temperature and pressure are present
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         DO jk = 1, inpfile%nlev
+            IF (( inpfile%pob(jk,ji,2) < 9999.0 ) .AND. &
+               &( inpfile%pext(jk,ji,1) < 9999.0 ) .AND. &
+               &( zpres(jk,ji) < 9999.0 ) ) THEN
+               inpfile%pob(jk,ji,1) = potemp( REAL(inpfile%pob(jk,ji,2), wp),  &
+                  &                           REAL(inpfile%pext(jk,ji,1), wp), &
+                  &                           REAL(zpres(jk,ji),wp),  &
+                  &                           0.0_wp )
+            ELSE
+               inpfile%pob(jk,ji,1) = fbrmdi
+            ENDIF
+         END DO
+      END DO
+
+      !---------------------------------------------------------------------
+      !  Initialize flags since they are not in the CORIOLIS input files
+      !---------------------------------------------------------------------
+
+      inpfile%ioqcf(:,:)      = 0
+      inpfile%ipqcf(:,:)      = 0
+      inpfile%itqcf(:,:)      = 0
+      inpfile%idqcf(:,:,:)    = 0
+      inpfile%ivqcf(:,:,:)    = 0
+      inpfile%ivlqcf(:,:,:,:) = 0
+
+   END SUBROUTINE read_coriofile
Index: /utils/tools_ticket2413/OBSTOOLS/src/obsseaice_io.h90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/obsseaice_io.h90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/obsseaice_io.h90	(revision 12863)
@@ -0,0 +1,270 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: obsseaice_io.h90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (./LICENSE)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE read_seaice( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_seaice **
+      !!
+      !! ** Purpose : Read from file the SEAICE observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! References : 
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      CHARACTER(LEN=12),PARAMETER :: cpname = 'read_seaice'
+      INTEGER :: i_file_id    ! netcdf IDS
+      INTEGER :: i_time_id
+      INTEGER :: i_ni_id
+      INTEGER :: i_data_id
+      INTEGER :: i_var_id
+      INTEGER :: i_data       ! Number of data per parameter in current file
+      INTEGER :: i_time       ! Number of reference times in file
+      INTEGER, DIMENSION(:), POINTER :: &
+         & i_reftime        ! Reference time in file in seconds since 1/1/1981.
+      INTEGER, DIMENSION(:,:), POINTER :: &
+         & i_dtime, &       ! Offset in seconds since reference time
+         & i_qc,    &       ! Quality control flag.
+         & i_type           ! Type of seaice measurement.            
+      REAL(wp), DIMENSION(:), POINTER :: &
+         & z_phi,   &       ! Latitudes
+         & z_lam            ! Longitudes
+      REAL(wp), DIMENSION(:,:), POINTER :: &
+         & z_seaice         ! Seaice data     
+      INTEGER, PARAMETER :: imaxdim = 2    ! Assumed maximum for no. dims. in file
+      INTEGER, DIMENSION(2) :: idims       ! Dimensions in file
+      INTEGER :: iilen          ! Length of netCDF attributes
+      INTEGER :: itype          ! Typeof netCDF attributes
+      REAL(KIND=wp) :: zsca      ! Scale factor
+      REAL(KIND=wp) :: zoff      ! Offset for data in netcdf file
+      REAL(KIND=wp) :: z_offset  ! Offset for time conversion
+      REAL(KIND=wp) :: zfill     ! Fill value in netcdf file
+      CHARACTER (len=33) ::creftime     ! Reference time of file
+      INTEGER :: i_refyear       ! Integer version of reference time
+      INTEGER :: i_refmonth
+      INTEGER :: i_refday
+      INTEGER :: i_refhour
+      INTEGER :: i_refmin
+      INTEGER :: i_refsec
+      INTEGER :: ichunk
+      INTEGER :: jtim
+      INTEGER :: jobs
+      INTEGER :: iobs
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+         &                i_file_id, chunksize=ichunk), cpname, __LINE__ )
+      
+      ! Get the netCDF dimensions
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ),  &
+         &       cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_time_id, &
+         &                              len = i_time ),  &
+         &      cpname, __LINE__ )
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'ni', i_ni_id ),  &
+         &       cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_ni_id, &
+         &                              len = i_data ),  &
+         &      cpname, __LINE__ )
+      
+      
+      ! Allocate NetCDF variables
+      
+      ALLOCATE( &
+         & i_reftime    ( i_time                 ), &
+         & i_dtime      ( i_data,i_time  ), &      
+         & i_qc         ( i_data,i_time  ), & 
+         & i_type       ( i_data,i_time  ), &     
+         & z_phi        ( i_data                 ), &   
+         & z_lam        ( i_data                 ), &  
+         & z_seaice        ( i_data,i_time  )  &
+         & )
+      
+      ! Get reference time of file which is in seconds since 1981/1/1 00:00. 
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'time', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_time
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_reftime),&
+         &       cpname, __LINE__ )
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "units") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "units",creftime), cpname,  __LINE__ )
+      ELSE
+         creftime = "seconds since 1981-01-01 00:00:00"
+      ENDIF
+      READ(creftime(15:18),*)i_refyear
+      READ(creftime(20:21),*)i_refmonth
+      READ(creftime(23:24),*)i_refday
+      READ(creftime(26:27),*)i_refhour
+      READ(creftime(29:30),*)i_refmin
+      READ(creftime(32:33),*)i_refsec
+      !Work out offset in days between reference time and 1/1/1950.
+      CALL greg2jul( i_refsec, i_refmin, i_refhour, i_refday, &
+         &           i_refmonth, i_refyear, z_offset)
+      
+      ! Get list of times for each ob in seconds relative to reference time
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'SeaIce_dtime', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_dtime),&
+         &       cpname, __LINE__ )
+      zsca = 1.0      
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "scale_factor",zsca), cpname,  __LINE__ )
+      ENDIF
+      zoff = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "add_offset") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "add_offset",zoff), cpname,  __LINE__ )
+      ENDIF
+      i_dtime(:,:) = NINT((zsca * FLOAT(i_dtime(:,:))) &
+         &                 + zoff)
+      
+      ! Get longitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'lon', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_lam),   &
+         &         cpname, __LINE__ )
+      
+      ! Get latitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'lat', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_phi),   &
+         &         cpname, __LINE__ )
+      
+      ! Get seaice data
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'sea_ice_concentration', &
+         &                         i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_seaice), &
+         &       cpname, __LINE__ )
+      zoff = 0.
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "scale_factor",zsca), cpname, __LINE__ )
+      ENDIF
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       "scale_factor",zsca), cpname, __LINE__ )
+      ENDIF
+      zfill = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "_FillValue") &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       "_FillValue",zfill), cpname, __LINE__ )
+      ENDIF
+      WHERE(z_seaice(:,:) /=  zfill)
+         z_seaice(:,:) = (zsca * z_seaice(:,:)) + zoff
+      ELSEWHERE
+         z_seaice(:,:) = fbrmdi
+      END WHERE
+      
+      ! Get QC flag
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'confidence_flag', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_qc),   &
+            &       cpname, __LINE__ )
+      
+      ! Get seaice obs type
+      
+      i_type(:,:)=1
+      
+      ! Close the file
+      
+      CALL chkerr( nf90_close( i_file_id ), cpname, __LINE__ )
+
+      ! Fill the obfbdata structure
+
+      ! Allocate obfbdata
+      
+      iobs = i_data * i_time
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid )
+      inpfile%cname(1) = 'SEAICE'
+
+      ! Fill the obfbdata structure from input data
+
+      inpfile%cdjuldref = "19500101000000"
+      iobs = 0
+      DO jtim = 1, i_time
+         DO jobs = 1, i_data
+            iobs = iobs + 1
+            ! Characters
+            WRITE(inpfile%cdwmo(iobs),'(A6,A2)') 'seaice','  '
+            WRITE(inpfile%cdtyp(iobs),'(I4)') i_type(jobs,jtim)
+            ! Real values
+            inpfile%plam(iobs)         = z_lam(jobs)
+            inpfile%pphi(iobs)         = z_phi(jobs)
+            inpfile%pob(1,iobs,1)      = z_seaice(jobs,jtim)
+            inpfile%ptim(iobs)         = &
+               & REAL(i_reftime(jtim))/(60.*60.*24.) + &
+               & z_offset + REAL(i_dtime(jobs,jtim))/(60.*60.*24.)
+            inpfile%pdep(1,iobs)       = 0.0
+            ! Integers
+            inpfile%kindex(iobs)       = iobs
+            IF ( z_seaice(jobs,jtim) == fbrmdi ) THEN
+               inpfile%ioqc(iobs)      = 4
+               inpfile%ivqc(iobs,1)    = 4 
+               inpfile%ivlqc(1,iobs,1) = 4
+            ELSE 
+               inpfile%ioqc(iobs)      = i_qc(jobs,jtim)
+               inpfile%ivqc(iobs,1)    = i_qc(jobs,jtim)
+               inpfile%ivlqc(1,iobs,1) = 1
+            ENDIF
+            inpfile%ipqc(iobs)         = 0 
+            inpfile%ipqcf(:,iobs)      = 0
+            inpfile%itqc(iobs)         = 0
+            inpfile%itqcf(:,iobs)      = 0
+            inpfile%ivqcf(:,iobs,1)    = 0
+            inpfile%ioqcf(:,iobs)      = 0
+            inpfile%idqc(1,iobs)       = 0
+            inpfile%idqcf(1,1,iobs)    = 0
+            inpfile%ivlqcf(:,1,iobs,1) = 0
+         END DO
+      END DO
+
+   END SUBROUTINE read_seaice
+
+
Index: /utils/tools_ticket2413/OBSTOOLS/src/obssla_io.h90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/obssla_io.h90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/obssla_io.h90	(revision 12863)
@@ -0,0 +1,378 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: obssla_io.h90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (./LICENSE)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE read_avisofile( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_avisofile **
+      !!
+      !! ** Purpose : Read from file the AVISO SLA observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! References : http://www.aviso.oceanobs.com
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      CHARACTER(LEN=14),PARAMETER :: cpname = 'read_avisofile'
+      INTEGER :: i_file_id     ! netcdf IDS
+      INTEGER :: i_tracks_id
+      INTEGER :: i_cycles_id
+      INTEGER :: i_data_id
+      INTEGER :: i_var_id
+      INTEGER, PARAMETER :: imaxdim = 2    ! Assumed maximum for no. dims. in file
+      INTEGER, DIMENSION(2) :: idims       ! Dimensions in file
+      INTEGER :: iilen         ! Length of netCDF attributes
+      INTEGER :: itype         ! Typeof netCDF attributes
+      REAL(fbdp) :: zsca       ! Scale factor
+      REAL(fbdp) :: zfill      ! Fill value
+      CHARACTER(len=3) ::  cmission      ! Mission global attribute
+      INTEGER :: itracks       ! Maximum number of passes in file
+      INTEGER :: icycles       ! Maximum number of cycles for each pass
+      INTEGER :: idata         ! Number of data per parameter in current file
+      REAL(fbdp) :: zdeltat    ! Time gap getween two measurements in seconds
+      INTEGER, DIMENSION(:), POINTER :: & 
+         & iptracks,     &  ! List of passes contained in current file
+         & ipnbpoints,   &  ! Number of points per pass
+         & ipdataindexes    ! Index of data in theoretical profile
+      INTEGER, DIMENSION(:,:), POINTER :: & 
+         & ipcycles         ! List of cycles per pass
+      REAL(fbdp), DIMENSION(:), POINTER :: &
+         & zphi,   &        ! Latitudes
+         & zlam             ! Longitudes
+      REAL(fbdp), DIMENSION(:,:), POINTER :: &
+         & zbegindates      ! Date of point with index 0
+      REAL(fbdp) :: zbeginmiss    ! Missing data for dates
+      REAL(fbsp), DIMENSION(:,:), POINTER :: &
+         & zsla             ! SLA data
+      REAL(fbdp), DIMENSION(:), POINTER :: &
+         & zjuld            ! Julian date
+      LOGICAL, DIMENSION(:), POINTER :: &
+         & llskip           ! Skip observation
+      CHARACTER(len=14) :: cdjuldref    ! Julian data reference
+      INTEGER :: imission   ! Mission number converted from Mission global 
+                            ! netCDF atttribute.
+      CHARACTER(len=255) :: ctmp
+      INTEGER :: iobs
+      INTEGER :: jl
+      INTEGER :: jm
+      INTEGER :: jj
+      INTEGER :: ji
+      INTEGER :: jk
+      INTEGER :: jobs
+      INTEGER :: jcycle
+
+      ! Open the file
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, i_file_id ), &
+         &         cpname, __LINE__ )
+
+      ! Get the netCDF dimensions
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'Tracks', i_tracks_id ),  &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_tracks_id, &
+         &                                 len = itracks ),  &
+         &         cpname, __LINE__ )
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'Cycles', i_cycles_id ),  &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_cycles_id, &
+         &                                 len = icycles ),  &
+         &      cpname, __LINE__ )
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'Data', i_data_id ),  &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_data_id, &
+         &                                 len = idata ),  &
+         &         cpname, __LINE__ )
+
+      ! Allocate memory for input data
+
+      ALLOCATE( &
+         & iptracks     ( itracks          ), &  
+         & ipnbpoints   ( itracks          ), &  
+         & ipcycles     ( icycles, itracks ), &
+         & zphi         ( idata            ), &   
+         & zlam         ( idata            ), &  
+         & zbegindates  ( icycles, itracks ), &
+         & ipdataindexes( idata            ), & 
+         & zsla         ( icycles, idata   ), &
+         & zjuld        ( idata*icycles    ), &
+         & llskip       ( idata*icycles    )  &
+         & )
+
+      ! Get time gap getween two measurements in seconds
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'DeltaT', i_var_id ), & 
+         &         cpname, __LINE__ )
+      CALL chkdim( i_file_id, i_var_id, 0, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zdeltat), &
+         &         cpname, __LINE__ )
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     'scale_factor',zsca), cpname,  __LINE__)
+      ENDIF
+      zdeltat = zsca * zdeltat
+         
+      ! Get List of passes contained in current file      
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'Tracks', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = itracks
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, iptracks), &
+         &         cpname, __LINE__ )
+      
+      ! Get Number of points per pass
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'NbPoints', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = itracks
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, ipnbpoints),&
+         &         cpname, __LINE__ )
+      
+      ! Get list of cycles per pass
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'Cycles', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = icycles
+      idims(2) = itracks
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, ipcycles),   &
+         &         cpname, __LINE__ )
+
+      ! Get longitudes
+
+      CALL chkerr( nf90_inq_varid( i_file_id, 'Longitudes', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = idata
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zlam),   &
+         &         cpname, __LINE__ )
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
+         &                         == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     'scale_factor',zsca), cpname,  __LINE__)
+      ENDIF
+      zlam(:) = zsca * zlam(:)
+      
+      ! Get latitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'Latitudes', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = idata
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zphi),   &
+         &         cpname, __LINE__ )
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     'scale_factor',zsca), cpname,  __LINE__)
+      ENDIF
+      zphi(:) = zsca * zphi(:)
+      
+      ! Get date of point with index 0
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'BeginDates', i_var_id ), & 
+         &        cpname, __LINE__ )
+      idims(1) = icycles
+      idims(2) = itracks
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zbegindates), &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_attribute( i_file_id, i_var_id, &
+         &                                 'units', len = iilen,  &
+         &                                  xtype = itype), cpname, __LINE__ )
+      IF (( itype /= NF90_CHAR ) .OR. ( iilen > 255 )) THEN
+         CALL fatal_error('Error decoding BeginDates unit', __LINE__ )
+      ENDIF
+      CALL chkerr( nf90_get_att( i_file_id, i_var_id, 'units', &
+         &                       ctmp ), cpname, __LINE__ )
+      jl=1
+      DO jm = 1, LEN(TRIM(ctmp))
+         IF ((ctmp(jm:jm)>='0').AND.(ctmp(jm:jm)<='9')) THEN
+            cdjuldref(jl:jl) = ctmp(jm:jm)
+            jl=jl+1
+         ENDIF
+         IF (jl>14) EXIT
+      END DO
+      CALL chkerr( nf90_inquire_attribute( i_file_id, i_var_id, '_FillValue', &
+         &                                  xtype = itype), cpname, __LINE__ )
+      IF ( itype /= NF90_DOUBLE ) THEN
+         CALL fatal_error('Error decoding BeginDates missing data', __LINE__ )
+      ENDIF
+      CALL chkerr( nf90_get_att( i_file_id, i_var_id, '_FillValue', &
+         &                       zbeginmiss ), cpname, __LINE__ )
+
+      ! Get indices of data in theoretical profile
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'DataIndexes', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = idata
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, ipdataindexes),   &
+         &       cpname, __LINE__ )
+      
+      ! Get SLA data
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'SLA', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = icycles
+      idims(2) = idata
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zsla),   &
+         &         cpname, __LINE__ )
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
+         &                        == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       'scale_factor',zsca), cpname, __LINE__ )
+      ENDIF
+      zfill = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, '_FillValue') &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     '_FillValue',zfill), cpname,  __LINE__ )
+      ENDIF
+      WHERE(zsla(:,:) /=  zfill)
+         zsla(:,:) = zsca * zsla(:,:)
+      ELSEWHERE
+         zsla(:,:) = fbrmdi
+      END WHERE
+      
+      ! Get the global Mission netCDF attribute
+      
+      cmission='   '
+      CALL chkerr( nf90_inquire_attribute( i_file_id, nf90_global, &
+         &                                 'Mission', len = iilen,  &
+         &                                 xtype = itype), cpname, __LINE__ )
+      IF (( itype /= NF90_CHAR ) .OR. ( iilen > 3 )) THEN
+         CALL fatal_error('Error decoding Mission global attribute', __LINE__ )
+      ENDIF
+      CALL chkerr( nf90_get_att( i_file_id, nf90_global, 'Mission', &
+         &                       cmission ), cpname, __LINE__ )
+      
+      ! Convert it to an integer
+      imission = 0
+      DO jm = 1, imaxmissions
+         IF (cmission==cmissions(jm)) THEN
+            imission = jm
+            EXIT
+         ENDIF
+      END DO
+      
+      ! Close the file
+      
+      CALL chkerr( nf90_close( i_file_id ), cpname, __LINE__ )
+
+      ! Compute Julian dates for all observations
+      
+      jm = 0
+      jl = 0
+      DO jj = 1, itracks
+         DO ji = 1, ipnbpoints(jj)
+            jl = jl + 1
+            DO jk = 1, icycles
+               jm = jm + 1
+               IF (zbegindates(jk,jj)==zbeginmiss) THEN
+                  llskip(jm) = .TRUE.
+                  zjuld(jm)  = fbrmdi
+               ELSE
+                  llskip(jm) = .FALSE.
+                  zjuld(jm)  = zbegindates(jk,jj) + &
+                     &         (ipdataindexes(jl) * zdeltat / 86400._wp )
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! Get rid of missing data
+
+      jm = 0
+      DO jobs = 1, idata
+         DO jcycle = 1, icycles
+            jm = jm + 1
+            IF (zsla(jcycle,jobs) == fbrmdi) llskip(jm) = .TRUE.
+         END DO
+      END DO
+      
+      ! Allocate obfbdata
+
+      iobs = COUNT( .NOT.llskip(:) )
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid )
+      inpfile%cname(1) = 'SLA'
+
+      ! Fill the obfbdata structure from input data
+
+      inpfile%cdjuldref = cdjuldref
+      iobs = 0
+      jm = 0
+      DO jobs = 1, idata
+         DO jcycle = 1, icycles
+            jm = jm + 1
+            IF (llskip(jm)) CYCLE
+            iobs = iobs + 1
+            ! Characters
+            WRITE(inpfile%cdwmo(iobs),'(A3,A5)') cmissions(imission), '     '
+            WRITE(inpfile%cdtyp(iobs),'(I4)') imission
+            ! Real values
+            inpfile%plam(iobs)         = zlam(jobs)
+            inpfile%pphi(iobs)         = zphi(jobs)
+            inpfile%pob(1,iobs,1)      = zsla(jcycle,jobs)
+            inpfile%ptim(iobs)         = zjuld(jm)
+            inpfile%pdep(1,iobs)       = 0.0
+            ! Integers
+            inpfile%kindex(iobs)       = iobs
+            inpfile%ioqc(iobs)      = 1
+            inpfile%ivqc(iobs,1)    = 1
+            inpfile%ivlqc(1,iobs,1) = 1
+            inpfile%ipqc(iobs)         = 0 
+            inpfile%ipqcf(:,iobs)      = 0
+            inpfile%itqc(iobs)         = 0
+            inpfile%itqcf(:,iobs)      = 0
+            inpfile%ivqcf(:,iobs,1)    = 0
+            inpfile%ioqcf(:,iobs)      = 0
+            inpfile%idqc(1,iobs)       = 0
+            inpfile%idqcf(1,1,iobs)    = 0
+            inpfile%ivlqcf(:,1,iobs,1) = 0
+         END DO
+      END DO
+
+
+      ! Deallocate memory for input data
+
+      DEALLOCATE( &
+         & iptracks,      &
+         & ipnbpoints,    &
+         & ipcycles,      &
+         & zphi,          &
+         & zlam,          &  
+         & zbegindates,   &
+         & ipdataindexes, &
+         & zsla,          &
+         & zjuld,         &
+         & llskip         &
+         & )
+
+   END SUBROUTINE read_avisofile
+
Index: /utils/tools_ticket2413/OBSTOOLS/src/obssla_types.h90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/obssla_types.h90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/obssla_types.h90	(revision 12863)
@@ -0,0 +1,9 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: obssla_types.h90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (./LICENSE)
+   !!----------------------------------------------------------------------
+
+   INTEGER, PARAMETER :: imaxmissions=8
+   CHARACTER(len=3) :: cmissions(0:imaxmissions) = &
+      & (/ 'XXX', 'E1 ', 'E2 ', 'TP ', 'TPM', 'G2 ', 'J1 ', 'EN ', 'J2 ' /)
Index: /utils/tools_ticket2413/OBSTOOLS/src/obssst_io.h90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/obssst_io.h90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/obssst_io.h90	(revision 12863)
@@ -0,0 +1,286 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: obssst_io.h90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (./LICENSE)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE read_ghrsst( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_ghrsst **
+      !!
+      !! ** Purpose : Read from file the GHRSST observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! References : 
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      CHARACTER(LEN=12),PARAMETER :: cpname = 'read_ghrsst'
+      INTEGER :: i_file_id        ! netcdf IDS
+      INTEGER :: i_time_id
+      INTEGER :: i_ni_id
+      INTEGER :: i_data_id
+      INTEGER :: i_var_id
+      INTEGER :: i_data           ! Number of data per parameter in current file
+      INTEGER :: i_time           ! Number of reference times in file
+      INTEGER, DIMENSION(:), POINTER :: &
+         & i_reftime        ! Reference time in file in seconds since 1/1/1981.
+      INTEGER, DIMENSION(:,:), POINTER :: &
+         & i_dtime, &       ! Offset in seconds since reference time
+         & i_qc,    &       ! Quality control flag.
+         & i_type           ! Type of SST measurement.            
+      REAL(wp), DIMENSION(:), POINTER :: &
+         & z_phi,   &       ! Latitudes
+         & z_lam            ! Longitudes
+      REAL(wp), DIMENSION(:,:), POINTER :: &
+         & z_sst            ! SST data     
+      INTEGER, PARAMETER :: imaxdim = 2      ! Assumed maximum for no. dims. in file
+      INTEGER, DIMENSION(2) :: idims         ! Dimensions in file
+      INTEGER :: iilen            ! Length of netCDF attributes
+      INTEGER :: itype            ! Typeof netCDF attributes
+      REAL(KIND=wp) :: zsca           ! Scale factor
+      REAL(KIND=wp) :: zoff           ! Offset for data in netcdf file
+      REAL(KIND=wp) :: z_offset       ! Offset for time conversion
+      REAL(KIND=wp) :: zfill          ! Fill value in netcdf file
+      CHARACTER (len=33) :: creftime  ! Reference time of file
+      INTEGER :: i_refyear            ! Integer version of reference time
+      INTEGER :: i_refmonth
+      INTEGER :: i_refday
+      INTEGER :: i_refhour
+      INTEGER :: i_refmin
+      INTEGER :: i_refsec
+      INTEGER :: ichunk
+      INTEGER :: jtim
+      INTEGER :: jobs
+      INTEGER :: iobs
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+         &                i_file_id, chunksize=ichunk), cpname, __LINE__ )
+      
+      ! Get the netCDF dimensions
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ),  &
+         &       cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_time_id, &
+         &                              len = i_time ),  &
+         &      cpname, __LINE__ )
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'ni', i_ni_id ),  &
+         &       cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_ni_id, &
+         &                              len = i_data ),  &
+         &      cpname, __LINE__ )
+      
+      
+      ! Allocate NetCDF variables
+      
+      ALLOCATE( &
+         & i_reftime    ( i_time                 ), &
+         & i_dtime      ( i_data,i_time  ), &      
+         & i_qc         ( i_data,i_time  ), & 
+         & i_type       ( i_data,i_time  ), &     
+         & z_phi        ( i_data                 ), &   
+         & z_lam        ( i_data                 ), &  
+         & z_sst        ( i_data,i_time  )  &
+         & )
+      
+      ! Get reference time of file which is in seconds since 1981/1/1 00:00. 
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'time', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_time
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_reftime),&
+         &       cpname, __LINE__ )
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "units") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "units",creftime), cpname,  __LINE__ )
+      ELSE
+         creftime = "seconds since 1981-01-01 00:00:00"
+      ENDIF
+      READ(creftime(15:18),*)i_refyear
+      READ(creftime(20:21),*)i_refmonth
+      READ(creftime(23:24),*)i_refday
+      READ(creftime(26:27),*)i_refhour
+      READ(creftime(29:30),*)i_refmin
+      READ(creftime(32:33),*)i_refsec
+      !Work out offset in days between reference time and 1/1/1950.
+      CALL greg2jul( i_refsec, i_refmin, i_refhour, i_refday, &
+         &           i_refmonth, i_refyear, z_offset)
+      
+      ! Get list of times for each ob in seconds relative to reference time
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'sst_dtime', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_dtime),&
+         &       cpname, __LINE__ )
+      zsca = 1.0      
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "scale_factor",zsca), cpname,  __LINE__ )
+      ENDIF
+      zoff = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "add_offset") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "add_offset",zoff), cpname,  __LINE__ )
+      ENDIF
+      i_dtime(:,:) = NINT((zsca * FLOAT(i_dtime(:,:))) &
+         &                 + zoff)
+      
+      ! Get longitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'lon', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_lam),   &
+         &         cpname, __LINE__ )
+      
+      ! Get latitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'lat', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_phi),   &
+         &         cpname, __LINE__ )
+      
+      ! Get SST data
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'sea_surface_temperature', &
+         &                         i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_sst), &
+         &       cpname, __LINE__ )
+      zoff = 0.
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "scale_factor",zsca), cpname, __LINE__ )
+      ENDIF
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       "scale_factor",zsca), cpname, __LINE__ )
+      ENDIF
+      zfill = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "_FillValue") &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       "_FillValue",zfill), cpname, __LINE__ )
+      ENDIF
+      WHERE(z_sst(:,:) /=  zfill)
+         z_sst(:,:) = (zsca * z_sst(:,:)) + zoff
+      ELSEWHERE
+         z_sst(:,:) = fbrmdi
+      END WHERE
+      
+      ! Get QC flag
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'confidence_flag', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_qc),   &
+            &       cpname, __LINE__ )
+      
+      ! Get SST obs type
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'data_source', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_type),   &
+         &       cpname, __LINE__ )
+      
+      ! Close the file
+      
+      CALL chkerr( nf90_close( i_file_id ), cpname, __LINE__ )
+
+      ! Fill the obfbdata structure
+
+      ! Allocate obfbdata
+      
+      iobs = i_data * i_time
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid )
+      inpfile%cname(1) = 'SST'
+
+      ! Fill the obfbdata structure from input data
+
+      inpfile%cdjuldref = "19500101000000"
+      iobs = 0
+      DO jtim = 1, i_time
+         DO jobs = 1, i_data
+            iobs = iobs + 1
+            ! Characters
+            WRITE(inpfile%cdwmo(iobs),'(A6,A2)') 'ghrsst','  '
+            WRITE(inpfile%cdtyp(iobs),'(I4)') i_type(jobs,jtim)
+            ! Real values
+            inpfile%plam(iobs)         = z_lam(jobs)
+            inpfile%pphi(iobs)         = z_phi(jobs)
+            inpfile%pob(1,iobs,1)      = z_sst(jobs,jtim)
+            inpfile%ptim(iobs)         = &
+               & REAL(i_reftime(jtim))/(60.*60.*24.) + &
+               & z_offset + REAL(i_dtime(jobs,jtim))/(60.*60.*24.)
+            inpfile%pdep(1,iobs)       = 0.0
+            ! Integers
+            inpfile%kindex(iobs)       = iobs
+            IF ( z_sst(jobs,jtim) == fbrmdi ) THEN
+               inpfile%ioqc(iobs)      = 4
+               inpfile%ivqc(iobs,1)    = 4 
+               inpfile%ivlqc(1,iobs,1) = 4
+            ELSE 
+               inpfile%ioqc(iobs)      = i_qc(jobs,jtim)
+               inpfile%ivqc(iobs,1)    = i_qc(jobs,jtim)
+               inpfile%ivlqc(1,iobs,1) = 1
+            ENDIF
+            inpfile%ipqc(iobs)         = 0 
+            inpfile%ipqcf(:,iobs)      = 0
+            inpfile%itqc(iobs)         = 0
+            inpfile%itqcf(:,iobs)      = 0
+            inpfile%ivqcf(:,iobs,1)    = 0
+            inpfile%ioqcf(:,iobs)      = 0
+            inpfile%idqc(1,iobs)       = 0
+            inpfile%idqcf(1,1,iobs)    = 0
+            inpfile%ivlqcf(:,1,iobs,1) = 0
+         END DO
+      END DO
+
+      DEALLOCATE( &
+         & i_reftime, &
+         & i_dtime,   &
+         & i_qc,      &
+         & i_type,    &
+         & z_phi,     &
+         & z_lam,     &
+         & z_sst      &
+         & )
+
+   END SUBROUTINE read_ghrsst
+
+
Index: /utils/tools_ticket2413/OBSTOOLS/src/obsvel_io.h90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/obsvel_io.h90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/obsvel_io.h90	(revision 12863)
@@ -0,0 +1,360 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: obsvel_io.h90 2287 2010-10-18 07:53:52Z smasson $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE read_taondbc( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_enactfile **
+      !!
+      !! ** Purpose : Read from file the TAO data fro NDBC.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! ** Reference : http://tao.noaa.gov/tao/data_deliv/deliv_ndbc.shtml
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original version.
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      INTEGER :: iobs                ! Number of observations
+      INTEGER :: ilev                ! Number of levels
+      INTEGER :: ilat                ! Number of latitudes
+      INTEGER :: ilon                ! Number of longtudes
+      INTEGER :: itim                ! Number of obs. times
+      INTEGER :: i_file_id
+      INTEGER :: i_dimid_id
+      INTEGER :: i_phi_id
+      INTEGER :: i_lam_id
+      INTEGER :: i_depth_id
+      INTEGER :: i_var_id
+      INTEGER :: i_time_id
+      INTEGER :: i_time2_id
+      INTEGER :: i_qc_var_id
+      CHARACTER(LEN=40) :: cl_fld_lam
+      CHARACTER(LEN=40) :: cl_fld_phi
+      CHARACTER(LEN=40) :: cl_fld_depth
+      CHARACTER(LEN=40) :: cl_fld_var_u
+      CHARACTER(LEN=40) :: cl_fld_var_v
+      CHARACTER(LEN=40) :: cl_fld_var_qc_uv1
+      CHARACTER(LEN=40) :: cl_fld_var_qc_uv2
+      CHARACTER(LEN=40) :: cl_fld_time
+      CHARACTER(LEN=40) :: cl_fld_time2
+      INTEGER :: ja
+      INTEGER :: jo
+      INTEGER :: jk
+      INTEGER :: jt
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: &
+         & zv,     &
+         & zu,     &
+         & zuv1qc, &
+         & zuv2qc
+      REAL(wp), ALLOCATABLE, DIMENSION(:) :: &
+         & zdep, &
+         & zlat, &
+         & zlon, &
+         & zjuld
+      REAL(wp) :: zl
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: &
+         & itime, &
+         & itime2
+      CHARACTER(LEN=50) :: cdjulref
+      CHARACTER(LEN=12), PARAMETER :: cl_name = 'read_taondbc'
+      CHARACTER(len=1) :: cns, cew
+
+      !-----------------------------------------------------------------------
+      ! Initialization
+      !-----------------------------------------------------------------------
+      cl_fld_lam                 = 'lon'
+      cl_fld_phi                 = 'lat'
+      cl_fld_depth               = 'depth'
+      cl_fld_time                = 'time'
+      cl_fld_time2               = 'time2'
+
+      !-----------------------------------------------------------------------
+      ! Open file
+      !-----------------------------------------------------------------------
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+            &      i_file_id ),           cl_name, __LINE__ )
+
+      !-----------------------------------------------------------------------
+      ! Read the heading of the file
+      !-----------------------------------------------------------------------
+      IF(ldwp) WRITE(kunit,*)
+      IF(ldwp) WRITE(kunit,*) ' read_taondbc :' 
+      IF(ldwp) WRITE(kunit,*) ' ~~~~~~~~~~~~'
+      
+      !---------------------------------------------------------------------
+      ! Read the number of observations and of levels to allocate array
+      !---------------------------------------------------------------------
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'time', i_dimid_id ),        &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = itim ),    &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'depth', i_dimid_id ),       &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = ilev ),    &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'lat', i_dimid_id ),           &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = ilat ),    &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'lon', i_dimid_id ),         &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = ilon ),    &
+         &         cl_name, __LINE__ ) 
+
+      iobs = itim * ilat * ilon
+      IF(ldwp)WRITE(kunit,*) '         No. of data records = ', iobs
+      IF(ldwp)WRITE(kunit,*) '         No. of levels       = ', ilev
+      IF(ldwp)WRITE(kunit,*) 
+
+      !---------------------------------------------------------------------
+      ! Allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 2, iobs, ilev, 0, 0, ldgrid )
+      inpfile%cname(1) = 'UVEL'
+      inpfile%cname(2) = 'VVEL'
+      inpfile%coblong(1) = 'Zonal current'
+      inpfile%coblong(2) = 'Meridional current'
+      inpfile%cobunit(1) = 'Meters per second'
+      inpfile%cobunit(2) = 'Meters per second'
+
+      ALLOCATE( &
+         & zu(ilon,ilat,ilev,itim),     &
+         & zv(ilon,ilat,ilev,itim),     &
+         & zdep(ilev),                  &
+         & zuv1qc(ilon,ilat,ilev,itim), &
+         & zuv2qc(ilon,ilat,ilev,itim), &
+         & itime(itim),                 &
+         & itime2(itim),                &
+         & zlat(ilat),                  &
+         & zlon(ilon),                  &
+         & zjuld(itim)                  &
+         & )
+
+      !---------------------------------------------------------------------
+      ! Read the time/position variables 
+      !---------------------------------------------------------------------
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_time, i_time_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_time_id, itime ),                                     &
+         &         cl_name, __LINE__ )
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_time2, i_time2_id ),                             &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_time2_id, itime2 ),                                   &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_depth, i_depth_id ),                             &
+            &         cl_name, __LINE__ )         
+      CALL chkerr( nf90_get_var  ( i_file_id, i_depth_id, zdep ),                                     &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_phi, i_phi_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_phi_id, zlat ),                                       &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_lam, i_lam_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_lam_id, zlon ),                                       &
+         &         cl_name, __LINE__ )
+      
+      !---------------------------------------------------------------------
+      ! Read the variables
+      !---------------------------------------------------------------------
+
+      ! ADCP format assumed
+      cl_fld_var_u = 'u_1205'
+      IF ( nf90_inq_varid( i_file_id, cl_fld_var_u, i_var_id ) /= nf90_noerr ) THEN
+         ! Try again with current meter format
+         cl_fld_var_u = 'U_320'
+         IF ( nf90_inq_varid( i_file_id, cl_fld_var_u, i_var_id ) /= nf90_noerr ) THEN
+            CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
+         ENDIF
+      ENDIF
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zu ),                                         &
+         &         cl_name, __LINE__ )
+      
+      ! ADCP format assumed
+      cl_fld_var_v = 'v_1206'
+      IF ( nf90_inq_varid( i_file_id, cl_fld_var_v, i_var_id ) /= nf90_noerr ) THEN
+         ! Try again with current meter format
+         cl_fld_var_v = 'V_321'
+         IF ( nf90_inq_varid( i_file_id, cl_fld_var_v, i_var_id ) /= nf90_noerr ) THEN
+            CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
+         ENDIF
+      ENDIF
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zv ),                                         &
+         &         cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Read the QC attributes
+      !---------------------------------------------------------------------
+      
+      ! ADCP format assumed
+      cl_fld_var_qc_uv1 = 'QU_5205'
+      IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv1, i_qc_var_id ) /= nf90_noerr ) THEN
+         ! Try again with current meter format
+         cl_fld_var_qc_uv1 = 'QCS_5300'
+         IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv1, i_qc_var_id ) /= nf90_noerr ) THEN
+            ! Try again with high freq. current meter format
+            cl_fld_var_qc_uv1 = 'QCU_5320'
+            IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv1, i_qc_var_id ) /= nf90_noerr ) THEN
+               CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
+            ENDIF
+         ENDIF
+      ENDIF
+      CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, zuv1qc),                                   &
+         &         cl_name, __LINE__ )
+
+      ! ADCP format assumed
+      cl_fld_var_qc_uv2 = 'QV_5206'
+      IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv2, i_qc_var_id ) /= nf90_noerr ) THEN
+         ! Try again with current meter format
+         cl_fld_var_qc_uv2 = 'QCD_5310'
+         IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv2, i_qc_var_id ) /= nf90_noerr ) THEN
+            ! Try again with high freq. current meter format
+            cl_fld_var_qc_uv2 = 'QCV_5321'
+            IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv2, i_qc_var_id ) /= nf90_noerr ) THEN
+               CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
+            ENDIF
+         ENDIF
+      ENDIF
+      CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, zuv2qc),                                   &
+         &         cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Close file
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_close( i_file_id ),           cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Convert to to 19500101 based Julian date
+      !---------------------------------------------------------------------
+      DO jt = 1, itim
+         zjuld(jt) = REAL(itime(jt),wp) + REAL(itime2(jt),wp)/86400000.0_wp &
+            &           - 2433283.0_wp
+      END DO
+      inpfile%cdjuldref = '19500101000000'
+
+      !---------------------------------------------------------------------
+      ! Copy info to obfbdata structure
+      !---------------------------------------------------------------------
+
+      iobs = 0
+      DO jt = 1, itim
+         DO ja = 1, ilat
+            DO jo = 1, ilon
+               iobs = iobs + 1
+               zl = zlon(jo)
+               IF ( zl > 180.0_wp ) zl = zl - 360.0_wp
+               IF ( zl < 0 ) THEN
+                  cew = 'w'
+               ELSE
+                  cew = 'e'
+               ENDIF
+               IF ( zlat(jo) < 0 ) THEN
+                  cns = 's'
+               ELSE
+                  cns = 'n'
+               ENDIF
+               WRITE(inpfile%cdwmo(iobs),'(A1,I2.2,A1,I3.3)') &
+                  & cns, ABS(NINT(zlat(ja))), cew, ABS(NINT(zl))
+               DO jk = 1, ilev
+                  inpfile%pob(jk,iobs,1)     = zu(jo,ja,jk,jt)
+                  inpfile%pob(jk,iobs,2)     = zv(jo,ja,jk,jt)
+                  inpfile%pdep(jk,iobs)      = zdep(jk)
+                  inpfile%ivlqc(jk,iobs,1:2) = INT( MAX( zuv1qc(jo,ja,jk,jt), zuv2qc(jo,ja,jk,jt) ) )
+               END DO
+               inpfile%plam(iobs) = zlon(jo)
+               inpfile%pphi(iobs) = zlat(ja)
+               inpfile%ptim(iobs) = zjuld(jt)
+            END DO
+         END DO
+      END DO
+
+      ! No position, time, depth and variable QC in input files
+      DO jo = 1, iobs
+         inpfile%ipqc(jo) = 1
+         inpfile%itqc(jo) = 1
+         inpfile%ivqc(jo,1:2) = 1
+         DO jk = 1, ilev
+            inpfile%idqc(jk,jo) = 1
+         END DO
+      END DO
+
+      !---------------------------------------------------------------------
+      ! Set the platform information
+      !---------------------------------------------------------------------
+      inpfile%cdtyp(:)=' 820'
+
+      !---------------------------------------------------------------------
+      ! Set QC flags for missing data and rescale to m/s
+      !---------------------------------------------------------------------
+
+      DO jo = 1, iobs
+         DO jk = 1, ilev
+            IF ( ( ABS(inpfile%pob(jk,jo,1)) > 10000.0_wp ) .OR. &
+               & ( ABS(inpfile%pob(jk,jo,2)) > 10000.0_wp ) ) THEN
+               inpfile%ivlqc(jk,jo,:) = 4
+               inpfile%pob(jk,jo,1) = fbrmdi
+               inpfile%pob(jk,jo,2) = fbrmdi
+            ELSE
+               inpfile%pob(jk,jo,1) = 0.01 * inpfile%pob(jk,jo,1)
+               inpfile%pob(jk,jo,2) = 0.01 * inpfile%pob(jk,jo,2)
+            ENDIF
+         END DO
+      END DO
+
+      !---------------------------------------------------------------------
+      ! Set file indexes
+      !---------------------------------------------------------------------
+
+      DO jo = 1, inpfile%nobs
+         inpfile%kindex(jo) = jo
+      END DO
+
+      !---------------------------------------------------------------------
+      ! Initialize flags since they are not in the TAO input files
+      !---------------------------------------------------------------------
+
+      inpfile%ioqcf(:,:)      = 0
+      inpfile%ipqcf(:,:)      = 0
+      inpfile%itqcf(:,:)      = 0
+      inpfile%idqcf(:,:,:)    = 0
+      inpfile%ivqcf(:,:,:)    = 0
+      inpfile%ivlqcf(:,:,:,:) = 0
+
+      !---------------------------------------------------------------------
+      ! Deallocate data
+      !---------------------------------------------------------------------
+      DEALLOCATE( &
+         & zu,     &
+         & zv,     &
+         & zdep,   &
+         & zuv1qc, &
+         & zuv2qc, &
+         & itime,  &
+         & itime2, &
+         & zlat,   &
+         & zlon,   &
+         & zjuld   &
+         & )
+
+   END SUBROUTINE read_taondbc
Index: /utils/tools_ticket2413/OBSTOOLS/src/omonainfo.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/omonainfo.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/omonainfo.F90	(revision 12863)
@@ -0,0 +1,1283 @@
+#define __MYFILE__ 'omonainfo.F90'
+MODULE omonainfo
+   
+   ! Specific utilities for omona files
+   ! 
+   ! History
+   ! Original: Magdalena A. Balmaseda
+   !           2010: Split as to remove "scale factor information", 
+   !           which is now in auxgrid
+   !
+   
+   
+   USE netcdf
+   USE nctools
+   USE ioncdf
+   USE coords
+!   USE orcagrid
+
+   CHARACTER(len=4)    :: cl_expnam  
+   CHARACTER(len=8)    :: cl_date
+   CHARACTER(len=80)   :: cl_filename_out
+   CHARACTER(len=80)   :: cl_filename2_out 
+   CHARACTER(len=3)    :: cl_code
+   CHARACTER(len=1)    :: cl_grid
+   CHARACTER(len=80)   :: cl_var,cl_var_out
+   CHARACTER(len=80)   :: cl_varname1, cl_varname2, cl_varunit1, cl_varunit2
+   CHARACTER(len=1)    :: sec !o =box average omona
+                              !x =zonal section. Integral along x
+                              !y =meridional section. Integral along y
+
+   CHARACTER(len=1)    :: grid0='?'
+   
+   INTEGER ::  i_nb_dims,i_dp
+   INTEGER ::  i_fill
+   REAL, DIMENSION(:,:),     ALLOCATABLE :: z_var_2d
+   REAL, DIMENSION(:,:,:),   ALLOCATABLE :: z_var_3d
+   REAL, DIMENSION(:),       ALLOCATABLE :: z_dep2
+
+   PUBLIC  :: variable_att, write_omona_netcdf, &
+      &       write_dep_netcdf, create_time_series_netcdf_file
+
+   
+   INTERFACE write_omona_netcdf
+      MODULE PROCEDURE write_omona_netcdf_2d_r, write_omona_netcdf_3d_r
+   END INTERFACE
+   
+CONTAINS
+
+   !
+   !----------------------------------------------------------------------
+   !
+   ! W R I T E _ O M O N A _ N E T C D F
+   !
+   !----------------------------------------------------------------------
+   !
+   SUBROUTINE write_omona_netcdf_2d_r (cl_filename, z_field,i_time, &
+      cl_boxes, z_missing,i_fill)
+      !
+      ! write a 2d array (time_serie) of reals
+      !
+      IMPLICIT NONE
+      !
+      CHARACTER(len=80), INTENT(in)                :: cl_filename
+      INTEGER, DIMENSION(:), INTENT(in)            :: i_time
+      INTEGER, INTENT(inout)                       :: i_fill
+      REAL, DIMENSION(:,:), INTENT(in)             :: z_field
+      REAL, INTENT(in)                             :: z_missing
+      CHARACTER(len=20), DIMENSION(:), INTENT(in)  :: cl_boxes
+      
+      !
+      LOGICAL               :: clbon
+      INTEGER               :: i_var_exist, i_pos
+      INTEGER               :: i_file_id, i_var_id
+      INTEGER               :: i_nb_files,i_z, i_b
+      INTEGER               :: i_tim_id,i_box_id
+      INTEGER               :: i_time_var
+      INTEGER               :: i_file
+      INTEGER, DIMENSION(2) :: i_dim, i_tab_start, i_tab_count
+      INTEGER               :: i_rest_start, i_rest_end
+      INTEGER               :: i_time0, i_time1
+      REAL                  :: z_min, z_max
+      REAL                  :: z_min_old, z_max_old
+      INTEGER, DIMENSION(:), ALLOCATABLE :: i_time_old
+      INTEGER, DIMENSION(:), ALLOCATABLE :: i_time_rest
+      INTEGER               :: i_t
+      REAL, DIMENSION(:,:), ALLOCATABLE :: z_old_2d
+      !
+      i_tab_start(1) = 1
+      i_z=1
+      i_b=SIZE(z_field,1)
+      i_nb_files = SIZE(z_field,2)
+      i_tab_count(1) = i_b
+      i_tab_count(2) = i_nb_files
+      i_rest_start = 0
+      i_rest_end   = 0
+      i_time0      = 0
+      i_time1      = 0
+      
+      WRITE(6,*)' Input time dimensions ',i_nb_files
+      WRITE(6,*)' file for output       ',cl_filename
+      !
+      z_min = MINVAL(z_field, mask = z_field .NE. z_missing )
+      z_max = MAXVAL(z_field, mask = z_field .NE. z_missing )
+      !
+      
+      INQUIRE( FILE=cl_filename_out, EXIST=clbon )
+      WRITE(*,*)' Inquiring clbon ',clbon
+      IF ( .NOT. clbon ) THEN
+         CALL create_time_series_netcdf_file ( cl_filename, cl_boxes)
+      ELSE
+         WRITE(*,*)' Time series file already exists'
+      ENDIF
+      !     
+      WRITE(*,*)' opening file ',cl_filename
+      CALL nchdlerr( nf90_open( cl_filename, nf90_write, i_file_id ) ,__LINE__,__MYFILE__)
+      !
+      
+      WRITE(*,*)' Inquiring var ',cl_var_out
+      i_var_exist = nf90_inq_varid( i_file_id, cl_var_out, i_var_id ) 
+      WRITE(*,*)' i_var_exist ',i_var_exist, i_var_id
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_tim_id ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_inq_dimid( i_file_id, 'box', i_box_id ) ,__LINE__,__MYFILE__)
+         i_dim(1) = i_box_id
+         i_dim(2) = i_tim_id
+         !         write(*,*)' i_dim ',i_dim
+         !
+         CALL nchdlerr( nf90_redef(i_file_id) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var(i_file_id, cl_var_out, nf90_real, i_dim, i_var_id ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', cl_varname1 ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', cl_varname2 ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units',cl_varunit1 ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'unit_long',cl_varunit2 ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'missing_value', z_missing ) ,__LINE__,__MYFILE__)
+         WRITE(*,*)'nf_put valid_min ',z_min
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,__LINE__,__MYFILE__)
+         WRITE(*,*)'nf_put valid_max ',z_max
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,__LINE__,__MYFILE__)
+         
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,__LINE__,__MYFILE__)
+         
+         CALL nchdlerr( nf90_inq_varid( i_file_id, 'time', i_time_var ) ,__LINE__,__MYFILE__)
+         i_pos = 1 
+         i_tab_start(2)=1
+      ELSE
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_min', z_min_old ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_max', z_max_old ) ,__LINE__,__MYFILE__)
+         z_min = MIN( z_min, z_min_old )
+         z_max = MAX( z_max, z_max_old )
+         CALL nchdlerr( nf90_redef( i_file_id ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,__LINE__,__MYFILE__)
+         
+         CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_tim_id ) ,__LINE__,__MYFILE__)
+ 
+         CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_tim_id,len=i_pos ) ,__LINE__,__MYFILE__)
+         ALLOCATE(i_time_old(i_pos))
+         
+         CALL nchdlerr( nf90_inq_varid( i_file_id, 'time', i_time_var ) ,__LINE__,__MYFILE__)
+         
+         CALL nchdlerr( nf90_get_var( i_file_id, i_time_var, i_time_old ) ,__LINE__,__MYFILE__)
+         i_tab_start(2)=i_pos+1
+         DO i_t=i_pos,1,-1
+            IF(i_time_old(i_t).GE.i_time(1)) THEN
+               i_tab_start(2)=i_t
+            ELSE
+               EXIT
+            ENDIF
+         ENDDO
+         WRITE(*,*)' i_tab_start(2)',i_tab_start(2)
+
+         IF (I_FILL == 1 ) THEN
+           DO i_t=1,i_tab_start(2),1
+             IF(i_time_old(i_t).LT.i_time(1)) THEN
+                i_time0=i_t+1
+             ELSE
+                EXIT
+             ENDIF
+          ENDDO
+          WRITE(*,*)' i_tab_start(2), i_time0',i_tab_start(2),i_time0
+          i_time0=min(i_time0,i_tab_start(2))
+          i_tab_start(2)=i_time0
+          i_time1=i_tab_start(2)+i_tab_count(2)-1
+          WRITE(*,*)' Starting at time ',i_time_old(i_tab_start(2)-1),i_time(1)
+          i_rest_start=i_time1+1
+          i_rest_end = i_pos
+          IF ( i_rest_end .gt. i_rest_start ) THEN
+            ALLOCATE( z_old_2d(i_b, i_pos))
+            CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, z_old_2d ) ,__LINE__,__MYFILE__)
+            z_old_2d(:,i_time0:i_time1)=z_field
+            i_time_old(i_time0:i_time1)=i_time
+            i_tab_start(2)=1
+            i_tab_count(2)=i_pos
+            WRITE(*,*)' writing output I_FILL i_time0 ',i_time0
+            WRITE(*,*)' writing output I_FILL i_time1 ',i_time1
+            CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, &
+            & z_old_2d, start=i_tab_start, count=i_tab_count),__LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_var( i_file_id, i_time_var, &
+         & i_time_old,start=(/i_tab_start(2)/), count=(/i_tab_count(2)/)),__LINE__,__MYFILE__)
+          ELSE
+            I_FILL = 0
+            DEALLOCATE(i_time_old)
+            DEALLOCATE(i_time_rest)
+            DEALLOCATE(z_old_2d)
+          ENDIF
+         ELSE
+         WRITE(*,*)' Starting at time ',i_time_old(i_tab_start(2)-1),i_time(1)
+         DEALLOCATE(i_time_old)
+         ENDIF
+      ENDIF
+      !
+      IF ( I_FILL == 0 ) THEN
+         WRITE(*,*)' writing output start ',i_tab_start
+	 WRITE(*,*)' writing output count ',i_tab_count
+         CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, &
+         & z_field, start=i_tab_start, count=i_tab_count),__LINE__,__MYFILE__)
+
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_var, &
+         & i_time,start=(/i_tab_start(2)/), count=(/i_tab_count(2)/)),__LINE__,__MYFILE__)
+      ENDIF
+
+      !
+      
+      CALL nchdlerr( nf90_close( i_file_id ) ,__LINE__,__MYFILE__)
+      !
+      RETURN
+      !
+   END SUBROUTINE write_omona_netcdf_2d_r
+   !
+   !----------------------------------------------------------------------
+   !
+   SUBROUTINE write_omona_netcdf_3d_r (cl_filename, z_field,i_time, &
+                                       cl_boxes, z_missing, i_fill)
+!
+! write a 3d array (time_serie) of reals
+!
+      IMPLICIT NONE
+!
+      CHARACTER(len=80), INTENT(in)                :: cl_filename 
+      INTEGER, DIMENSION(:), INTENT(in)            :: i_time
+      INTEGER, INTENT(inout)                       :: i_fill
+      REAL, DIMENSION(:,:,:), INTENT(in)           :: z_field
+      REAL, INTENT(in)                             :: z_missing
+      CHARACTER(len=20), DIMENSION(:), INTENT(in)  :: cl_boxes
+
+!
+      LOGICAL               :: clbon
+      INTEGER               :: i_var_exist, i_pos
+      INTEGER               :: i_file_id, i_var_id
+      INTEGER               :: i_nb_files,i_z,i_b
+      INTEGER               :: i_tim_id,i_box_id,i_z_id
+      INTEGER               :: i_time_var
+      INTEGER               :: i_file
+      INTEGER, DIMENSION(3) :: i_dim, i_tab_start, i_tab_count
+      INTEGER               :: i_rest_start, i_rest_end
+      INTEGER               :: i_time0, i_time1
+      REAL                  :: z_min, z_max
+      REAL                  :: z_min_old, z_max_old
+      INTEGER, DIMENSION(:), ALLOCATABLE :: i_time_old
+      INTEGER, DIMENSION(:), ALLOCATABLE :: i_time_rest
+      INTEGER               :: i_t
+      REAL, DIMENSION(:,:,:), ALLOCATABLE :: z_old_3d
+!
+      i_tab_start(1) = 1
+      i_tab_start(2) = 1
+      i_tab_start(3) = 1
+      i_z=SIZE(z_field,1)   !depth
+      i_b=SIZE(z_field,2)   !nbox
+      i_nb_files = SIZE(z_field,3)
+      i_tab_count(1) = i_z
+      i_tab_count(2) = i_b
+      i_tab_count(3) = i_nb_files
+      i_time0        = 0
+      i_time1        = 0
+      i_rest_start   = 0
+      i_rest_end     = 0
+
+!      write(6,*)' in write_3d ,shape(z_field) ',shape(z_field)
+!      write(6,*)' i_z =',i_z
+!      write(6,*)' i_b =',i_b
+!      write(6,*)' i_nb_files =',i_nb_files
+
+
+!
+      z_min = MINVAL(z_field, mask = z_field .NE. z_missing )
+      z_max = MAXVAL(z_field, mask = z_field .NE. z_missing )
+!
+      INQUIRE( FILE=cl_filename, EXIST=clbon )
+      IF ( .NOT. clbon ) THEN
+         CALL create_time_series_netcdf_file ( cl_filename, cl_boxes)
+      ELSE
+         WRITE(*,*)' Time series file already exists'
+      ENDIF
+!     
+      WRITE(*,*)' opening file ',cl_filename
+      CALL nchdlerr( nf90_open( cl_filename, nf90_write, i_file_id ) ,__LINE__,__MYFILE__)
+!
+      WRITE(*,*)'Inquiring var ',cl_var_out, i_var_id
+      i_var_exist = nf90_inq_varid( i_file_id, cl_var_out, i_var_id)
+      WRITE(*,*)'i_var_exist ',i_var_exist
+
+      IF ( i_var_exist .NE. 0 ) THEN
+!       write(*,*)' Inquiring dimensions'
+       CALL nchdlerr( nf90_inq_dimid( i_file_id, 'depth', i_z_id ) ,__LINE__,__MYFILE__)
+       CALL nchdlerr( nf90_inq_dimid( i_file_id, 'box', i_box_id ) ,__LINE__,__MYFILE__)
+       CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_tim_id ) ,__LINE__,__MYFILE__)
+
+       i_dim(1) = i_z_id
+       i_dim(2) = i_box_id
+       i_dim(3) = i_tim_id
+!       write(*,*)' In write_omona_ncdf_3d: Dimensions: i_dim ',i_dim
+
+
+       CALL nchdlerr( nf90_redef( i_file_id ) ,__LINE__,__MYFILE__)
+       CALL nchdlerr( nf90_def_var( i_file_id, cl_var_out,  nf90_real,i_dim, i_var_id ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', cl_varname1 ),__LINE__,__MYFILE__ )
+       CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', cl_varname2 ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units', cl_varunit1 ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'unit_long', cl_varunit2 ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'missing_value', z_missing ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,__LINE__,__MYFILE__)
+!
+        CALL nchdlerr( nf90_enddef( i_file_id ) ,__LINE__,__MYFILE__)
+
+!       CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_tim_id ) ,__LINE__,__MYFILE__)
+!        write(6,*)' inq_dimid ',i_tim_id
+        CALL nchdlerr( nf90_inq_varid( i_file_id, 'time', i_time_var ) ,__LINE__,__MYFILE__)
+        WRITE(*,*) 'inq_varid i_tim_id for var time ',i_time_var
+        i_pos = 1 
+        i_tab_start(3)=1
+      ELSE
+        !new addition
+!        CALL nchdlerr (nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dim ) ,__LINE__,__MYFILE__)
+!        write(6,*)' after inquire variable i_dim = ',i_dim
+!      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(1), len=i_pos )  ,__LINE__,__MYFILE__)
+!        write(6,*)' i_dim(1), len(1) ',i_dim(1),i_pos
+!      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(2), len=i_pos )  ,__LINE__,__MYFILE__)
+!        write(6,*)' i_dim(2), len(2) ',i_dim(2),i_pos
+!      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(3), len=i_pos )  ,__LINE__,__MYFILE__)
+!        write(6,*)' i_dim(3), len(3) ',i_dim(3),i_pos
+        !!!!
+
+        CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_min', z_min_old ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_max', z_max_old ) ,__LINE__,__MYFILE__)
+        z_min = MIN( z_min, z_min_old )
+        z_max = MAX( z_max, z_max_old )
+        CALL nchdlerr( nf90_redef( i_file_id ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_enddef( i_file_id ) ,__LINE__,__MYFILE__)
+
+
+ 
+!        CALL nchdlerr( nf90_inq_varid( i_file_id, 'depth', i_z_id ) ,__LINE__,__MYFILE__)
+!        CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_z_id, len=i_pos ) ,__LINE__,__MYFILE__)
+!        write(*,*)' i_z_id, dim ',i_z_id,i_pos
+
+!        CALL nchdlerr( nf90_inq_varid( i_file_id, 'box', i_box_id ) ,__LINE__,__MYFILE__)
+!        CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_box_id, len=i_pos ) ,__LINE__,__MYFILE__)
+!        write(*,*)' i_box_id, dim ',i_box_id,i_pos
+
+
+ 
+       CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_tim_id ) ,__LINE__,__MYFILE__)
+!        write(6,*)' inq_dimid ',i_tim_id
+        CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_tim_id, len=i_pos ) ,__LINE__,__MYFILE__)
+!       write(*,*) 'inq_var_id i_tim_id,dim ',i_tim_id,i_pos
+        ALLOCATE(i_time_old(i_pos))
+        CALL nchdlerr( nf90_inq_varid( i_file_id, 'time', i_time_var ) ,__LINE__,__MYFILE__)
+!        write(*,*) 'inq_var_id time',i_time_var
+        CALL nchdlerr( nf90_get_var( i_file_id, i_time_var, i_time_old ) ,__LINE__,__MYFILE__)
+        i_tab_start(3)=i_pos+1
+        DO i_t=i_pos,1,-1
+          IF(i_time_old(i_t).GE.i_time(1)) THEN
+            i_tab_start(3)=i_t
+          ELSE
+            EXIT
+         ENDIF
+        ENDDO
+
+         WRITE(*,*)'i_tab_start(3)',i_tab_start(3)
+         WRITE(*,*)'i_tab_count(3)',i_tab_count(3)
+
+         IF (I_FILL == 1 ) THEN
+           DO i_t=1,i_tab_start(3),1
+             IF(i_time_old(i_t).LT.i_time(1)) THEN
+                i_time0=i_t+1
+             ELSE
+                EXIT
+             ENDIF
+           ENDDO
+
+           i_time0=min(i_time0,i_tab_start(3))
+           i_tab_start(3)=i_time0
+           i_time1=i_time0+i_tab_count(3)-1
+           WRITE(*,*)'i_time0,i_tab_count(3),i_time1',i_Time0,i_tab_count(3),i_time1
+           WRITE(*,*)' Starting at time ',i_time_old(i_tab_start(3)-1),i_time(1)
+           i_rest_start=i_time1+1
+           i_rest_end = i_pos
+          IF ( i_rest_end .gt. i_rest_start ) THEN
+            ALLOCATE( z_old_3d(i_z,i_b, i_pos))
+            CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, z_old_3d ) ,__LINE__,__MYFILE__)
+            z_old_3d(:,:,i_time0:i_time1)=z_field
+            i_time_old(i_time0:i_time1)=i_time
+            i_tab_start(3)=1
+            i_tab_count(3)=i_pos
+            WRITE(*,*)' writing output I_FILL i_time0 ',i_time0
+            WRITE(*,*)' writing output I_FILL i_time1 ',i_time1
+            CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, &
+            & z_old_3d, start=i_tab_start, count=i_tab_count),__LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_var( i_file_id, i_time_var, &
+         & i_time_old,start=(/i_tab_start(3)/), count=(/i_tab_count(3)/)),__LINE__,__MYFILE__)
+          ELSE
+            I_FILL = 0
+            DEALLOCATE(i_time_old)
+            DEALLOCATE(i_time_rest)
+            DEALLOCATE(z_old_3d)
+          ENDIF
+         ELSE
+          WRITE(*,*)' Starting at time ',i_time_old(i_tab_start(3)-1),i_time(1)
+          DEALLOCATE(i_time_old)
+         ENDIF
+      ENDIF
+      !
+      IF ( I_FILL == 0 ) THEN
+         WRITE(*,*)' writing output count ',i_tab_count
+         WRITE(*,*)' writing output start ',i_tab_start
+         CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, &
+           z_field, start=i_tab_start, count=i_tab_count),__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_var, &
+           i_time,start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ),__LINE__,__MYFILE__)
+      ENDIF
+!
+      CALL nchdlerr( nf90_close( i_file_id ),__LINE__,__MYFILE__ )
+!
+      RETURN
+      !
+   END SUBROUTINE write_omona_netcdf_3d_r
+   !!----------------------------------------------------------------------
+   !
+   SUBROUTINE write_dep_netcdf ( cl_filename, cl_boxes, z_dep )
+      !
+      ! write a 2d array (map) of reals
+      !
+      IMPLICIT NONE
+      !
+      CHARACTER(len=80), INTENT(in)    :: cl_filename
+      CHARACTER(len=20), DIMENSION(:), INTENT(in)  :: cl_boxes
+      REAL, DIMENSION(:),   INTENT(in) :: z_dep
+      !
+      LOGICAL               :: clbon
+      INTEGER               :: i_file_id, i_var_id
+      INTEGER               :: i_dim_z_id
+      INTEGER               :: i_dimz, i_var_exist
+      INTEGER, DIMENSION(1) :: i_dim
+      REAL                  :: z_min, z_max
+      !
+      i_dimz = i_dp
+      !
+      z_min = MINVAL(z_dep)
+      z_max = MAXVAL(z_dep)
+      !
+      INQUIRE( FILE=cl_filename, EXIST=clbon )
+      IF ( .NOT. clbon ) THEN
+         CALL create_time_series_netcdf_file ( cl_filename, cl_boxes )
+      ELSE
+         WRITE(*,*)' Time series file already exists'
+      ENDIF
+      !     
+      CALL nchdlerr( nf90_open( cl_filename, nf90_write, i_file_id ) ,__LINE__,__MYFILE__)
+      !
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'depth', i_dim_z_id ) ,__LINE__,__MYFILE__)
+      i_dim(1) = i_dim_z_id
+      !      write(6,*)' defining depth axis : i_dim(1)= ',i_dim(1)
+      !
+      i_var_exist = nf90_inq_varid( i_file_id, "depth", i_var_id ) 
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var( i_file_id, "depth", nf90_real,i_dim, i_var_id ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name','depth') ,__LINE__,__MYFILE__) 
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', 'depth below the surface') ,__LINE__,__MYFILE__) 
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units', 'm' ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'unit_long','meter' ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,__LINE__,__MYFILE__)
+      ENDIF
+      !
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, z_dep) ,__LINE__,__MYFILE__)
+      !
+      CALL nchdlerr( nf90_close( i_file_id ) ,__LINE__,__MYFILE__)
+      !
+      RETURN
+      !
+   END SUBROUTINE write_dep_netcdf
+   !
+   !
+   !----------------------------------------------------------------------
+   !
+   ! C R E A T E _ T I M E _ S E R I E S _ N E T C D F _ F I L E
+   !
+   !----------------------------------------------------------------------
+   !
+   SUBROUTINE create_time_series_netcdf_file ( cl_filename,cl_boxes)
+      !
+      ! create time_series netcdf file
+      !
+      IMPLICIT NONE
+      !
+
+      CHARACTER(len=80), INTENT(in)         :: cl_filename
+      CHARACTER(len=20), DIMENSION(:)       :: cl_boxes
+      !
+      LOGICAL               :: clbon
+      INTEGER               :: i_file_id, i_dim_z_id, i_dim_box_id, &
+         i_dim_len_id, i_dim_t_id
+      INTEGER               :: i_box_id, i_tim_id
+      INTEGER               :: i_nbox
+      !
+      i_nbox = SIZE(cl_boxes,1)
+      !
+      
+      WRITE(*,*)' create_time_series',cl_filename
+      CALL nchdlerr( nf90_create( cl_filename, nf90_clobber, i_file_id ) ,__LINE__,__MYFILE__)
+      !
+      CALL nchdlerr( nf90_def_dim( i_file_id, 'len', 20, i_dim_len_id ) ,__LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_def_dim( i_file_id, 'depth',i_dp, i_dim_z_id ) ,__LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_def_dim( i_file_id, 'box', i_nbox, i_dim_box_id ) ,__LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_def_dim( i_file_id, 'time', nf90_unlimited, i_dim_t_id ) ,__LINE__,__MYFILE__)
+
+
+      WRITE(*,*)' In create_time_series_ntcdf'
+      WRITE(*,*)' z,box,time:       ',i_dim_z_id,i_dim_box_id, i_dim_t_id
+
+      WRITE(*,*)' Definining box var '
+      CALL nchdlerr( nf90_def_var( i_file_id, 'box', nf90_char, &
+         (/i_dim_len_id,i_dim_box_id/), i_box_id ),__LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_box_id, &
+         'long_name', 'Name of the box' ) ,__LINE__,__MYFILE__)
+
+      WRITE(*,*)' Definining time var'
+      CALL nchdlerr( nf90_def_var( i_file_id, 'time', nf90_int, &
+         (/i_dim_t_id/),i_tim_id ) ,__LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_tim_id, 'standard_name','time') ,__LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_tim_id, 'long_name','time') ,__LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_tim_id, 'unit','days as %Y%m%d') ,__LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_tim_id, 'unit_long','days as %Y%m%d') ,__LINE__,__MYFILE__)
+      !
+      CALL nchdlerr( nf90_enddef( i_file_id ) ,__LINE__,__MYFILE__)
+
+      CALL nchdlerr( nf90_put_var( i_file_id, i_box_id, cl_boxes &
+         ),__LINE__,__MYFILE__ )
+      !
+      CALL nchdlerr( nf90_close( i_file_id ),__LINE__,__MYFILE__ )
+      !
+      RETURN
+      !
+   END SUBROUTINE create_time_series_netcdf_file
+
+
+   !-----------------------------------------------------------------------
+   SUBROUTINE variable_att
+      !-----------------------------------------------------------------------
+      !
+      !                       ROUTINE variable_att
+      !                     **********************
+      !
+      !  Purpose :
+      !  -------
+      !    set attributes for a given variable name 
+      !
+      !  Original :  M. Balmaseda
+      IMPLICIT NONE
+      !-----------------------------------------------------------------------
+      !   Different variables
+      !-----------------------------------------------------------------------
+      !
+      INTEGER:: ji,jj,jk
+      REAL   :: dx0    !nominal longitudinal resolution in deg
+      REAL   :: alat, alon,aux
+      INTEGER,DIMENSION(:,:), ALLOCATABLE:: iaux
+
+      SELECT CASE ( TRIM(cl_var) )
+      CASE ('sosstsst')
+         i_nb_dims=2
+         cl_var_out='specified_sea_surface_temperature'
+         cl_varname1='Sea_Surface_Temperature'
+         cl_varname2='Sea Surface Temperature'
+         cl_varunit1='C'
+         cl_varunit2='degrees C'
+         cl_code='159'
+         cl_grid='t'
+      CASE ('somxl010')
+         i_nb_dims=2
+         cl_var_out='ocean_mixed_layer_thickness'
+         cl_varname1='ocean_mixed_layer_thickness'
+         cl_varname2='depth of the ocean mixed layer from the surface'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='148'
+         cl_grid='t'
+      CASE ('somixhgt')
+         i_nb_dims=2
+         cl_var_out='turbocline_depth'
+         cl_varname1='turbocline_depth'
+         cl_varname2='turbocline depth'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='248'
+         cl_grid='t'
+      CASE ('somxlt05')
+         i_nb_dims=2
+         cl_var_out='ocean_mixed_layer_depth'
+         cl_varname1='ocean_mixed_layer_depth'
+         cl_varname2='depth of the ocean mixed layer T 0.5 criteria'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='348'
+         cl_grid='t'
+      CASE ('sohtc300')
+         i_nb_dims=2
+         cl_var_out='hc300'
+         cl_varname1='300m_ocean_heat_content'
+         cl_varname2='ocean heat content over the first 300m'
+         cl_varunit1='J/m2'
+         cl_varunit2='J/m2'
+         cl_code='164'
+         cl_grid='t'
+      CASE ('sohtc700')
+         i_nb_dims=2
+         cl_var_out='hc700'
+         cl_varname1='700m_ocean_heat_content'
+         cl_varname2='ocean heat content over the first 700m'
+         cl_varunit1='J/m2'
+         cl_varunit2='J/m2'
+         cl_code='264'
+         cl_grid='t'
+      CASE ('sohtcbtm')
+         i_nb_dims=2
+         cl_var_out='hcbtm'
+         cl_varname1='Column_ocean_heat_content'
+         cl_varname2='ocean heat content over the whole column'
+         cl_varunit1='J/m2'
+         cl_varunit2='J/m2'
+         cl_code='364'
+         cl_grid='t'
+      CASE ('sosal300')
+         i_nb_dims=2
+         cl_var_out='sal300'
+         cl_varname1='300m_integrated salinity'
+         cl_varname2='salinity integrated over the first 300m'
+         cl_varunit1='psu*m'
+         cl_varunit2='psu*m'
+         cl_code='175'
+         cl_grid='t'
+      CASE ('sosal700')
+         i_nb_dims=2
+         cl_var_out='sal700'
+         cl_varname1='700m_integrated salinity'
+         cl_varname2='salinity integrated over the first 700m'
+         cl_varunit1='psu*m'
+         cl_varunit2='psu*m'
+         cl_code='275'
+         cl_grid='t'
+      CASE ('sosalbtm')
+         i_nb_dims=2
+         cl_var_out='salbtm'
+         cl_varname1='Column_integrate_salinity'
+         cl_varname2='Integrated Salinity over the whole column'
+         cl_varunit1='psu*m'
+         cl_varunit2='psu*m'
+         cl_code='375'
+         cl_grid='t'
+      CASE ('so20chgt')
+         i_nb_dims=2
+         cl_var_out='d20_isotherm_depth'
+         cl_varname1='depth'
+         cl_varname2='depth of the D20 isotherm'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='163'
+         cl_grid='t'
+      CASE ('so28chgt')
+         i_nb_dims=2
+         cl_var_out='d28_isotherm_depth'
+         cl_varname1='28I_depth'
+         cl_varname2='depth of the D28 isotherm'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='263'
+         cl_grid='t'
+      CASE ('so26chgt')
+         i_nb_dims=2
+         cl_var_out='d26_isotherm_depth'
+         cl_varname1='26I_depth'
+         cl_varname2='depth of the D26 isotherm'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='463'
+         cl_grid='t'
+      CASE ('sothedep')
+         i_nb_dims=2
+         cl_var_out='thermocline_depth'
+         cl_varname1='thermocline_depth'
+         cl_varname2='thermocline depth'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='363'
+         cl_grid='t'
+      CASE ('sossheig')
+         i_nb_dims=2
+         cl_var_out='sea_surface_height_above_geoid'
+         cl_varname1='sea_surface_height_above_geoid'
+         cl_varname2='sea_surface_height_above_geoid'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='145'      
+         cl_grid='t'
+      CASE ('sostheig')
+         i_nb_dims=2
+         cl_var_out='steric_height'
+         cl_varname1='steric_height'
+         cl_varname2='steric_height'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='150'      
+         cl_grid='t'
+      CASE ('sobpheig')
+         i_nb_dims=2
+         cl_var_out='bottom_pressure_equivalent_height'
+         cl_varname1='Bottom Pressure'
+         cl_varname2='Bottom Pressure'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='149'      
+         cl_grid='t'
+      CASE ('sohefldo')
+         i_nb_dims=2
+         cl_var_out='specified_surface_heat_flux'
+         cl_varname1='Net Downward Heat Flux'
+         cl_varname2='Net Downward Heat Flux'
+         cl_varunit1='W/m2'
+         cl_varunit2='Watt_per_square_meter'
+         cl_code='160'      
+         cl_grid='t'
+      CASE ('sohefldp')
+         i_nb_dims=2
+         cl_var_out='heat_flux_correction'
+         cl_varname1='Surface_Heat_Flux_Damping'
+         cl_varname2='Surface Heat Flux: Damping'
+         cl_varunit1='W/m2'
+         cl_varunit2='Watt_per_square_meter'
+         cl_code='162'      
+         cl_grid='t'
+      CASE ('soshfldo')
+         i_nb_dims=2
+         cl_var_out='absorbed_solar_radiation'
+         cl_varname1='Shortwave_Radiation'
+         cl_varname2='Shortwave Radiation'
+         cl_varunit1='W/m2'
+         cl_varunit2='Watt_per_square_meter'
+         cl_code='157'      
+         cl_grid='t'
+      CASE ('sosalflx')
+         i_nb_dims=2
+         cl_var_out='Surface_Salt_Flux'
+         cl_varname1='Surface_Salt_Flux'
+         cl_varname2='Surface Salt Flux'
+         cl_varunit1='Kg/m2/s'
+         cl_varunit2='Kg/m2/s'
+         cl_code='260'      
+         cl_grid='t'
+      CASE ('sosafldp')
+         i_nb_dims=2
+         cl_var_out='Surface_salt_flux_damping'
+         cl_varname1=cl_var_out
+         cl_varname2='Surface salt flux: damping'
+         cl_varunit1='Kg/m2/s'
+         cl_varunit2='Kg/m2/s'
+         cl_code='261'      
+         cl_grid='t'
+      CASE ('sowaflup')
+         i_nb_dims=2
+         cl_var_out='Net_Upward_Water_Flux'
+         cl_varname1=cl_var_out
+         cl_varname2=cl_var_out
+         cl_varunit1='Kg/m2/s'
+         cl_varunit2='Kg/m2/s'
+         cl_code='258'      
+         cl_grid='t'
+      CASE ('sowafldp')
+         i_nb_dims=2
+         cl_var_out='Surface_Water_Flux_Damping'
+         cl_varname1=cl_var_out
+         cl_varname2=cl_var_out
+         cl_varunit1='Kg/m2/s'
+         cl_varunit2='Kg/m2/s'
+         cl_code='262'      
+         cl_grid='t'
+      CASE ('soicetem')
+         i_nb_dims=2
+         cl_var_out='Ice_Surface_Temperature'
+         cl_varname1=cl_var_out
+         cl_varname2=cl_var_out
+         cl_varunit1='K'
+         cl_varunit2='Kelvin'
+         cl_code='429'      
+         cl_grid='t'
+      CASE ('soicealb')
+         i_nb_dims=2
+         cl_var_out='Ice_Albedo'
+         cl_varname1=cl_var_out
+         cl_varname2=cl_var_out
+         cl_varunit1='dl'
+         cl_varunit2='dimensionless'
+         cl_code='430'      
+         cl_grid='t'
+      CASE ('soicecov')
+         i_nb_dims=2
+         cl_var_out='Ice_Fraction'
+         cl_varname1=cl_var_out
+         cl_varname2=cl_var_out
+         cl_varunit1='dl'
+         cl_varunit2='dimensionless'
+         cl_code='431'      
+         cl_grid='t'
+      CASE ('votemper')
+         i_nb_dims=3
+         cl_var_out='sea_water_potential_temperature'
+         cl_varname1='sea_water_potential_temperature'
+         cl_varname2='Potential temperature ref to surface C'
+         cl_varunit1='C'
+         cl_varunit2='degree_Celcius'
+         cl_code='129'
+         cl_grid='t'
+      CASE ('vosaline')
+         i_nb_dims=3
+         cl_var_out='sea_water_salinity'
+         cl_varname1='sea_water_salinity'
+         cl_varname2='sea water salinity'
+         cl_varunit1='PSU'
+         cl_varunit2='practical_salinity_scale'
+         cl_code='130'
+         cl_grid='t'
+      CASE ('vosigmat')
+         i_nb_dims=3
+         cl_var_out='sigmat'
+         cl_varname1='sigmat'
+         cl_varname2='sigmat'
+         cl_varunit1='C'
+         cl_varunit2='NA'
+         cl_code='138'
+         cl_grid='t'
+      CASE ('vottrdmp')
+         i_nb_dims=3
+         cl_var_out='Damping_T_3D'
+         cl_varname1='Damping_T_3D'
+         cl_varname2='Damping T 3D'
+         cl_varunit1='C/s'
+         cl_varunit2='degree_Celsius/second'
+         cl_code='201'
+         cl_grid='t'
+      CASE ('vostrdmp')
+         i_nb_dims=3
+         cl_var_out='Damping_S_3D'
+         cl_varname1='Damping_S_3D'
+         cl_varname2='Damping S_3D'
+         cl_varunit1='psu/s'
+         cl_varunit2='psu/second'
+         cl_code='202'
+         cl_grid='t'
+      CASE ('votbiasd')
+         i_nb_dims=3
+         cl_var_out='Bias_T_direct'
+         cl_varname1='Bias_T_direct'
+         cl_varname2='Bias_T_direct'
+         cl_varunit1='C'
+         cl_varunit2='degree_Celsius'
+         cl_code='203'
+         cl_grid='t'
+      CASE ('vosbiasd')
+         i_nb_dims=3
+         cl_var_out='Bias_S_direct'
+         cl_varname1='Bias_S_direct'
+         cl_varname2='Bias_S_direct'
+         cl_varunit1='psu'
+         cl_varunit2='psu'
+         cl_code='204'
+         cl_grid='t'
+      CASE ('votbiasp')
+         i_nb_dims=3
+         cl_var_out='Bias_T_pressure'
+         cl_varname1='Bias_T_pressure'
+         cl_varname2='Bias_T_pressure'
+         cl_varunit1='C'
+         cl_varunit2='degree_Celsius'
+         cl_code='205'
+         cl_grid='t'
+      CASE ('vosbiasp')
+         i_nb_dims=3
+         cl_var_out='Bias_S_pressure'
+         cl_varname1='Bias_S_pressure'
+         cl_varname2='Bias_S_pressure'
+         cl_varunit1='psu'
+         cl_varunit2='psu'
+         cl_code='206'
+         cl_grid='t'
+      CASE ('vorbiasp')
+         i_nb_dims=3
+         cl_var_out='Bias_rho_pressure'
+         cl_varname1='Bias_rho_pressure'
+         cl_varname2='Bias_rho_pressure'
+         cl_varunit1='kg/m3/s'
+         cl_varunit2='kg/m3/s'
+         cl_code='207'
+         cl_grid='t'
+      CASE ('sozotaux')
+         i_nb_dims=2
+         cl_var_out='surface_downward_eastward_stress'
+         cl_varname1='Wind_Stress_along_i-axis'
+         cl_varname2=cl_var_out
+         cl_varunit1='N/m2'
+         cl_varunit2='N/m2'
+         cl_code='153'      
+         cl_grid='u'
+         if (sec .eq. 'v') then
+            cl_varname2='taux*x*z'
+            cl_varunit1='Sv'
+            cl_varunit2='Sv'
+         endif
+         if (sec .eq. 'u') then
+            cl_varname2='taux*y*z'
+            cl_varunit1='Sv'
+            cl_varunit2='Sv'
+         endif
+      CASE ('vozocrtx')
+         i_nb_dims=3
+         cl_var_out='sea_water_x_velocity'
+         cl_varname1='sea_water_x_velocity'
+         cl_varname2='U zonal current m/s'
+         cl_varunit1='m/s'
+         cl_varunit2='meter_per_second'
+         cl_code='131'
+         cl_grid='u'
+         if (sec .eq. 'u') then
+            cl_var_out='zonal_transport'
+            cl_varname1='zonal_transport'
+            cl_varname2='zonal_transport'
+            cl_varunit1='Sv'
+            cl_varunit2='Sv'
+         endif
+      CASE ('vozout')
+         i_nb_dims=3
+         cl_var_out='UT'
+         cl_varname1='UT'
+         cl_varname2='UT'
+         cl_varunit1='K*m/s'
+         cl_varunit2='K*m/s'
+         cl_code='169'
+         cl_grid='t'
+         if (sec .eq. 'u') then
+          cl_var_out='zonal_H_transport'
+          cl_varname1='zonal_H_transport'
+          cl_varname2='zonal_H_transport'
+          cl_varunit1='PW'
+          cl_varunit2='PW'
+         endif
+      CASE ('vozous')
+         i_nb_dims=3
+         cl_var_out='US'
+         cl_varname1='US'
+         cl_varname2='US'
+         cl_varunit1='psu*m/s'
+         cl_varunit2='psu*m/s'
+         cl_code='171'
+         cl_grid='t'
+         if (sec .eq. 'u') then
+          cl_var_out='zonal_S_transport'
+          cl_varname1='zonal_S_transport'
+          cl_varname2='zonal_S_transport'
+          cl_varunit1='kT/s'
+          cl_varunit2='kT/s'
+         endif
+      CASE ('vomecrty')
+         i_nb_dims=3
+         cl_var_out='sea_water_y_velocity'
+         cl_varname1='sea_water_y_velocity'
+         cl_varname2='V meridional current m/s'
+         cl_varunit1='m/s'
+         cl_varunit2='meter_per_second'
+         cl_code='132'
+         cl_grid='v'
+         if (sec .eq. 'v') then
+            cl_var_out='meridional_transport'
+            cl_varname1='meridional_transport'
+            cl_varname2='meridional_transport'
+            cl_varunit1='Sv'
+            cl_varunit2='Sv'
+         endif
+      CASE ('sometauy')
+         i_nb_dims=2
+         cl_var_out='surface_downward_northward_stress'
+         cl_varname1='Wind_Stress_along_j-axis'
+         cl_varname2=cl_var_out
+         cl_varunit1='N/m2'
+         cl_varunit2='N/m2'
+         cl_code='154'      
+         cl_grid='v'
+         if (sec .eq. 'v') then
+            cl_varname2='tauy*x*z'
+            cl_varunit1='Sv'
+            cl_varunit2='Sv'
+         endif
+         if (sec .eq. 'u') then
+            cl_varname2='tauy*y*z'
+            cl_varunit1='Sv'
+            cl_varunit2='Sv'
+         endif
+      CASE ('vomevt')
+         i_nb_dims=3
+         cl_var_out='VT'
+         cl_varname1='VT'
+         cl_varname2='VT'
+         cl_varunit1='K*m/s'
+         cl_varunit2='K*m/s'
+         cl_code='170'
+         cl_grid='t'
+         if (sec .eq. 'v') then
+          cl_var_out='meridional_H_transport'
+          cl_varname1='meridional_H_transport'
+          cl_varname2='meridional_H_transport'
+          cl_varunit1='PW'
+          cl_varunit2='PW'
+         endif
+      CASE ('vomevs')
+         i_nb_dims=3
+         cl_var_out='VS'
+         cl_varname1='VS'
+         cl_varname2='VS'
+         cl_varunit1='psu*m/s'
+         cl_varunit2='psu*m/s'
+         cl_code='172'
+         cl_grid='t'
+         if (sec .eq. 'v') then
+          cl_var_out='meridional_S_transport'
+          cl_varname1='meridional_S_transport'
+          cl_varname2='meridional_S_transport'
+          cl_varunit1='kT/s'
+          cl_varunit2='kT/s'
+         endif
+      CASE ('vovecrtz')
+         i_nb_dims=3
+         cl_var_out='upward_sea_water_velocity'
+         cl_varname1='upward_sea_water_velocity'
+         cl_varname2='W vertical current m/s'
+         cl_varunit1='m/s'
+         cl_varunit2='meter_per_second'
+         cl_code='133'
+         cl_grid='f'
+      CASE ('votkeavm')
+         i_nb_dims=3
+         cl_var_out='vertical_eddy_viscosity'
+         cl_varname1='vertical_eddy_viscosity'
+         cl_varname2='vertical eddy viscosity'
+         cl_varunit1='m2/s'
+         cl_varunit2='square_meter_per_second'
+         cl_code='135'
+         cl_grid='f'
+      CASE ('votkeavt')
+         i_nb_dims=3
+         cl_var_out='vertical_eddy_diffusivity'
+         cl_varname1='vertical_eddy_diffusivity'
+         cl_varname2='vertical eddy diffusivity'
+         cl_varunit1='m2/s'
+         cl_varunit2='square_meter_per_second'
+         cl_code='136'
+         cl_grid='f'
+      CASE ('votkeevm')
+         i_nb_dims=3
+         cl_var_out='enhanced_vertical_eddy_viscosity'
+         cl_varname1='enhanced_vertical_eddy_viscosity'
+         cl_varname2='enhanced vertical eddy viscosity'
+         cl_varunit1='m2/s'
+         cl_varunit2='square_meter_per_second'
+         cl_code='235'
+         cl_grid='f'
+      CASE ('votkeevd')
+         i_nb_dims=3
+         cl_var_out='enhanced_vertical_eddy_diffusivity'
+         cl_varname1='enhanced_vertical_eddy_diffusivity'
+         cl_varname2='enhanced vertical eddy diffusivity'
+         cl_varunit1='m2/s'
+         cl_varunit2='square_meter_per_second'
+         cl_code='236'
+         cl_grid='f'
+      CASE ('voddmavs')
+         i_nb_dims=3
+         cl_var_out='salt_vertical_eddy_diffusivity'
+         cl_varname1='salt_vertical_eddy_diffusivity'
+         cl_varname2='salt vertical eddy diffusivity'
+         cl_varunit1='m2/s'
+         cl_varunit2='square_meter_per_second'
+         cl_code='237'
+         cl_grid='f'
+      CASE ('bckint')
+         i_nb_dims=3
+         cl_var_out='assim_incr_temperature'
+         cl_varname1='assim_incr_temperature'
+         cl_varname2='assim_incr_temperature'
+         cl_varunit1='K/s'
+         cl_varunit2='Kelvin_per_second'
+         cl_code='178'
+         cl_grid='t'
+      CASE ('bckins')
+         i_nb_dims=3
+         cl_var_out='assim_incr_salinity'
+         cl_varname1='assim_incr_salinity'
+         cl_varname2='assim_incr_salinity'
+         cl_varunit1='psu/s'
+         cl_varunit2='psu_per_second'
+         cl_code='184'
+         cl_grid='t'
+      CASE ('bckinu')
+         i_nb_dims=3
+         cl_var_out='assim_incr_uvel'
+         cl_varname1='assim_incr_uvel'
+         cl_varname2='assim_incr_uvel'
+         cl_varunit1='m/s2'
+         cl_varunit2='meter_per_square_second'
+         cl_code='179'
+         cl_grid='u'
+      CASE ('bckinv')
+         i_nb_dims=3
+         cl_var_out='assim_incr_vvel'
+         cl_varname1='assim_incr_vvel'
+         cl_varname2='assim_incr_vvel'
+         cl_varunit1='m/s2'
+         cl_varunit2='meter_per_square_second'
+         cl_code='180'
+         cl_grid='v'
+      CASE ('bckineta')
+         i_nb_dims=2
+         cl_var_out='assim_incr_eta'
+         cl_varname1='assim_incr_eta'
+         cl_varname2='assim_incr_eta'
+         cl_varunit1='m/s'
+         cl_varunit2='meter_per_second'
+         cl_code='181'
+         cl_grid='t'
+      CASE ('vozoeivu')
+         i_nb_dims=3
+         cl_var_out='vozoeivu'
+         cl_varname1='vozoeivu'
+         cl_varname2='eddy U velocity m/s'
+         cl_varunit1='m/s'
+         cl_varunit2='meter_per_second'
+         cl_code='231'
+      CASE ('vomeeivv')
+         i_nb_dims=3
+         cl_var_out='vomeeivv'
+         cl_varname1='vomeeivv'
+         cl_varname2='eddy V velocity m/s'
+         cl_varunit1='m/s'
+         cl_varunit2='meter_per_second'
+         cl_code='232'
+      CASE default
+         WRITE(*,*)'Variables not defined' 
+         CALL ABORT
+      END SELECT
+      cl_var_out  = TRIM(cl_var_out) 
+      cl_varname1 = TRIM(cl_varname1) 
+      cl_varname2 = TRIM(cl_varname2) 
+      cl_varunit1 = TRIM(cl_varunit1) 
+      cl_varunit2 = TRIM(cl_varunit2)
+      cl_code     = TRIM(cl_code)
+      cl_grid     = TRIM(cl_grid) 
+
+      cl_filename_out = TRIM(cl_expnam) // TRIM(cl_date) // '_' // TRIM(cl_code) //sec//'mona.nc'
+      cl_filename2_out = TRIM(cl_expnam) // TRIM(cl_date) // '_' // TRIM(cl_code) // 'xy' //sec//'mona.nc'
+!      IF ( i_nb_dims .EQ. 2 ) THEN
+!         i_dp=1
+!      ELSE
+!         i_dp=jpk
+!      ENDIF
+      WRITE(*,*)'Variable Attributes: '
+      WRITE(*,*)'   cl_var_out = ',cl_var_out
+!      WRITE(*,*)'   i_dp       = ',i_dp
+      WRITE(*,*)'   cl_grid    = ',cl_grid
+      WRITE(*,*)'   cl_code    = ',cl_code
+      WRITE(*,*)'   i_nb_dims  = ',i_nb_dims
+      WRITE(*,*)'------------------------------------ '
+
+      RETURN
+   END SUBROUTINE variable_att
+   !-----------------------------------------------------------------------
+   SUBROUTINE obs_variable_att(cl_type)
+      !-----------------------------------------------------------------------
+      !
+      !                       ROUTINE obs_variable_att
+      !                     ****************************
+      !
+      !  Purpose :
+      !  -------
+      !    set attributes for a given variable name (feedback version)
+      !
+      !  Original :  K. Mogensen
+      IMPLICIT NONE
+      !-----------------------------------------------------------------------
+      !   Different variables
+      !-----------------------------------------------------------------------
+      CHARACTER(len=*) :: cl_type
+      !
+      SELECT CASE ( TRIM(cl_var) )
+      CASE ('sossheig')
+         i_nb_dims=2
+         cl_var_out='sea_surface_height_above_geoid'
+         cl_varname1='sea_surface_height_above_geoid'
+         cl_varname2='sea_surface_height_above_geoid'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='145' 
+      CASE ('sosstsst')
+         i_nb_dims=2
+         cl_var_out='sea_surface_temperature'
+         cl_varname1='sea_surface_temperature'
+         cl_varname2='sea_surface_temperature'
+         cl_varunit1='K'
+         cl_varunit2='Kelvin'
+         cl_code='159'
+      CASE ('votemper')
+         i_nb_dims=3
+         cl_var_out='sea_water_potential_temperature'
+         cl_varname1='sea_water_potential_temperature'
+         cl_varname2='Potential temperature ref to surface C'
+         cl_varunit1='C'
+         cl_varunit2='degree_Celcius'
+         cl_code='129'
+      CASE ('vosaline')
+         i_nb_dims=3
+         cl_var_out='sea_water_salinity'
+         cl_varname1='sea_water_salinity'
+         cl_varname2='sea water salinity'
+         cl_varunit1='PSU'
+         cl_varunit2='practical_salinity_scale'
+         cl_code='130'
+      CASE ('vozocrtx')
+         i_nb_dims=3
+         cl_var_out='sea_water_x_velocity'
+         cl_varname1='sea_water_x_velocity'
+         cl_varname2='U zonal current m/s'
+         cl_varunit1='m/s'
+         cl_varunit2='meter_per_second'
+         cl_code='131'
+      CASE ('vomecrty')
+         i_nb_dims=3
+         cl_var_out='sea_water_y_velocity'
+         cl_varname1='sea_water_y_velocity'
+         cl_varname2='V meridional current m/s'
+         cl_varunit1='m/s'
+         cl_varunit2='meter_per_second'
+         cl_code='132'
+      CASE default
+         WRITE(*,*)'Variables not defined' 
+         CALL ABORT
+      END SELECT
+      cl_var_out  = TRIM(cl_var_out) 
+      cl_varname1 = TRIM(cl_varname1) 
+      cl_varname2 = TRIM(cl_varname2) 
+      cl_varunit1 = TRIM(cl_varunit1) 
+      cl_varunit2 = TRIM(cl_varunit2)
+      cl_code     = TRIM(cl_code)
+      cl_filename_out = TRIM(cl_expnam) // TRIM(cl_date) // '_' // &
+         & TRIM(cl_code) // '_'//TRIM(cl_type)//'_'//'fbmona.nc'
+      cl_filename2_out = TRIM(cl_expnam) // TRIM(cl_date) // '_' // &
+         & TRIM(cl_code) // '_'//TRIM(cl_type)//'_'// 'xy' //'_'//'fbmona.nc'
+     
+      RETURN
+   END SUBROUTINE obs_variable_att
+
+
+END MODULE omonainfo
Index: /utils/tools_ticket2413/OBSTOOLS/src/ooo_utils.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/ooo_utils.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/ooo_utils.F90	(revision 12863)
@@ -0,0 +1,39 @@
+MODULE ooo_utils
+   !! =================================================================
+   !!                    *** MODULE ooo_utils ***
+   !! =================================================================
+   USE par_oce
+
+   IMPLICIT NONE
+
+   ! Define double precision obfillflt
+   REAL(kind=dp), PARAMETER :: obfilldbl=99999.
+
+   !! $Id: ooo_utils.F90 5215 2015-04-15 16:11:56Z nicolasmartin $
+   CONTAINS
+
+
+   SUBROUTINE date_format(date_str)
+      !---------------------------------------
+      ! Routine to create creation date string
+      !---------------------------------------
+
+      ! Routine arguments
+      CHARACTER(len=*), INTENT(OUT) :: date_str
+      ! Local variables
+      CHARACTER(8)  :: date
+      CHARACTER(10) :: time
+
+      CHARACTER(10)  :: date_part
+      CHARACTER(8)  :: time_part
+
+      CALL date_and_time(DATE=date)
+      CALL date_and_time(TIME=time)
+      date_part  = date(1:4)//'/'//date(5:6)//'/'//date(7:8)
+      time_part  = time(1:2)//':'//time(3:4)//':'//time(5:6)
+
+      date_str   = date_part//' '//time_part
+
+   END SUBROUTINE date_format
+
+END MODULE ooo_utils
Index: /utils/tools_ticket2413/OBSTOOLS/src/par_kind.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/par_kind.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/par_kind.F90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../src/OCE/par_kind.F90
Index: /utils/tools_ticket2413/OBSTOOLS/src/par_oce.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/par_oce.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/par_oce.F90	(revision 12863)
@@ -0,0 +1,99 @@
+MODULE par_oce
+   !!======================================================================
+   !!                        ***  par_oce  ***
+   !! Ocean :   set the ocean parameters
+   !!======================================================================
+   !! History :  OPA  !  1991     (Imbard, Levy, Madec)  Original code
+   !!   NEMO     1.0  !  2004-01  (G. Madec, J.-M. Molines)  Free form and module
+   !!            3.3  !  2010-09  (C. Ethe) TRA-TRC merge: add jpts, jp_tem & jp_sal
+   !!----------------------------------------------------------------------
+   USE par_kind          ! kind parameters
+
+   IMPLICIT NONE
+   PUBLIC
+
+   !!----------------------------------------------------------------------
+   !!   Domain decomposition
+   !!----------------------------------------------------------------------
+   !! if we dont use massively parallel computer (parameters jpni=jpnj=1) so jpiglo=jpi and jpjglo=jpj
+   INTEGER, PUBLIC            ::   jpni         !: number of processors following i 
+   INTEGER, PUBLIC            ::   jpnj         !: number of processors following j
+   INTEGER, PUBLIC            ::   jpnij        !: nb of local domain = nb of processors ( <= jpni x jpnj )
+   INTEGER, PUBLIC, PARAMETER ::   jpr2di = 0   !: number of columns for extra outer halo 
+   INTEGER, PUBLIC, PARAMETER ::   jpr2dj = 0   !: number of rows    for extra outer halo 
+   INTEGER, PUBLIC, PARAMETER ::   jpreci = 1   !: number of columns for overlap 
+   INTEGER, PUBLIC, PARAMETER ::   jprecj = 1   !: number of rows    for overlap 
+
+   !!----------------------------------------------------------------------
+   !!                   namcfg namelist parameters
+   !!----------------------------------------------------------------------
+   CHARACTER(lc) ::   cp_cfg           !: name of the configuration
+   CHARACTER(lc) ::   cp_cfz           !: name of the zoom of configuration
+   INTEGER       ::   jp_cfg           !: resolution of the configuration
+
+   ! data size                                       !!! * size of all input files *
+   INTEGER       ::   jpidta           !: 1st lateral dimension ( >= jpi )
+   INTEGER       ::   jpjdta           !: 2nd    "         "    ( >= jpj )
+   INTEGER       ::   jpkdta           !: number of levels      ( >= jpk )
+
+   ! global or zoom domain size                      !!! * computational domain *
+   INTEGER       ::   jpiglo           !: 1st dimension of global domain --> i
+   INTEGER       ::   jpjglo           !: 2nd    -                  -    --> j
+
+   ! zoom starting position 
+   INTEGER       ::   jpizoom          !: left bottom (i,j) indices of the zoom
+   INTEGER       ::   jpjzoom          !: in data domain indices
+
+!   ! Domain characteristics
+!   INTEGER       ::   jperio           !: lateral cond. type (between 0 and 6)
+!   !                                       !  = 0 closed                 ;   = 1 cyclic East-West
+!   !                                       !  = 2 equatorial symmetric   ;   = 3 North fold T-point pivot
+!   !                                       !  = 4 cyclic East-West AND North fold T-point pivot
+!   !                                       !  = 5 North fold F-point pivot
+!   !                                       !  = 6 cyclic East-West AND North fold F-point pivot
+
+   ! Input file read offset
+   LOGICAL       ::   ln_use_jattr     !: Use file global attribute: open_ocean_jstart to determine start j-row 
+                                           ! when reading input from those netcdf files that have the 
+                                           ! attribute defined. This is designed to enable input files associated 
+                                           ! with the extended grids used in the under ice shelf configurations to 
+                                           ! be used without redundant rows when the ice shelves are not in use.
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp)      ::   pp_not_used       = 999999._wp   !: vertical grid parameter
+   REAL(wp)      ::   pp_to_be_computed = 999999._wp   !:    -      -       -
+
+
+
+
+   !!---------------------------------------------------------------------
+   !! Active tracer parameters
+   !!---------------------------------------------------------------------
+   INTEGER, PUBLIC, PARAMETER ::   jpts   = 2    !: Number of active tracers (=2, i.e. T & S )
+   INTEGER, PUBLIC, PARAMETER ::   jp_tem = 1    !: indice for temperature
+   INTEGER, PUBLIC, PARAMETER ::   jp_sal = 2    !: indice for salinity
+
+   !!---------------------------------------------------------------------
+   !! Domain Matrix size  (if AGRIF, they are not all parameters)
+   !!---------------------------------------------------------------------
+#if defined key_agrif
+   INTEGER, PUBLIC, PARAMETER ::   nbghostcells = 1                             !: number of ghost cells
+   INTEGER, PUBLIC            ::   nbcellsx     = jpiglo - 2 - 2*nbghostcells   !: number of cells in i-direction
+   INTEGER, PUBLIC            ::   nbcellsy     = jpjglo - 2 - 2*nbghostcells   !: number of cells in j-direction
+   !
+#endif
+   INTEGER, PUBLIC  ::   jpi   ! = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   !: first  dimension
+   INTEGER, PUBLIC  ::   jpj   ! = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   !: second dimension
+   INTEGER, PUBLIC  ::   jpk   ! = jpkdta
+   INTEGER, PUBLIC  ::   jpim1 ! = jpi-1                                            !: inner domain indices
+   INTEGER, PUBLIC  ::   jpjm1 ! = jpj-1                                            !:   -     -      -
+   INTEGER, PUBLIC  ::   jpkm1 ! = jpk-1                                            !:   -     -      -
+   INTEGER, PUBLIC  ::   jpij  ! = jpi*jpj                                          !:  jpi x jpj
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: par_oce.F90 5974 2015-12-02 10:52:05Z timgraham $ 
+   !! Software governed by the CeCILL licence (./LICENSE)
+   !!======================================================================
+END MODULE par_oce
Index: /utils/tools_ticket2413/OBSTOOLS/src/proftools.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/proftools.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/proftools.F90	(revision 12863)
@@ -0,0 +1,34 @@
+MODULE proftools
+
+   ! Various tools to manipulate fb profiles data.
+
+   USE obs_fbm
+   IMPLICIT NONE
+
+CONTAINS
+
+   SUBROUTINE sealsfromargo( fbdata )
+
+      ! Separate seals  from argo
+
+      ! Notes:
+      ! Argo is type 831
+      ! Seals have station ids from Q9900000 to Q9900328
+      ! according to
+      ! http://www.nodc.noaa.gov/GTSPP/document/codetbls/shipcode/name_1-C.html
+      ! on 2010-04-28 but we assume that all Q990???? are seals
+      
+      TYPE(obfbdata) :: fbdata
+      CHARACTER(len=ilentyp) :: cdtyp
+      INTEGER :: i
+
+      DO i=1,fbdata%nobs
+         
+         cdtyp=ADJUSTL(fbdata%cdtyp(i))
+         IF ((cdtyp(1:3)=='831') .AND. &
+            &(fbdata%cdwmo(i)(1:4)=='Q990')) fbdata%cdtyp(i)='Seal'
+      ENDDO
+
+   END SUBROUTINE sealsfromargo
+
+END MODULE proftools
Index: /utils/tools_ticket2413/OBSTOOLS/src/sla2fb.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/sla2fb.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/sla2fb.F90	(revision 12863)
@@ -0,0 +1,102 @@
+PROGRAM sla2fb
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM sla2fb **
+   !!
+   !!  ** Purpose : Convert AVISO SLA format to feedback format
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !!
+   !!   Usage:
+   !!     sla2fb.exe [-s type] outputfile inputfile1 inputfile2 ...
+   !!   Option:
+   !!     -s            Select altimeter data_source
+   !!
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE obs_fbm
+   USE obs_sla_io
+   USE convmerge
+   IMPLICIT NONE
+   !
+   ! Command line arguments for output file and input files
+   !
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nargs
+   CHARACTER(len=256) :: cdoutfile
+   CHARACTER(len=256),ALLOCATABLE :: cdinfile(:)
+   CHARACTER(len=256) :: cdtmp
+   CHARACTER(len=5) :: cdsource
+   !
+   ! Input data
+   !
+   TYPE(obfbdata), POINTER :: slaf(:)
+   INTEGER :: ninfiles,ntotobs
+   !
+   ! Output data
+   !
+   TYPE(obfbdata) :: fbdata
+   !
+   ! Loop variables
+   !
+   INTEGER :: ip,ia,ji,jk,noff
+   !
+   ! Get number of command line arguments
+   !
+   nargs=IARGC()
+   IF (nargs < 1) THEN
+      WRITE(*,'(A)')'Usage:'
+      WRITE(*,'(A)')'sla2fb [-s type] outputfile inputfile1 inputfile2 ...'
+      CALL abort()
+   ENDIF
+   cdsource=''
+   !
+   ! Get input data
+   !
+   noff=1
+   IF ( nargs > 1 ) THEN
+      CALL getarg(1,cdtmp)
+      IF (TRIM(cdtmp)=='-s') THEN
+         IF ( nargs < 3 ) THEN
+            WRITE(*,*)'Missing arguments to -s <datasource>'
+            CALL abort
+         ENDIF
+         CALL getarg(2,cdsource)
+         noff=3
+      ENDIF
+   ENDIF
+   CALL getarg(noff,cdoutfile)
+   ninfiles = nargs - noff
+   ALLOCATE( slaf(MAX(nargs-noff,1)) )
+   ALLOCATE( cdinfile(nargs-noff) )
+   ntotobs = 0
+   DO ia=1,ninfiles
+      CALL getarg( ia + noff, cdinfile(ia) )
+      WRITE(*,'(2A)')'File = ',TRIM(cdinfile(ia))
+      CALL read_avisofile( TRIM(cdinfile(ia)), slaf(ia), 6, .TRUE., .FALSE. )
+      WRITE(*,'(A,I9,A)')'has',slaf(ia)%nobs,' observations'
+      IF (LEN_TRIM(cdsource)>0) THEN
+         DO ji=1,slaf(ia)%nobs
+            slaf(ia)%cdwmo(ji)=TRIM(slaf(ia)%cdwmo(ji))//'_'//TRIM(cdsource)
+         ENDDO
+      ENDIF
+      ntotobs = ntotobs + slaf(ia)%nobs
+   ENDDO
+   IF (ninfiles==0) THEN
+      CALL init_obfbdata( slaf(1) )
+      CALL alloc_obfbdata( slaf(1), 1, 0, 1, 0, 0, .FALSE. )
+      slaf(1)%cname(1) = 'SLA'
+      slaf(1)%cdjuldref = '19500101000000'
+   ENDIF
+   WRITE(*,'(A,I8)') 'Total observations : ',ntotobs
+   !
+   ! Merge and output the data.
+   !
+   CALL conv_fbmerge( TRIM(cdoutfile), ninfiles, slaf )
+
+END PROGRAM sla2fb
Index: /utils/tools_ticket2413/OBSTOOLS/src/str_c_to_for.h90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/str_c_to_for.h90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/str_c_to_for.h90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../src/OCE/OBS/str_c_to_for.h90
Index: /utils/tools_ticket2413/OBSTOOLS/src/test_arrays_mod.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/test_arrays_mod.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/test_arrays_mod.F90	(revision 12863)
@@ -0,0 +1,94 @@
+MODULE test_arrays_mod
+USE obs_fbm
+
+INTERFACE test_arrays
+	MODULE PROCEDURE test_real_arrays
+	MODULE PROCEDURE test_real_arrays_2D
+	MODULE PROCEDURE test_real_arrays_3D
+	MODULE PROCEDURE test_integer_arrays
+END INTERFACE test_arrays
+
+CONTAINS
+
+   LOGICAL FUNCTION test_real_arrays(array_in,array_out)
+	IMPLICIT NONE
+	INTEGER :: i
+	REAL(KIND=fbdp) :: array_in(:), array_out(:)
+
+	test_real_arrays=.TRUE.
+	DO i=1,SIZE(array_in)
+		IF (array_in(i) /= array_out(i)) THEN
+			test_real_arrays=.FALSE.
+		END IF
+	END DO
+
+	IF (SIZE(array_in) /= SIZE(array_out)) THEN
+			test_real_arrays=.FALSE.
+	END IF
+
+	END FUNCTION test_real_arrays
+
+
+   LOGICAL FUNCTION test_real_arrays_2D(array_in,array_out)
+	IMPLICIT NONE
+	INTEGER :: i, j
+	REAL(KIND=fbdp) :: array_in(:,:), array_out(:,:)
+
+	test_real_arrays_2D=.TRUE.
+	DO j=1,SIZE(array_in,2)
+		DO i=1,SIZE(array_in,1)
+			IF (array_in(i,j) /= array_out(i,j)) THEN
+				test_real_arrays_2D=.FALSE.
+			END IF
+		END DO
+	END DO
+
+	IF (SIZE(array_in) /= SIZE(array_out)) THEN
+			test_real_arrays_2D=.FALSE.
+	END IF
+
+	END FUNCTION test_real_arrays_2D
+
+
+   LOGICAL FUNCTION test_real_arrays_3D(array_in,array_out)
+	IMPLICIT NONE
+	INTEGER :: i, j, k
+	REAL(KIND=fbdp) :: array_in(:,:,:), array_out(:,:,:)
+
+	test_real_arrays_3D=.TRUE.
+	DO k=1,SIZE(array_in,3)
+		DO j=1,SIZE(array_in,2)
+			DO i=1,SIZE(array_in,1)
+				IF (array_in(i,j,k) /= array_out(i,j,k)) THEN
+					test_real_arrays_3D=.FALSE.
+				END IF
+			END DO
+		END DO
+	END DO
+
+	IF (SIZE(array_in) /= SIZE(array_out)) THEN
+			test_real_arrays_3D=.FALSE.
+	END IF
+
+	END FUNCTION test_real_arrays_3D
+
+
+   LOGICAL FUNCTION test_integer_arrays(array_in,array_out)
+	IMPLICIT NONE
+	INTEGER :: i
+	INTEGER :: array_in(:), array_out(:)
+
+	test_integer_arrays=.TRUE.
+	DO i=1,SIZE(array_in)
+		IF (array_in(i) /= array_out(i)) THEN
+			test_integer_arrays=.FALSE.
+		END IF
+	END DO
+
+	IF (SIZE(array_in) /= SIZE(array_out)) THEN
+			test_integer_arrays=.FALSE.
+	END IF
+
+	END FUNCTION test_integer_arrays
+
+END MODULE test_arrays_mod
Index: /utils/tools_ticket2413/OBSTOOLS/src/test_fbgenerate.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/test_fbgenerate.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/test_fbgenerate.F90	(revision 12863)
@@ -0,0 +1,787 @@
+MODULE test_fbgenerate	
+USE obs_fbm
+USE test_arrays_mod
+USE fbgenerate_coords
+
+CONTAINS
+
+   SUBROUTINE tester
+	IMPLICIT NONE
+	REAL(KIND=fbdp) :: array10_in(10), array1_in(1), array2_in(2), array3_in(3)
+	REAL(KIND=fbdp) :: array10_out(10), array1_out(1), array2_out(2), array3_out(3)
+	REAL(KIND=fbdp) :: array_4x3_in(3,4,1), array_4x3_out(3,4,1)
+	REAL(KIND=fbdp), ALLOCATABLE :: lat_array_in(:), lat_array_out(:)
+	REAL(KIND=fbdp), ALLOCATABLE :: lon_array_in(:), lon_array_out(:)
+	INTEGER :: iarray10_in(10), iarray1_in(1), iarray2_in(2), iarray3_in(3)
+	INTEGER :: iarray10_out(10), iarray1_out(1), iarray2_out(2), iarray3_out(3)
+	LOGICAL :: okay = .TRUE.
+	LOGICAL :: okay_too = .TRUE.
+	LOGICAL :: all_okay = .TRUE.
+	INTEGER, PARAMETER :: FV_int = 99999
+	REAL(KIND=fbdp), PARAMETER :: FV_real = 99999.0_fbdp
+	
+   ! A single non-FillVal value should be replicated n times
+	array1_in(:)=(/1.0_fbdp/)
+	array1_out(:)=(/1.0_fbdp/)
+	CALL set_depths(array1_in,1,FV_real)
+	okay = test_arrays(array1_in,array1_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 1 failed"
+		all_okay = .FALSE.
+	END IF
+
+   ! A single non-FillVal value should be replicated n times
+	array2_in(:) = (/1.0_fbdp, FV_real/)
+	array2_out(:) = (/1.0_fbdp, 1.0_fbdp/)
+	CALL set_depths(array2_in,2,FV_real)
+	okay = test_arrays(array2_in,array2_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 2 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! A single non-FillVal value should be replicated n times
+	array10_in(:) = (/1.0_fbdp,FV_real,FV_real,FV_real,FV_real,FV_real,FV_real,FV_real,FV_real,FV_real/)
+	array10_out(:) = 1.0_fbdp
+	CALL set_depths(array10_in,10,FV_real)
+	okay = test_arrays(array10_in,array10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 3 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! A single non-FillVal value should be replicated n times
+	array3_in(:) = (/1.0_fbdp,FV_real,FV_real/)
+	array3_out(:) = 1.0_fbdp
+	CALL set_depths(array3_in,3,FV_real)
+	okay = test_arrays(array3_in,array3_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 4 failed"
+		all_okay = .FALSE.
+	END IF
+		
+	! A full list of n non-FillVals should be left unaltered.
+	array2_in(:) = (/1.0_fbdp, 2.0_fbdp/)
+	array2_out(:) = (/1.0_fbdp, 2.0_fbdp/)
+	CALL set_depths(array2_in,2,FV_real)
+	okay = test_arrays(array2_in,array2_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 5 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! A full list of n non-FillVals should be left unaltered.
+	array3_in(:) = (/3.0_fbdp, 2.0_fbdp, 56.23_fbdp/)
+	array3_out(:) = (/3.0_fbdp, 2.0_fbdp, 56.23_fbdp/)
+	CALL set_depths(array3_in,3,FV_real)
+	okay = test_arrays(array3_in,array3_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 6 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! A full list of n non-FillVals should be left unaltered.
+	array10_in(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, -5.0_fbdp, 5.0_fbdp, 67.0_fbdp, 7.0_fbdp, 8.0_fbdp, 9.0_fbdp, 10.0_fbdp/)
+	array10_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, -5.0_fbdp, 5.0_fbdp, 67.0_fbdp, 7.0_fbdp, 8.0_fbdp, 9.0_fbdp, 10.0_fbdp/)
+	CALL set_depths(array10_in,10,FV_real)
+	okay = test_arrays(array10_in,array10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 7 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	array10_in(:) = (/1.0_fbdp,10.0_fbdp,1.0_fbdp,FV_real,FV_real,FV_real,FV_real,FV_real,FV_real,FV_real/)
+	array10_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp, 6.0_fbdp, 7.0_fbdp, 8.0_fbdp, 9.0_fbdp, 10.0_fbdp/)
+	CALL set_depths(array10_in,10,FV_real)
+	okay = test_arrays(array10_in,array10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 8 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	array10_in(:) = (/1.0_fbdp, 3.25_fbdp, 0.25_fbdp, FV_real,FV_real,FV_real,FV_real,FV_real,FV_real,FV_real/)
+	array10_out(:) = (/1.0_fbdp, 1.25_fbdp, 1.5_fbdp, 1.75_fbdp, 2.0_fbdp, 2.25_fbdp, 2.5_fbdp, 2.75_fbdp, 3.0_fbdp, 3.25_fbdp/)
+	CALL set_depths(array10_in,10,FV_real)
+	okay = test_arrays(array10_in,array10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 9 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	array10_in(:) = (/3.25_fbdp, 1.0_fbdp, -0.25_fbdp, FV_real,FV_real,FV_real,FV_real,FV_real,FV_real,FV_real/)
+	array10_out(:) = (/3.25_fbdp, 3.0_fbdp, 2.75_fbdp, 2.5_fbdp, 2.25_fbdp, 2.0_fbdp, 1.75_fbdp, 1.5_fbdp, 1.25_fbdp, 1.0_fbdp/)
+	CALL set_depths(array10_in,10,FV_real)
+	okay = test_arrays(array10_in,array10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 11 failed"
+		all_okay = .FALSE.
+	END IF
+	
+   ! A single non-FillVal value should be replicated n times
+	iarray1_in(:)=(/19991231/)
+	iarray1_out(:)=(/19991231/)
+	CALL set_date(iarray1_in,1,FV_int)
+	okay = test_arrays(iarray1_in,iarray1_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 12 failed"
+		all_okay = .FALSE.
+	END IF
+
+   ! A single non-FillVal value should be replicated n times
+	iarray2_in(:) = (/19991231, FV_int/)
+	iarray2_out(:) = (/19991231, 19991231/)
+	CALL set_date(iarray2_in,2,FV_int)
+	okay = test_arrays(iarray2_in,iarray2_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 13 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! A single non-FillVal value should be replicated n times
+	iarray10_in(:) = (/20110101,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int/)
+	iarray10_out(:) = 20110101
+	CALL set_date(iarray10_in,10,FV_int)
+	okay = test_arrays(iarray10_in,iarray10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 14 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! A single non-FillVal value should be replicated n times
+	iarray3_in(:) = (/20110101,FV_int,FV_int/)
+	iarray3_out(:) = 20110101
+	CALL set_date(iarray3_in,3,FV_int)
+	okay = test_arrays(iarray3_in,iarray3_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 15 failed"
+		all_okay = .FALSE.
+	END IF
+		
+	! A full list of n non-FillVals should be left unaltered.
+	iarray2_in(:) = (/19991231, 20000101/)
+	iarray2_out(:) = (/19991231, 20000101/)
+	CALL set_date(iarray2_in,2,FV_int)
+	okay = test_arrays(iarray2_in,iarray2_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 16 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! A full list of n non-FillVals should be left unaltered.
+	iarray3_in(:) = (/19840101, 19001231, 20500612/)
+	iarray3_out(:) = (/19840101, 19001231, 20500612/)
+	CALL set_date(iarray3_in,3,FV_int)
+	okay = test_arrays(iarray3_in,iarray3_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 17 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! A full list of n non-FillVals should be left unaltered.
+	iarray10_in(:) = (/20091231, 20100101, 20100102, 20100103, 20091231, &
+	                    20100105, 20100106, 20091231, 20100108, 20100109/)
+	iarray10_out(:) = (/20091231, 20100101, 20100102, 20100103, 20091231, &
+	                    20100105, 20100106, 20091231, 20100108, 20100109/)
+	CALL set_date(iarray10_in,10,FV_int)
+	okay = test_arrays(iarray10_in,iarray10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 18 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	iarray10_in(:) = (/20091231,20100109,1,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int/)
+	iarray10_out(:) = (/20091231, 20100101, 20100102, 20100103, 20100104, &
+	                    20100105, 20100106, 20100107, 20100108, 20100109/)
+	CALL set_date(iarray10_in,10,FV_int)
+	okay = test_arrays(iarray10_in,iarray10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 19 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	iarray10_in(:) = (/20100109,20091231,-1,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int/)
+	iarray10_out(:) = (/20100109, 20100108, 20100107, 20100106, 20100105, &
+	                    20100104, 20100103, 20100102, 20100101, 20091231/)
+	CALL set_date(iarray10_in,10,FV_int)
+	okay = test_arrays(iarray10_in,iarray10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 20 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	iarray10_in(:) = (/20100101,20100401,10,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int/)
+	iarray10_out(:) = (/20100101, 20100111, 20100121, 20100131, 20100210, &
+	                    20100220, 20100302, 20100312, 20100322, 20100401/)
+	CALL set_date(iarray10_in,10,FV_int)
+	okay = test_arrays(iarray10_in,iarray10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 21 failed"
+		all_okay = .FALSE.
+	END IF
+
+   ! A single non-FillVal value should be replicated n times
+	iarray1_in(:)=(/0000/)
+	iarray1_out(:)=(/0/)
+	CALL set_time(iarray1_in,1,FV_int)
+	okay = test_arrays(iarray1_in,iarray1_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 22 failed"
+		all_okay = .FALSE.
+	END IF
+
+   ! A single non-FillVal value should be replicated n times
+	iarray2_in(:) = (/0600, FV_int/)
+	iarray2_out(:) = (/600, 600/)
+	CALL set_time(iarray2_in,2,FV_int)
+	okay = test_arrays(iarray2_in,iarray2_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 23 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! A full list of n non-FillVals should be left unaltered.
+	iarray2_in(:) = (/0600, 1200/)
+	iarray2_out(:) = (/0600, 1200/)
+	CALL set_time(iarray2_in,2,FV_int)
+	okay = test_arrays(iarray2_in,iarray2_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 24 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! A full list of n non-FillVals should be left unaltered.
+	iarray10_in(:) = (/1, 2, 3, -5, 5, 67, 7, 8, 9, 10/)
+	iarray10_out(:) = (/1, 2, 3, -5, 5, 67, 7, 8, 9, 10/)
+	CALL set_time(iarray10_in,10,FV_int)
+	okay = test_arrays(iarray10_in,iarray10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 25 failed"
+		all_okay = .FALSE.
+	END IF
+
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	iarray10_in(:) = (/0000,0430,0030,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int/)
+	iarray10_out(:) = (/0, 30, 100, 130, 200, &
+	                    230, 300, 330, 400, 430/)
+	CALL set_time(iarray10_in,10,FV_int)
+	okay = test_arrays(iarray10_in,iarray10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 26 failed"
+		WRITE(*,*) iarray10_in
+		all_okay = .FALSE.
+	END IF
+
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	iarray10_in(:) = (/2200,0230,0030,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int/)
+	iarray10_out(:) = (/2200, 2230, 2300, 2330, 0, &
+	                    30, 100, 130, 200, 230/)
+	CALL set_time(iarray10_in,10,FV_int)
+	okay = test_arrays(iarray10_in,iarray10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 27 failed"
+		WRITE(*,*) iarray10_in
+		all_okay = .FALSE.
+	END IF
+
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	iarray10_in(:) = (/2200,1730,-0030,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int/)
+	iarray10_out(:) = (/2200, 2130, 2100, 2030, 2000, &
+	                    1930, 1900, 1830, 1800, 1730/)
+	CALL set_time(iarray10_in,10,FV_int)
+	okay = test_arrays(iarray10_in,iarray10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 28 failed"
+		WRITE(*,*) iarray10_in
+		all_okay = .FALSE.
+	END IF
+
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	iarray10_in(:) = (/0100,2200,-0020,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int/)
+	iarray10_out(:) = (/0100, 0040, 0020, 0000, 2340, &
+	                    2320, 2300, 2240, 2220, 2200/)
+	CALL set_time(iarray10_in,10,FV_int)
+	okay = test_arrays(iarray10_in,iarray10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 29 failed"
+		WRITE(*,*) iarray10_in
+		all_okay = .FALSE.
+	END IF
+
+	! Three non-FillVal values should be used as the start, end, step in conjunction with n
+	iarray10_in(:) = (/1700,0630,90,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int,FV_int/)
+	iarray10_out(:) = (/1700, 1830, 2000, 2130, 2300, &
+	                    0030, 0200, 0330, 0500, 0630/)
+	CALL set_time(iarray10_in,10,FV_int)
+	okay = test_arrays(iarray10_in,iarray10_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 30 failed"
+		WRITE(*,*) iarray10_in
+		all_okay = .FALSE.
+	END IF
+
+	! A single obs value should be replicated throught the array(obs,levels)
+	array_4x3_in(:,1,1) = (/1.0,FV_real,FV_real/)
+	array_4x3_in(:,2,1) = (/FV_real,FV_real,FV_real/)
+	array_4x3_in(:,3,1) = (/FV_real,FV_real,FV_real/)
+	array_4x3_in(:,4,1) = (/FV_real,FV_real,FV_real/)
+	array_4x3_out(:,1,1) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp/)
+	array_4x3_out(:,2,1) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp/)
+	array_4x3_out(:,3,1) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp/)
+	array_4x3_out(:,4,1) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp/)
+	CALL set_obs_values(array_4x3_in,1,4,3,FV_real)
+	okay = test_arrays(array_4x3_in,array_4x3_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 31 failed"
+		WRITE(*,*) array_4x3_in
+		WRITE(*,*)
+		WRITE(*,*) array_4x3_out
+		all_okay = .FALSE.
+	END IF
+
+	! A full specification of the obs values should be unaltered
+	array_4x3_in(:,1,1) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp/)
+	array_4x3_in(:,2,1) = (/4.0_fbdp, 5.0_fbdp, 6.0_fbdp/)
+	array_4x3_in(:,3,1) = (/7.0_fbdp, 8.0_fbdp, 9.0_fbdp/)
+	array_4x3_in(:,4,1) = (/10.0_fbdp, 11.0_fbdp, 12.0_fbdp/)
+	array_4x3_out(:,1,1) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp/)
+	array_4x3_out(:,2,1) = (/4.0_fbdp, 5.0_fbdp, 6.0_fbdp/)
+	array_4x3_out(:,3,1) = (/7.0_fbdp, 8.0_fbdp, 9.0_fbdp/)
+	array_4x3_out(:,4,1) = (/10.0_fbdp, 11.0_fbdp, 12.0_fbdp/)
+	CALL set_obs_values(array_4x3_in,1,4,3,FV_real)
+	okay = test_arrays(array_4x3_in,array_4x3_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 32 failed"
+		WRITE(*,*) array_4x3_in
+		WRITE(*,*)
+		WRITE(*,*) array_4x3_out
+		all_okay = .FALSE.
+	END IF
+
+	! A single profile should be replicated at all lat/lons
+	array_4x3_in(:,1,1) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp/)
+	array_4x3_in(:,2,1) = (/FV_real, FV_real, FV_real/)
+	array_4x3_in(:,3,1) = (/FV_real, FV_real, FV_real/)
+	array_4x3_in(:,4,1) = (/FV_real, FV_real, FV_real/)
+	array_4x3_out(:,1,1) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp/)
+	array_4x3_out(:,2,1) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp/)
+	array_4x3_out(:,3,1) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp/)
+	array_4x3_out(:,4,1) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp/)
+	CALL set_obs_values(array_4x3_in,1,4,3,FV_real)
+	okay = test_arrays(array_4x3_in,array_4x3_out)
+	IF (okay .EQV. .FALSE.) THEN
+	   WRITE(*,*) "Test 33 failed"
+		WRITE(*,*) array_4x3_in
+		WRITE(*,*)
+		WRITE(*,*) array_4x3_out
+		all_okay = .FALSE.
+	END IF
+
+	! A single profile position should only be given where nobs=1
+	ALLOCATE(lat_array_in(1),	&
+				lon_array_in(1),	&
+				lat_array_out(1), &
+				lon_array_out(1)	)
+	lat_array_in(:) = (/1.0_fbdp/)
+	lon_array_in(:) = (/1.0_fbdp/)
+	lat_array_out(:) = (/1.0_fbdp/)
+	lon_array_out(:) = (/1.0_fbdp/)
+	CALL set_spatial_coords(lat_array_in,lon_array_in,1,FV_real)
+	okay = test_arrays(lat_array_in,lat_array_out)
+	okay_too = test_arrays(lon_array_in,lon_array_out)
+	IF ((okay .EQV. .FALSE.) .OR. (okay_too .EQV. .FALSE.)) THEN
+	   WRITE(*,*) "Test 34 failed"
+		WRITE(*,*) lat_array_in
+		WRITE(*,*) lon_array_in
+		WRITE(*,*) lat_array_out
+		WRITE(*,*) lon_array_out
+		all_okay = .FALSE.
+	END IF
+	DEALLOCATE(lat_array_in,	&
+				  lon_array_in,	&
+				  lat_array_out,	&
+				  lon_array_out	)
+
+	! A single lat and list of lons should give nobs observations
+	ALLOCATE(lat_array_in(4),	&
+				lon_array_in(4),	&
+				lat_array_out(4), &
+				lon_array_out(4)	)
+	lat_array_in(:) = (/1.0_fbdp, FV_real, FV_real, FV_real/)
+	lon_array_in(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp/)
+	lat_array_out(:) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp/)
+	lon_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp/)
+	CALL set_spatial_coords(lat_array_in,lon_array_in,4,FV_real)
+	okay = test_arrays(lat_array_in,lat_array_out)
+	okay_too = test_arrays(lon_array_in,lon_array_out)
+	IF ((okay .EQV. .FALSE.) .OR. (okay_too .EQV. .FALSE.)) THEN
+	   WRITE(*,*) "Test 35 failed"
+		WRITE(*,*) lat_array_in
+		WRITE(*,*) lon_array_in
+		WRITE(*,*) lat_array_out
+		WRITE(*,*) lon_array_out
+		all_okay = .FALSE.
+	END IF
+	DEALLOCATE(lat_array_in,	&
+				  lon_array_in,	&
+				  lat_array_out,	&
+				  lon_array_out	)
+
+	! A single lat and bounded lons should give nobs = no elements in expanded bounds
+	ALLOCATE(lat_array_in(3),	&
+				lon_array_in(3),	&
+				lat_array_out(3), &
+				lon_array_out(3)	)
+	lat_array_in(:) = (/1.0_fbdp, FV_real, FV_real/)
+	lon_array_in(:) = (/1.0_fbdp, 3.0_fbdp, 1.0_fbdp/)
+	lat_array_out(:) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp/)
+	lon_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp/)
+	CALL set_spatial_coords(lat_array_in,lon_array_in,3,FV_real)
+	okay = test_arrays(lat_array_in,lat_array_out)
+	okay_too = test_arrays(lon_array_in,lon_array_out)
+	IF ((okay .EQV. .FALSE.) .OR. (okay_too .EQV. .FALSE.)) THEN
+	   WRITE(*,*) "Test 36 failed"
+		WRITE(*,*) lat_array_in
+		WRITE(*,*) lon_array_in
+		WRITE(*,*) lat_array_out
+		WRITE(*,*) lon_array_out
+		all_okay = .FALSE.
+	END IF
+	DEALLOCATE(lat_array_in,	&
+				  lon_array_in,	&
+				  lat_array_out,	&
+				  lon_array_out	)
+
+	! A single lat and bounded lons should give nobs = no elements in expanded bounds
+	ALLOCATE(lat_array_in(5),	&
+				lon_array_in(5),	&
+				lat_array_out(5), &
+				lon_array_out(5)	)
+	lat_array_in(:) = (/1.0_fbdp, FV_real, FV_real, FV_real, FV_real/)
+	lon_array_in(:) = (/1.0_fbdp, 5.0_fbdp, 1.0_fbdp, FV_real, FV_real/)
+	lat_array_out(:) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp/)
+	lon_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/)
+	CALL set_spatial_coords(lat_array_in,lon_array_in,5,FV_real)
+	okay = test_arrays(lat_array_in,lat_array_out)
+	okay_too = test_arrays(lon_array_in,lon_array_out)
+	IF ((okay .EQV. .FALSE.) .OR. (okay_too .EQV. .FALSE.)) THEN
+	   WRITE(*,*) "Test 37 failed"
+		WRITE(*,*) lat_array_in
+		WRITE(*,*) lon_array_in
+		WRITE(*,*) lat_array_out
+		WRITE(*,*) lon_array_out
+		all_okay = .FALSE.
+	END IF
+	DEALLOCATE(lat_array_in,	&
+				  lon_array_in,	&
+				  lat_array_out,	&
+				  lon_array_out	)
+
+	! A single lon and bounded lats should give nobs = no elements in expanded bounds
+	ALLOCATE(lat_array_in(5),	&
+				lon_array_in(5),	&
+				lat_array_out(5), &
+				lon_array_out(5)	)
+	lat_array_in(:) = (/1.0_fbdp, 5.0_fbdp, 1.0_fbdp, FV_real, FV_real/)
+	lon_array_in(:) = (/1.0_fbdp, FV_real, FV_real, FV_real, FV_real/)
+	lat_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/)
+	lon_array_out(:) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp/)
+	CALL set_spatial_coords(lat_array_in,lon_array_in,5,FV_real)
+	okay = test_arrays(lat_array_in,lat_array_out)
+	okay_too = test_arrays(lon_array_in,lon_array_out)
+	IF ((okay .EQV. .FALSE.) .OR. (okay_too .EQV. .FALSE.)) THEN
+	   WRITE(*,*) "Test 38 failed"
+		WRITE(*,*) lat_array_in
+		WRITE(*,*) lon_array_in
+		WRITE(*,*) lat_array_out
+		WRITE(*,*) lon_array_out
+		all_okay = .FALSE.
+	END IF
+	DEALLOCATE(lat_array_in,	&
+				  lon_array_in,	&
+				  lat_array_out,	&
+				  lon_array_out	)
+
+	! A list of lats and lons with same number of elements as nobs should be unaltered
+	ALLOCATE(lat_array_in(5),	&
+				lon_array_in(5),	&
+				lat_array_out(5), &
+				lon_array_out(5)	)
+	lat_array_in(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/)
+	lon_array_in(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/)
+	lat_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/)
+	lon_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/)
+	CALL set_spatial_coords(lat_array_in,lon_array_in,5,FV_real)
+	okay = test_arrays(lat_array_in,lat_array_out)
+	okay_too = test_arrays(lon_array_in,lon_array_out)
+	IF ((okay .EQV. .FALSE.) .OR. (okay_too .EQV. .FALSE.)) THEN
+	   WRITE(*,*) "Test 39 failed"
+		WRITE(*,*) lat_array_in
+		WRITE(*,*) lon_array_in
+		WRITE(*,*) lat_array_out
+		WRITE(*,*) lon_array_out
+		all_okay = .FALSE.
+	END IF
+	DEALLOCATE(lat_array_in,	&
+				  lon_array_in,	&
+				  lat_array_out,	&
+				  lon_array_out	)
+
+	! A list of lats and lons with fewer elements as nobs should be gridded 
+	! to produce nobs observations - list all lons at same lat, before stepping in lat.
+	ALLOCATE(lat_array_in(25),	&
+				lon_array_in(25),	&
+				lat_array_out(25), &
+				lon_array_out(25)	)
+	lat_array_in(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp,&
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real/)
+	lon_array_in(:) = (/10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp,&
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real/)
+	lat_array_out(:) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp, & 
+								2.0_fbdp, 2.0_fbdp, 2.0_fbdp, 2.0_fbdp, 2.0_fbdp, &
+								3.0_fbdp, 3.0_fbdp, 3.0_fbdp, 3.0_fbdp, 3.0_fbdp, &
+								4.0_fbdp, 4.0_fbdp, 4.0_fbdp, 4.0_fbdp, 4.0_fbdp, &
+								5.0_fbdp, 5.0_fbdp, 5.0_fbdp, 5.0_fbdp, 5.0_fbdp/)
+	lon_array_out(:) = (/10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp,&
+								10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp,&
+								10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp,&
+								10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp,&
+								10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp/)
+	CALL set_spatial_coords(lat_array_in,lon_array_in,25,FV_real)
+	okay = test_arrays(lat_array_in,lat_array_out)
+	okay_too = test_arrays(lon_array_in,lon_array_out)
+	IF ((okay .EQV. .FALSE.) .OR. (okay_too .EQV. .FALSE.)) THEN
+	   WRITE(*,*) "Test 40 failed"
+		WRITE(*,*) lat_array_in
+		WRITE(*,*) lon_array_in
+		WRITE(*,*) lat_array_out
+		WRITE(*,*) lon_array_out
+		all_okay = .FALSE.
+	END IF
+	DEALLOCATE(lat_array_in,	&
+				  lon_array_in,	&
+				  lat_array_out,	&
+				  lon_array_out	)
+
+	! A list of lats and lon bounds with fewer elements as nobs should be gridded 
+	! to produce nobs observations - list all lons at same lat, before stepping in lat.
+	ALLOCATE(lat_array_in(25),	&
+				lon_array_in(25),	&
+				lat_array_out(25), &
+				lon_array_out(25)	)
+	lat_array_in(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp,&
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real/)
+	lon_array_in(:) = (/10.0_fbdp, 50.0_fbdp, 10.0_fbdp, FV_real, FV_real,&
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real/)
+	lat_array_out(:) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp, & 
+								2.0_fbdp, 2.0_fbdp, 2.0_fbdp, 2.0_fbdp, 2.0_fbdp, &
+								3.0_fbdp, 3.0_fbdp, 3.0_fbdp, 3.0_fbdp, 3.0_fbdp, &
+								4.0_fbdp, 4.0_fbdp, 4.0_fbdp, 4.0_fbdp, 4.0_fbdp, &
+								5.0_fbdp, 5.0_fbdp, 5.0_fbdp, 5.0_fbdp, 5.0_fbdp/)
+	lon_array_out(:) = (/10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp,&
+								10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp,&
+								10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp,&
+								10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp,&
+								10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp/)
+	CALL set_spatial_coords(lat_array_in,lon_array_in,25,FV_real)
+	okay = test_arrays(lat_array_in,lat_array_out)
+	okay_too = test_arrays(lon_array_in,lon_array_out)
+	IF ((okay .EQV. .FALSE.) .OR. (okay_too .EQV. .FALSE.)) THEN
+	   WRITE(*,*) "Test 41 failed"
+		WRITE(*,*) lat_array_in
+		WRITE(*,*) lon_array_in
+		WRITE(*,*) lat_array_out
+		WRITE(*,*) lon_array_out
+		all_okay = .FALSE.
+	END IF
+	DEALLOCATE(lat_array_in,	&
+				  lon_array_in,	&
+				  lat_array_out,	&
+				  lon_array_out	)
+
+
+	! A list of lats and lon bounds with the same number of elements as nobs should be 
+	! unaltered expect for bounds expansion
+	ALLOCATE(lat_array_in(5),	&
+				lon_array_in(5),	&
+				lat_array_out(5), &
+				lon_array_out(5)	)
+	lat_array_in(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/)
+	lon_array_in(:) = (/10.0_fbdp, 50.0_fbdp, 10.0_fbdp, FV_real, FV_real/)
+	lat_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/)
+	lon_array_out(:) = (/10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp/)
+	CALL set_spatial_coords(lat_array_in,lon_array_in,5,FV_real)
+	okay = test_arrays(lat_array_in,lat_array_out)
+	okay_too = test_arrays(lon_array_in,lon_array_out)
+	IF ((okay .EQV. .FALSE.) .OR. (okay_too .EQV. .FALSE.)) THEN
+	   WRITE(*,*) "Test 42 failed"
+		WRITE(*,*) lat_array_in
+		WRITE(*,*) lon_array_in
+		WRITE(*,*) lat_array_out
+		WRITE(*,*) lon_array_out
+		all_okay = .FALSE.
+	END IF
+	DEALLOCATE(lat_array_in,	&
+				  lon_array_in,	&
+				  lat_array_out,	&
+				  lon_array_out	)
+	
+
+	! A list of lons and lat bounds with the same number of elements as nobs should be 
+	! unaltered expect for bounds expansion
+	ALLOCATE(lat_array_in(5),	&
+				lon_array_in(5),	&
+				lat_array_out(5), &
+				lon_array_out(5)	)
+	lat_array_in(:) = (/10.0_fbdp, 50.0_fbdp, 10.0_fbdp, FV_real, FV_real/)
+	lon_array_in(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/)
+	lat_array_out(:) = (/10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp, 50.0_fbdp/)
+	lon_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/)
+	CALL set_spatial_coords(lat_array_in,lon_array_in,5,FV_real)
+	okay = test_arrays(lat_array_in,lat_array_out)
+	okay_too = test_arrays(lon_array_in,lon_array_out)
+	IF ((okay .EQV. .FALSE.) .OR. (okay_too .EQV. .FALSE.)) THEN
+	   WRITE(*,*) "Test 43 failed"
+		WRITE(*,*) lat_array_in
+		WRITE(*,*) lon_array_in
+		WRITE(*,*) lat_array_out
+		WRITE(*,*) lon_array_out
+		all_okay = .FALSE.
+	END IF
+	DEALLOCATE(lat_array_in,	&
+				  lon_array_in,	&
+				  lat_array_out,	&
+				  lon_array_out	)
+	
+
+	! A list of lons and lat bounds with fewer elements as nobs should be gridded 
+	! to produce nobs observations - list all lons at same lat, before stepping in lat.
+	ALLOCATE(lat_array_in(25),	&
+				lon_array_in(25),	&
+				lat_array_out(25), &
+				lon_array_out(25)	)
+	lat_array_in(:) = (/10.0_fbdp, 50.0_fbdp, 10.0_fbdp, FV_real, FV_real,&
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real/)
+	lon_array_in(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp,&
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real/)
+	lat_array_out(:) = (/10.0_fbdp, 10.0_fbdp, 10.0_fbdp, 10.0_fbdp, 10.0_fbdp, & 
+								20.0_fbdp, 20.0_fbdp, 20.0_fbdp, 20.0_fbdp, 20.0_fbdp, &
+								30.0_fbdp, 30.0_fbdp, 30.0_fbdp, 30.0_fbdp, 30.0_fbdp, &
+								40.0_fbdp, 40.0_fbdp, 40.0_fbdp, 40.0_fbdp, 40.0_fbdp, &
+								50.0_fbdp, 50.0_fbdp, 50.0_fbdp, 50.0_fbdp, 50.0_fbdp/)
+	lon_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp,&
+								1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp,&
+								1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp,&
+								1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp,&
+								1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/)
+	CALL set_spatial_coords(lat_array_in,lon_array_in,25,FV_real)
+	okay = test_arrays(lat_array_in,lat_array_out)
+	okay_too = test_arrays(lon_array_in,lon_array_out)
+	IF ((okay .EQV. .FALSE.) .OR. (okay_too .EQV. .FALSE.)) THEN
+	   WRITE(*,*) "Test 44 failed"
+		WRITE(*,*) lat_array_in
+		WRITE(*,*) lon_array_in
+		WRITE(*,*) lat_array_out
+		WRITE(*,*) lon_array_out
+		all_okay = .FALSE.
+	END IF
+	DEALLOCATE(lat_array_in,	&
+				  lon_array_in,	&
+				  lat_array_out,	&
+				  lon_array_out	)
+
+
+	! A single lat and bounded lons should give nobs = no elements in expanded bounds
+	ALLOCATE(lat_array_in(5),	&
+				lon_array_in(5),	&
+				lat_array_out(5), &
+				lon_array_out(5)	)
+	lat_array_in(:) = (/1.0_fbdp, FV_real, FV_real, FV_real, FV_real/)
+	lon_array_in(:) = (/1.0_fbdp, 5.0_fbdp, 1.0_fbdp, FV_real, FV_real/)
+	lat_array_out(:) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp/)
+	lon_array_out(:) = (/1.0_fbdp, 2.0_fbdp, 3.0_fbdp, 4.0_fbdp, 5.0_fbdp/)
+	CALL set_spatial_coords(lat_array_in,lon_array_in,5,FV_real)
+	okay = test_arrays(lat_array_in,lat_array_out)
+	okay_too = test_arrays(lon_array_in,lon_array_out)
+	IF ((okay .EQV. .FALSE.) .OR. (okay_too .EQV. .FALSE.)) THEN
+	   WRITE(*,*) "Test 45 failed"
+		WRITE(*,*) lat_array_in
+		WRITE(*,*) lon_array_in
+		WRITE(*,*) lat_array_out
+		WRITE(*,*) lon_array_out
+		all_okay = .FALSE.
+	END IF
+	DEALLOCATE(lat_array_in,	&
+				  lon_array_in,	&
+				  lat_array_out,	&
+				  lon_array_out	)
+
+
+	! Bounded lat and bounded lons - list all lons at same lat, before stepping in lat.
+	ALLOCATE(lat_array_in(20),	&
+				lon_array_in(20),	&
+				lat_array_out(20), &
+				lon_array_out(20)	)
+	lat_array_in(:) = (/1.0_fbdp, 5.0_fbdp, 1.0_fbdp, FV_real, FV_real,&
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real/)
+	lon_array_in(:) = (/10.0_fbdp, 40.0_fbdp, 10.0_fbdp, FV_real, FV_real,&
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real, &
+	                    FV_real, FV_real, FV_real, FV_real, FV_real/)
+	lat_array_out(:) = (/1.0_fbdp, 1.0_fbdp, 1.0_fbdp, 1.0_fbdp, & 
+								2.0_fbdp, 2.0_fbdp, 2.0_fbdp, 2.0_fbdp, &
+								3.0_fbdp, 3.0_fbdp, 3.0_fbdp, 3.0_fbdp, &
+								4.0_fbdp, 4.0_fbdp, 4.0_fbdp, 4.0_fbdp, &
+								5.0_fbdp, 5.0_fbdp, 5.0_fbdp, 5.0_fbdp/)
+	lon_array_out(:) = (/10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp,&
+								10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp,&
+								10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp,&
+								10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp,&
+								10.0_fbdp, 20.0_fbdp, 30.0_fbdp, 40.0_fbdp/)
+	CALL set_spatial_coords(lat_array_in,lon_array_in,20,FV_real)
+	okay = test_arrays(lat_array_in,lat_array_out)
+	okay_too = test_arrays(lon_array_in,lon_array_out)
+	IF ((okay .EQV. .FALSE.) .OR. (okay_too .EQV. .FALSE.)) THEN
+	   WRITE(*,*) "Test 46 failed"
+		WRITE(*,*) lat_array_in
+		WRITE(*,*) lon_array_in
+		WRITE(*,*) lat_array_out
+		WRITE(*,*) lon_array_out
+		all_okay = .FALSE.
+	END IF
+	DEALLOCATE(lat_array_in,	&
+				  lon_array_in,	&
+				  lat_array_out,	&
+				  lon_array_out	)
+
+
+	IF (all_okay) WRITE(*,*) "All tests passed"
+	
+	END SUBROUTINE tester
+
+END MODULE test_fbgenerate	
Index: /utils/tools_ticket2413/OBSTOOLS/src/toolspar_kind.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/toolspar_kind.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/toolspar_kind.F90	(revision 12863)
@@ -0,0 +1,8 @@
+MODULE toolspar_kind
+  IMPLICIT NONE
+  INTEGER, PUBLIC, PARAMETER ::          &  !: Floating point section
+       sp = SELECTED_REAL_KIND( 6, 37),  &  !: single precision (real 4)
+       dp = SELECTED_REAL_KIND(12,307),  &  !: double precision (real 8)
+       wp = SELECTED_REAL_KIND(12,307),  &  !: double precision (real 8)
+       ik = SELECTED_INT_KIND(6)            !: integer precision 
+END MODULE toolspar_kind
Index: /utils/tools_ticket2413/OBSTOOLS/src/vel2fb.F90
===================================================================
--- /utils/tools_ticket2413/OBSTOOLS/src/vel2fb.F90	(revision 12863)
+++ /utils/tools_ticket2413/OBSTOOLS/src/vel2fb.F90	(revision 12863)
@@ -0,0 +1,86 @@
+PROGRAM vel2fb
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM vel2fb **
+   !!
+   !!  ** Purpose : Convert TAO/PIRATA/RAMA currents to feedback format
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !!
+   !!   Usage:
+   !!     vel2fb.exe outputfile inputfile1 inputfile2 ...
+   !! 
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE obs_fbm
+   USE obs_vel_io
+   USE convmerge
+   IMPLICIT NONE
+   !
+   ! Command line arguments for output file and input files
+   !
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nargs
+   CHARACTER(len=256) :: cdoutfile
+   CHARACTER(len=256),ALLOCATABLE :: cdinfile(:)
+   !
+   ! Input data
+   !
+   TYPE(obfbdata), POINTER :: velf(:)
+   INTEGER :: ninfiles,ntotvel,nmaxlev
+   INTEGER,ALLOCATABLE  :: iset(:),inum(:),iindex(:)
+   !
+   ! Output data
+   !
+   TYPE(obfbdata) :: fbdata
+   !
+   ! Loop variables
+   !
+   INTEGER :: ia,ii,ij
+   !
+   ! Get number of command line arguments
+   !
+   nargs=IARGC()
+   IF (nargs < 1) THEN
+      WRITE(*,'(A)')'Usage:'
+      WRITE(*,'(A)')'vel2fb outputfile inputfile1 inputfile2 ...'
+      CALL abort()
+   ENDIF
+   CALL getarg(1,cdoutfile)
+   !
+   ! Get input data
+   !
+   ALLOCATE( velf(MAX(nargs-1,1)) )
+   ALLOCATE( cdinfile(nargs-1) )
+   ntotvel = 0
+   ninfiles  = nargs - 1
+   DO ia = 1,ninfiles
+      CALL getarg( ia + 1, cdinfile(ia) )
+      CALL read_taondbc( TRIM(cdinfile(ia)), velf(ia), 6, .TRUE., .FALSE. )
+      WRITE(*,'(2A)')'File = ',TRIM(cdinfile(ia))
+      WRITE(*,'(A,I9,A)')'has',velf(ia)%nobs,' profiles'
+      ntotvel = ntotvel + velf(ia)%nobs
+      nmaxlev   = MAX( nmaxlev, velf(ia)%nlev )
+   ENDDO
+   IF (ninfiles==0) THEN
+      CALL init_obfbdata( velf(1) )
+      CALL alloc_obfbdata( velf(1), 2, 0, 1, 0, 1, .FALSE. )
+      velf(1)%cname(1) = 'UVEL'
+      velf(1)%cname(2) = 'VVEL'
+      velf(1)%coblong(1) = 'Zonal current'
+      velf(1)%coblong(2) = 'Meridional current'
+      velf(1)%cobunit(1) = 'Meters per second'
+      velf(1)%cobunit(2) = 'Meters per second'
+   ENDIF
+   WRITE(*,'(A,I8)') 'Total profiles : ',ntotvel
+   !
+   ! Merge and output the data.
+   !
+   CALL conv_fbmerge( TRIM(cdoutfile), ninfiles, velf )
+
+END PROGRAM vel2fb
Index: /utils/tools_ticket2413/README.rst
===================================================================
--- /utils/tools_ticket2413/README.rst	(revision 12863)
+++ /utils/tools_ticket2413/README.rst	(revision 12863)
@@ -0,0 +1,134 @@
+*****
+Tools
+*****
+
+.. todo::
+
+   The 'Tools' chapter needs to be enriched
+
+.. contents::
+   :local:
+   :depth: 1
+
+A set of tools is provided with NEMO to setup user own configuration and (pre|post)process data.
+
+How to compile a tool
+=====================
+
+The tool can be compiled using the maketools script in the tools directory as follows:
+
+.. code-block:: console
+
+   $ ./maketools -m 'my_arch' -n '<TOOL_NAME>'
+
+where ``my_arch`` can be selected among available architecture files or providing a user defined one.
+
+List of tools
+=============
+
+BDY_TOOLS
+---------
+
+It contains the utility *bdy_reorder* used to reorder old BDY data files used with
+previous versions of the model (before 3.4) to make them compatible with NEMO 3.4.
+
+DMP_TOOLS
+---------
+
+Used to create a netcdf file called :file:`resto.nc` containing
+restoration coefficients for use with the :file:`tra_dmp` module in NEMO
+(see :download:`DMP_TOOLS README <../../../tools/DMP_TOOLS/README>`).
+
+DOMAINcfg
+---------
+
+This tool allows the creation of a domain configuration file (``domain_cfg.nc``) containing
+the ocean domain information required to define an ocean configuration from scratch.
+(see :download:`DOMAINcfg README <../../../tools/DOMAINcfg/README>`).
+
+GRIDGEN
+-------
+
+A toolbox allowing the creation of regional configurations from curvilinear grid
+(see :download:`GRIDGEN documentation <../../../tools/GRIDGEN/doc_cfg_tools.pdf>`).
+
+MISCELLANEOUS
+-------------
+
+The tool allows to create alternative configurations to the community without
+having to rely on system team sponsorship and support.
+
+MPP_PREP
+--------
+
+This tool provides the user with information to choose the best domain decomposition.
+The tool computes the number of water processors for all possible decompositions,
+up to a maximum number of processors
+(see :download:`MPP_PREP documentation <../../../tools/MPP_PREP/mpp_nc.pdf>` and
+:download:`MPP_PREP archive <../../../tools/MPP_PREP/mpp_prep-1.0.tar.gz>`).
+
+NESTING
+-------
+
+AGRIF nesting tool allows for the seamless two-way coupling of nested sub-models within
+the NEMO framework as long as these are defined on subsets of the original root grid.
+It allows to create the grid coordinates, the surface forcing and the initial conditions required by
+each sub-model when running a NEMO/AGRIF embedded mode
+(see :download:`NESTING README <../../../tools/NESTING/README>`).
+
+OBSTOOLS
+--------
+
+A series of Fortran utilities which are helpful in handling observation files and
+the feedback file output from the NEMO observation operator.
+Further info are available in the :doc:`Nemo manual <cite>`.
+
+REBUILD_NEMO
+------------
+
+REBUILD_NEMO is a tool to rebuild NEMO output files from multiple processors
+(mesh_mask, restart or XIOS output files) into one file
+(see :download:`REBUILD_NEMO README <../../../tools/REBUILD_NEMO/README.rst>`).
+
+REBUILD
+-------
+
+It contains the old version of REBUILD_NEMO tool based on the IOIPSL code.
+
+SCOORD_GEN
+----------
+
+Offline tool to generate a vertical coordinates input file for use with S coordinates.
+This has been carried out by copying the model code to an offline tool and then
+modifying it to suppress the use of 3D arrays (to reduce memory usage).
+The tool has been created in preparation for the removal of the vertical grid definition from
+the code.
+The output file should contain all variables that are necessary to restart the model.
+
+SECTIONS_DIADCT
+---------------
+
+When the Transport across sections diagnostic is activated (``key_diadct``),
+this tool is used to build the binary file containing the pathways between
+the extremities of each section.
+Further info are available in the :doc:`Nemo manual <cite>`.
+
+SIREN
+-----
+
+SIREN is a configuration management tool to set up regional configurations with NEMO
+(see :download:`SIREN README <../../../tools/SIREN/README>`).
+
+WEIGHTS
+-------
+
+This directory contains software for generating and manipulating interpolation weights for use with
+the Interpolation On the Fly (IOF) option in NEMO v3 onwards
+(see :download:`WEIGHTS README <../../../tools/WEIGHTS/README>`).
+
+TOYATM
+------
+
+This directory contains a simplified model that send/receive atmospheric fields to/from NEMO.
+Used to test the coupling interface.
+This toy requires OASIS3-MCT to be installed and properly defined in the arch file.
Index: /utils/tools_ticket2413/REBUILD/rebuild
===================================================================
--- /utils/tools_ticket2413/REBUILD/rebuild	(revision 12863)
+++ /utils/tools_ticket2413/REBUILD/rebuild	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../ext/IOIPSL/tools/rebuild
Index: /utils/tools_ticket2413/REBUILD/src/calendar.f90
===================================================================
--- /utils/tools_ticket2413/REBUILD/src/calendar.f90	(revision 12863)
+++ /utils/tools_ticket2413/REBUILD/src/calendar.f90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../ext/IOIPSL/src/calendar.f90
Index: /utils/tools_ticket2413/REBUILD/src/defprec.f90
===================================================================
--- /utils/tools_ticket2413/REBUILD/src/defprec.f90	(revision 12863)
+++ /utils/tools_ticket2413/REBUILD/src/defprec.f90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../ext/IOIPSL/src/defprec.f90
Index: /utils/tools_ticket2413/REBUILD/src/errioipsl.f90
===================================================================
--- /utils/tools_ticket2413/REBUILD/src/errioipsl.f90	(revision 12863)
+++ /utils/tools_ticket2413/REBUILD/src/errioipsl.f90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../ext/IOIPSL/src/errioipsl.f90
Index: /utils/tools_ticket2413/REBUILD/src/flincom.f90
===================================================================
--- /utils/tools_ticket2413/REBUILD/src/flincom.f90	(revision 12863)
+++ /utils/tools_ticket2413/REBUILD/src/flincom.f90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../ext/IOIPSL/src/flincom.f90
Index: /utils/tools_ticket2413/REBUILD/src/flio_rbld.f90
===================================================================
--- /utils/tools_ticket2413/REBUILD/src/flio_rbld.f90	(revision 12863)
+++ /utils/tools_ticket2413/REBUILD/src/flio_rbld.f90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../ext/IOIPSL/tools/flio_rbld.f90
Index: /utils/tools_ticket2413/REBUILD/src/fliocom.f90
===================================================================
--- /utils/tools_ticket2413/REBUILD/src/fliocom.f90	(revision 12863)
+++ /utils/tools_ticket2413/REBUILD/src/fliocom.f90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../ext/IOIPSL/src/fliocom.f90
Index: /utils/tools_ticket2413/REBUILD/src/getincom.f90
===================================================================
--- /utils/tools_ticket2413/REBUILD/src/getincom.f90	(revision 12863)
+++ /utils/tools_ticket2413/REBUILD/src/getincom.f90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../ext/IOIPSL/src/getincom.f90
Index: /utils/tools_ticket2413/REBUILD/src/histcom.f90
===================================================================
--- /utils/tools_ticket2413/REBUILD/src/histcom.f90	(revision 12863)
+++ /utils/tools_ticket2413/REBUILD/src/histcom.f90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../ext/IOIPSL/src/histcom.f90
Index: /utils/tools_ticket2413/REBUILD/src/ioipsl.f90
===================================================================
--- /utils/tools_ticket2413/REBUILD/src/ioipsl.f90	(revision 12863)
+++ /utils/tools_ticket2413/REBUILD/src/ioipsl.f90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../ext/IOIPSL/src/ioipsl.f90
Index: /utils/tools_ticket2413/REBUILD/src/mathelp.f90
===================================================================
--- /utils/tools_ticket2413/REBUILD/src/mathelp.f90	(revision 12863)
+++ /utils/tools_ticket2413/REBUILD/src/mathelp.f90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../ext/IOIPSL/src/mathelp.f90
Index: /utils/tools_ticket2413/REBUILD/src/nc4interface.F90
===================================================================
--- /utils/tools_ticket2413/REBUILD/src/nc4interface.F90	(revision 12863)
+++ /utils/tools_ticket2413/REBUILD/src/nc4interface.F90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../ext/IOIPSL/src/nc4interface.F90
Index: /utils/tools_ticket2413/REBUILD/src/ncunderflow.f90
===================================================================
--- /utils/tools_ticket2413/REBUILD/src/ncunderflow.f90	(revision 12863)
+++ /utils/tools_ticket2413/REBUILD/src/ncunderflow.f90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../ext/IOIPSL/tools/ncunderflow.f90
Index: /utils/tools_ticket2413/REBUILD/src/restcom.f90
===================================================================
--- /utils/tools_ticket2413/REBUILD/src/restcom.f90	(revision 12863)
+++ /utils/tools_ticket2413/REBUILD/src/restcom.f90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../ext/IOIPSL/src/restcom.f90
Index: /utils/tools_ticket2413/REBUILD/src/stringop.f90
===================================================================
--- /utils/tools_ticket2413/REBUILD/src/stringop.f90	(revision 12863)
+++ /utils/tools_ticket2413/REBUILD/src/stringop.f90	(revision 12863)
@@ -0,0 +1,1 @@
+link ../../../ext/IOIPSL/src/stringop.f90
Index: /utils/tools_ticket2413/REBUILD_NEMO/BATCH_TEMPLATES/param_XC40_METO
===================================================================
--- /utils/tools_ticket2413/REBUILD_NEMO/BATCH_TEMPLATES/param_XC40_METO	(revision 12863)
+++ /utils/tools_ticket2413/REBUILD_NEMO/BATCH_TEMPLATES/param_XC40_METO	(revision 12863)
@@ -0,0 +1,3 @@
+#!/bin/ksh
+BATCH_CMD="qsub"
+ARCH="XC40_METO"
Index: /utils/tools_ticket2413/REBUILD_NEMO/BATCH_TEMPLATES/rebuild_nemo_batch_PW7_METO
===================================================================
--- /utils/tools_ticket2413/REBUILD_NEMO/BATCH_TEMPLATES/rebuild_nemo_batch_PW7_METO	(revision 12863)
+++ /utils/tools_ticket2413/REBUILD_NEMO/BATCH_TEMPLATES/rebuild_nemo_batch_PW7_METO	(revision 12863)
@@ -0,0 +1,31 @@
+#!/bin/ksh
+#
+#@ shell           = /usr/bin/ksh
+#@ class           = serial
+#@ job_type        = serial
+#@ job_name        = rebuild_nemo
+#@ output          = $(job_name).$(jobid).out
+#@ error           = $(job_name).$(jobid).out
+#@ notification    = never
+#@ resources       = ConsumableMemory(MEMORY)
+#@ node            = 1
+#@ parallel_threads = 8
+#@ task_affinity    = cpu(NTHREADS)
+#@ cpu_limit        = 00:5:00
+#@ wall_clock_limit = 00:5:00
+#@ queue
+
+export OMP_NUM_THREADS=NTHREADS
+
+MPI_DSM_VERBOSE=1; export MPI_DSM_VERBOSE
+
+nam_rebuild=NAMELIST
+indir=INDIR
+
+
+cd ${LOADL_STEP_INITDIR}
+
+${indir}/rebuild_nemo.exe $nam_rebuild
+RC=$?
+
+exit $RC
Index: /utils/tools_ticket2413/REBUILD_NEMO/BATCH_TEMPLATES/rebuild_nemo_batch_XC40_METO
===================================================================
--- /utils/tools_ticket2413/REBUILD_NEMO/BATCH_TEMPLATES/rebuild_nemo_batch_XC40_METO	(revision 12863)
+++ /utils/tools_ticket2413/REBUILD_NEMO/BATCH_TEMPLATES/rebuild_nemo_batch_XC40_METO	(revision 12863)
@@ -0,0 +1,21 @@
+#!/bin/bash --login
+#PBS -N Rebuild_Nemo
+#PBS -q shared
+#PBS -l ncpus=NTHREADS
+#PBS -l mem=MEMORY
+#PBS -l walltime=1:0:0
+
+export OMP_NUM_THREADS=NTHREADS
+indir=INDIR
+nam_rebuild=NAMELIST
+
+ulimit -s unlimited
+ulimit -n NOPEN
+
+module load cray-snplauncher
+cd $PBS_O_WORKDIR
+${indir}/rebuild_nemo.exe $nam_rebuild
+
+RC=$?
+
+exit $RC
Index: /utils/tools_ticket2413/REBUILD_NEMO/README.rst
===================================================================
--- /utils/tools_ticket2413/REBUILD_NEMO/README.rst	(revision 12863)
+++ /utils/tools_ticket2413/REBUILD_NEMO/README.rst	(revision 12863)
@@ -0,0 +1,118 @@
+============
+REBUILD_NEMO
+============
+REBUILD_NEMO is a tool to rebuild NEMO output files from multiple processors (mesh_mask, restart or XIOS output files) into one file.
+
+Description
+===========
+
+NEMO rebuild has the following features:
+ * dynamically works out what variables require rebuilding
+ * does not copy subdomain halo regions
+ * works for 1,2,3 and 4d arrays or types for all valid NetCDF types
+ * utilises OMP shared memory parallelisation where applicable
+ * time 'slicing' for lower memory use  (only for 4D vars with unlimited dimension)
+
+The code reads the filestem and number of subdomains from the namelist file nam_rebuild.
+| The 1st subdomain file is used to determine the dimensions and variables in all the input files. 
+It is also used to find which dimensions (and hence which variables) require rebuilding 
+as well as information about the global domain.
+| It then opens all the input files (unbuffered) and creates an array of netcdf identifiers
+before looping through all the variables and updating the rebuilt output file (either by direct 
+copying or looping over the number of domains and rebuilding as appropriate).
+| The code looks more complicated than it is because it has lots of case statements to deal with all 
+the various NetCDF data types and with various data dimensions (up to 4d).
+| Diagnostic output is written to numout (default 6 - stdout)
+and errors are written to numerr (default 0 - stderr).
+| If time slicing is specified the code will use less memory but take a little longer.
+It does this by breaking down the 4D input variables over their 4th dimension 
+(generally time) by way of a while loop.
+
+How to compile it
+=================
+REBUILD_NEMO is compiled in the same manner as all the other tools. 
+The compilation script is maketools and the option are very similar to makenemo. 
+
+Here an example of how to compile REBUILD_NEMO on the MetOffice XC40 HPC:
+
+.. code-block:: console
+                      
+        $ ./maketools -n REBUILD_NEMO -m XC40_METO
+
+Usage
+=====
+There is 2 manners to use REBUILD_NEMO:
+
+* **rebuild_nemo shell script**
+
+If the rebuild_nemo shell script it used, the namelist is filled automatically depending on the on-line arguments.
+
+.. code-block:: console
+
+ $ ./rebuild_nemo
+
+  NEMO Rebuild
+  ************
+
+  usage: rebuild_nemo [-l -p -s -m -n -r -d -x -y -z -t -c] filebase ndomain [rebuild dimensions]
+
+  flags:    -l arch            submit to compute node
+            -p num             use num threads
+            -s num             split 4D vars into time slice of size num
+            -m                 force masking of global arrays (zero if no mdi)
+            -n namelist        full path to namelist file to be created (otherwise default nam_rebuild+_process_id is used)
+            -r memory          Memory to request on compute node including units (Default = 10Gb)
+
+      key_netcdf4 only 
+            -d deflate_level     deflate level for output files
+            -x chunksize along x 
+            -y chunksize along y 
+            -z chunksize along z 
+            -t chunksize along t 
+            -c total size of the chunk cache 
+
+In case the option '-l arch' is used, a template for the batch script and parameter for job submission has to be provided in BATCH_TEMPLATES (param_arch and rebuild_nemo_batch_arch). 
+Exemple from the XC40_METO architecture can be found in the directory. 
+Some keywords (NTHREADS, MEMORY, INDIR, NAMELIST and NOPEN) from the template are replaced by the rebuild_nemo script.
+
+* **rebuild_nemo.exe + namelist**
+
+If rebuild_nemo.exe is used directly, a namelist has to be provided. Default name is nam_rebuild. A specific name can be provided as argument.
+The minimal namelist required is (here example to rebuild a mesh_mask split in 36 files):
+
+.. code-block:: console
+
+         &nam_rebuild
+         filebase='mesh_mask'
+         ndomain=36
+         /
+
+Some option can be added (the value mentioned here are the default value):
+
+.. code-block:: console
+
+         l_maskout=.false       !(-m option: useful if input file comes from a run using land suppression)
+         nslicesize=0           !(-s option: 0 means no splitting in time slice)
+         deflate_level=0        !(-d option)
+         nc4_xchunk=206         !(-x option)
+         nc4_ychunk=135         !(-y option)
+         nc4_zchunk=1           !(-z option)
+         nc4_tchunk=1           !(-t option)
+         fchunksize=32000000    !(-c option)
+
+Example
+=======
+
+Here is an example of usage of rebuild_nemo shelf script
+(rebuild mesh_mask files on the XC40_METO computer with deflation level set to 1 and chunksize to (1,1,100,100)):
+
+.. code-block:: console
+
+          $ rebuild_nemo -l XC40_METO -m -d 1 -x 100 -y 100 -z 1 -t 1 mesh_mask 36
+
+          output is mask using netcdf missing value (_Fillvalue attribute) or 0 if missing value not in the netcdf.
+
+          file mesh_mask,  num_domains 36, num_threads 1
+          Submitting job to compute node
+          8510610.xcs00
+         $
Index: /utils/tools_ticket2413/REBUILD_NEMO/icb_combrest.py
===================================================================
--- /utils/tools_ticket2413/REBUILD_NEMO/icb_combrest.py	(revision 12863)
+++ /utils/tools_ticket2413/REBUILD_NEMO/icb_combrest.py	(revision 12863)
@@ -0,0 +1,275 @@
+import os
+from netCDF4 import Dataset
+from argparse import ArgumentParser
+import numpy as np
+import sys
+
+#
+# Basic iceberg trajectory restart post-processing python script.
+# This script collects iceberg information from the distributed restarts written
+# out by each processing region and writes the information into a global restart file.
+# The global restart file must already exist and contain the collated 2D spatial fields
+# as prepared by utilities such as rebuild_nemo. This python script simply adds the
+# iceberg position and state data that is held using the unlimited dimension 'n' which
+# has been ignored by rebuild_nemo. Each processing region that contains icebergs will
+# (probably) have a different number of icebergs (indicated by differing values for the
+# current size of the unlimited dimension). This script collects all icebergs into a 
+# single unordered list.
+#
+
+parser = ArgumentParser(description='produce a global trajectory restart file from distributed output\
+                                     files, e.g. \n python ./icb_pp.py \
+                                     -f  icebergs_00692992_restart_ -n 480 -o icebergs_restart.nc [-O]')
+
+parser.add_argument('-f',dest='froot',help='fileroot_of_distrbuted_data; root name of \
+                     distributed trajectory restart file (usually completed with XXXX.nc, where \
+                     XXXX is the 4 digit processor number)', 
+                     default='icebergs_00692992_restart_')
+
+parser.add_argument('-n',dest='fnum',help='number of distributed files to process', 
+                     type=int, default=None)
+
+parser.add_argument('-o',dest='fout',help='global_iceberg_restart; file name to append the \
+                     global iceberg restart data to.', default='icebergs_restart.nc')
+
+parser.add_argument('-O',dest='fcre',help='Create the output file from scratch rather than \
+                     append to an existing file.', \
+                     action='store_true', default=False)
+
+args = parser.parse_args()
+
+default_used = 0
+if args.froot is None:
+    pathstart = 'icebergs_00692992_restart_'
+    default_used = 1
+else:
+    pathstart = args.froot
+
+if args.fnum is None:
+    procnum = 0
+    default_used = 1
+else:
+    procnum = args.fnum
+
+if args.fout is None:
+    pathout = 'icebergs_restart.nc'
+    default_used = 1
+else:
+    pathout = args.fout
+
+if default_used == 1:
+   print('At least one default value will be used; command executing is:')
+   print('icb_combrest.py -f ',pathstart,' -n ',procnum,' -o ',pathout)
+
+if procnum < 1:
+   print('Need some files to collate! procnum = ',procnum)
+   sys.exit(11)
+
+icu = []
+times = []
+ntraj = 0
+nk = 0
+#
+# Loop through all distributed datasets to obtain the total number 
+# of icebergs to transfer
+#
+for n in range(procnum):
+ nn = '%4.4d' % n
+ try:
+   fw = Dataset(pathstart+nn+'.nc')
+ except:
+   print 'Error: unable to open input file: ' + pathstart+nn+'.nc'
+   sys.exit(12)
+ for d in fw.dimensions :
+  if d == 'n' :
+   if len(fw.dimensions['n']) > 0:
+#    print 'icebergs found in: ' + pathstart+nn+'.nc' 
+     if len(fw.dimensions['k']) > nk :
+       nk = len(fw.dimensions['k'])
+     ntraj = ntraj + len(fw.dimensions['n'])
+ fw.close()
+#
+print(ntraj, ' icebergs found across all datasets')
+#
+# Declare 2-D arrays to receive the data from all files
+#
+lons = np.zeros(ntraj)
+lats = np.zeros(ntraj)
+xis  = np.zeros(ntraj)
+yjs  = np.zeros(ntraj)
+uvs  = np.zeros(ntraj)
+vvs  = np.zeros(ntraj)
+mas  = np.zeros(ntraj)
+ths  = np.zeros(ntraj)
+wis  = np.zeros(ntraj)
+les  = np.zeros(ntraj)
+dys  = np.zeros(ntraj)
+mss  = np.zeros(ntraj)
+msb  = np.zeros(ntraj)
+hds  = np.zeros(ntraj)
+yrs  = np.zeros(ntraj      , dtype=int)
+num  = np.zeros((ntraj, nk), dtype=int)
+#
+# loop through distributed datasets again, this time
+# collecting all trajectory data
+#
+nt = 0
+for n in range(procnum):
+ nn = '%4.4d' % n
+ fw = Dataset(pathstart+nn+'.nc')
+ for d in fw.dimensions :
+  if d == 'n' :
+# Note many distributed datafiles will contain no iceberg data
+# so skip quickly over these
+    m  = len(fw.dimensions['n'])
+    if m > 0:
+#     print pathstart+nn+'.nc'
+      lons[nt:nt+m]  = fw.variables['lon'][:]
+      lats[nt:nt+m]  = fw.variables['lat'][:]
+      xis[nt:nt+m]   = fw.variables['xi'][:]
+      yjs[nt:nt+m]   = fw.variables['yj'][:]
+      uvs[nt:nt+m]   = fw.variables['uvel'][:]
+      vvs[nt:nt+m]   = fw.variables['vvel'][:]
+      mas[nt:nt+m]   = fw.variables['mass'][:]
+      ths[nt:nt+m]   = fw.variables['thickness'][:]
+      wis[nt:nt+m]   = fw.variables['width'][:]
+      les[nt:nt+m]   = fw.variables['length'][:]
+      dys[nt:nt+m]   = fw.variables['day'][:]
+      mss[nt:nt+m]   = fw.variables['mass_scaling'][:]
+      msb[nt:nt+m]   = fw.variables['mass_of_bits'][:]
+      hds[nt:nt+m]   = fw.variables['heat_density'][:]
+      yrs[nt:nt+m]   = fw.variables['year'][:]
+      num[nt:nt+m,:] = fw.variables['number'][:,:]
+      nt = nt + m
+ fw.close()
+
+# Finally create the output file and write out the collated sets
+#
+if args.fcre :
+  try:
+    fo = Dataset(pathout, 'w', format='NETCDF4')
+  except:
+    print 'Error accessing output file: ' + pathout
+    print 'Check it is a writable location.'
+    sys.exit(13)
+else :
+  # Copy 2D variables across to output file from input file. This step avoids problems if rebuild_nemo 
+  # has created an "n" dimension in the prototype rebuilt file (ie. if there are icebergs on the zeroth 
+  # processor). 
+  try:
+    os.rename(pathout,pathout.replace('.nc','_WORK.nc'))
+  except OSError:
+    print 'Error: unable to move icebergs restart file: '+pathout
+    sys.exit(14)
+  #
+  try:
+    fi = Dataset(pathout.replace('.nc','_WORK.nc'), 'r')
+  except:
+    print 'Error: unable to open icebergs restart file: '+pathout.replace('.nc','_WORK.nc')
+    sys.exit(15)
+  fo = Dataset(pathout, 'w')
+  for dim in ['x','y','c','k']:
+    indim = fi.dimensions[dim]
+    fo.createDimension(dim, len(indim))
+  for var in ['kount','calving','calving_hflx','stored_ice','stored_heat']:
+    invar = fi.variables[var]
+    fo.createVariable(var, invar.datatype, invar.dimensions)
+    fo.variables[var][:] = invar[:]
+    if "long_name" in invar.ncattrs():
+        fo.variables[var].long_name = invar.long_name
+    if "units" in invar.ncattrs():
+        fo.variables[var].units = invar.units
+  os.remove(pathout.replace('.nc','_WORK.nc'))
+#
+add_k = 1
+for d in fo.dimensions :
+  if d == 'n' :
+    print 'Error: dimension n already exists in output file'
+    sys.exit(16)
+  if d == 'k' :
+    add_k = 0
+onn  = fo.createDimension('n', None)
+if add_k > 0 :
+ onk = fo.createDimension('k', nk)
+olon = fo.createVariable('lon', 'f8',('n'))
+olat = fo.createVariable('lat', 'f8',('n'))
+oxis = fo.createVariable('xi', 'f8',('n'))
+oyjs = fo.createVariable('yj', 'f8',('n'))
+ouvs = fo.createVariable('uvel', 'f8',('n'))
+ovvs = fo.createVariable('vvel', 'f8',('n'))
+omas = fo.createVariable('mass', 'f8',('n'))
+oths = fo.createVariable('thickness', 'f8',('n'))
+owis = fo.createVariable('width', 'f8',('n'))
+oles = fo.createVariable('length', 'f8',('n'))
+odys = fo.createVariable('day', 'f8',('n'))
+omss = fo.createVariable('mass_scaling', 'f8',('n'))
+omsb = fo.createVariable('mass_of_bits', 'f8',('n'))
+ohds = fo.createVariable('heat_density', 'f8',('n'))
+oyrs = fo.createVariable('year', 'i4',('n'))
+onum = fo.createVariable('number', 'i4',('n','k'))
+#
+olon[:] = lons
+olon.long_name = "longitude"
+olon.units = "degrees_E" 
+#
+olat[:] = lats
+olat.long_name = "latitude"
+olat.units = "degrees_N"
+#
+oxis[:] = xis
+oxis.long_name = "x grid box position"
+oxis.units = "fractional"
+#
+oyjs[:] = yjs
+oyjs.long_name = "y grid box position"
+oyjs.units = "fractional"
+#
+ouvs[:] = uvs
+ouvs.long_name = "zonal velocity"
+ouvs.units = "m/s"
+#
+ovvs[:] = vvs
+ovvs.long_name = "meridional velocity"
+ovvs.units = "m/s"
+#
+omas[:] = mas
+omas.long_name = "mass"
+omas.units = "kg"
+#
+oths[:] = ths
+oths.long_name = "thickness"
+oths.units = "m"
+#
+owis[:] = wis
+owis.long_name = "width"
+owis.units = "m"
+#
+oles[:] = les
+oles.long_name = "length"
+oles.units = "m"
+#
+odys[:] = dys
+odys.long_name = "year day of calving event"
+odys.units = "days"
+#
+omss[:] = mss
+omss.long_name = "scaling factor for mass of calving berg"
+omss.units = "none"
+#
+omsb[:] = msb
+omsb.long_name = "mass of bergy bits"
+omsb.units = "kg"
+#
+ohds[:] = hds
+ohds.long_name = "heat density"
+ohds.units = "J/kg"
+#
+oyrs[:] = yrs
+oyrs.long_name = "calendar year of calving event"
+oyrs.units = "years"
+#
+onum[:,:] = num
+onum.long_name = "iceberg number on this processor"
+onum.units = "count"
+#
+fo.close()
Index: /utils/tools_ticket2413/REBUILD_NEMO/nam_rebuild
===================================================================
--- /utils/tools_ticket2413/REBUILD_NEMO/nam_rebuild	(revision 12863)
+++ /utils/tools_ticket2413/REBUILD_NEMO/nam_rebuild	(revision 12863)
@@ -0,0 +1,12 @@
+&nam_rebuild
+filebase='mesh_mask'
+ndomain=36
+l_maskout=.false       !(-m option: useful if input file comes from a run using land suppression)
+nslicesize=0           !(-s option: 0 means no splitting in time slice)
+deflate_level=1        !(-d option)
+nc4_xchunk=206         !(-x option)
+nc4_ychunk=135         !(-y option)
+nc4_zchunk=1           !(-z option)
+nc4_tchunk=1           !(-t option)
+fchunksize=32000000    !(-c option)
+/
Index: /utils/tools_ticket2413/REBUILD_NEMO/rebuild_nemo
===================================================================
--- /utils/tools_ticket2413/REBUILD_NEMO/rebuild_nemo	(revision 12863)
+++ /utils/tools_ticket2413/REBUILD_NEMO/rebuild_nemo	(revision 12863)
@@ -0,0 +1,183 @@
+#!/bin/ksh
+
+# CALLS: rebuild_nemo.exe
+
+#set -ax
+usage ()
+{
+   echo
+   echo "  NEMO Rebuild"
+   echo "  ************"
+   echo
+   echo "  usage: ${0##*/} [-l -p -s -m -n -r -d -x -y -z -t -c] filebase ndomain [rebuild dimensions]"
+   echo
+   echo "  flags:    -l arch            submit to compute node"
+   echo "            -p num             use num threads"
+   echo "            -s num             split 4D vars into time slice of size num"
+   echo "            -m                 force masking of global arrays (zero if no mdi)"
+   echo "            -n namelist        full path to namelist file to be created (otherwise default nam_rebuild+_process_id is used)"
+   echo "            -r memory          Memory to request on compute node including units (Default = 10Gb)"
+   echo ""
+   echo "      key_netcdf4 only "
+   echo "            -d deflate_level     deflate level for output files"
+   echo "            -x chunksize along x " 
+   echo "            -y chunksize along y " 
+   echo "            -z chunksize along z " 
+   echo "            -t chunksize along t " 
+   echo "            -c total size of the chunk cache "
+   echo
+   exit 1
+}
+
+while getopts l:p:s:n:r:d:x:y:z:t:c:m opt
+do
+  case ${opt} in
+      l) 
+         BATCH="yes"
+         ARCH=${OPTARG}
+      ;;
+      p)
+         OMP_NUM_THREADS=${OPTARG}
+      ;;
+      s)
+         NSLICESIZE=${OPTARG}
+      ;;
+      m) 
+         NMASK="TRUE"
+         echo ""
+         echo "output is mask using netcdf missing value (_Fillvalue attribute) or 0 if missing value not in the netcdf."
+         echo ""
+      ;;
+      d)
+         DEFLATE=${OPTARG}
+      ;;
+      n)
+         nam_rebuild=${OPTARG}
+      ;;
+      r)
+         MEMORY=${OPTARG}
+      ;;
+      x)
+         NXCHUNK=${OPTARG}
+      ;;
+      y)
+         NYCHUNK=${OPTARG}
+      ;;
+      z)
+         NZCHUNK=${OPTARG}
+      ;;
+      t)
+         NTCHUNK=${OPTARG}
+      ;;
+      c)
+         CHUNKSIZE=${OPTARG}
+      ;;
+  esac
+done
+shift $(expr ${OPTIND} - 1)
+
+if [[ $# -lt 2 ]] ; then
+   usage
+fi
+
+script_dir=$(dirname $0)
+
+file=$1
+ndomain=$2
+DIM1=$3
+DIM2=$4
+export OMP_NUM_THREADS=${OMP_NUM_THREADS:-1}
+nam_rebuild=${nam_rebuild:-nam_rebuild_$$}
+MEMORY=${MEMORY:-10Gb}
+
+#Find out the maximum number of files that can be opened and increase if necessary)
+nopen=$(ulimit -n)
+if [[ $ndomain -gt $nopen ]] ; then
+  nopen=$((ndomain+4))   # +2 failed !!!
+fi
+
+if [[ -n ${DIM1} && -n ${DIM2} ]] ; then
+   dim_str=" dims '${DIM1}','${DIM2}'"
+   dims="dims='${DIM1}','${DIM2}'"
+fi
+
+echo "file ${file},  num_domains ${ndomain}, num_threads ${OMP_NUM_THREADS}${dim_str}"
+
+cat > $nam_rebuild << EOC
+&nam_rebuild
+filebase='${file}'
+ndomain=${ndomain}
+EOC
+if [[ -n ${dims} ]] ; then
+   echo ${dims} >> $nam_rebuild
+fi
+if [[ -n ${NCSLICESIZE} ]] ; then
+   echo " nslicesize=${NCSLICESIZE}" >> $nam_rebuild
+fi
+if [[ -n ${NMASK} ]] ; then
+   echo " l_maskout=.true." >> $nam_rebuild
+fi
+if [[ -n ${DEFLATE} ]] ; then
+   echo " deflate_level=${DEFLATE}" >> $nam_rebuild
+fi
+if [[ -n ${NXCHUNK} ]] ; then
+   echo " nc4_xchunk=${NXCHUNK}" >> $nam_rebuild
+fi
+if [[ -n ${NYCHUNK} ]] ; then
+   echo " nc4_ychunk=${NYCHUNK}" >> $nam_rebuild
+fi
+if [[ -n ${NZCHUNK} ]] ; then
+   echo " nc4_zchunk=${NZCHUNK}" >> $nam_rebuild
+fi
+if [[ -n ${NTCHUNK} ]] ; then
+   echo " nc4_tchunk=${NTCHUNK}" >> $nam_rebuild
+fi
+if [[ -n ${CHUNKSIZE} ]] ; then
+   echo " fchunksize=${CHUNKSIZE}" >> $nam_rebuild
+fi
+
+
+
+echo "/" >> $nam_rebuild
+
+if [[ ${BATCH} == "yes" ]] ; then
+
+   template_dir=${script_dir}/BATCH_TEMPLATES/
+   param_file=${template_dir}/param_${ARCH}
+   if [ ! -f $param_file ]; then 
+      echo ''
+      echo "E R R O R: $param_file is missing, stop 42"
+      echo ''
+      echo "check your arch name or add one $param_file file in BATCH_TEMPLATES"
+      echo ''
+      exit 42
+   fi
+   . $param_file
+
+   batch_file=rebuild_nemo_batch_${ARCH}
+   if [ ! -f ${template_dir}/${batch_file} ]; then 
+      echo ''
+      echo "E R R O R: $batch_file is missing, stop 42"
+      echo ''
+      echo "check your arch name or add one $batch_file file in BATCH_TEMPLATES"
+      echo ''
+      exit 42
+   fi
+
+   #Create a modified local copy of the batch submission file
+   #The process ID is appended to the end of the file name so it is unique
+   cat ${template_dir}/${batch_file} | sed -e"s/NTHREADS/${OMP_NUM_THREADS}/" \
+      -e"s/MEMORY/${MEMORY}/" \
+      -e"s:INDIR:${script_dir}:" \
+      -e"s/NOPEN/${nopen}/" \
+      -e"s/NAMELIST/${nam_rebuild}/" > ${batch_file}_$$.sh
+   
+   #Submit the job
+   echo "Submitting job to compute node"
+   $BATCH_CMD ${batch_file}_$$.sh
+
+else
+   ulimit -n $nopen
+   ${script_dir}/rebuild_nemo.exe $nam_rebuild
+fi
+
Index: /utils/tools_ticket2413/REBUILD_NEMO/src/rebuild_nemo.F90
===================================================================
--- /utils/tools_ticket2413/REBUILD_NEMO/src/rebuild_nemo.F90	(revision 12863)
+++ /utils/tools_ticket2413/REBUILD_NEMO/src/rebuild_nemo.F90	(revision 12863)
@@ -0,0 +1,1326 @@
+PROGRAM rebuild_nemo
+#define key_netcdf4
+   !!=========================================================================
+   !!                        ***  rebuild_nemo  ***
+   !!=========================================================================
+   !!
+   !!  A routine to rebuild NEMO files from multiple processors into one file.
+   !!  This routine is designed to be much quicker than the old IOIPSL rebuild
+   !!  but at the cost of an increased memory usage.
+   !!
+   !!  NEMO rebuild has the following features:
+   !!     * dynamically works out what variables require rebuilding
+   !!     * does not copy subdomain halo regions
+   !!     * works for 1,2,3 and 4d arrays or types for all valid NetCDF types
+   !!     * utilises OMP shared memory parallelisation where applicable
+   !!     * time 'slicing' for lower memory use 
+   !!       (only for 4D vars with unlimited dimension)
+   !!
+   !!  Ed Blockley - August 2011
+   !!  (based on original code by Matt Martin)
+   !!  Julien Palmieri and Andrew Coward - September 2018 (add compression and chunking)
+   !!
+   !!-------------------------------------------------------------------------
+   !!
+   !!  The code reads the filestem and number of subdomains from the namelist file nam_rebuild.
+   !! 
+   !!  The 1st subdomain file is used to determine the dimensions and variables in all the input files. 
+   !!  It is also used to find which dimensions (and hence which variables) require rebuilding 
+   !!  as well as information about the global domain.
+   !!
+   !!  It then opens all the input files (unbuffered) and creates an array of netcdf identifiers
+   !!  before looping through all the variables and updating the rebuilt output file (either by direct 
+   !!  copying or looping over the number of domains and rebuilding as appropriate).
+   !!  
+   !!  The code looks more complicated than it is because it has lots of case statements to deal with all 
+   !!  the various NetCDF data types and with various data dimensions (up to 4d).
+   !!
+   !!  Diagnostic output is written to numout (default 6 - stdout)
+   !!  and errors are written to numerr (default 0 - stderr).
+   !!
+   !!  If time slicing is specified the code will use less memory but take a little longer.
+   !!  It does this by breaking down the 4D input variables over their 4th dimension 
+   !!  (generally time) by way of a while loop.
+   !!
+   !!-------------------------------------------------------------------------------
+  
+   USE netcdf
+
+!$ USE omp_lib           ! Note OpenMP sentinel
+
+   IMPLICIT NONE
+
+   ! kind specifications
+   INTEGER,PARAMETER :: i1=SELECTED_INT_KIND(2)          ! NF90_BYTE 
+   INTEGER,PARAMETER :: i2=SELECTED_INT_KIND(4)          ! NF90_SHORT
+   INTEGER,PARAMETER :: i4=SELECTED_INT_KIND(9)          ! NF90_INT
+   INTEGER,PARAMETER :: sp=SELECTED_REAL_KIND(6,37)      ! NF90_FLOAT
+   INTEGER,PARAMETER :: dp=SELECTED_REAL_KIND(12,307)    ! NF90_DOUBLE
+
+   INTEGER,PARAMETER :: numnam = 11
+   INTEGER,PARAMETER :: numout = 6
+   INTEGER,PARAMETER :: numerr = 0
+
+   LOGICAL, PARAMETER :: l_verbose = .true. 
+    
+   CHARACTER(LEN=nf90_max_name) :: filebase, suffix, attname, dimname, varname, time, date, zone, timestamp
+   CHARACTER(LEN=nf90_max_name), ALLOCATABLE :: filenames(:), indimnames(:)
+   CHARACTER(LEN=nf90_max_name), DIMENSION(2) :: dims
+   CHARACTER(LEN=256) :: cnampath, cdimlst, cdim
+   CHARACTER(LEN=50)  :: clibnc ! netcdf library version
+
+   INTEGER :: ndomain, ifile, ndomain_file, nslicesize, deflate_level
+   INTEGER :: ncid, outid, idim, istop
+   INTEGER :: natts, attid, xtype, varid, rbdims 
+   INTEGER :: jv, ndims, nvars, dimlen, dimids(4)
+   INTEGER :: dimid, unlimitedDimId, di, dj, dr
+   INTEGER :: nmax_unlimited, nt, ntslice 
+   INTEGER :: fchunksize = 32000000  ! NetCDF global file chunk cache size
+   INTEGER :: patchchunk             ! NetCDF processor-domain file chunk cache size
+   INTEGER :: nthreads = 1
+   INTEGER :: chunkalg = 0          ! NetCDF4 variable chunking algorithm
+                                    ! Default variable chunksizes (typical ORCA025
+                                    ! recommendations which can be adjusted via namelist
+                                    ! or will be bounded if too large for domain.)
+   INTEGER :: nc4_xchunk = 206      ! Default x (longitude) variable chunk size
+   INTEGER :: nc4_ychunk = 135      ! Default y (latitude)  variable chunk size
+   INTEGER :: nc4_zchunk = 1        ! Default z (depth) variable chunk size (almost always 1)
+   INTEGER :: nc4_tchunk = 1        ! Default t (time)  variable chunk size (almost always 1)
+   INTEGER, ALLOCATABLE  :: outdimids(:), outdimlens(:), indimlens(:), inncids(:)
+   INTEGER, ALLOCATABLE  :: chunksizes(:)
+   INTEGER, ALLOCATABLE  :: global_sizes(:), rebuild_dims(:)
+   INTEGER, DIMENSION(2) :: halo_start, halo_end, local_sizes
+   INTEGER, DIMENSION(2) :: idomain, jdomain, rdomain, start_pos
+   INTEGER :: ji, jj, jk, jl, jr
+   INTEGER :: nargs                 ! number of arguments
+   INTEGER, EXTERNAL :: iargc
+ 
+   REAL(sp) :: ValMin, ValMax, InMin, InMax, rmdi
+   REAL(dp), ALLOCATABLE :: mdiVals(:)
+
+   ! NF90_BYTE local data arrays
+   INTEGER(i1), ALLOCATABLE, SAVE, DIMENSION(:) :: localdata_1d_i1
+   INTEGER(i1), ALLOCATABLE, SAVE, DIMENSION(:,:) :: localdata_2d_i1
+   INTEGER(i1), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: localdata_3d_i1
+   INTEGER(i1), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: localdata_4d_i1
+
+   ! NF90_SHORT local data arrays
+   INTEGER(i2), ALLOCATABLE, SAVE, DIMENSION(:) :: localdata_1d_i2
+   INTEGER(i2), ALLOCATABLE, SAVE, DIMENSION(:,:) :: localdata_2d_i2
+   INTEGER(i2), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: localdata_3d_i2
+   INTEGER(i2), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: localdata_4d_i2
+
+   ! NF90_INT local data arrays
+   INTEGER(i4), ALLOCATABLE, SAVE, DIMENSION(:) :: localdata_1d_i4
+   INTEGER(i4), ALLOCATABLE, SAVE, DIMENSION(:,:) :: localdata_2d_i4
+   INTEGER(i4), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: localdata_3d_i4
+   INTEGER(i4), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: localdata_4d_i4
+
+   ! NF90_FLOAT local data arrays
+   REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:) :: localdata_1d_sp
+   REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: localdata_2d_sp
+   REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: localdata_3d_sp
+   REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: localdata_4d_sp
+
+   ! NF90_DOUBLE local data arrays
+   REAL(dp), ALLOCATABLE, SAVE, DIMENSION(:) :: localdata_1d_dp
+   REAL(dp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: localdata_2d_dp
+   REAL(dp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: localdata_3d_dp
+   REAL(dp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: localdata_4d_dp
+
+   ! NF90_BYTE global data arrays
+   INTEGER(i1) :: globaldata_0d_i1
+   INTEGER(i1), ALLOCATABLE, DIMENSION(:) :: globaldata_1d_i1
+   INTEGER(i1), ALLOCATABLE, DIMENSION(:,:) :: globaldata_2d_i1
+   INTEGER(i1), ALLOCATABLE, DIMENSION(:,:,:) :: globaldata_3d_i1
+   INTEGER(i1), ALLOCATABLE, DIMENSION(:,:,:,:) :: globaldata_4d_i1
+
+   ! NF90_SHORT global data arrays
+   INTEGER(i2) :: globaldata_0d_i2
+   INTEGER(i2), ALLOCATABLE, DIMENSION(:) :: globaldata_1d_i2
+   INTEGER(i2), ALLOCATABLE, DIMENSION(:,:) :: globaldata_2d_i2
+   INTEGER(i2), ALLOCATABLE, DIMENSION(:,:,:) :: globaldata_3d_i2
+   INTEGER(i2), ALLOCATABLE, DIMENSION(:,:,:,:) :: globaldata_4d_i2
+
+   ! NF90_INT global data arrays
+   INTEGER(i4) :: globaldata_0d_i4
+   INTEGER(i4), ALLOCATABLE, DIMENSION(:) :: globaldata_1d_i4
+   INTEGER(i4), ALLOCATABLE, DIMENSION(:,:) :: globaldata_2d_i4
+   INTEGER(i4), ALLOCATABLE, DIMENSION(:,:,:) :: globaldata_3d_i4
+   INTEGER(i4), ALLOCATABLE, DIMENSION(:,:,:,:) :: globaldata_4d_i4
+ 
+   ! NF90_FLOAT global data arrays
+   REAL(sp) :: globaldata_0d_sp
+   REAL(sp), ALLOCATABLE, DIMENSION(:) :: globaldata_1d_sp
+   REAL(sp), ALLOCATABLE, DIMENSION(:,:) :: globaldata_2d_sp
+   REAL(sp), ALLOCATABLE, DIMENSION(:,:,:) :: globaldata_3d_sp
+   REAL(sp), ALLOCATABLE, DIMENSION(:,:,:,:) :: globaldata_4d_sp
+
+   ! NF90_DOUBLE global data arrays
+   REAL(dp) :: globaldata_0d_dp
+   REAL(dp), ALLOCATABLE, DIMENSION(:) :: globaldata_1d_dp
+   REAL(dp), ALLOCATABLE, DIMENSION(:,:) :: globaldata_2d_dp
+   REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) :: globaldata_3d_dp
+   REAL(dp), ALLOCATABLE, DIMENSION(:,:,:,:) :: globaldata_4d_dp
+
+   LOGICAL :: l_valid     = .false.
+   LOGICAL :: l_noRebuild = .false.
+   LOGICAL :: l_findDims  = .true.
+   LOGICAL :: l_maskout   = .false.
+   LOGICAL :: l_namexist  = .false.
+
+   NAMELIST/nam_rebuild/ filebase, ndomain, dims, nslicesize, l_maskout, deflate_level, &
+                       & nc4_xchunk, nc4_ychunk, nc4_zchunk, nc4_tchunk, fchunksize         
+
+   external      :: getarg
+
+   !End of definitions 
+
+!--------------------------------------------------------------------------------
+!0. OMP setup
+
+!$OMP PARALLEL DEFAULT(NONE) SHARED(nthreads)
+!$OMP MASTER
+!$      nthreads = omp_get_num_threads()
+!$      WRITE(numout,*) 'Running OMP with ',nthreads,' thread(s).'
+!$OMP END MASTER
+!$OMP END PARALLEL
+ 
+!--------------------------------------------------------------------------------
+!1.0 Check netcdf version for warning
+   clibnc = TRIM(nf90_inq_libvers())
+   IF (ICHAR(clibnc(1:1)) <= 3) THEN
+      PRINT *, '=========================================================='
+      PRINT *, 'You are using old netcdf library (',TRIM(clibnc),').'
+      PRINT *, 'REBUILD_NEMO support of old netcdf library will end soon'
+      PRINT *, 'please consider moving to netcdf 4 or higher'
+      PRINT *, '=========================================================='
+   END IF
+
+!1.1 Get the namelist path
+   !Determine the number of arguments on the command line
+   nargs=iargc()
+   !Check that the required argument is present, if it is not then set it to the default value: nam_rebuild
+   IF (nargs == 0) THEN
+      WRITE(numout,*)
+      WRITE(numout,*) 'W A R N I N G : Namelist path not supplied as command line argument. Using default, nam_rebuild.'
+      cnampath='nam_rebuild'
+   ELSE IF (nargs == 1) THEN
+      CALL getarg(1, cnampath)
+   ELSE 
+      WRITE(numerr,*) 'E R R O R ! : Incorrect number of command line arguments. Please supply only'
+      WRITE(numerr,*) '         the path to the namelist file, or no arguments to use default value'
+      STOP 1
+   END IF
+
+   ! check presence of namelist
+   INQUIRE(FILE=cnampath, EXIST=l_namexist)
+   IF (.NOT. l_namexist) THEN
+      WRITE(numout,*)
+      WRITE(numout,*) 'E R R O R : Namelist '//TRIM(cnampath)//' not present.'
+      STOP 42
+   END IF
+
+!1.2 Read in the namelist 
+
+   dims(:) = ""
+   nslicesize = 0
+   deflate_level = 0
+   OPEN( UNIT=numnam, FILE=TRIM(cnampath), FORM='FORMATTED', STATUS='OLD' )
+   READ( numnam, nam_rebuild )
+   CLOSE( numnam )
+   IF( .NOT. ALL(dims(:) == "") ) l_findDims = .false.
+
+!1.3 Set up the filenames and fileids
+
+   ALLOCATE(filenames(ndomain))
+   IF (l_verbose) WRITE(numout,*) 'Rebuilding the following files:'
+   DO ifile = 1, ndomain
+      WRITE(suffix,'(i4.4)') ifile-1
+      filenames(ifile) = TRIM(filebase)//'_'//TRIM(suffix)//'.nc'
+      IF (l_verbose) WRITE(numout,*) TRIM(filenames(ifile))
+   END DO
+   ALLOCATE(inncids(ndomain))
+  
+!---------------------------------------------------------------------------
+!2. Read in the global dimensions from the first input file and set up the output file
+ 
+   CALL check_nf90( nf90_open( TRIM(filenames(1)), nf90_share, ncid ) )
+   CALL check_nf90( nf90_inquire( ncid, ndims, nvars, natts ) )
+    
+!2.0 Read in the total number of processors the file is expecting and check it's correct  
+  
+   CALL check_nf90( nf90_get_att( ncid, nf90_global, 'DOMAIN_number_total', ndomain_file ) )
+   IF( ndomain /= ndomain_file ) THEN
+      WRITE(numerr,*) 'ERROR! : number of files to rebuild in file does not agree with namelist'
+      WRITE(numerr,*) 'Attribute DOMAIN_number_total is : ', ndomain_file
+      WRITE(numerr,*) 'Number of files specified in namelist is: ', ndomain
+      STOP 2
+   ENDIF
+  
+!2.1 Set up the output file
+#if defined key_netcdf4
+   CALL check_nf90( nf90_create( TRIM(filebase)//'.nc', nf90_netcdf4, outid, chunksize=fchunksize ) )
+#else
+   CALL check_nf90( nf90_create( TRIM(filebase)//'.nc', nf90_64bit_offset, outid, chunksize=fchunksize ) )
+#endif
+
+!2.2 Set up dimensions in output file
+
+!2.2.0 Find out how many dimensions are required to be rebuilt and which ones they are
+   CALL check_nf90( nf90_inquire_attribute( ncid, nf90_global, 'DOMAIN_dimensions_ids', xtype, rbdims, attid ) )
+
+   ALLOCATE(rebuild_dims(rbdims))
+   CALL check_nf90( nf90_get_att( ncid, nf90_global, 'DOMAIN_dimensions_ids', rebuild_dims ) )
+
+   ALLOCATE(global_sizes(rbdims))
+   CALL check_nf90( nf90_get_att( ncid, nf90_global, 'DOMAIN_size_global', global_sizes ) )
+   IF (l_verbose) WRITE(numout,*) 'Size of global arrays: ', global_sizes
+
+
+!2.2.1 Copy the dimensions into the output file apart from rebuild_dims() which are dimensioned globally 
+   ALLOCATE(indimlens(ndims), indimnames(ndims), outdimlens(ndims))
+   CALL check_nf90( nf90_inquire( ncid, unlimitedDimId = unlimitedDimId ) )
+   istop = 0
+   DO idim = 1, ndims
+      CALL check_nf90( nf90_inquire_dimension( ncid, idim, dimname, dimlen ) )
+      CALL check_nf90( nf90_get_att( ncid, nf90_global, 'DOMAIN_size_local', local_sizes ) )
+      indimlens(idim) = dimlen    
+      indimnames(idim) = dimname
+      IF (l_findDims) THEN
+         IF( idim == rebuild_dims(1) ) THEN
+            IF( dimlen == local_sizes(1) ) THEN 
+               dimlen = global_sizes(1)
+               dims(1) = trim(dimname)
+            ELSE
+               istop = 1
+            ENDIF
+         ENDIF
+         IF( rbdims > 1 .AND. idim == rebuild_dims(2) ) THEN
+            IF( dimlen == local_sizes(2) ) THEN
+               dimlen = global_sizes(2)
+               dims(2) = trim(dimname)
+            ELSE
+               istop = 1
+            ENDIF
+         ENDIF
+      ELSE ! l_findDims = false
+         IF( TRIM(dimname) == TRIM(dims(1))) THEN
+            dimlen = global_sizes(1)
+            rebuild_dims(1) = idim
+         ENDIF
+         IF( rbdims > 1 .AND. TRIM(dimname) == TRIM(dims(2))) THEN
+            dimlen = global_sizes(2)
+            rebuild_dims(2) = idim
+         ENDIF
+      ENDIF
+
+      IF( idim == unlimitedDimId ) THEN
+         CALL check_nf90( nf90_def_dim( outid, dimname, nf90_unlimited, dimid) )
+         nmax_unlimited = dimlen
+      ELSE
+         CALL check_nf90( nf90_def_dim( outid, dimname, dimlen, dimid) )
+      ENDIF
+      outdimlens(idim) = dimlen
+   END DO
+   ! nmax_unlimited is only used for time-slicing so we set it to be at least 1 to 
+   ! account for files with no record dimension or zero length record dimension(!)
+   nmax_unlimited = max(nmax_unlimited,1)
+
+   IF( istop == 1 ) THEN
+      WRITE(numerr,*) 'ERROR! : DOMAIN_local_sizes attribute does not match rebuild dimension lengths in the first file'
+      WRITE(numerr,*) 'Attribute DOMAIN_local_sizes is : ', local_sizes
+      WRITE(numerr,*) 'Dimensions to be rebuilt are of size : ', outdimlens(rebuild_dims(1)), outdimlens(rebuild_dims(2)) 
+      STOP 3
+   ENDIF
+
+   IF (l_findDims) THEN
+      IF (l_verbose) WRITE(numout,*) 'Finding rebuild dimensions from the first file...'
+   ELSE
+      IF (l_verbose) WRITE(numout,*) 'Using rebuild dimensions given in namelist...'
+   ENDIF
+
+   IF( rbdims > 1 ) THEN
+      IF (l_verbose) WRITE(numout,*) 'Rebuilding across dimensions '//TRIM(indimnames(rebuild_dims(1)))//  &
+         &                      ' and '//TRIM(indimnames(rebuild_dims(2)))
+   ELSE
+      IF (l_verbose) WRITE(numout,*) 'Rebuilding across dimension '//TRIM(indimnames(rebuild_dims(1)))
+   ENDIF
+      
+!2.2.2 Copy the global attributes into the output file, apart from those beginning with DOMAIN_  
+!      Also need to change the file_name attribute and the TimeStamp attribute.
+   DO attid = 1, natts
+      CALL check_nf90( nf90_inq_attname( ncid, nf90_global, attid, attname ) )
+      IF( INDEX( attname, "DOMAIN_" ) == 1 ) CYCLE
+      IF( INDEX( attname, "file_name") == 1 ) CYCLE
+      IF( INDEX( attname, "associate_file") == 1 ) CYCLE
+      IF (l_verbose) WRITE(numout,*) 'Copying attribute '//TRIM(attname)//' into destination file...'
+      CALL check_nf90( nf90_copy_att( ncid, nf90_global, attname, outid, nf90_global ) )
+   END DO
+   CALL check_nf90( nf90_put_att( outid, nf90_global, "file_name", TRIM(filebase)//'.nc') )
+   IF (l_verbose) WRITE(numout,*) 'Writing new file_name attribute'  
+   CALL DATE_AND_TIME ( date=date, time=time, zone=zone )
+   timestamp = date(7:8) // "/" // date(5:6) // "/" // date(1:4) // " " // &
+               time(1:2) // ":" // time(3:4) // ":" // time(5:6) // " " // &
+               zone  
+   CALL check_nf90( nf90_put_att( outid, nf90_global, "TimeStamp", timestamp ) )
+   IF (l_verbose) WRITE(numout,*) 'Writing new TimeStamp attribute'
+  
+!2.2.3 Copy the variable definitions and attributes into the output file.
+   ALLOCATE(mdiVals(nvars))
+   mdiVals(:)=0
+   DO jv = 1, nvars
+      CALL check_nf90( nf90_inquire_variable( ncid, jv, varname, xtype, ndims, dimids, natts ) )
+      ALLOCATE(outdimids(ndims))
+      ALLOCATE(chunksizes(ndims))
+      IF( ndims > 0 ) then
+        DO idim = 1, ndims
+           outdimids(idim) = dimids(idim)
+           chunksizes(idim) = outdimlens(dimids(idim))
+           cdim='|'//TRIM(indimnames(dimids(idim)))//'|'
+
+! trick to find var in a list of suggestion (var0 and var1 : INDEX(|var0|var1|,|var|)
+           cdimlst='|x|x_grid_T|x_grid_U|x_grid_V|x_grid_W|'
+           if( INDEX(TRIM(cdimlst),TRIM(cdim)) > 0 ) &
+    &                             chunksizes(idim) = min(outdimlens(dimids(idim)), max(nc4_xchunk,1))
+
+           cdimlst='|y|y_grid_T|y_grid_U|y_grid_V|y_grid_W|'
+           if( INDEX(TRIM(cdimlst),TRIM(cdim)) > 0 ) &
+    &                             chunksizes(idim) = min(outdimlens(dimids(idim)), max(nc4_ychunk,1))
+
+           cdimlst='|z|deptht|depthu|depthv|depthw|depth|nav_lev|'
+           if( INDEX(TRIM(cdimlst),TRIM(cdim)) > 0 ) &
+    &                             chunksizes(idim) = min(outdimlens(dimids(idim)), max(nc4_zchunk,1))
+
+           cdimlst='|t|time|time_counter|'
+           if( INDEX(TRIM(cdimlst),TRIM(cdim)) > 0 ) &
+    &                             chunksizes(idim) = min(outdimlens(dimids(idim)), max(nc4_tchunk,1))
+
+        END DO
+#if defined key_netcdf4
+        CALL check_nf90( nf90_def_var( outid, varname, xtype, outdimids, varid, &
+                                       deflate_level=deflate_level ) )
+        IF (l_verbose) WRITE(numout,*) 'Dims    : ',ndims, outdimids(1:ndims)
+        IF (l_verbose) WRITE(numout,*) 'names   : ',(TRIM(indimnames(dimids(idim)))//' ',idim=1,ndims)
+        IF (l_verbose) WRITE(numout,*) 'lens    : ',(outdimlens(dimids(idim)),idim=1,ndims)
+        IF (l_verbose) WRITE(numout,*) 'Chunking: ',chunksizes
+        IF (l_verbose) WRITE(numout,*) 'Deflation : ',deflate_level
+        IF (l_verbose) WRITE(numout,*) 'Chunk algo: ',chunkalg
+        CALL check_nf90( nf90_def_var_chunking( outid, varid, chunkalg, &
+   &                                 chunksizes ) )
+      ELSE
+        CALL check_nf90( nf90_def_var( outid, varname, xtype, outdimids, varid ) )
+#else
+      CALL check_nf90( nf90_def_var( outid, varname, xtype, outdimids, varid ) )
+#endif
+      ENDIF
+      DEALLOCATE(outdimids)
+      DEALLOCATE(chunksizes)
+      IF (l_verbose) WRITE(numout,*) 'Defining variable '//TRIM(varname)//'...' 
+      IF( natts > 0 ) THEN
+         DO attid = 1, natts
+            CALL check_nf90( nf90_inq_attname( ncid, varid, attid, attname ) )
+            IF ( attname == "_FillValue" ) THEN
+               CALL check_nf90( nf90_get_att( ncid, varid, attname, rmdi ) )
+               mdiVals(jv)=rmdi
+            ENDIF
+            CALL check_nf90( nf90_copy_att( ncid, varid, attname, outid, varid ) )
+         END DO
+      ENDIF
+   END DO
+
+!2.3 End definitions in output file and copy 1st file ncid to the inncids array
+
+   CALL check_nf90( nf90_enddef( outid ) )
+   inncids(1) = ncid
+   IF (l_verbose) WRITE(numout,*) 'Finished defining output file.'
+  
+!---------------------------------------------------------------------------
+!3. Read in data from each file for each variable 
+
+!3.1 Open each file and store the ncid in inncids array
+
+   IF (l_verbose) WRITE(numout,*) 'Opening input files...'
+
+   ! Set a file chunk cache size for the processor-domain files that scales with the number of processors
+   patchchunk = max(8192, fchunksize/ndomain)
+
+   ! open files 
+   DO ifile = 2, ndomain
+      CALL check_nf90( nf90_open( TRIM(filenames(ifile)), nf90_share, ncid, chunksize=patchchunk ) )
+      inncids(ifile) = ncid
+   END DO
+   IF (l_verbose) WRITE(numout,*) 'All input files open.'
+
+   DO jv = 1, nvars
+
+      ValMin = 1.e10
+      ValMax = -1.e10
+      l_valid = .false.
+      istop = nf90_noerr
+      nt = 1
+      ntslice = nmax_unlimited
+      IF( nslicesize == 0 ) nslicesize = nmax_unlimited
+
+!3.2 Inquire variable to find out name and how many dimensions it has
+!    and importantly whether it contains the dimensions in rebuild_dims()
+
+      ncid = inncids(1)
+      CALL check_nf90( nf90_inquire_variable( ncid, jv, varname, xtype, ndims, dimids, natts ) )
+
+      l_noRebuild = .true.
+      IF( ANY( dimids(1:ndims) == rebuild_dims(1) )) l_noRebuild = .false.
+      IF( rbdims > 1 ) THEN
+         IF( ANY( dimids(1:ndims) == rebuild_dims(2) )) l_noRebuild = .false.
+      ENDIF
+
+!3.2.0 start while loop for time slicing
+
+      DO WHILE( nt <= nmax_unlimited )
+
+         IF( ndims > 3 ) THEN
+            ntslice = MIN( nslicesize, nmax_unlimited + 1 - nt )
+         ENDIF
+
+      IF (l_noRebuild) THEN
+
+         IF( nslicesize == nmax_unlimited .OR. ndims <= 3 ) THEN
+            IF (l_verbose) WRITE(numout,*) 'Copying data from variable '//TRIM(varname)//'...'
+         ELSE
+            IF (l_verbose) WRITE(numout,'(A,I3,A,I3,A)') ' Copying data from variable '  &
+            &                 //TRIM(varname)//' for slices ',nt,' to ',nt+ntslice-1,' ...'
+         ENDIF
+
+!3.2.1 If rebuilding not required then just need to read in variable
+!      for copying direct into output file after the OMP (files) loop.
+         IF( ndims == 0 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_i1 ) )
+               CASE( NF90_SHORT )
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_i2 ) )
+               CASE( NF90_INT )
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_i4 ) )
+               CASE( NF90_FLOAT )
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_sp ) )
+               CASE( NF90_DOUBLE )
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_dp ) )
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP 4
+            END SELECT
+
+         ELSEIF( ndims == 1 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_1d_i1(indimlens(dimids(1))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_i1 ) )
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_1d_i2(indimlens(dimids(1))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_i2 ) )
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_1d_i4(indimlens(dimids(1))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_i4 ) )
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_1d_sp(indimlens(dimids(1))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_sp ) )
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_1d_dp(indimlens(dimids(1))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_dp ) )
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP 4
+            END SELECT
+
+         ELSEIF( ndims == 2 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_2d_i1(indimlens(dimids(1)),indimlens(dimids(2))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_i1 ) )
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_2d_i2(indimlens(dimids(1)),indimlens(dimids(2))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_i2 ) )
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_2d_i4(indimlens(dimids(1)),indimlens(dimids(2))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_i4 ) )
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_2d_sp(indimlens(dimids(1)),indimlens(dimids(2))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_sp ) )
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_2d_dp(indimlens(dimids(1)),indimlens(dimids(2))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_dp ) )
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP 4
+            END SELECT
+
+         ELSEIF( ndims == 3 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_3d_i1(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_i1 ) )
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_3d_i2(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_i2 ) )
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_3d_i4(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_i4 ) )
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_3d_sp(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_sp ) )
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_3d_dp(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_dp ) )
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP 4
+            END SELECT
+
+         ELSEIF( ndims == 4 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_4d_i1(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3)),ntslice))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_i1, start=(/1,1,1,nt/) ) )
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_4d_i2(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3)),ntslice))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_i2, start=(/1,1,1,nt/) ) )
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_4d_i4(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3)),ntslice))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_i4, start=(/1,1,1,nt/) ) )
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_4d_sp(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3)),ntslice))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_sp, start=(/1,1,1,nt/) ) )
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_4d_dp(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3)),ntslice))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_dp, start=(/1,1,1,nt/) ) )
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP 4
+            END SELECT
+
+         ENDIF
+
+      ELSE  ! l_noRebuild = .false.
+
+!3.2.2 For variables that require rebuilding we need to read in from all ndomain files
+!      Here we allocate global variables ahead of looping over files
+         IF( nslicesize == nmax_unlimited .OR. ndims <= 3 ) THEN
+            IF (l_verbose) WRITE(numout,*) 'Rebuilding data from variable '//TRIM(varname)//'...'
+         ELSE
+            IF (l_verbose) WRITE(numout,'(A,I3,A,I3,A)') ' Rebuilding data from variable '  &
+            &                 //TRIM(varname)//' for slices ',nt,' to ',nt+ntslice-1,' ...'
+         ENDIF
+         IF( ndims == 1 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_1d_i1(outdimlens(dimids(1))))
+                  IF (l_maskout) globaldata_1d_i1(:)=mdiVals(jv)
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_1d_i2(outdimlens(dimids(1))))
+                  IF (l_maskout) globaldata_1d_i2(:)=mdiVals(jv)
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_1d_i4(outdimlens(dimids(1))))
+                  IF (l_maskout) globaldata_1d_i4(:)=mdiVals(jv)
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_1d_sp(outdimlens(dimids(1))))
+                  IF (l_maskout) globaldata_1d_sp(:)=mdiVals(jv)
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_1d_dp(outdimlens(dimids(1))))
+                  IF (l_maskout) globaldata_1d_dp(:)=mdiVals(jv)
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP 4
+            END SELECT
+
+         ELSEIF( ndims == 2 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_2d_i1(outdimlens(dimids(1)),outdimlens(dimids(2))))
+                  IF (l_maskout) globaldata_2d_i1(:,:)=mdiVals(jv)
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_2d_i2(outdimlens(dimids(1)),outdimlens(dimids(2))))
+                  IF (l_maskout) globaldata_2d_i2(:,:)=mdiVals(jv)
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_2d_i4(outdimlens(dimids(1)),outdimlens(dimids(2))))
+                  IF (l_maskout) globaldata_2d_i4(:,:)=mdiVals(jv)
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_2d_sp(outdimlens(dimids(1)),outdimlens(dimids(2))))
+                  IF (l_maskout) globaldata_2d_sp(:,:)=mdiVals(jv)
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_2d_dp(outdimlens(dimids(1)),outdimlens(dimids(2))))
+                  IF (l_maskout) globaldata_2d_dp(:,:)=mdiVals(jv)
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP 4
+            END SELECT
+
+         ELSEIF( ndims == 3 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_3d_i1(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3))))
+                  IF (l_maskout) globaldata_3d_i1(:,:,:)=mdiVals(jv)
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_3d_i2(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3))))
+                  IF (l_maskout) globaldata_3d_i2(:,:,:)=mdiVals(jv)
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_3d_i4(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3))))
+                  IF (l_maskout) globaldata_3d_i4(:,:,:)=mdiVals(jv)
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_3d_sp(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3))))
+                  IF (l_maskout) globaldata_3d_sp(:,:,:)=mdiVals(jv)
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_3d_dp(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3))))
+                  IF (l_maskout) globaldata_3d_dp(:,:,:)=mdiVals(jv)
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP 4
+            END SELECT
+
+         ELSEIF( ndims == 4 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_4d_i1(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3)),ntslice))
+                  IF (l_maskout) globaldata_4d_i1(:,:,:,:)=mdiVals(jv)
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_4d_i2(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3)),ntslice))
+                  IF (l_maskout) globaldata_4d_i2(:,:,:,:)=mdiVals(jv)
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_4d_i4(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3)),ntslice))
+                  IF (l_maskout) globaldata_4d_i4(:,:,:,:)=mdiVals(jv)
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_4d_sp(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3)),ntslice))
+                  IF (l_maskout) globaldata_4d_sp(:,:,:,:)=mdiVals(jv)
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_4d_dp(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3)),ntslice))
+                  IF (l_maskout) globaldata_4d_dp(:,:,:,:)=mdiVals(jv)
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP 4
+            END SELECT
+         ELSE
+            WRITE(numerr,*) 'ERROR! : A netcdf variable has more than 4 dimensions which is not taken into account'
+            STOP 4
+         ENDIF
+
+!$OMP  PARALLEL DO DEFAULT(NONE)                                                          &
+!$OMP& PRIVATE(ifile,ncid,xtype,start_pos,local_sizes,InMin,InMax,natts,                  &
+!$OMP&         ndims,attid,attname,dimids,idim,dimname,dimlen,unlimitedDimId,             &
+!$OMP&         halo_start,halo_end,idomain,jdomain,rdomain,di,dj,dr,                      &
+!$OMP&         localdata_1d_i2,localdata_1d_i4,localdata_1d_sp,localdata_1d_dp,           &
+!$OMP&         localdata_2d_i2,localdata_2d_i4,localdata_2d_sp,localdata_2d_dp,           &
+!$OMP&         localdata_3d_i2,localdata_3d_i4,localdata_3d_sp,localdata_3d_dp,           &
+!$OMP&         localdata_4d_i2,localdata_4d_i4,localdata_4d_sp,localdata_4d_dp,           &
+!$OMP&         localdata_1d_i1,localdata_2d_i1,localdata_3d_i1,localdata_4d_i1)           &
+!$OMP& SHARED(jv,nvars,varname,filenames,ValMin,ValMax,indimlens,outdimlens,rbdims,       &
+!$OMP&        ndomain,outid,fchunksize,istop,l_valid,nthreads,inncids,rebuild_dims,       &
+!$OMP&        globaldata_1d_i2,globaldata_1d_i4,globaldata_1d_sp,globaldata_1d_dp,        &
+!$OMP&        globaldata_2d_i2,globaldata_2d_i4,globaldata_2d_sp,globaldata_2d_dp,        &
+!$OMP&        globaldata_3d_i2,globaldata_3d_i4,globaldata_3d_sp,globaldata_3d_dp,        &
+!$OMP&        globaldata_4d_i2,globaldata_4d_i4,globaldata_4d_sp,globaldata_4d_dp,        &
+!$OMP&        globaldata_1d_i1,globaldata_2d_i1,globaldata_3d_i1,globaldata_4d_i1,        &
+!$OMP&        ntslice,nt,nmax_unlimited,indimnames,dims,patchchunk)
+
+         DO ifile = 1, ndomain
+
+            ncid = inncids(ifile)
+!$OMP CRITICAL
+            CALL check_nf90( nf90_get_att( ncid, nf90_global, 'DOMAIN_size_local', local_sizes ), istop )
+            CALL check_nf90( nf90_get_att( ncid, nf90_global, 'DOMAIN_position_first', start_pos ), istop )
+            CALL check_nf90( nf90_get_att( ncid, nf90_global, 'DOMAIN_halo_size_start', halo_start ), istop )
+            CALL check_nf90( nf90_get_att( ncid, nf90_global, 'DOMAIN_halo_size_end', halo_end ), istop )
+            CALL check_nf90( nf90_inquire_variable( ncid, jv, varname, xtype, ndims, dimids, natts ), istop )
+            CALL check_nf90( nf90_inquire( ncid, unlimitedDimId = unlimitedDimId ), istop )
+!$OMP END CRITICAL
+
+            ! set defaults for rebuilding so that i is 1st, j 2nd
+            di=1
+            dj=2
+
+            IF( rbdims == 1 ) THEN
+               ! override defaults above and set other variables
+               start_pos(2) = 1
+               local_sizes(2) = outdimlens(3-dimids(2))
+               halo_end(2) = 0
+               halo_start(2) = 0
+               di=rebuild_dims(1)
+               dj=3-di
+            ENDIF
+
+!3.3.1 Generate local domain interior sizes from local_sizes and halo sizes
+!      idomain defines the 1st and last interior points in the i direction and
+!      jdomain defines the 1st and last interior points in the j direction
+
+            idomain(1) = 1 + halo_start(di)
+            idomain(2) = local_sizes(di) - halo_end(di)
+            jdomain(1) = 1 + halo_start(dj)
+            jdomain(2) = local_sizes(dj) - halo_end(dj)
+
+!3.3.2 For rbdims or more dimensions put the data array from this input file into the correct
+!      part of the output data array. Assume the first dimensions are those to be rebuilt.
+
+            IF( ndims == 1 ) THEN
+
+               IF( rebuild_dims(1) == 1 ) THEN
+                  dr = di
+                  rdomain = idomain
+               ELSE
+                  dr = dj
+                  rdomain = jdomain
+               ENDIF
+
+              SELECT CASE( xtype )
+                  CASE( NF90_BYTE )
+                     ALLOCATE(localdata_1d_i1(local_sizes(dr)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_1d_i1 ), istop )
+                     DO jr = rdomain(1), rdomain(2)
+                        globaldata_1d_i1(start_pos(dr) + jr - 1) = localdata_1d_i1(jr)
+                     END DO
+                     DEALLOCATE(localdata_1d_i1)
+                  CASE( NF90_SHORT )
+                     ALLOCATE(localdata_1d_i2(local_sizes(dr)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_1d_i2 ), istop )
+                     DO jr = rdomain(1), rdomain(2)
+                        globaldata_1d_i2(start_pos(dr) + jr - 1) = localdata_1d_i2(jr)
+                     END DO
+                     DEALLOCATE(localdata_1d_i2)
+                  CASE( NF90_INT )
+                     ALLOCATE(localdata_1d_i4(local_sizes(dr)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_1d_i4 ), istop )
+                     DO jr = rdomain(1), rdomain(2)
+                        globaldata_1d_i4(start_pos(dr) + jr - 1) = localdata_1d_i4(jr)
+                     END DO
+                     DEALLOCATE(localdata_1d_i4)
+                  CASE( NF90_FLOAT )
+                     ALLOCATE(localdata_1d_sp(local_sizes(dr)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_1d_sp ), istop )
+                     DO jr = rdomain(1), rdomain(2)
+                        globaldata_1d_sp(start_pos(dr) + jr - 1) = localdata_1d_sp(jr)
+                     END DO
+                     DEALLOCATE(localdata_1d_sp)
+                  CASE( NF90_DOUBLE )
+                     ALLOCATE(localdata_1d_dp(local_sizes(dr)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_1d_dp ), istop )
+                     DO jr = rdomain(1), rdomain(2)
+                        globaldata_1d_dp(start_pos(dr) + jr - 1) = localdata_1d_dp(jr)
+                     END DO
+                     DEALLOCATE(localdata_1d_dp)
+                  CASE DEFAULT
+                     WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                     istop = istop + 1
+               END SELECT
+
+            ELSEIF( ndims == 2 ) THEN
+        
+               SELECT CASE( xtype )
+                  CASE( NF90_BYTE )
+                     ALLOCATE(localdata_2d_i1(local_sizes(di),local_sizes(dj)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_2d_i1 ), istop )
+                        DO jj = jdomain(1), jdomain(2)
+                           DO ji = idomain(1), idomain(2)
+                              globaldata_2d_i1(start_pos(di) + ji - 1, start_pos(dj) + jj - 1) = localdata_2d_i1(ji,jj)
+                        END DO
+                     END DO
+                     DEALLOCATE(localdata_2d_i1)
+                  CASE( NF90_SHORT )
+                     ALLOCATE(localdata_2d_i2(local_sizes(di),local_sizes(dj)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_2d_i2 ), istop )
+                     DO jj = jdomain(1), jdomain(2)
+                        DO ji = idomain(1), idomain(2)
+                           globaldata_2d_i2(start_pos(di) + ji - 1, start_pos(dj) + jj - 1) = localdata_2d_i2(ji,jj)
+                        END DO
+                     END DO
+                     DEALLOCATE(localdata_2d_i2)
+                  CASE( NF90_INT )
+                     ALLOCATE(localdata_2d_i4(local_sizes(di),local_sizes(dj)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_2d_i4 ), istop )
+                     DO jj = jdomain(1), jdomain(2)
+                        DO ji = idomain(1), idomain(2)
+                           globaldata_2d_i4(start_pos(di) + ji - 1, start_pos(dj) + jj - 1) = localdata_2d_i4(ji,jj)
+                        END DO
+                     END DO
+                     DEALLOCATE(localdata_2d_i4)
+                  CASE( NF90_FLOAT )
+                     ALLOCATE(localdata_2d_sp(local_sizes(di),local_sizes(dj)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_2d_sp ), istop )
+                     DO jj = jdomain(1), jdomain(2)
+                        DO ji = idomain(1), idomain(2)
+                           globaldata_2d_sp(start_pos(di) + ji - 1, start_pos(dj) + jj - 1) = localdata_2d_sp(ji,jj)
+                        END DO
+                     END DO
+                     DEALLOCATE(localdata_2d_sp)
+                  CASE( NF90_DOUBLE )
+                     ALLOCATE(localdata_2d_dp(local_sizes(di),local_sizes(dj)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_2d_dp ), istop )
+                     DO jj = jdomain(1), jdomain(2)
+                        DO ji = idomain(1), idomain(2)
+                           globaldata_2d_dp(start_pos(di) + ji - 1, start_pos(dj) + jj - 1) = localdata_2d_dp(ji,jj)
+                        END DO
+                     END DO
+                     DEALLOCATE(localdata_2d_dp) 
+                  CASE DEFAULT
+                     WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                     istop = istop + 1
+               END SELECT
+
+            ELSEIF( ndims == 3 ) THEN
+
+               SELECT CASE( xtype )
+                  CASE( NF90_BYTE )
+                     ALLOCATE(localdata_3d_i1(local_sizes(di),local_sizes(dj),indimlens(dimids(3))))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_3d_i1 ), istop )
+!$OMP  PARALLEL DO DEFAULT(NONE) PRIVATE(ji,jj,jk)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_3d_i1,localdata_3d_i1,di,dj) 
+                     DO jk = 1, indimlens(dimids(3))
+                        DO jj = jdomain(1), jdomain(2)
+                           DO ji = idomain(1), idomain(2)
+                              globaldata_3d_i1(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk) = localdata_3d_i1(ji,jj,jk)
+                           END DO
+                        END DO
+                     END DO
+!$OMP END PARALLEL DO
+                     DEALLOCATE(localdata_3d_i1)
+                  CASE( NF90_SHORT )
+                     ALLOCATE(localdata_3d_i2(local_sizes(di),local_sizes(dj),indimlens(dimids(3))))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_3d_i2 ), istop )
+!$OMP  PARALLEL DO DEFAULT(NONE) PRIVATE(ji,jj,jk)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_3d_i2,localdata_3d_i2,di,dj) 
+                     DO jk = 1, indimlens(dimids(3))
+                        DO jj = jdomain(1), jdomain(2)
+                           DO ji = idomain(1), idomain(2)
+                              globaldata_3d_i2(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk) = localdata_3d_i2(ji,jj,jk)
+                           END DO
+                        END DO
+                     END DO
+!$OMP END PARALLEL DO
+                     DEALLOCATE(localdata_3d_i2)
+                  CASE( NF90_INT )
+                     ALLOCATE(localdata_3d_i4(local_sizes(di),local_sizes(dj),indimlens(dimids(3))))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_3d_i4 ), istop )
+!$OMP  PARALLEL DO DEFAULT(NONE) PRIVATE(ji,jj,jk)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_3d_i4,localdata_3d_i4,di,dj) 
+                     DO jk = 1, indimlens(dimids(3))
+                        DO jj = jdomain(1), jdomain(2)
+                           DO ji = idomain(1), idomain(2)
+                              globaldata_3d_i4(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk) = localdata_3d_i4(ji,jj,jk)
+                           END DO
+                        END DO
+                     END DO
+!$OMP END PARALLEL DO
+                     DEALLOCATE(localdata_3d_i4)
+                  CASE( NF90_FLOAT )
+                     ! TG: This if statement is added to check if the 1st dimension is the corners (for lon_bounds) variables
+                     ! TG: Had to add the unsatisfactory check for 'lon' as it failed for diaptr files
+                     ! TG: Would like to find a better assumption for this.
+                     IF ( trim(indimnames(dimids(1))) /= dims(1) .AND. indimnames(dimids(1)) .NE. 'lon' ) THEN 
+                        ALLOCATE(localdata_3d_sp(indimlens(dimids(1)),local_sizes(di),local_sizes(dj)))
+                        WRITE(*,*) 'test', ifile, jv, indimlens(dimids(1)),local_sizes(di),local_sizes(dj)
+                        CALL check_nf90( nf90_get_var( ncid, jv, localdata_3d_sp ), istop )
+                        WRITE(*,*) 'test2'
+                        DO jj = jdomain(1), jdomain(2)
+                           DO ji = idomain(1), idomain(2)
+                              DO jk = 1, indimlens(dimids(1))
+                                 globaldata_3d_sp(jk, start_pos(di) + ji - 1, start_pos(dj) + jj - 1) = localdata_3d_sp(jk,ji,jj)
+                              END DO
+                           END DO
+                        END DO
+                     ELSE
+                        ALLOCATE(localdata_3d_sp(local_sizes(di),local_sizes(dj),indimlens(dimids(3))))
+                        CALL check_nf90( nf90_get_var( ncid, jv, localdata_3d_sp ), istop ) 
+!$OMP  PARALLEL DO DEFAULT(NONE) PRIVATE(ji,jj,jk)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_3d_sp,localdata_3d_sp,di,dj) 
+                        DO jk = 1, indimlens(dimids(3))
+                           DO jj = jdomain(1), jdomain(2)
+                              DO ji = idomain(1), idomain(2)
+                                 globaldata_3d_sp(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk) = localdata_3d_sp(ji,jj,jk)
+                              END DO
+                           END DO
+                        END DO
+!$OMP END PARALLEL DO
+                     ENDIF
+                     DEALLOCATE(localdata_3d_sp)
+                  CASE( NF90_DOUBLE )
+                     IF ( trim(indimnames(dimids(1))) /= dims(1) ) THEN
+                        ALLOCATE(localdata_3d_dp(indimlens(dimids(1)),local_sizes(di),local_sizes(dj)))
+                        CALL check_nf90( nf90_get_var( ncid, jv, localdata_3d_dp ), istop ) 
+                        DO jj = jdomain(1), jdomain(2)
+                           DO ji = idomain(1), idomain(2)
+                              DO jk = 1, indimlens(dimids(1))
+                                 globaldata_3d_dp(jk, start_pos(di) + ji - 1, start_pos(dj) + jj - 1) = localdata_3d_dp(jk,ji,jj)
+                              END DO
+                           END DO
+                        END DO
+                     ELSE
+                        ALLOCATE(localdata_3d_dp(local_sizes(di),local_sizes(dj),indimlens(dimids(3))))
+                        CALL check_nf90( nf90_get_var( ncid, jv, localdata_3d_dp ), istop ) 
+!$OMP  PARALLEL DO DEFAULT(NONE) PRIVATE(ji,jj,jk)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_3d_dp,localdata_3d_dp,di,dj)
+                        DO jk = 1, indimlens(dimids(3))
+                           DO jj = jdomain(1), jdomain(2)
+                              DO ji = idomain(1), idomain(2)
+                                 globaldata_3d_dp(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk) = localdata_3d_dp(ji,jj,jk)
+                              END DO
+                           END DO
+                        END DO
+!$OMP END PARALLEL DO
+                     ENDIF
+                     DEALLOCATE(localdata_3d_dp)
+                  CASE DEFAULT
+                     WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                     istop = istop + 1
+               END SELECT
+      
+            ELSEIF (ndims == 4) THEN
+        
+               SELECT CASE( xtype )
+                  CASE( NF90_BYTE )
+                     ALLOCATE(localdata_4d_i1(local_sizes(di),local_sizes(dj),               &
+                         &                     indimlens(dimids(3)),ntslice))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_4d_i1, start=(/1,1,1,nt/) ), istop )
+!$OMP  PARALLEL DEFAULT(NONE) PRIVATE(ji,jj,jk,jl)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_4d_i1,localdata_4d_i1,di,dj,nt,ntslice)
+                     DO jl = 1, ntslice
+!$OMP DO 
+                        DO jk = 1, indimlens(dimids(3))
+                           DO jj = jdomain(1), jdomain(2)
+                              DO ji = idomain(1), idomain(2)
+                                 globaldata_4d_i1(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk, jl) = localdata_4d_i1(ji,jj,jk,jl)
+                              END DO
+                           END DO
+                        END DO
+!$OMP END DO nowait
+                     END DO
+!$OMP END PARALLEL
+                     DEALLOCATE(localdata_4d_i1)
+                  CASE( NF90_SHORT )
+                     ALLOCATE(localdata_4d_i2(local_sizes(di),local_sizes(dj),               &
+                        &                     indimlens(dimids(3)),ntslice))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_4d_i2, start=(/1,1,1,nt/) ), istop )
+!$OMP  PARALLEL DEFAULT(NONE) PRIVATE(ji,jj,jk,jl)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_4d_i2,localdata_4d_i2,di,dj,nt,ntslice)
+                     DO jl = 1, ntslice
+!$OMP DO 
+                        DO jk = 1, indimlens(dimids(3))
+                           DO jj = jdomain(1), jdomain(2) 
+                              DO ji = idomain(1), idomain(2)
+                                 globaldata_4d_i2(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk, jl) = localdata_4d_i2(ji,jj,jk,jl)
+                              END DO
+                           END DO
+                        END DO
+!$OMP END DO nowait
+                     END DO
+!$OMP END PARALLEL
+                     DEALLOCATE(localdata_4d_i2)
+                  CASE( NF90_INT )
+                     ALLOCATE(localdata_4d_i4(local_sizes(di),local_sizes(dj),               &
+                        &                     indimlens(dimids(3)),ntslice))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_4d_i4, start=(/1,1,1,nt/) ), istop )
+!$OMP  PARALLEL DEFAULT(NONE) PRIVATE(ji,jj,jk,jl)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_4d_i4,localdata_4d_i4,di,dj,nt,ntslice)
+                     DO jl = 1, ntslice
+!$OMP DO
+                        DO jk = 1, indimlens(dimids(3))
+                           DO jj = jdomain(1), jdomain(2) 
+                              DO ji = idomain(1), idomain(2)
+                                 globaldata_4d_i4(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk, jl) = localdata_4d_i4(ji,jj,jk,jl)
+                              END DO
+                           END DO
+                        END DO
+!$OMP END DO nowait
+                     END DO
+!$OMP END PARALLEL
+                     DEALLOCATE(localdata_4d_i4)
+                  CASE( NF90_FLOAT )
+                     ALLOCATE(localdata_4d_sp(local_sizes(di),local_sizes(dj),               &
+                        &                     indimlens(dimids(3)),ntslice))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_4d_sp, start=(/1,1,1,nt/) ), istop )
+!$OMP  PARALLEL DEFAULT(NONE) PRIVATE(ji,jj,jk,jl)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_4d_sp,localdata_4d_sp,di,dj,nt,ntslice) 
+                     DO jl = 1, ntslice
+!$OMP DO
+                        DO jk = 1, indimlens(dimids(3))
+                           DO jj = jdomain(1), jdomain(2) 
+                              DO ji = idomain(1), idomain(2)
+                                 globaldata_4d_sp(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk, jl) = localdata_4d_sp(ji,jj,jk,jl)
+                              END DO
+                           END DO
+                        END DO
+!$OMP END DO nowait
+                     END DO
+!$OMP END PARALLEL
+                     DEALLOCATE(localdata_4d_sp)
+                  CASE( NF90_DOUBLE )
+                     ALLOCATE(localdata_4d_dp(local_sizes(di),local_sizes(dj),               &
+                        &                     indimlens(dimids(3)),ntslice))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_4d_dp, start=(/1,1,1,nt/) ), istop )
+!$OMP  PARALLEL DEFAULT(NONE) PRIVATE(ji,jj,jk,jl)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_4d_dp,localdata_4d_dp,di,dj,nt,ntslice) 
+                     DO jl = 1, ntslice
+!$OMP DO
+                        DO jk = 1, indimlens(dimids(3))
+                           DO jj = jdomain(1), jdomain(2) 
+                              DO ji = idomain(1), idomain(2)
+                                 globaldata_4d_dp(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk, jl) = localdata_4d_dp(ji,jj,jk,jl)
+                              END DO
+                           END DO
+                        END DO
+!$OMP END DO nowait
+                     END DO
+!$OMP END PARALLEL
+                     DEALLOCATE(localdata_4d_dp)
+                  CASE DEFAULT
+                     WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                     istop = istop + 1
+               END SELECT
+
+            ENDIF ! l_noRebuild false
+
+!3.4 Work out if the valid_min and valid_max attributes exist for this variable.
+!    If they do then calculate the extrema over all input files.
+
+            DO attid = 1, natts
+               CALL check_nf90( nf90_inq_attname( ncid, jv, attid, attname ), istop )
+               IF( INDEX( attname, "valid_min" ) == 1 ) THEN
+                  CALL check_nf90( nf90_get_att( ncid, jv, attname, InMin), istop )
+                  l_valid = .true.
+               ENDIF
+               IF( INDEX( attname, "valid_max" ) == 1 ) THEN
+                  CALL check_nf90( nf90_get_att( ncid, jv, attname, InMax ), istop )
+                  l_valid = .true.
+               ENDIF
+            END DO
+
+            IF (l_valid) THEN
+!$OMP CRITICAL
+               IF( InMin < ValMin ) ValMin = InMin
+               IF( InMax > ValMax ) ValMax = InMax
+!$OMP END CRITICAL
+            ENDIF
+
+!3.5 Abort if failure and only 1 thread 
+
+            IF( nthreads == 1 .AND. istop /= nf90_noerr )  THEN
+               WRITE(numerr,*) '*** NEMO rebuild failed! ***'
+               STOP 5
+            ENDIF
+        
+         END DO  ! loop over files
+!$OMP END PARALLEL DO
+
+!3.6 Abort if any of the OMP threads failed
+         IF( istop /= nf90_noerr )  THEN
+            WRITE(numerr,*) '*** NEMO rebuild failed! ***'
+            STOP 5
+         ENDIF
+
+      ENDIF ! ndims > 2
+
+!---------------------------------------------------------------------------
+!4. Write data to output file
+
+      IF (l_verbose) WRITE(numout,*) 'Writing variable '//TRIM(varname)//'...'
+
+!4.1 If the valid min and max attributes exist then update them in the file
+
+      IF( l_valid ) THEN
+         CALL check_nf90( nf90_put_att( outid, jv, "valid_min", ValMin ) )
+         CALL check_nf90( nf90_put_att( outid, jv, "valid_max", ValMax ) )
+      ENDIF
+
+!4.2 Write the data to the output file depending on how many dimensions it has
+
+      IF( ndims == 0 ) THEN
+
+         SELECT CASE( xtype )
+            CASE( NF90_BYTE )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_0d_i1 ) )
+            CASE( NF90_SHORT )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_0d_i2 ) )
+            CASE( NF90_INT )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_0d_i4 ) )
+            CASE( NF90_FLOAT )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_0d_sp ) )
+            CASE( NF90_DOUBLE )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_0d_dp ) )
+            CASE DEFAULT   
+               WRITE(numerr,*) '0d Unknown nf90 type: ', xtype
+               STOP 4
+         END SELECT
+
+      ELSEIF( ndims == 1 ) THEN
+
+         SELECT CASE( xtype )
+            CASE( NF90_BYTE )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_1d_i1 ) )
+               DEALLOCATE(globaldata_1d_i1)
+            CASE( NF90_SHORT )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_1d_i2 ) )
+               DEALLOCATE(globaldata_1d_i2)
+            CASE( NF90_INT )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_1d_i4 ) )
+               DEALLOCATE(globaldata_1d_i4)
+            CASE( NF90_FLOAT )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_1d_sp ) )
+               DEALLOCATE(globaldata_1d_sp)
+            CASE( NF90_DOUBLE )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_1d_dp ) )
+               DEALLOCATE(globaldata_1d_dp)
+            CASE DEFAULT   
+               WRITE(numerr,*) '1d Unknown nf90 type: ', xtype
+               STOP 4
+         END SELECT
+
+      ELSEIF( ndims == 2 ) THEN  
+     
+         SELECT CASE( xtype )   
+            CASE( NF90_BYTE )                   
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_2d_i1 ) )
+               DEALLOCATE(globaldata_2d_i1)
+            CASE( NF90_SHORT )                   
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_2d_i2 ) )
+               DEALLOCATE(globaldata_2d_i2)
+            CASE( NF90_INT )                              
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_2d_i4 ) )
+               DEALLOCATE(globaldata_2d_i4)
+            CASE( NF90_FLOAT )                              
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_2d_sp ) )
+               DEALLOCATE(globaldata_2d_sp)
+            CASE( NF90_DOUBLE )                                         
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_2d_dp ) )
+               DEALLOCATE(globaldata_2d_dp)
+            CASE DEFAULT   
+               WRITE(numerr,*) '2d Unknown nf90 type: ', xtype
+               STOP 4
+         END SELECT     
+                      
+      ELSEIF( ndims == 3 ) THEN
+      
+         SELECT CASE( xtype ) 
+            CASE( NF90_BYTE )                   
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_3d_i1 ) )
+               DEALLOCATE(globaldata_3d_i1)
+            CASE( NF90_SHORT )                   
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_3d_i2 ) )
+               DEALLOCATE(globaldata_3d_i2)
+            CASE( NF90_INT )                              
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_3d_i4 ) )
+               DEALLOCATE(globaldata_3d_i4)
+            CASE( NF90_FLOAT )                              
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_3d_sp ) )
+               DEALLOCATE(globaldata_3d_sp)
+            CASE( NF90_DOUBLE )                                         
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_3d_dp ) )
+               DEALLOCATE(globaldata_3d_dp)
+            CASE DEFAULT   
+               WRITE(numerr,*) '3d Unknown nf90 type: ', xtype
+               STOP 4
+         END SELECT     
+    
+      ELSEIF( ndims == 4 ) THEN
+
+         SELECT CASE( xtype )   
+            CASE( NF90_BYTE )                   
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_4d_i1, start=(/1,1,1,nt/) ) )
+               DEALLOCATE(globaldata_4d_i1)
+            CASE( NF90_SHORT )                   
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_4d_i2, start=(/1,1,1,nt/) ) )
+               DEALLOCATE(globaldata_4d_i2)
+            CASE( NF90_INT )                              
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_4d_i4, start=(/1,1,1,nt/) ) )
+               DEALLOCATE(globaldata_4d_i4)
+            CASE( NF90_FLOAT )                              
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_4d_sp, start=(/1,1,1,nt/) ) )
+               DEALLOCATE(globaldata_4d_sp)
+            CASE( NF90_DOUBLE )                                         
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_4d_dp, start=(/1,1,1,nt/) ) )
+               DEALLOCATE(globaldata_4d_dp)
+            CASE DEFAULT   
+               WRITE(numerr,*) '4d Unknown nf90 type: ', xtype
+               STOP 4
+         END SELECT     
+         ! why only for big data set, test the cost.
+         CALL check_nf90( nf90_sync( outid ) )    ! flush buffers to disk after writing big 4D datasets
+    
+      ENDIF
+
+         nt = nt + ntslice
+
+      END DO ! WHILE loop
+    
+   END DO  ! loop over variables
+
+!---------------------------------------------------------------------------
+!5. Close files
+
+!5.1 Close input files
+
+   IF (l_verbose) WRITE(numout,*) 'Closing input files...'
+   DO ifile = 1, ndomain
+      ncid = inncids(ifile)
+      CALL check_nf90( nf90_close( ncid ) )
+   END DO
+
+!5.2 Close output file
+
+   IF (l_verbose) WRITE(numout,*) 'Closing output file...'
+   CALL check_nf90( nf90_close( outid ) )
+
+   IF (l_verbose) WRITE(numout,*) 'NEMO rebuild completed successfully'
+   IF (l_verbose) WRITE(numout,*)
+
+CONTAINS
+
+
+   SUBROUTINE check_nf90(status, errorFlag)
+   !---------------------------------------------------------------------
+   !  Checks return code from nf90 library calls and warns if needed
+   !  If errorFlag is present then it just increments this flag (OMP use)
+   !
+   !---------------------------------------------------------------------
+      INTEGER, INTENT(IN   ) :: status
+      INTEGER, INTENT(INOUT), OPTIONAL :: errorFlag
+   !---------------------------------------------------------------------
+
+      IF( status /= nf90_noerr ) THEN
+         WRITE(numerr,*) 'ERROR! : '//TRIM(nf90_strerror(status))
+         IF( PRESENT( errorFlag ) ) THEN
+            errorFlag = errorFlag + status
+         ELSE
+            WRITE(numerr,*) "*** NEMO rebuild failed ***"
+            WRITE(numerr,*)
+            STOP 5
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE check_nf90
+
+
+END PROGRAM rebuild_nemo
Index: /utils/tools_ticket2413/SCOORD_GEN/namelist
===================================================================
--- /utils/tools_ticket2413/SCOORD_GEN/namelist	(revision 12863)
+++ /utils/tools_ticket2413/SCOORD_GEN/namelist	(revision 12863)
@@ -0,0 +1,28 @@
+!-----------------------------------------------------------------------
+&namzgr_sco    !   s-coordinate or hybrid z-s-coordinate
+!-----------------------------------------------------------------------
+   ln_s_sh94   = .false.    !  Song & Haidvogel 1994 hybrid S-sigma   (T)|
+   ln_s_sf12   = .true.   !  Siddorn & Furner 2012 hybrid S-z-sigma (T)| if both are false the NEMO tanh stretching is applied
+   ln_sigcrit  = .true.    !  use sigma coordinates below critical depth (T) or Z coordinates (F) for Siddorn & Furner stretch
+                           !  stretching coefficients for all functions
+   rn_jpk      =  51       ! Number of S levels
+   ln_eq_taper = .false.   !  Tapering of S coords near equator
+   cn_coord_hgr = 'coordinates.nc'  ! File containing gphit (latitude) coordinate for use if ln_eq_taper=.true.
+   rn_sbot_min =   10.0    !  minimum depth of s-bottom surface (>0) (m)
+   rn_sbot_max = 7000.0    !  maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+   rn_hc       =   50.0    !  critical depth for transition to stretched coordinates
+                        !!!!!!!  Envelop bathymetry
+   rn_rmax     =    0.3    !  maximum cut-off r-value allowed (0<r_max<1)
+                        !!!!!!!  SH94 stretching coefficients  (ln_s_sh94 = .true.)
+   rn_theta    =    6.0    !  surface control parameter (0<=theta<=20)
+   rn_bb       =    0.8    !  stretching with SH94 s-sigma   
+                        !!!!!!!  SF12 stretching coefficient  (ln_s_sf12 = .true.)
+   rn_alpha    =    4.4    !  stretching with SF12 s-sigma
+   rn_efold    =    0.0    !  efold length scale for transition to stretched coord
+   rn_zs       =    1.0    !  depth of surface grid box
+                           !  bottom cell depth (Zb) is a linear function of water depth Zb = H*a + b
+   rn_zb_a     =    0.024  !  bathymetry scaling factor for calculating Zb
+   rn_zb_b     =   -0.2    !  offset for calculating Zb
+                        !!!!!!!! Other stretching (not SH94 or SF12) [also uses rn_theta above]
+   rn_thetb    =    1.0    !  bottom control parameter  (0<=thetb<= 1) 
+/
Index: /utils/tools_ticket2413/SCOORD_GEN/src/scoord_gen.F90
===================================================================
--- /utils/tools_ticket2413/SCOORD_GEN/src/scoord_gen.F90	(revision 12863)
+++ /utils/tools_ticket2413/SCOORD_GEN/src/scoord_gen.F90	(revision 12863)
@@ -0,0 +1,664 @@
+PROGRAM SCOORD_GEN
+      !!----------------------------------------------------------------------
+      !!                  ***  PROGRAM scoord_gen  ***
+      !!                     
+      !! ** Purpose :   define the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate
+      !!         The depth of model levels is defined as the product of an
+      !!      analytical function by the local bathymetry, while the vertical
+      !!      scale factors are defined as the product of the first derivative
+      !!      of the analytical function by the bathymetry.
+      !!      (this solution save memory as depth and scale factors are not
+      !!      3d fields)
+      !!          - Read bathymetry (in meters) at t-point and compute the
+      !!         bathymetry at u-, v-, and f-points.
+      !!            hbatu = mi( hbatt )
+      !!            hbatv = mj( hbatt )
+      !!            hbatf = mi( mj( hbatt ) )
+      !!          - Compute z_gsigt, z_gsigw, z_esigt, z_esigw from an analytical
+      !!         function and its derivative given as function.
+      !!            z_gsigt(k) = fssig (k    )
+      !!            z_gsigw(k) = fssig (k-0.5)
+      !!            z_esigt(k) = fsdsig(k    )
+      !!            z_esigw(k) = fsdsig(k-0.5)
+      !!      Three options for stretching are give, and they can be modified
+      !!      following the users requirements. Nevertheless, the output as
+      !!      well as the way to compute the model levels and scale factors
+      !!      must be respected in order to insure second order accuracy
+      !!      schemes.
+      !!
+      !!      The three methods for stretching available are:
+      !! 
+      !!           s_sh94 (Song and Haidvogel 1994)
+      !!                a sinh/tanh function that allows sigma and stretched sigma
+      !!
+      !!           s_sf12 (Siddorn and Furner 2012?)
+      !!                allows the maintenance of fixed surface and or
+      !!                bottom cell resolutions (cf. geopotential coordinates) 
+      !!                within an analytically derived stretched S-coordinate framework.
+      !! 
+      !!          s_tanh  (Madec et al 1996)
+      !!                a cosh/tanh function that gives stretched coordinates        
+      !!
+      !! ** History: 2015: Tim Graham - Code created based on online zdf_sco routine
+      !!
+      !!
+      !!----------------------------------------------------------------------
+      !
+      USE utils
+      IMPLICIT NONE
+
+
+     !!----------------------------------------------------------------------
+      !
+      !
+      OPEN( UNIT=numnam, FILE='namelist', FORM='FORMATTED', STATUS='OLD' )
+      READ( numnam, namzgr_sco )
+      CLOSE( numnam )
+      jpk = INT(rn_jpk)
+
+      WRITE(*,*)
+      WRITE(*,*) 'scoord_gen : s-coordinate or hybrid z-s-coordinate'
+      WRITE(*,*) '~~~~~~~~~~~'
+      WRITE(*,*) '   Namelist namzgr_sco'
+      WRITE(*,*) '     stretching coeffs '
+      WRITE(*,*) '        Number of levels                             rn_jpk        = ',rn_jpk
+      WRITE(*,*) '        maximum depth of s-bottom surface (>0)       rn_sbot_max   = ',rn_sbot_max
+      WRITE(*,*) '        minimum depth of s-bottom surface (>0)       rn_sbot_min   = ',rn_sbot_min
+      WRITE(*,*) '        Critical depth                               rn_hc         = ',rn_hc
+      WRITE(*,*) '        maximum cut-off r-value allowed              rn_rmax       = ',rn_rmax
+      WRITE(*,*) '        Tapering in vicinity of equator              ln_eq_taper   = ',ln_eq_taper
+      WRITE(*,*) '        Horizontal Coordinate File                   cn_coord_hgr  = ',cn_coord_hgr
+      WRITE(*,*) '     Song and Haidvogel 1994 stretching              ln_s_sh94     = ',ln_s_sh94
+      WRITE(*,*) '        Song and Haidvogel 1994 stretching coefficients'
+      WRITE(*,*) '        surface control parameter (0<=rn_theta<=20)  rn_theta      = ',rn_theta
+      WRITE(*,*) '        bottom  control parameter (0<=rn_thetb<= 1)  rn_thetb      = ',rn_thetb
+      WRITE(*,*) '        stretching parameter (song and haidvogel)    rn_bb         = ',rn_bb
+      WRITE(*,*) '     Siddorn and Furner 2012 stretching              ln_s_sf12     = ',ln_s_sf12
+      WRITE(*,*) '        switching to sigma (T) or Z (F) at H<Hc      ln_sigcrit    = ',ln_sigcrit
+      WRITE(*,*) '        Siddorn and Furner 2012 stretching coefficients'
+      WRITE(*,*) '        stretchin parameter ( >1 surface; <1 bottom) rn_alpha      = ',rn_alpha
+      WRITE(*,*) '        e-fold length scale for transition region    rn_efold      = ',rn_efold
+      WRITE(*,*) '        Surface cell depth (Zs) (m)                  rn_zs         = ',rn_zs
+      WRITE(*,*) '        Bathymetry multiplier for Zb                 rn_zb_a       = ',rn_zb_a
+      WRITE(*,*) '        Offset for Zb                                rn_zb_b       = ',rn_zb_b
+      WRITE(*,*) '        Bottom cell (Zb) (m) = H*rn_zb_a + rn_zb_b'
+
+      
+      ! Read in bathy, jpi and jpj from bathy.nc
+      CALL read_bathy()
+
+      !Allocate all other allocatable variables
+      ios = dom_oce_alloc()
+      IF( ios .NE. 0) THEN
+         WRITE(0,*) 'Unable to allocate all arrays'
+         STOP 1
+      ENDIF
+
+      hift(:,:) = rn_sbot_min                     ! set the minimum depth for the s-coordinate
+      hifu(:,:) = rn_sbot_min
+      hifv(:,:) = rn_sbot_min
+      hiff(:,:) = rn_sbot_min
+
+      !                                        ! set maximum ocean depth
+      bathy(:,:) = MIN( rn_sbot_max, bathy(:,:) )
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+           IF( bathy(ji,jj) > 0. )   bathy(ji,jj) = MAX( rn_sbot_min, bathy(ji,jj) )
+         END DO
+      END DO
+      !                                        ! =============================
+      !                                        ! Define the envelop bathymetry   (hbatt)
+      !                                        ! =============================
+      ! use r-value to create hybrid coordinates
+      zenv(:,:) = bathy(:,:)
+      !
+      ! set first land point adjacent to a wet cell to sbot_min as this needs to be included in smoothing
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+           IF( bathy(ji,jj) == 0. ) THEN
+             iip1 = MIN( ji+1, jpi )
+             ijp1 = MIN( jj+1, jpj )
+             iim1 = MAX( ji-1, 1 )
+             ijm1 = MAX( jj-1, 1 )
+             IF( (bathy(iip1,jj) + bathy(iim1,jj) + bathy(ji,ijp1) + bathy(ji,ijm1) +              &
+        &         bathy(iip1,ijp1) + bathy(iim1,ijm1) + bathy(iip1,ijp1) + bathy(iim1,ijm1)) > 0. ) THEN
+               zenv(ji,jj) = rn_sbot_min
+             ENDIF
+           ENDIF
+         END DO
+      END DO
+      ! 
+      ! smooth the bathymetry (if required)
+      scosrf(:,:) = 0.             ! ocean surface depth (here zero: no under ice-shelf sea)
+      scobot(:,:) = bathy(:,:)        ! ocean bottom  depth
+      !
+      jl = 0
+      zrmax = 1.
+      !   
+      !     
+      ! set scaling factor used in reducing vertical gradients
+      zrfact = ( 1. - rn_rmax ) / ( 1. + rn_rmax )
+      !
+      ! initialise temporary evelope depth arrays
+      ztmpi1(:,:) = zenv(:,:)
+      ztmpi2(:,:) = zenv(:,:)
+      ztmpj1(:,:) = zenv(:,:)
+      ztmpj2(:,:) = zenv(:,:)
+      !
+      ! initialise temporary r-value arrays
+      zri(:,:) = 1.
+      zrj(:,:) = 1.
+
+      !                                                            ! ================ !
+      DO WHILE( jl <= 10000 .AND. ( zrmax - rn_rmax ) > 1.e-8 ) !  Iterative loop  !
+         !                                                         ! ================ !
+         jl = jl + 1
+         zrmax = 0.
+         ! we set zrmax from previous r-values (zri and zrj) first
+         ! if set after current r-value calculation (as previously)
+         ! we could exit DO WHILE prematurely before checking r-value
+         ! of current zenv
+         DO jj = 1, jpj 
+            DO ji = 1, jpi
+               zrmax = MAX( zrmax, ABS(zri(ji,jj)), ABS(zrj(ji,jj)) )
+            END DO
+         END DO
+         zri(:,:) = 0.
+         zrj(:,:) = 0.
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               iip1 = MIN(ji+1,jpi) 
+               ijp1 = MIN(jj+1,jpj)     
+               IF( (zenv(ji,jj) > 0.) .AND. (zenv(iip1,jj) > 0.)) THEN
+                  zri(ji,jj) = ( zenv(iip1,jj  ) - zenv(ji,jj) ) / ( zenv(iip1,jj  ) + zenv(ji,jj) )
+               END IF
+               IF( (zenv(ji,jj) > 0.) .AND. (zenv(ji,ijp1) > 0.)) THEN
+                  zrj(ji,jj) = ( zenv(ji  ,ijp1) - zenv(ji,jj) ) / ( zenv(ji  ,ijp1) + zenv(ji,jj) )
+               END IF
+               IF( zri(ji,jj) >  rn_rmax )   ztmpi1(ji  ,jj  ) = zenv(iip1,jj  ) * zrfact
+               IF( zri(ji,jj) < -rn_rmax )   ztmpi2(iip1,jj  ) = zenv(ji  ,jj  ) * zrfact
+               IF( zrj(ji,jj) >  rn_rmax )   ztmpj1(ji  ,jj  ) = zenv(ji  ,ijp1) * zrfact
+               IF( zrj(ji,jj) < -rn_rmax )   ztmpj2(ji  ,ijp1) = zenv(ji  ,jj  ) * zrfact
+            END DO
+         END DO
+         !
+         WRITE(*,*) 'zgr_sco :   iter= ',jl, ' rmax= ', zrmax
+         !
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zenv(ji,jj) = MAX(zenv(ji,jj), ztmpi1(ji,jj), ztmpi2(ji,jj), ztmpj1(ji,jj), ztmpj2(ji,jj) )
+            END DO
+         END DO
+         !                                                  ! ================ !
+      END DO                                                !     End loop     !
+      !                                                     ! ================ !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zenv(ji,jj) = MAX( zenv(ji,jj), rn_sbot_min ) ! set all points to avoid undefined scale value warnings
+         END DO
+      END DO
+      !
+      ! Envelope bathymetry saved in hbatt
+      hbatt(:,:) = zenv(:,:) 
+      IF( ln_eq_taper) THEN
+        CALL READ_GPHIT()
+        IF( MINVAL( gphit(:,:) ) * MAXVAL( gphit(:,:) ) <= 0. ) THEN
+          WRITE(*,*) 's-coordinates are tapered in vicinity of the Equator' 
+          DO jj = 1, jpj
+             DO ji = 1, jpi
+                ztaper = EXP( -(gphit(ji,jj)/8.)**2. )
+                hbatt(ji,jj) = rn_sbot_max * ztaper + hbatt(ji,jj) * ( 1. - ztaper )
+             END DO
+          END DO
+        ENDIF
+      ENDIF
+      !
+      !                                        ! ==============================
+      !                                        !   hbatu, hbatv, hbatf fields
+      !                                        ! ==============================
+      WRITE(*,*)
+      WRITE(*,*) ' zgr_sco: minimum depth of the envelop topography set to : ', rn_sbot_min
+      hbatu(:,:) = rn_sbot_min
+      hbatv(:,:) = rn_sbot_min
+      hbatf(:,:) = rn_sbot_min
+      DO jj = 1, jpj-1
+        DO ji = 1, jpi-1   ! NO vector opt.
+           hbatu(ji,jj) = 0.50 * ( hbatt(ji  ,jj) + hbatt(ji+1,jj  ) )
+           hbatv(ji,jj) = 0.50 * ( hbatt(ji  ,jj) + hbatt(ji  ,jj+1) )
+           hbatf(ji,jj) = 0.25 * ( hbatt(ji  ,jj) + hbatt(ji  ,jj+1)   &
+              &                     + hbatt(ji+1,jj) + hbatt(ji+1,jj+1) )
+        END DO
+      END DO
+      ! 
+      zhbat(:,:) = hbatu(:,:)   
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( hbatu(ji,jj) == 0. ) THEN
+               IF( zhbat(ji,jj) == 0. )   hbatu(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0. )   hbatu(ji,jj) = zhbat(ji,jj)
+            ENDIF
+         END DO
+      END DO
+      zhbat(:,:) = hbatv(:,:)  
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( hbatv(ji,jj) == 0. ) THEN
+               IF( zhbat(ji,jj) == 0. )   hbatv(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0. )   hbatv(ji,jj) = zhbat(ji,jj)
+            ENDIF
+         END DO
+      END DO
+      zhbat(:,:) = hbatf(:,:)   
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( hbatf(ji,jj) == 0. ) THEN
+               IF( zhbat(ji,jj) == 0. )   hbatf(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0. )   hbatf(ji,jj) = zhbat(ji,jj)
+            ENDIF
+         END DO
+      END DO
+
+!!bug:  key_helsinki a verifer
+      hift(:,:) = MIN( hift(:,:), hbatt(:,:) )
+      hifu(:,:) = MIN( hifu(:,:), hbatu(:,:) )
+      hifv(:,:) = MIN( hifv(:,:), hbatv(:,:) )
+      hiff(:,:) = MIN( hiff(:,:), hbatf(:,:) )
+
+         WRITE(*,*) ' MAX val hif   t ', MAXVAL( hift (:,:) ), ' f ', MAXVAL( hiff (:,:) ),  &
+            &                        ' u ',   MAXVAL( hifu (:,:) ), ' v ', MAXVAL( hifv (:,:) )
+         WRITE(*,*) ' MIN val hif   t ', MINVAL( hift (:,:) ), ' f ', MINVAL( hiff (:,:) ),  &
+            &                        ' u ',   MINVAL( hifu (:,:) ), ' v ', MINVAL( hifv (:,:) )
+         WRITE(*,*) ' MAX val hbat  t ', MAXVAL( hbatt(:,:) ), ' f ', MAXVAL( hbatf(:,:) ),  &
+            &                        ' u ',   MAXVAL( hbatu(:,:) ), ' v ', MAXVAL( hbatv(:,:) )
+         WRITE(*,*) ' MIN val hbat  t ', MINVAL( hbatt(:,:) ), ' f ', MINVAL( hbatf(:,:) ),  &
+            &                        ' u ',   MINVAL( hbatu(:,:) ), ' v ', MINVAL( hbatv(:,:) )
+      
+      ! Create the output file
+      CALL make_coord_file()
+
+      !                                            ! =======================
+      !                                            !   s-coordinate fields     (gdep., e3.)
+      !                                            ! =======================
+      !
+      ! non-dimensional "sigma" for model level depth at w- and t-levels
+
+
+!========================================================================
+! Song and Haidvogel  1994 (ln_s_sh94=T)
+! Siddorn and Furner 2012 (ln_sf12=T)
+! or  tanh function       (both false)                    
+! To reduce memory loop over jpk and write each level to file
+!========================================================================
+      IF      ( ln_s_sh94 ) THEN 
+                           CALL s_sh94()
+      ELSE IF ( ln_s_sf12 ) THEN
+                           CALL s_sf12()
+      ELSE                 
+                           CALL s_tanh()
+      ENDIF
+
+!Write all 2D variables to output file
+      CALL write_netcdf_2d_vars()
+      CALL check_nf90( nf90_close(ncout) )
+
+ 
+      !
+END PROGRAM SCOORD_GEN
+
+!!======================================================================
+   SUBROUTINE s_sh94()
+
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE s_sh94  ***
+      !!                     
+      !! ** Purpose :   stretch the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate stretch using the Song and Haidvogel 1994
+      !!                mixed S/sigma coordinate
+      !!
+      !! Reference : Song and Haidvogel 1994. 
+      !!----------------------------------------------------------------------
+      !
+      USE utils
+      REAL(wp) ::   zcoeft, zcoefw   ! temporary scalars
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_gsigw3p1, z_gsigt3m1, z_gsi3w3m1
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_esigt3, z_esigw3, z_esigtu3 
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3           
+
+      ALLOCATE( z_gsigw3(jpi,jpj), z_gsigt3(jpi,jpj), z_gsi3w3(jpi,jpj) )
+      ALLOCATE( z_esigt3(jpi,jpj), z_esigw3(jpi,jpj), z_esigtu3(jpi,jpj)) 
+      ALLOCATE( z_esigtv3(jpi,jpj), z_esigtf3(jpi,jpj), z_esigwu3(jpi,jpj)) 
+      ALLOCATE( z_esigwv3(jpi,jpj), z_gsigw3p1(jpi,jpj), z_gsigt3m1(jpi,jpj) )
+      ALLOCATE( z_gsi3w3m1(jpi,jpj) )
+ 
+      z_gsigw3  = 0.   ;   z_gsigt3  = 0.   ;   z_gsi3w3  = 0.
+      z_esigt3  = 0.   ;   z_esigw3  = 0. 
+      z_esigtu3 = 0.   ;   z_esigtv3 = 0.   ;   z_esigtf3 = 0.
+      z_esigwu3 = 0.   ;   z_esigwv3 = 0.
+
+      DO jk = 1,jpk
+         DO ji = 1, jpi
+            DO jj = 1, jpj
+
+               IF( hbatt(ji,jj) > rn_hc ) THEN    !deep water, stretched sigma
+                     z_gsigw3(ji,jj) = -fssig1( REAL(jk,wp)-0.5, rn_bb )
+                     z_gsigw3p1(ji,jj) = -fssig1( REAL(jk+1,wp)-0.5, rn_bb )
+                     z_gsigt3(ji,jj) = -fssig1( REAL(jk,wp)    , rn_bb )
+               ELSE ! shallow water, uniform sigma
+                     z_gsigw3(ji,jj) =   REAL(jk-1,wp)            / REAL(jpk-1,wp)
+                     z_gsigw3p1(ji,jj) =   REAL(jk,wp)            / REAL(jpk-1,wp)
+                     z_gsigt3(ji,jj) = ( REAL(jk-1,wp) + 0.5 ) / REAL(jpk-1,wp)
+               ENDIF
+               !
+             !gsi3w3m1 & gsigt3m1 only used if jk /= 1 and is set at the end of the loop over jk
+               IF( jk .EQ. 1) THEN
+                  z_esigw3(ji,jj ) = 2. * ( z_gsigt3(ji,jj ) - z_gsigw3(ji,jj ) )
+                  z_gsi3w3(ji,jj) = 0.5 * z_esigw3(ji,jj)
+               ELSE
+                  z_esigw3(ji,jj) = z_gsigt3(ji,jj) - z_gsigt3m1(ji,jj)
+                  z_gsi3w3(ji,jj) = z_gsi3w3m1(ji,jj) + z_esigw3(ji,jj)
+               ENDIF
+               IF( jk .EQ. jpk) THEN
+                  z_esigt3(ji,jj) = 2. * ( z_gsigt3(ji,jj) - z_gsigw3(ji,jj) )
+               ELSE
+                  z_esigt3(ji,jj ) = z_gsigw3p1(ji,jj) - z_gsigw3(ji,jj)
+               ENDIF
+               !
+
+               zcoeft = ( REAL(jk,wp) - 0.5 ) / REAL(jpk-1,wp)
+               zcoefw = ( REAL(jk,wp) - 1.0 ) / REAL(jpk-1,wp)
+               gdept_0(ji,jj) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigt3(ji,jj)+rn_hc*zcoeft )
+               gdepw_0(ji,jj) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsigw3(ji,jj)+rn_hc*zcoefw )
+               gdep3w_0(ji,jj) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*z_gsi3w3(ji,jj)+rn_hc*zcoeft )
+              !
+            END DO   ! for all jj's
+         END DO    ! for all ji's
+
+         DO ji = 1, jpi-1
+            DO jj = 1, jpj-1
+               z_esigtu3(ji,jj) = ( hbatt(ji,jj)*z_esigt3(ji,jj)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj) )   &
+                  &              / ( hbatt(ji,jj)+hbatt(ji+1,jj) )
+               z_esigtv3(ji,jj) = ( hbatt(ji,jj)*z_esigt3(ji,jj)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1) )   &
+                  &              / ( hbatt(ji,jj)+hbatt(ji,jj+1) )
+               z_esigtf3(ji,jj) = ( hbatt(ji,jj)*z_esigt3(ji,jj)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj)     &
+                  &                + hbatt(ji,jj+1)*z_esigt3(ji,jj+1)+hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1) )   &
+                  &              / ( hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) )
+               z_esigwu3(ji,jj) = ( hbatt(ji,jj)*z_esigw3(ji,jj)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj) )   &
+                  &              / ( hbatt(ji,jj)+hbatt(ji+1,jj) )
+               z_esigwv3(ji,jj) = ( hbatt(ji,jj)*z_esigw3(ji,jj)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1) )   &
+                  &              / ( hbatt(ji,jj)+hbatt(ji,jj+1) )
+               !
+               e3t_0(ji,jj) = ( (hbatt(ji,jj)-rn_hc)*z_esigt3 (ji,jj) + rn_hc/REAL(jpk-1,wp) )
+               e3u_0(ji,jj) = ( (hbatu(ji,jj)-rn_hc)*z_esigtu3(ji,jj) + rn_hc/REAL(jpk-1,wp) )
+               e3v_0(ji,jj) = ( (hbatv(ji,jj)-rn_hc)*z_esigtv3(ji,jj) + rn_hc/REAL(jpk-1,wp) )
+               e3f_0(ji,jj) = ( (hbatf(ji,jj)-rn_hc)*z_esigtf3(ji,jj) + rn_hc/REAL(jpk-1,wp) )
+               !
+               e3w_0 (ji,jj) = ( (hbatt(ji,jj)-rn_hc)*z_esigw3 (ji,jj) + rn_hc/REAL(jpk-1,wp) )
+               e3uw_0(ji,jj) = ( (hbatu(ji,jj)-rn_hc)*z_esigwu3(ji,jj) + rn_hc/REAL(jpk-1,wp) )
+               e3vw_0(ji,jj) = ( (hbatv(ji,jj)-rn_hc)*z_esigwv3(ji,jj) + rn_hc/REAL(jpk-1,wp) )
+            END DO
+         END DO
+
+         z_gsigt3m1 = z_gsigt3
+         z_gsi3w3m1 = z_gsi3w3
+ 
+         where (e3t_0   (:,:).eq.0.0)  e3t_0(:,:) = 1.0
+         where (e3u_0   (:,:).eq.0.0)  e3u_0(:,:) = 1.0
+         where (e3v_0   (:,:).eq.0.0)  e3v_0(:,:) = 1.0
+         where (e3f_0   (:,:).eq.0.0)  e3f_0(:,:) = 1.0
+         where (e3w_0   (:,:).eq.0.0)  e3w_0(:,:) = 1.0
+         where (e3uw_0  (:,:).eq.0.0)  e3uw_0(:,:) = 1.0
+         where (e3vw_0  (:,:).eq.0.0)  e3vw_0(:,:) = 1.0
+        
+         CALL write_netcdf_3d_vars(jk)
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+                  IF( scobot(ji,jj) >= gdept_0(ji,jj) )   mbathy(ji,jj) = MAX( 2, jk )
+                  IF( scobot(ji,jj) == 0.             )   mbathy(ji,jj) = 0
+            END DO
+         END DO
+      END DO !End of loop over jk
+
+      DEALLOCATE( z_gsigw3, z_gsigt3, z_gsi3w3, z_gsigw3p1, z_gsigt3m1, z_gsi3w3m1)
+      DEALLOCATE( z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )
+
+   END SUBROUTINE s_sh94
+
+   SUBROUTINE s_sf12
+
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE s_sf12 *** 
+      !!                     
+      !! ** Purpose :   stretch the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate stretch using the Siddorn and Furner 2012?
+      !!                mixed S/sigma/Z coordinate
+      !!
+      !!                This method allows the maintenance of fixed surface and or
+      !!                bottom cell resolutions (cf. geopotential coordinates) 
+      !!                within an analytically derived stretched S-coordinate framework.
+      !!
+      !!
+      !! Reference : Siddorn and Furner 2012 (submitted Ocean modelling).
+      !!----------------------------------------------------------------------
+      !
+      USE utils
+      REAL(wp) ::   zsmth               ! smoothing around critical depth
+      REAL(wp) ::   zzs, zzb           ! Surface and bottom cell thickness in sigma space
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_gsigw3p1, z_gsigt3m1, z_gsi3w3m1
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_esigt3, z_esigw3, z_esigtu3 
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3           
+
+      ALLOCATE( z_gsigw3(jpi,jpj), z_gsigt3(jpi,jpj), z_gsi3w3(jpi,jpj) )
+      ALLOCATE( z_esigt3(jpi,jpj), z_esigw3(jpi,jpj), z_esigtu3(jpi,jpj)) 
+      ALLOCATE( z_esigtv3(jpi,jpj), z_esigtf3(jpi,jpj), z_esigwu3(jpi,jpj)) 
+      ALLOCATE( z_esigwv3(jpi,jpj), z_gsigw3p1(jpi,jpj), z_gsigt3m1(jpi,jpj) )
+      ALLOCATE( z_gsi3w3m1(jpi,jpj) )
+
+      z_gsigw3  = 0.   ;   z_gsigt3  = 0.   ;   z_gsi3w3  = 0.
+      z_esigt3  = 0.   ;   z_esigw3  = 0. 
+      z_esigtu3 = 0.   ;   z_esigtv3 = 0.   ;   z_esigtf3 = 0.
+      z_esigwu3 = 0.   ;   z_esigwv3 = 0.
+      
+
+      DO jk = 1,jpk
+         DO ji = 1, jpi
+            DO jj = 1, jpj
+             IF (hbatt(ji,jj)>rn_hc) THEN !deep water, stretched sigma
+              
+                zzb = hbatt(ji,jj)*rn_zb_a + rn_zb_b   ! this forces a linear bottom cell depth relationship with H,.
+                                                     ! could be changed by users but care must be taken to do so carefully
+                zzb = 1.0-(zzb/hbatt(ji,jj))
+            
+                zzs = rn_zs / hbatt(ji,jj) 
+              
+                IF (rn_efold /= 0.0) THEN
+                   zsmth   = tanh( (hbatt(ji,jj)- rn_hc ) / rn_efold )
+                ELSE
+                   zsmth = 1.0 
+                ENDIF
+                  
+                z_gsigw3(ji,jj) =  REAL(jk-1,wp)        /REAL(jpk-1,wp)
+                z_gsigw3p1(ji,jj) =  REAL(jk,wp)        /REAL(jpk-1,wp)
+                z_gsigt3(ji,jj) = (REAL(jk-1,wp)+0.5)/REAL(jpk-1,wp)
+                z_gsigw3(ji,jj) = fgamma( z_gsigw3(ji,jj), zzb, zzs, zsmth  )
+                z_gsigw3p1(ji,jj) = fgamma( z_gsigw3p1(ji,jj), zzb, zzs, zsmth  )
+                z_gsigt3(ji,jj) = fgamma( z_gsigt3(ji,jj), zzb, zzs, zsmth  )
+ 
+             ELSE IF(ln_sigcrit) THEN ! shallow water, uniform sigma
+
+                z_gsigw3(ji,jj) =  REAL(jk-1,wp)     /REAL(jpk-1,wp)
+                z_gsigw3p1(ji,jj) =  REAL(jk,wp)     /REAL(jpk-1,wp)
+                z_gsigt3(ji,jj) = (REAL(jk-1,wp)+0.5)/REAL(jpk-1,wp)
+
+             ELSE  ! shallow water, z coordinates
+
+               z_gsigw3(ji,jj) =  REAL(jk-1,wp)        /REAL(jpk-1,wp)*(rn_hc/hbatt(ji,jj))
+               z_gsigw3p1(ji,jj) =  REAL(jk,wp)        /REAL(jpk-1,wp)*(rn_hc/hbatt(ji,jj))
+               z_gsigt3(ji,jj) = (REAL(jk-1,wp)+0.5)/REAL(jpk-1,wp)*(rn_hc/hbatt(ji,jj))
+
+             ENDIF
+
+             !gsi3w3m1 & z_gsigt3m1 only used if jk /= 1 and is set at the end of the loop over jk
+             IF( jk .EQ. 1) THEN
+                z_esigw3(ji,jj  ) = 2.0 * (z_gsigt3(ji,jj ) - z_gsigw3(ji,jj ))
+                z_gsi3w3(ji,jj) = 0.5 * z_esigw3(ji,jj) 
+             ELSE
+                z_esigw3(ji,jj) = z_gsigt3(ji,jj) - z_gsigt3m1(ji,jj)
+                z_gsi3w3(ji,jj) = z_gsi3w3m1(ji,jj) + z_esigw3(ji,jj)
+             ENDIF
+             IF( jk .EQ. jpk) THEN
+                z_esigt3(ji,jj) = 2.0 * (z_gsigt3(ji,jj) - z_gsigw3(ji,jj))
+             ELSE
+                z_esigt3(ji,jj) = z_gsigw3p1(ji,jj) - z_gsigw3(ji,jj)
+             ENDIF
+
+             gdept_0(ji,jj) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigt3(ji,jj)
+             gdepw_0(ji,jj) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsigw3(ji,jj)
+             gdep3w_0(ji,jj) = (scosrf(ji,jj)+hbatt(ji,jj))*z_gsi3w3(ji,jj)
+
+            ENDDO   ! for all jj's
+         ENDDO    ! for all ji's
+
+         DO ji=1,jpi-1
+            DO jj=1,jpj-1
+
+               z_esigtu3(ji,jj) = ( hbatt(ji,jj)*z_esigt3(ji,jj)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj) ) / &
+                                     ( hbatt(ji,jj)+hbatt(ji+1,jj) )
+               z_esigtv3(ji,jj) = ( hbatt(ji,jj)*z_esigt3(ji,jj)+hbatt(ji,jj+1)*z_esigt3(ji,jj+1) ) / &
+                                     ( hbatt(ji,jj)+hbatt(ji,jj+1) )
+               z_esigtf3(ji,jj) = ( hbatt(ji,jj)*z_esigt3(ji,jj)+hbatt(ji+1,jj)*z_esigt3(ji+1,jj) +  &
+                                       hbatt(ji,jj+1)*z_esigt3(ji,jj+1)+hbatt(ji+1,jj+1)*z_esigt3(ji+1,jj+1) ) / &
+                                     ( hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) )
+               z_esigwu3(ji,jj) = ( hbatt(ji,jj)*z_esigw3(ji,jj)+hbatt(ji+1,jj)*z_esigw3(ji+1,jj) ) / &
+                                     ( hbatt(ji,jj)+hbatt(ji+1,jj) )
+               z_esigwv3(ji,jj) = ( hbatt(ji,jj)*z_esigw3(ji,jj)+hbatt(ji,jj+1)*z_esigw3(ji,jj+1) ) / &
+                                     ( hbatt(ji,jj)+hbatt(ji,jj+1) )
+
+               e3t_0(ji,jj)=(scosrf(ji,jj)+hbatt(ji,jj))*z_esigt3(ji,jj)
+               e3u_0(ji,jj)=(scosrf(ji,jj)+hbatu(ji,jj))*z_esigtu3(ji,jj)
+               e3v_0(ji,jj)=(scosrf(ji,jj)+hbatv(ji,jj))*z_esigtv3(ji,jj)
+               e3f_0(ji,jj)=(scosrf(ji,jj)+hbatf(ji,jj))*z_esigtf3(ji,jj)
+               !
+               e3w_0(ji,jj)=hbatt(ji,jj)*z_esigw3(ji,jj)
+               e3uw_0(ji,jj)=hbatu(ji,jj)*z_esigwu3(ji,jj)
+               e3vw_0(ji,jj)=hbatv(ji,jj)*z_esigwv3(ji,jj)
+            ENDDO
+         ENDDO
+         ! Keep some arrays for next level
+         z_gsigt3m1 = z_gsigt3
+         z_gsi3w3m1 = z_gsi3w3
+ 
+         where (e3t_0   (:,:).eq.0.0)  e3t_0(:,:) = 1.0
+         where (e3u_0   (:,:).eq.0.0)  e3u_0(:,:) = 1.0
+         where (e3v_0   (:,:).eq.0.0)  e3v_0(:,:) = 1.0
+         where (e3f_0   (:,:).eq.0.0)  e3f_0(:,:) = 1.0
+         where (e3w_0   (:,:).eq.0.0)  e3w_0(:,:) = 1.0
+         where (e3uw_0  (:,:).eq.0.0)  e3uw_0(:,:) = 1.0
+         where (e3vw_0  (:,:).eq.0.0)  e3vw_0(:,:) = 1.0
+         
+         CALL write_netcdf_3d_vars(jk)
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+                  IF( scobot(ji,jj) >= gdept_0(ji,jj) )   mbathy(ji,jj) = MAX( 2, jk )
+                  IF( scobot(ji,jj) == 0.             )   mbathy(ji,jj) = 0
+            END DO
+         END DO
+
+      ENDDO ! End of loop over jk
+
+      DEALLOCATE( z_gsigw3, z_gsigt3, z_gsi3w3, z_gsigw3p1, z_gsigt3m1, z_gsi3w3m1)
+      DEALLOCATE( z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )
+
+   END SUBROUTINE s_sf12
+
+   SUBROUTINE s_tanh()
+
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE s_tanh*** 
+      !!                     
+      !! ** Purpose :   stretch the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate stretch 
+      !!
+      !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408.
+      !!----------------------------------------------------------------------
+
+      USE utils
+      REAL(wp) ::   zcoeft, zcoefw   ! temporary scalars
+
+      REAL(wp), ALLOCATABLE, DIMENSION(:) :: z_gsigw, z_gsigt, z_gsi3w
+      REAL(wp), ALLOCATABLE, DIMENSION(:) :: z_esigt, z_esigw
+
+      ALLOCATE( z_gsigw(jpk), z_gsigt(jpk), z_gsi3w(jpk) )
+      ALLOCATE( z_esigt(jpk), z_esigw(jpk) )
+
+      z_gsigw  = 0.   ;   z_gsigt  = 0.   ;   z_gsi3w  = 0.
+      z_esigt  = 0.   ;   z_esigw  = 0. 
+
+      DO jk = 1, jpk
+        z_gsigw(jk) = -fssig( REAL(jk,wp)-0.5 )
+        z_gsigt(jk) = -fssig( REAL(jk,wp)        )
+      END DO
+      WRITE(*,*) 'z_gsigw 1 jpk    ', z_gsigw(1), z_gsigw(jpk)
+      !
+      ! Coefficients for vertical scale factors at w-, t- levels
+!!gm bug :  define it from analytical function, not like juste bellow....
+!!gm        or betteroffer the 2 possibilities....
+      DO jk = 1, jpk-1
+         z_esigt(jk  ) = z_gsigw(jk+1) - z_gsigw(jk)
+         z_esigw(jk+1) = z_gsigt(jk+1) - z_gsigt(jk)
+      END DO
+      z_esigw( 1 ) = 2. * ( z_gsigt(1  ) - z_gsigw(1  ) ) 
+      z_esigt(jpk) = 2. * ( z_gsigt(jpk) - z_gsigw(jpk) )
+      !
+      ! Coefficients for vertical depth as the sum of e3w scale factors
+      z_gsi3w(1) = 0.5 * z_esigw(1)
+      DO jk = 2, jpk
+         z_gsi3w(jk) = z_gsi3w(jk-1) + z_esigw(jk)
+      END DO
+!!gm: e3uw, e3vw can be suppressed  (modif in dynzdf, dynzdf_iso, zdfbfr) (save 2 3D arrays)
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+              zcoeft = ( REAL(jk,wp) - 0.5 ) / REAL(jpk-1,wp)
+              zcoefw = ( REAL(jk,wp) - 1.0 ) / REAL(jpk-1,wp)
+              gdept_0(ji,jj) = ( scosrf(ji,jj) + (hbatt(ji,jj)-hift(ji,jj))*z_gsigt(jk) + hift(ji,jj)*zcoeft )
+              gdepw_0(:,:) = ( scosrf(ji,jj) + (hbatt(ji,jj)-hift(ji,jj))*z_gsigw(jk) + hift(ji,jj)*zcoefw )
+              gdep3w_0(:,:) = ( scosrf(ji,jj) + (hbatt(ji,jj)-hift(ji,jj))*z_gsi3w(jk) + hift(ji,jj)*zcoeft )
+              e3t_0(ji,jj) = ( (hbatt(ji,jj)-hift(ji,jj))*z_esigt(jk) + hift(ji,jj)/REAL(jpk-1,wp) )
+              e3u_0(ji,jj) = ( (hbatu(ji,jj)-hifu(ji,jj))*z_esigt(jk) + hifu(ji,jj)/REAL(jpk-1,wp) )
+              e3v_0(ji,jj) = ( (hbatv(ji,jj)-hifv(ji,jj))*z_esigt(jk) + hifv(ji,jj)/REAL(jpk-1,wp) )
+              e3f_0(ji,jj) = ( (hbatf(ji,jj)-hiff(ji,jj))*z_esigt(jk) + hiff(ji,jj)/REAL(jpk-1,wp) )
+              !
+              e3w_0(ji,jj) = ( (hbatt(ji,jj)-hift(ji,jj))*z_esigw(jk) + hift(ji,jj)/REAL(jpk-1,wp) )
+              e3uw_0(ji,jj) = ( (hbatu(ji,jj)-hifu(ji,jj))*z_esigw(jk) + hifu(ji,jj)/REAL(jpk-1,wp) )
+              e3vw_0(ji,jj) = ( (hbatv(ji,jj)-hifv(ji,jj))*z_esigw(jk) + hifv(ji,jj)/REAL(jpk-1,wp) )
+              IF( scobot(ji,jj) >= gdept_0(ji,jj) )   mbathy(ji,jj) = MAX( 2, jk )
+              IF( scobot(ji,jj) == 0.             )   mbathy(ji,jj) = 0
+            END DO
+         END DO
+         where (e3t_0   (:,:).eq.0.0)  e3t_0(:,:) = 1.0
+         where (e3u_0   (:,:).eq.0.0)  e3u_0(:,:) = 1.0
+         where (e3v_0   (:,:).eq.0.0)  e3v_0(:,:) = 1.0
+         where (e3f_0   (:,:).eq.0.0)  e3f_0(:,:) = 1.0
+         where (e3w_0   (:,:).eq.0.0)  e3w_0(:,:) = 1.0
+         where (e3uw_0  (:,:).eq.0.0)  e3uw_0(:,:) = 1.0
+         where (e3vw_0  (:,:).eq.0.0)  e3vw_0(:,:) = 1.0
+ 
+         CALL write_netcdf_3d_vars(jk)
+      ENDDO ! End of loop over jk
+
+
+      DEALLOCATE( z_gsigw, z_gsigt, z_gsi3w )
+      DEALLOCATE( z_esigt, z_esigw )
+
+   END SUBROUTINE s_tanh
Index: /utils/tools_ticket2413/SCOORD_GEN/src/utils.F90
===================================================================
--- /utils/tools_ticket2413/SCOORD_GEN/src/utils.F90	(revision 12863)
+++ /utils/tools_ticket2413/SCOORD_GEN/src/utils.F90	(revision 12863)
@@ -0,0 +1,330 @@
+MODULE utils
+
+   USE netcdf
+
+   IMPLICIT NONE
+   PUBLIC             ! allows the acces to par_oce when dom_oce is used
+   !                  ! exception to coding rules... to be suppressed ???
+
+!   PUBLIC dom_oce_alloc
+
+   INTEGER, PARAMETER   :: dp=8 , sp=4, wp=dp
+
+   !! All coordinates
+   !! ---------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gdep3w_0           !: depth of t-points (sum of e3w) (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gdept_0, gdepw_0   !: analytical (time invariant) depth at t-w  points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gphit              !: latitude at t points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3v_0  , e3f_0     !: analytical (time invariant) vertical scale factors at  v-f
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3t_0  , e3u_0     !:                                      t-u  points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3vw_0             !: analytical (time invariant) vertical scale factors at  vw
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3w_0  , e3uw_0    !:                                      w-uw points (m)
+
+   !! s-coordinate and hybrid z-s-coordinate
+   !! =----------------======---------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hbatv , hbatf      !: ocean depth at the vertical of  v--f
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hbatt , hbatu      !:                                 t--u points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   scosrf, scobot     !: ocean surface and bottom topographies 
+   !                                                                           !  (if deviating from coordinate surfaces in HYBRID)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hifv  , hiff       !: interface depth between stretching at v--f
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hift  , hifu       !: and quasi-uniform spacing             t--u points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rx1                !: Maximum grid stiffness ratio
+
+   !!----------------------------------------------------------------------
+   !! masks, bathymetry
+   !! ---------------------------------------------------------------------
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbathy             !: number of ocean level (=0, 1, ... , jpk-1)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bathy              !: ocean depth (meters - read from file)
+
+   !! Other variables needed by scoord_gen
+   INTEGER  ::   jpi, jpj, jpk            ! Size of the domain - read from bathy or namelist?
+   INTEGER  ::   ji, jj, jk, jl           ! dummy loop argument
+   INTEGER  ::   iip1, ijp1, iim1, ijm1   ! temporary integers
+   INTEGER  ::   ios                      ! Local integer output status for namelist read and allocation
+   INTEGER,PARAMETER  ::   numnam=8       ! File handle for namelist 
+   REAL(wp) ::   zrmax, ztaper   ! temporary scalars
+   REAL(wp) ::   zrfact
+   !
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztmpi1, ztmpi2, ztmpj1, ztmpj2
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zenv, ztmp, zmsk, zri, zrj, zhbat
+
+   !Namelist variables
+   REAL(wp) :: rn_jpk, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax, rn_theta
+   REAL(wp) :: rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b
+   LOGICAL :: ln_s_sh94, ln_s_sf12, ln_sigcrit, ln_eq_taper
+   CHARACTER(len=50) :: cn_coord_hgr
+
+   NAMELIST/namzgr_sco/rn_jpk, ln_s_sh94, ln_s_sf12, ln_sigcrit, ln_eq_taper, & 
+                  &      cn_coord_hgr, rn_sbot_min, rn_sbot_max, rn_hc, rn_rmax,rn_theta, &
+                  &      rn_thetb, rn_bb, rn_alpha, rn_efold, rn_zs, rn_zb_a, rn_zb_b
+
+  ! IDs for output netcdf file
+  INTEGER :: id_x, id_y, id_z
+  INTEGER :: ncout
+  INTEGER, DIMENSION(20) :: var_ids  !Array to contain all variable IDs
+
+   CONTAINS
+
+   INTEGER FUNCTION dom_oce_alloc()
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(4) :: ierr
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !
+      ALLOCATE( zenv(jpi,jpj), ztmp(jpi,jpj), zmsk(jpi,jpj), zri(jpi,jpj), zrj(jpi,jpj), &
+         &      zhbat(jpi,jpj) , ztmpi1(jpi,jpj), ztmpi2(jpi,jpj), ztmpj1(jpi,jpj), ztmpj2(jpi,jpj), STAT=ierr(1) )
+         !
+      ALLOCATE( gdep3w_0(jpi,jpj) , e3v_0(jpi,jpj) , e3f_0(jpi,jpj) ,                         &
+         &      gdept_0(jpi,jpj) , e3t_0(jpi,jpj) , e3u_0 (jpi,jpj) ,                         &
+         &      gdepw_0(jpi,jpj) , e3w_0(jpi,jpj) , e3vw_0(jpi,jpj) ,                         &
+         &      gphit(jpi,jpj)   , e3uw_0(jpi,jpj) , STAT=ierr(2) )
+         !
+         !
+      ALLOCATE( hbatv (jpi,jpj) , hbatf (jpi,jpj) ,     &
+         &      hbatt (jpi,jpj) , hbatu (jpi,jpj) ,     &
+         &      scosrf(jpi,jpj) , scobot(jpi,jpj) ,     &
+         &      hifv  (jpi,jpj) , hiff  (jpi,jpj) ,     &
+         &      hift  (jpi,jpj) , hifu  (jpi,jpj) , rx1 (jpi,jpj) , STAT=ierr(3) )
+
+      ALLOCATE( mbathy(jpi,jpj) , STAT=ierr(4) )
+     !
+      dom_oce_alloc = MAXVAL(ierr)
+      !
+   END FUNCTION dom_oce_alloc
+ 
+
+   SUBROUTINE read_bathy()
+     !! Read bathymetry from input netcdf file
+     INTEGER :: var_id, ncin
+
+     CALL check_nf90( nf90_open('bathy_meter.nc', NF90_NOWRITE, ncin), 'Error opening bathy_meter.nc file' )
+
+     ! Find the size of the input bathymetry
+     CALL dimlen(ncin, 'lon', jpi)    
+     CALL dimlen(ncin, 'lat', jpj)    
+     
+     ALLOCATE( bathy(jpi, jpj) )
+     
+     ! Read the bathymetry variable from file
+     CALL check_nf90( nf90_inq_varid( ncin, 'Bathymetry', var_id ), 'Cannot get variable ID for bathymetry')
+     CALL check_nf90( nf90_get_var( ncin, var_id, bathy, (/ 1,1 /), (/ jpi, jpj /) ) )
+
+     CALL check_nf90( nf90_close(ncin), 'Error closing bathy.nc file' )
+
+   END SUBROUTINE read_bathy
+
+   SUBROUTINE read_gphit()
+   !! Read gphit from horizontal coordinate file if required
+     INTEGER :: var_id, ncin
+
+     CALL check_nf90( nf90_open(cn_coord_hgr, NF90_NOWRITE, ncin), 'Error opening horizontal coordinate file' )
+
+     ! Read gphit variable from file
+     CALL check_nf90( nf90_inq_varid( ncin, 'gphit', var_id ), 'Cannot get variable ID for bathymetry')
+     CALL check_nf90( nf90_get_var( ncin, var_id, gphit, (/ 1,1 /), (/ jpi, jpj /) ) )
+
+     CALL check_nf90( nf90_close(ncin), 'Error closing horizontal coordinate file' )
+
+   END SUBROUTINE read_gphit
+
+   SUBROUTINE dimlen( ncid, dimname, len )
+     ! Determine the length of dimension dimname
+     INTEGER, INTENT(in)          :: ncid
+     CHARACTER(LEN=*), INTENT(in) :: dimname
+     INTEGER, INTENT(out)         :: len
+     ! Local variables
+     INTEGER :: id_var
+
+     id_var = 1
+     CALL check_nf90( nf90_inq_dimid(ncid, dimname, id_var), 'Dimension not found in file')
+     CALL check_nf90( nf90_inquire_dimension(ncid,id_var,len=len))
+
+   END SUBROUTINE dimlen
+  
+ 
+   SUBROUTINE make_coord_file()
+     ! Create new coordinates file and define dimensions and variables ready for
+     ! writing
+     
+
+     !Create the file
+     CALL check_nf90( nf90_create('coord_zgr.nc', NF90_NETCDF4, ncout), 'Could not create output file')
+     !
+     !Define dimensions
+     CALL check_nf90( nf90_def_dim(ncout, 'x', jpi, id_x) )
+     CALL check_nf90( nf90_def_dim(ncout, 'y', jpj, id_y) )
+     CALL check_nf90( nf90_def_dim(ncout, 'z', jpk, id_z) )
+     !
+     !Define variables - include all varibles that would be put into the mesh
+     !mask file
+     CALL check_nf90( nf90_def_var(ncout, 'gdept_0', nf90_double, (/id_x, id_y,id_z/), var_ids(1)) )
+     CALL check_nf90( nf90_def_var(ncout, 'gdepw_0', nf90_double, (/id_x, id_y,id_z/), var_ids(2)) )
+     CALL check_nf90( nf90_def_var(ncout, 'gdep3w_0', nf90_double, (/id_x, id_y,id_z/), var_ids(3)) )
+     CALL check_nf90( nf90_def_var(ncout, 'e3f_0', nf90_double, (/id_x, id_y,id_z/), var_ids(4)) )
+     CALL check_nf90( nf90_def_var(ncout, 'e3t_0', nf90_double, (/id_x, id_y,id_z/), var_ids(5)) )
+     CALL check_nf90( nf90_def_var(ncout, 'e3u_0', nf90_double, (/id_x, id_y,id_z/), var_ids(6)) )
+     CALL check_nf90( nf90_def_var(ncout, 'e3v_0', nf90_double, (/id_x, id_y,id_z/), var_ids(7)) )
+     CALL check_nf90( nf90_def_var(ncout, 'e3w_0', nf90_double, (/id_x, id_y,id_z/), var_ids(8)) )
+     CALL check_nf90( nf90_def_var(ncout, 'e3uw_0', nf90_double, (/id_x, id_y,id_z/), var_ids(9)) )
+     CALL check_nf90( nf90_def_var(ncout, 'e3vw_0', nf90_double, (/id_x, id_y,id_z/), var_ids(10)) )
+     ! 2D fields
+     CALL check_nf90( nf90_def_var(ncout, 'mbathy', nf90_double, (/id_x, id_y/), var_ids(11)) )
+     CALL check_nf90( nf90_def_var(ncout, 'hbatt', nf90_double, (/id_x, id_y/), var_ids(12)) )
+     CALL check_nf90( nf90_def_var(ncout, 'hbatu', nf90_double, (/id_x, id_y/), var_ids(13)) )
+     CALL check_nf90( nf90_def_var(ncout, 'hbatv', nf90_double, (/id_x, id_y/), var_ids(14)) )
+     CALL check_nf90( nf90_def_var(ncout, 'hbatf', nf90_double, (/id_x, id_y/), var_ids(15)) )
+     CALL check_nf90( nf90_def_var(ncout, 'rx1', nf90_double, (/id_x, id_y/), var_ids(16)) )
+
+     
+     ! End define mode
+     CALL check_nf90( nf90_enddef(ncout) )
+     
+     WRITE(*,*) 'Opened coord_zgr.nc file and defined variables'
+
+   END SUBROUTINE make_coord_file
+
+   SUBROUTINE write_netcdf_2d_vars()
+
+     CALL check_nf90( nf90_put_var(ncout, var_ids(11), mbathy, (/ 1,1 /), (/ jpi, jpj /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(12), hbatt, (/ 1,1 /), (/ jpi, jpj /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(13), hbatu, (/ 1,1 /), (/ jpi, jpj /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(14), hbatv, (/ 1,1 /), (/ jpi, jpj /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(15), hbatf, (/ 1,1 /), (/ jpi, jpj /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(16), rx1, (/ 1,1 /), (/ jpi, jpj /) ) )
+
+   END SUBROUTINE write_netcdf_2d_vars
+
+   SUBROUTINE write_netcdf_3d_vars(kk)
+   ! Write  variables to the netcdf file at level kk
+     INTEGER, INTENT(in) :: kk
+
+     CALL check_nf90( nf90_put_var(ncout, var_ids(1), gdept_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(2), gdepw_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(3), gdep3w_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(4), e3f_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(5), e3t_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(6), e3u_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(7), e3v_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(8), e3w_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(9), e3uw_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+     CALL check_nf90( nf90_put_var(ncout, var_ids(10), e3vw_0, (/ 1,1,kk /), (/ jpi, jpj,1 /) ) )
+
+   END SUBROUTINE write_netcdf_3d_vars
+
+   SUBROUTINE check_nf90( istat, message )
+      !Check for netcdf errors
+      INTEGER, INTENT(in) :: istat
+      CHARACTER(LEN=*), INTENT(in), OPTIONAL :: message
+
+      IF (istat /= nf90_noerr) THEN
+         WRITE(*,*) 'ERROR! : '//TRIM(nf90_strerror(istat))
+         IF ( PRESENT(message) ) THEN ; WRITE(*,*) message ; ENDIF
+         STOP
+      ENDIF
+
+   END SUBROUTINE check_nf90
+   FUNCTION fssig( pk ) RESULT( pf )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE fssig ***
+      !!       
+      !! ** Purpose :   provide the analytical function in s-coordinate
+      !!          
+      !! ** Method  :   the function provide the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and jpk)
+      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+      !!----------------------------------------------------------------------
+!     USE utils, ONLY : wp,rn_theta,rn_thetb,jpk
+      IMPLICIT NONE
+      REAL(wp), INTENT(in) ::   pk   ! continuous "k" coordinate
+      REAL(wp)             ::   pf   ! sigma value
+      !!----------------------------------------------------------------------
+      !
+      pf =   (   TANH( rn_theta * ( -(pk-0.5) / REAL(jpk-1) + rn_thetb )  )   &
+         &     - TANH( rn_thetb * rn_theta                                )  )   &
+         & * (   COSH( rn_theta                           )                      &
+         &     + COSH( rn_theta * ( 2. * rn_thetb - 1. ) )  )              &
+         & / ( 2. * SINH( rn_theta ) )
+      !
+   END FUNCTION fssig
+
+   FUNCTION fssig1( pk1, pbb ) RESULT( pf1 )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE fssig1 ***
+      !!
+      !! ** Purpose :   provide the Song and Haidvogel version of the analytical function in s-coordinate
+      !!
+      !! ** Method  :   the function provides the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and jpk)
+      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+      !!----------------------------------------------------------------------
+!     USE utils, ONLY : wp, jpk, rn_theta
+      IMPLICIT NONE
+      REAL(wp), INTENT(in) ::   pk1   ! continuous "k" coordinate
+      REAL(wp), INTENT(in) ::   pbb   ! Stretching coefficient
+      REAL(wp)             ::   pf1   ! sigma value
+      !!----------------------------------------------------------------------
+      !
+      IF ( rn_theta == 0 ) then      ! uniform sigma
+         pf1 = - ( pk1 - 0.5 ) / REAL( jpk-1 )
+      ELSE                        ! stretched sigma
+         pf1 =   ( 1. - pbb ) * ( SINH( rn_theta*(-(pk1-0.5)/REAL(jpk-1)) ) ) / SINH( rn_theta )              &
+            &  + pbb * (  (TANH( rn_theta*( (-(pk1-0.5)/REAL(jpk-1)) + 0.5) ) - TANH( 0.5 * rn_theta )  )  &
+            &        / ( 2. * TANH( 0.5 * rn_theta ) )  )
+      ENDIF
+      !
+   END FUNCTION fssig1
+
+   FUNCTION fgamma( pk1, pzb, pzs, psmth) RESULT( p_gamma )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE fgamma  ***
+      !!
+      !! ** Purpose :   provide analytical function for the s-coordinate
+      !!
+      !! ** Method  :   the function provides the non-dimensional position of
+      !!                T and W (i.e. between 0 and 1)
+      !!                T-points at integer values (between 1 and jpk)
+      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+      !!
+      !!                This method allows the maintenance of fixed surface and or
+      !!                bottom cell resolutions (cf. geopotential coordinates) 
+      !!                within an analytically derived stretched S-coordinate framework.
+      !!
+      !! Reference  :   Siddorn and Furner, in prep
+      !!----------------------------------------------------------------------
+!     USE utils, ONLY : jpk,wp,rn_alpha
+      IMPLICIT NONE
+      REAL(wp), INTENT(in   ) ::   pk1           ! continuous "k" coordinate
+      REAL(wp)                ::   p_gamma       ! stretched coordinate
+      REAL(wp), INTENT(in   ) ::   pzb           ! Bottom box depth
+      REAL(wp), INTENT(in   ) ::   pzs           ! surface box depth
+      REAL(wp), INTENT(in   ) ::   psmth         ! Smoothing parameter
+      REAL(wp)                ::   za1,za2,za3   ! local variables
+      REAL(wp)                ::   zn1,zn2       ! local variables
+      REAL(wp)                ::   za,zb,zx      ! local variables
+      !!----------------------------------------------------------------------
+      !
+
+      zn1  =  1./(jpk-1.)
+      zn2  =  1. -  zn1
+
+      za1 = (rn_alpha+2.0)*zn1**(rn_alpha+1.0)-(rn_alpha+1.0)*zn1**(rn_alpha+2.0) 
+      za2 = (rn_alpha+2.0)*zn2**(rn_alpha+1.0)-(rn_alpha+1.0)*zn2**(rn_alpha+2.0)
+      za3 = (zn2**3.0 - za2)/( zn1**3.0 - za1)
+     
+      za = pzb - za3*(pzs-za1)-za2
+      za = za/( zn2-0.5*(za2+zn2**2.0) - za3*(zn1-0.5*(za1+zn1**2.0) ) )
+      zb = (pzs - za1 - za*( zn1-0.5*(za1+zn1**2.0 ) ) ) / (zn1**3.0 - za1)
+      zx = 1.0-za/2.0-zb
+
+      p_gamma = za*(pk1*(1.0-pk1/2.0))+zb*pk1**3.0 +  &
+                  & zx*( (rn_alpha+2.0)*pk1**(rn_alpha+1.0)- &
+                  &      (rn_alpha+1.0)*pk1**(rn_alpha+2.0) )
+      p_gamma = p_gamma*psmth+pk1*(1.0-psmth)
+
+      !
+   END FUNCTION fgamma
+
+
+END MODULE utils
Index: /utils/tools_ticket2413/SECTIONS_DIADCT/run/job.ksh
===================================================================
--- /utils/tools_ticket2413/SECTIONS_DIADCT/run/job.ksh	(revision 12863)
+++ /utils/tools_ticket2413/SECTIONS_DIADCT/run/job.ksh	(revision 12863)
@@ -0,0 +1,46 @@
+#!/bin/ksh
+set -x
+#####################################################
+#     CONFIGURATION CHOICE                          #
+#####################################################
+#CONFIG=ORCA2_LIM GYRE
+CONFIG=ORCA2_LIM
+
+#####################################################
+#     CONFIGURATION DESCRIPTION                     #
+#####################################################
+# each configuration is defined by:
+#   - INSPACE: directory the coordinate netcdf file is
+#   - COOR_FIL: configuration's coordinate netcdf file
+#   - LIST:     configuration's list of sections
+#
+#####################################################
+case $CONFIG in
+#
+ORCA2_LIM)
+INSPACE=/dataref/rd/INITIALISATION/ORCA2
+COOR_FIL=coordinates.nc
+LIST=list_sections.ascii_global
+;;
+#
+GYRE)
+INSPACE=/perm/ms/fr/ar5
+COOR_FIL=mesh_mask.nc
+LIST=list_sections.ascii_GYRE
+;;
+#
+esac
+
+#####################################################
+#     RUN                                           #
+#####################################################
+BIN=diadct_sections.exe
+
+export CTLDIR=`pwd`
+cd ${CTLDIR}
+rm -f coordinates.nc ${BIN} list_sections.ascii
+cp ../${BIN} .
+ln -sf ${LIST} list_sections.ascii
+ln -s $INSPACE/$COOR_FIL ./coordinates.nc
+./${BIN}
+mv section_ijglobal.diadct section_ijglobal.diadct_$CONFIG 
Index: /utils/tools_ticket2413/SECTIONS_DIADCT/run/list_sections.ascii_GYRE
===================================================================
--- /utils/tools_ticket2413/SECTIONS_DIADCT/run/list_sections.ascii_GYRE	(revision 12863)
+++ /utils/tools_ticket2413/SECTIONS_DIADCT/run/list_sections.ascii_GYRE	(revision 12863)
@@ -0,0 +1,3 @@
+ -80.     14.    -80.     30.   00 okstrpond noice  SEC1
+ -70.     14.    -70.     30.   00 okstrpond noice  SEC2
+ -90.     20.    -60.     20.   00 okstrpond noice  SEC3
Index: /utils/tools_ticket2413/SECTIONS_DIADCT/run/list_sections.ascii_exp
===================================================================
--- /utils/tools_ticket2413/SECTIONS_DIADCT/run/list_sections.ascii_exp	(revision 12863)
+++ /utils/tools_ticket2413/SECTIONS_DIADCT/run/list_sections.ascii_exp	(revision 12863)
@@ -0,0 +1,27 @@
+(F7.2,1X,F7.2,1X,F7.2,1X,F7.2,1X,I2,1X,A9,1X,A5,1X,A40)
+
+long1   lat1    long2   lat2    nbclasse S/T transp? ice transp? section name
+
+-xxx.xx_-xxx.xx_-xxx.xx_-xxx.xx_ii_aaaaaaaaa_aaaaa_aaaaa....
+ 100.    -23.9   115.    -23.9  00 nostrpond noice IND_W1
+ 100.    -33.8   117.    -33.8  00 nostrpond noice IND_W2
+ 100.    -33.8   100.      2.   00 nostrpond noice IND_W3
+ 122.    -45.    122.    -30.   00 nostrpond noice IND_S1
+ 139.5   -45.    139.5   -32.   00 nostrpond noice IND_S2
+ 122.    -45.    139.5   -45.   00 nostrpond noice IND_S3
+ 150.    -28.5   165.    -28.5  00 nostrpond noice IND_E1
+ 148.    -34.    165.    -34.   00 nostrpond noice IND_E2
+ 146.    -41.7   165.    -41.7  00 nostrpond noice IND_E3
+ 165.    -41.7   165.    -28.5  00 nostrpond noice IND_E4
+ 149.    -10.    165.    -10.   00 nostrpond noice IND_E6
+ 165.    -41.7   173.    -41.7  00 nostrpond noice IND_E7
+ 115.     24.    122.     17.   00 nostrpond noice IND_N1
+ 125.      8.    134.     -2.   00 nostrpond noice IND_N2
+ 114.1    -8.45  118.9    -8.45 00 nostrpond noice IND_N3
+ 121.8    -8.7   124.1    -9.7  00 nostrpond noice IND_N4
+ 124.1    -9.7   127.    -15.   00 nostrpond noice IND_N5
+ 115.    -25.    104.     -4.   00 nostrpond noice IND_N6
+ 116.      2.3   134.     -2.   00 nostrpond noice IND_N8
+  33.   -22.2     45.    -22.2  00 nostrpond noice IND_AG1
+  25.   -33.65    44.    -33.65 00 nostrpond noice IND_AG2
+  44.   -22.2     44.    -33.65 00 nostrpond noice IND_AG3
Index: /utils/tools_ticket2413/SECTIONS_DIADCT/run/list_sections.ascii_global
===================================================================
--- /utils/tools_ticket2413/SECTIONS_DIADCT/run/list_sections.ascii_global	(revision 12863)
+++ /utils/tools_ticket2413/SECTIONS_DIADCT/run/list_sections.ascii_global	(revision 12863)
@@ -0,0 +1,357 @@
+ -68.    -54.5   -60.    -64.7  00 okstrpond noice ACC_Drake_Passage
+  27.    -73.     27.    -30.   00 nostrpond noice ACC_LeCap
+ 116.    -70.    116.    -33.8  00 nostrpond noice ACC_WAUS
+ 147.3   -70.    147.3   -41.   00 okstrpond noice ACC_TAS
+ 167.4   -73.    167.4   -45.5  00 nostrpond noice ACC_NZ
+ -82.     73.4   -82.     74.9  00 nostrpond   ice ARC_Lancaster_sound
+ -81.     75.1   -81.     76.6  00 nostrpond   ice ARC_Jones_Strait
+ -76.     78.4   -72.     78.3  00 nostrpond   ice ARC_Robeson_Channel
+ -64.6    60.3   -65.     61.5  00 nostrpond   ice ARC_Hudson_Strait
+  20.9    71.5    16.     77.   03 nostrpond   ice ARC_Bear_Island
+zsal
+ 0.00
+34.9
+50.0
+  33.5    68.     33.5    74.   03 nostrpond   ice ARC_Kola_Section
+zsal
+ 0.00
+34.9
+50.0
+  25.     80.     48.2    80.2  00 nostrpond   ice ARC_Spitzberg_FJLand
+  57.     80.3    65.9    76.4  03 nostrpond   ice ARC_FJLand_NovZemlija
+zsigi
+ 0.
+27.8
+30.0
+  57.     70.7    59.     70.2  00 nostrpond   ice ARC_Kara_Gate
+  25.     70.     22.6    77.8  05 nostrpond   ice ARC_Barents_Sea
+zsigi
+ 0.0
+25.0
+27.8
+29.0
+30.0
+ -21.5    79.5    15.     79.   05 nostrpond   ice ARC_Fram_Strait
+zsigi
+0.0
+25.0
+27.8
+29.0
+30.0
+ -81.     27.1   -73.     27.   04 nostrpond noice ATL_West_Atlantic_27N
+zlay
+    0.
+ 1000.
+ 6000.
+20000.
+ -35.     15.1   -35.     -8.   00 nostrpond noice ATL_Tropical_Atlantic_35W
+ -63.      9.    -55.     20.   03 nostrpond noice ATL_South_West_Atlantic
+ztem
+-2.0
+ 4.5
+40.0
+ -35.     54.    -30.5    52.   03 nostrpond noice ATL_Gibbs
+zlay
+    0.
+ 3000.
+20000.
+ -40.     -4.    -40.     10.   03 nostrpond noice ATL_North_Brazil_Current_40W
+zsigi
+ 0.0
+27.45
+30.0
+ -55.     -1.    -50.     10.   05 nostrpond noice ATL_North_Brazil_Current_10N
+zsigi
+ 0.0
+24.5
+27.125
+27.45
+30.0 
+ -53.    -30.1   -40.    -30.   00 nostrpond noice ATL_Brazil_Current_30S
+ -63     -40.1   -53.    -40.   00 nostrpond noice ATL_Falklands_Current_40S
+ -23.    -15.    -23.     15.   05 nostrpond noice ATL_Atlantic_Equatorial
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+   5.    -15.1    13.    -15.   00 nostrpond noice ATL_Benguela_Current_15S
+  10.    -40.     22.    -31.   00 nostrpond noice ATL_Agulhas_zone_30S
+  19.    -30.1   -54.0   -30.0  00 nostrpond noice ATL_Trans_Atlantic_30S
+  -7.     62.2    -4.5    58.   05 nostrpond noice ATL_England_Faroe
+zsigi
+ 0.0
+25.
+27.8
+29.
+30.0
+ -15.     65.     -7.     62.2  05 nostrpond noice ATL_Iceland_Faroe
+zsigi
+ 0.0
+25.
+27.8
+29.
+30.0
+ -37.     66.1   -22.5    66.   05 nostrpond   ice ATL_Denmark_Strait
+zsigi
+ 0.0
+25.
+27.8
+29.
+30.0
+ -44.     63.    -35.     61.   05 nostrpond   ice ATL_East_Greenland
+zsigi
+ 0.0
+25.
+27.8
+29.
+30.0
+ -45.     60.9   -45.     57.   05 nostrpond   ice ATL_South_Greenland
+zsigi
+ 0.0
+25.
+27.8
+29.
+30.0
+ -50.1    55.1   -61.     55.   05 nostrpond   ice ATL_Labrador_55N 
+zsigi
+ 0.0
+25.
+27.8
+29.
+30.0
+   8.     58.5    -2.5    57.   00 nostrpond noice ATL_England_Norway 
+  -5.7    35.5    -5.7    36.5  00 nostrpond noice ATL_Gibraltar 
+  -8.5    32.     -8.5    38.2  00 nostrpond noice ATL_Gulf_Cadiz
+ -44.     60.     -27.    56.   00 nostrpond noice ATL_Ovide1
+ -27.     56.     -16.    40.   00 nostrpond noice ATL_Ovide2
+ -16.     40.1     -8.1   40.   00 nostrpond noice ATL_Portugal
+  -4.     48.2     -8.1   43.1  05 nostrpond noice ATL_Biscay
+zsal
+ 0.0
+35.6
+36.0
+36.0
+50.0
+ -14.     26.1    -22.    26.   00 nostrpond noice ATL_South_Canaries
+ -24.     32.     -24.    37.9  03 nostrpond noice ATL_Acores_24W
+zlay
+   0.
+  800.
+20000.
+ -66.4    18.1    -63.    10.   05 nostrpond noice ATL_Antilles
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -60.1    18.1    -66.5   18.2  05 nostrpond noice ATL_Porto_Rico
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -66.5    18.1    -68.9   18.5  05 nostrpond noice ATL_Hispagnola_Porto_Rico
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -75.     20.2    -72.6   19.7  05 nostrpond noice ATL_Windward_Passage
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -77.5    18.2    -84.    14.   05 nostrpond noice ATL_Jamaica_Ridge
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -77.5    18.     -76.5   20.3  05 nostrpond noice ATL_Cuba_Jamaica
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -87.3    21.     -84.    22.2  05 nostrpond noice ATL_Yucatan_Strait_KANEC
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -80.5    22.5    -80.5   25.5  05 nostrpond noice ATL_Cuba_Florida
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -78.5    26.7    -80.5   27.   05 okstrpond noice ATL_Florida_Bahamas
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -70.     30.1    -82.    30.   05 nostrpond noice ATL_West_Atlantic_30N
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -70.     45.     -70.    30.1  05 nostrpond noice ATL_Gulf_Stream
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -55.     30.     -55.    47.9  05 nostrpond noice ATL_Gulf_Stream_2
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -55.     48.1     -3.9   48.   00 okstrpond noice ATL_Atlantic_48N
+ -85.     24.1    -10.8   24.   00 okstrpond noice ATL_Atlantic_24N
+ -75.6    24.     -10.8   24.   00 okstrpond noice ATL_Atlantic_24N1
+ -85.     26.1    -10.8   26.   04 okstrpond noice ATL_Atlantic_26N
+zlay
+    0.
+ 1000.
+ 6000.
+20000.
+ 100.    -23.9   115.    -23.9  00 nostrpond noice IND_W1
+ 100.    -33.8   117.    -33.8  00 nostrpond noice IND_W2
+ 100.    -33.8   100.      2.   00 nostrpond noice IND_W3
+ 122.    -45.    122.    -30.   00 nostrpond noice IND_S1
+ 139.5   -45.    139.5   -32.   00 nostrpond noice IND_S2
+ 122.    -45.    139.5   -45.   00 nostrpond noice IND_S3
+ 150.    -28.5   165.    -28.5  00 nostrpond noice IND_E1
+ 148.    -34.    165.    -34.   00 nostrpond noice IND_E2
+ 146.    -41.7   165.    -41.7  00 nostrpond noice IND_E3
+ 165.    -41.7   165.    -28.5  00 nostrpond noice IND_E4
+ 165.    -10.    165.    -28.5  00 nostrpond noice IND_E5
+ 149.    -10.    165.    -10.   00 nostrpond noice IND_E6
+ 165.    -41.7   173.    -41.7  00 nostrpond noice IND_E7
+ 115.     24.    122.     17.   00 nostrpond noice IND_N1
+ 125.      8.    134.     -2.   00 nostrpond noice IND_N2
+ 114.1    -8.45  118.9    -8.45 00 nostrpond noice IND_N3
+ 121.8    -8.7   124.1    -9.7  00 nostrpond noice IND_N4
+ 124.1    -9.7   127.    -15.   00 nostrpond noice IND_N5
+ 115.    -25.    104.     -4.   00 nostrpond noice IND_N6
+ 116.      2.3   134.     -2.   00 nostrpond noice IND_N8
+  33.   -22.2     45.    -22.2  00 nostrpond noice IND_AG1
+  25.   -33.65    44.    -33.65 00 nostrpond noice IND_AG2
+  44.   -22.2     44.    -33.65 00 nostrpond noice IND_AG3
+ 114.    -8.5    120.    -21.   05 nostrpond noice IND_Australia_Bali
+zlay
+    0.
+  200.
+  500.
+ 2000.
+20000.
+  45.     6.1     53.      6.   00 nostrpond noice IND_Somali_Current
+  39.   -16.      45.    -18.   00 nostrpond noice IND_Mozambique_Current
+  27.   -32.1     40.    -32.   06 nostrpond noice IND_Agulhas_Current_32S
+zsigi
+ 0.
+26.5
+26.75
+27.
+27.4
+50.0 
+  43.25   12.65   43.75   12.9  00 nostrpond noice IND_Bab_El_Manded
+  41.      0.1    50.      0.   00 nostrpond noice IND_Indian_Equatorial
+  81.    -20.     81.      8.   00 nostrpond noice IND_Indian_80E
+ 115.    -30.1   109.    -30.   00 nostrpond noice IND_West_Australia
+  52.    -24.     47.    -22.   00 nostrpond noice IND_Madagascar
+  25.    -30.1   120.    -30.   00 nostrpond noice IND_Indian_30S
+-171.5    66.2  -166.0    65.7  00 okstrpond   ice ARC_Bering_Strait
+-120.     47.1   142.5    47.   00 nostrpond noice PAC_Subarctic_Gyre_47N
+-130.     43.   -122.     47.   00 nostrpond noice PAC_OffCalif1
+-122.     40.   -130.     36.   00 nostrpond noice PAC_OffCalif2
+-118.     35.   -126.     31.   00 nostrpond noice PAC_OffCalif3
+ 121.     24.   -110.6    24.   03 okstrpond noice PAC_North_Pacific_24N
+zsigi
+20.
+27.
+30.
+-137.      7.   -137.     25.   00 nostrpond noice PAC_North_Pacific_137W_NEC
+-137.     25.   -137.     37.   00 nostrpond noice PAC_North_Pacific_137W_Kuroshio
+ 132.8    33.    137.     26.   00 nostrpond noice PAC_Kuroshio
+ 175.    -20.    175.     10.   00 nostrpond noice PAC_Pacific_Equatorial_175E
+-125.    -10.   -125.     10.   00 nostrpond noice PAC_Pacific_Equatorial_125W
+ -70.    -17.1   -76.    -17.   00 nostrpond noice PAC_Peru_Current
+ 152.    -30.1   175.    -30.   00 nostrpond noice PAC_East_Australia
+ 142.5    -8.    142.5   -13.   00 nostrpond noice PAC_Torres_Strait
+ 147.     10.    147.     50.   06 nostrpond noice PAC_Pacific_147E_10N_50N
+zsigi
+20.
+26.6
+26.7
+26.8
+27.2
+30.0
+ 165.      0.    165.     50.   06 nostrpond noice PAC_Pacific_165E
+zsigi
+20.
+26.6
+26.7
+26.8
+27.2
+30.0
+ 179.9     0.    179.9    50.   06 nostrpond noice PAC_Pacific_180E
+zsigi
+20.
+26.6
+26.7
+26.8
+27.2
+30.0
+-140.      0.   -140.     30.   06 nostrpond noice PAC_Pacific_140W
+zsigi
+20.
+26.6
+26.7
+26.8
+27.2
+30.0
+-150.     40.   -150.     60.5  00 nostrpond noice PAC_Alaskan_Gyre
+ 161.     55.   -162.     55.5  00 nostrpond noice PAC_Bering_Sea
+ 137.      0.    137.     36.   00 nostrpond noice PAC_JMA_137E_0N_35N
+ 150.    -30.    -70.    -30.   00 nostrpond noice PAC_Pacific_30S
+   0.     38.75    0.     35.36 00 nostrpond noice MED_0E
+   0.     38.75    1.37   39.   00 nostrpond noice MED_Ibiza_Channel
+   9.     36.8     9.     39.37 00 nostrpond noice MED_Sardinia_Channel
+   9.3    42.5    11.68   42.5  00 nostrpond noice MED_Corsica_Channel
+  10.5    36.6    12.9    37.85 00 nostrpond noice MED_Sicily_Strait
+  18.3    40.1    20.07   40.   00 nostrpond noice MED_Otranto_Strait
+  25.     31.5    25.     35.05 00 nostrpond noice MED_Cretan_Passage
+  28.     30.8    28.     37.32 00 nostrpond noice MED_Rhodes_Gyre
+  25.5    35.1    28.6    37.07 00 nostrpond noice MED_Kassos_Strait
+  33.4    35.     33.4    36.36 00 nostrpond noice MED_Cilician_Channel
+  22.9    36.8    23.85   35.42 00 nostrpond noice MED_Kytheron_Strait
+  10.08   60.     10.08,  56.   00 nostrpond noice BAL_WesternBaltic
+  10.     57.     13.     57.   00 nostrpond noice BAL_Kattegat
+  14.     57.     14.     53.   00 nostrpond noice BAL_Skagerrak
+ -53.5    47.     -43.    47.   00 nostrpond noice ATL_FlemishCap
+ -40.    -11.     20.    -11.1  03 okstrpond noice ATL_11S
+zsigi
+0.0
+28.12
+60.0
+  25.    -32.    120.    -32.   00 okstrpond noice IND_Indian_32S
+ 150.    -32.    -70.    -32.   00 okstrpond noice PAC_Pacific_32S
Index: /utils/tools_ticket2413/SECTIONS_DIADCT/run/namelist
===================================================================
--- /utils/tools_ticket2413/SECTIONS_DIADCT/run/namelist	(revision 12863)
+++ /utils/tools_ticket2413/SECTIONS_DIADCT/run/namelist	(revision 12863)
@@ -0,0 +1,8 @@
+&namdct
+!----------------------------------------!
+!nsecdebug =-1 (debug all section        !
+!          = 0 (no section to debug)     !
+!          = n (debug section # n        !
+!----------------------------------------!
+nsecdebug= 1
+/
Index: /utils/tools_ticket2413/SECTIONS_DIADCT/src/compute_sections.f90
===================================================================
--- /utils/tools_ticket2413/SECTIONS_DIADCT/src/compute_sections.f90	(revision 12863)
+++ /utils/tools_ticket2413/SECTIONS_DIADCT/src/compute_sections.f90	(revision 12863)
@@ -0,0 +1,692 @@
+MODULE compute_sections
+   !!=====================================================================
+   !!                       ***  MODULE  diadct  ***
+   !! Ocean diagnostics: Compute the transport through a section
+   !!
+   !! History: 2011: Clement Bricaud, Mercator-Ocean
+   !!
+   !!===============================================================
+   !! * Modules used
+   USE declarations 
+   USE sections_tools
+ 
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC compsec
+   
+   !! * Module variables
+ 
+CONTAINS
+
+  SUBROUTINE compsec(jsec,sec,lkdebug)         
+     !!---------------------------------------------------------------------
+     !!                     ***  ROUTINE compsec  ***
+     !!
+     !!  ** Purpose : Compute the series of mesh points that represent the section
+     !!               defined by its extremities.
+     !!
+     !!  ** Method  : 
+     !!          I.   Find which cells of the mesh the section is crossing
+     !!          II.  Classification of the intersections mesh/section
+     !!                  -first  classification west to east          
+     !!                  -second classification south to north 
+     !!          III. Find extremities of section in the mesh
+     !!          IV.  Find the series of mesh points that form the section
+     !!  ** Input: sec : the section to compute
+     !!
+     !!  ** Output:
+     !!---------------------------------------------------------------------
+     !! * Arguments
+     INTEGER,INTENT(IN)           :: jsec    ! number of the section
+     TYPE(SECTION), INTENT(INOUT) :: sec     ! information about the section
+     LOGICAL ,INTENT(IN)          :: lkdebug ! debug or not debug this section
+
+     !! * Local variables
+     INTEGER :: &
+        ji,jj            ,     & ! dummy loop argument
+        jseg             ,     & ! loop on segments that form the section    
+        nb_inmesh        ,     & ! number of intersections between the section and the mesh
+        nmesh                    ! number of cells in processor domain
+     INTEGER :: itest , jtest    ! dummy integer
+     REAL(wp)      :: &
+        zdistEst   , zdistNorth , zdistWest , zdistSouth ,  &! temporary scalars
+        zdistEst2  , zdistNorth2, zdistWest2, zdistSouth2,  &! temporary scalars
+        zdistEst3  , zdistNorth3, zdistWest3, zdistSouth3,  &! temporary scalars
+        zdistFirst , zdistLast  , zdistref  ,               &! temporary scalars
+        zdistante  , zdistante2 , zdistnew  , zdistnew2  ,  &! temporary scalars
+        zdeltai    , zdeltaj                                 ! temporary scalars
+     LOGICAL :: & 
+        ll_overlap_sec_left = .FALSE. , ll_overlap_sec_right = .FALSE. ,&! temporary logical
+        ll_date_domain_left = .FALSE. , ll_date_domain_right = .FALSE. ,&! temporary logical
+        ll_overlap_sec      = .FALSE. , ll_date_domain       = .FALSE. ,&! temporary logical
+        ll_test             = .FALSE.                                    ! temporary logical
+     LOGICAL :: lest, lwest, lnorth, lsouth
+     LOGICAL :: l_oldmethod
+     CHARACTER(len=120) :: cltmp
+     TYPE(COORD_SECTION) :: &
+        coord_a   , coord_b  , coord_d ,  coord_t ,               &!temporary point (long/lat)
+        coordFirst, coordLast, coordTemp                           !        "
+     TYPE(COORD_SECTION), DIMENSION(nb_point_max) :: coordSec      !intersections mesh/section    
+     TYPE(POINT_SECTION) :: &
+        endingPoint, prevPoint , nextPoint,           &!temporary point (I/J)
+        SouthPoint , NorthPoint, EstPoint , WestPoint  !        "
+     !!---------------------------------------------------------------------
+     IF( jsec==1 )THEN
+          PRINT*,'                '
+          PRINT*,'COMPUTE SECTIONS'
+          PRINT*,'----------------'
+     ENDIF
+
+     !debug
+     CALL write_debug(jsec,'compute section:')
+     CALL write_debug(jsec,'================')
+
+
+     !==================!
+     !0. Initializations!
+     !==================! 
+     
+     nmesh       = jpi*jpj          ! number of cells in processor domain
+     nb_inmesh   = 0                ! initialize number of intersections between section and the mesh
+     zdistEst  =0. ; zdistNorth=0. ; zdistWest=0. ; zdistSouth=0.   ! temporary scalars
+     zdistFirst=0. ; zdistLast =0.                                  ! temporary scalars
+     zdistante =0. ; zdistante2=0. ; zdistnew=0.  ; zdistnew2=0.    ! temporary scalars
+     zdeltai=0.    ; zdeltaj=0. 
+     coord_a     = COORD_SECTION( 0., 0. ) ; coord_b    = COORD_SECTION( 0., 0. )
+     coord_d     = COORD_SECTION( 0., 0. ) ; coord_t    = COORD_SECTION( 0., 0. ) 
+     coordFirst  = COORD_SECTION( 0., 0. ) ; coordLast  = COORD_SECTION( 0., 0. )
+     coordTemp   = COORD_SECTION( 0., 0. ) ; coordSec   = COORD_SECTION( 0., 0. )
+     endingPoint = POINT_SECTION( -1, -1 ) 
+     prevPoint   = POINT_SECTION( -1, -1 ) ; nextPoint   = POINT_SECTION( -1, -1 )
+     SouthPoint  = POINT_SECTION( -1, -1 ) ; NorthPoint  = POINT_SECTION( -1, -1 )
+     EstPoint    = POINT_SECTION( -1, -1 ) ; WestPoint   = POINT_SECTION( -1, -1 )
+
+     !===========================================================!    
+     !I. Find which cells of the mesh the section is  crossing  !
+     !===========================================================!
+
+     !loop on the mesh 
+     DO jj=2,jpj
+        DO ji=2,jpi
+           !-----------------------------------------------------------
+           !For each cell of the mesh, we find the intersection between 
+           !the section and the cell as described below:
+           !The cell is defined by 4 points A B C D 
+           !and the section by S1 and S2 
+           !
+           !Section\    ________
+           !        \ B|        |
+           !         \ |        |
+           !          \|one cell|
+           !      .....\        |
+           !           |\       |
+           !           | \      | 
+           !          A|__\_____|D
+           !       ........\
+           !----------------\-------------------------------------------
+
+           !definition of points A,B,D (we don't need C) 
+           coord_a = COORD_SECTION( glamf(ji-1,jj-1) ,gphif(ji-1,jj-1) )
+           coord_b = COORD_SECTION( glamf(ji-1,jj)   ,gphif(ji-1,jj)   )
+           coord_d = COORD_SECTION( glamf(ji,jj-1)   ,gphif(ji,jj-1)   )
+ 
+           !size of the cell 
+           zdeltai= glamf(ji-1,jj) - glamf(ji-1,jj-1) !zdeltai=[AB]
+           zdeltaj= gphif(ji,jj-1) - gphif(ji-1,jj-1) !zdeltaj=[AD]
+           
+           !intersection section/[AB]=?
+           coordTemp     = intersec(sec,coord_a,coord_b)     !compute intersection 
+ 
+           IF( coordTemp%lon .NE. -9999 )THEN
+              IF( nb_inmesh+1 .GT. nb_point_max )THEN
+                 PRINT*,"WARNING diadct: nb_point_max needs to be greater than ", nb_inmesh
+              ELSE    
+                 nb_inmesh=nb_inmesh+1              
+                 coordSec(nb_inmesh) = coordTemp    !store the intersection's coordinates
+
+                 !We need to know if the section crosses the overlapping band.
+
+                 !Fist we look if there is an intersection mesh/section 
+                 !just on the left of the overlapping band: 
+                 IF( coordTemp%lon .GT. glamf(1,1)-5  .AND. coordTemp%lon .LT. glamf(1,1) ) & 
+                    & ll_overlap_sec_left  = .TRUE.
+                 !And we look if there is an intersection mesh/section 
+                 !just on the right of the overlapping band:
+                 IF( coordTemp%lon .GT. glamf(jpi,1) .AND. coordTemp%lon .LT. glamf(1,1)+5 ) &
+                    & ll_overlap_sec_right = .TRUE.
+              ENDIF
+           ENDIF
+              
+           !intersection section/[AD]=?
+           coordTemp=intersec(sec,coord_a,coord_d)       !compute intersection
+           coordTemp%lon = coordTemp%lon !* zmask(ji,jj)-9999.*(1-zmask(ji,jj))
+           coordTemp%lat = coordTemp%lat !* zmask(ji,jj)-9999.*(1-zmask(ji,jj))
+
+           IF( coordTemp%lon .NE. -9999 )THEN
+              IF( nb_inmesh+1 .GT. nb_point_max )THEN
+                 PRINT*, "WARNING diadct: nb_point_max needs to be greater than ", nb_inmesh
+              ELSE  
+                 nb_inmesh=nb_inmesh+1
+                 coordSec(nb_inmesh)=coordTemp
+                   
+                 !We need to know if the section crosses the overlapping band:
+                 !same test as above 
+                 IF( coordTemp%lon .GE. glamf(1,1)-3  .AND. coordTemp%lon .LE. glamf(1,1) ) &
+                      & ll_overlap_sec_left  = .TRUE.
+                 IF( coordTemp%lon .GE. glamf(jpi,1) .AND. coordTemp%lon .LE. glamf(jpi,1)+3) & 
+                      & ll_overlap_sec_right = .TRUE. 
+              ENDIF
+           ENDIF
+         
+           !We need to know if the domain crosses the date line:
+           !Fist, we search a mesh point that is just one the left of date line:
+           IF( glamf(ji-1,jj-1) .GT.  175 .AND. glamf(ji-1,jj-1) .LT.  180 ) &
+              & ll_date_domain_left = .TRUE.
+           !And we search a mesh point that is just one the right of date line:
+           IF( glamf(ji-1,jj-1) .GT. -180 .AND. glamf(ji-1,jj-1) .LT. -175 ) &  
+              & ll_date_domain_right = .TRUE.
+ 
+        ENDDO
+     ENDDO !End of the loop on the mesh
+
+ 
+     !Crossing section/overlapping band (we need to know it for later):
+     !----------------------------------------------------------------- 
+     !If there is one intersection mesh/section just on the left of
+     !the overlapping band (ll_overlap_sec_left  = .TRUE.)
+     !AND there is one just the right of the overlapping band 
+     !(ll_overlap_sec_right  = .TRUE.),
+     !so the section crosses the overlapping band.
+     ll_overlap_sec = ll_overlap_sec_left .AND. ll_overlap_sec_right 
+
+     !Crossing of the domain and the date line (we need to know it for later): 
+     !------------------------------------------------------------------------
+     !If there is one point of the domain that is just on the left of the date line
+     !(ll_date_domain_left = .TRUE.) AND one point that is just on the right of the
+     !date line (ll_date_domain_right = .TRUE. ) 
+     !So the domain crosses the date line:
+     ll_date_domain = ll_date_domain_left .AND. ll_date_domain_right
+
+     !=====================================================!
+     ! II. Classification of the intersections mesh/section!
+     !=====================================================!
+
+     !   -first classification  west to east          
+     !   -second classification south to north        
+     !CAUTION: routine qcksrt doesn't work in the same way if the section
+     !and the domain crosse the date line (sec%ll_date_line=T and ll_date_domain=T)
+
+     IF( sec%ll_date_line .AND. ll_date_domain )THEN
+
+        !we add 360° to negative longitudes to have a good classification
+        DO jseg=1,nb_inmesh
+           IF( coordSec(jseg)%lon .LT. 0 ) coordSec(jseg)%lon=coordSec(jseg)%lon+360.
+        ENDDO
+        IF( sec%coordSec(1)%lon .NE. sec%coordSec(2)%lon ) THEN
+           CALL qcksrt(coordSec(:)%lon,coordSec(:)%lat,nb_inmesh)
+        ELSE
+           CALL qcksrt(coordSec(:)%lat,coordSec(:)%lon,nb_inmesh)
+        ENDIF
+        DO jseg=1,nb_inmesh
+           IF( coordSec(jseg)%lon .GT. 180 ) coordSec(jseg)%lon=coordSec(jseg)%lon-360.
+        ENDDO
+
+     ELSE     
+
+        IF( sec%coordSec(1)%lon .NE. sec%coordSec(2)%lon )THEN
+           CALL qcksrt(coordSec(:)%lon,coordSec(:)%lat,nb_inmesh)
+        ELSE
+           CALL qcksrt(coordSec(:)%lat,coordSec(:)%lon,nb_inmesh)
+        ENDIF
+
+     ENDIF
+
+     !debug
+     WRITE(cltmp,'(A20,i3.3)')'number intersections = ',nb_inmesh ; CALL write_debug(jsec,cltmp)
+     CALL write_debug(jsec,'List of intersections between grid and section: ')
+     DO jseg=1,nb_inmesh
+        WRITE(cltmp,'(i4.4,1X,2(f8.3,1X) )')jseg,coordSec(jseg) ;  CALL write_debug(jsec,cltmp)
+     ENDDO
+ 
+     !=====================================================!
+     ! III. Find extremities of section in the mesh        !
+     !=====================================================!
+     !we can find section's extremities in the mesh only if
+     !there is intersection between section and mesh (nb_inmesh .ne. 0)
+
+     IF( nb_inmesh .ne. 0 )THEN
+        coordFirst       = coordSec(1)
+        coordLast        = coordSec(nb_inmesh) 
+        sec%nb_point     = nb_inmesh
+        sec%listPoint(1) = POINT_SECTION(-1,-1)
+        zdistante        = 1000.
+        zdistante2       = 1000.
+
+        !First, we find the point of the mesh that is the closest 
+        !to the first intersection section/mesh (=coordFirst=coordSec(1)):
+        !this point will be called sec%listPoint(1).
+        !Then, we find the point of the mesh that is the closest
+        !to the last intersection section/mesh (coordLast=coordSec(nb_inmesh))
+        !this point will be called endingPoint.
+
+        DO jj=1,jpj
+           DO ji=1,jpi  
+              coord_t=COORD_SECTION(glamf(ji,jj),gphif(ji,jj))
+              zdistFirst = distance2(coord_t,coordFirst)
+              zdistLast = distance2(coord_t,coordLast)
+              IF( zdistFirst .LT. zdistante )THEN
+                 sec%listPoint(1) = POINT_SECTION(ji,jj)
+                 zdistante=zdistFirst
+              ENDIF
+              IF( zdistLast .LT. zdistante2 )THEN
+                 endingPoint = POINT_SECTION(ji,jj)
+                 zdistante2=zdistLast
+              ENDIF
+           ENDDO
+        ENDDO
+
+        IF( sec%listPoint(1)%I == endingPoint%I .AND. sec%listPoint(1)%J == endingPoint%J )THEN
+           sec%listPoint(1) = POINT_SECTION(-1,-1)
+           endingPoint      = POINT_SECTION(-1,-1)
+           coordFirst       = coordSec(1)
+           coordLast        = coordSec(2)
+           sec%nb_point     = 0
+        ENDIF
+
+     ELSE
+        !If there is no intersection section/mesh
+        sec%listPoint(1) = POINT_SECTION(-1,-1)
+        endingPoint      = POINT_SECTION(-1,-1)
+        coordFirst       = coordSec(1)
+        coordLast        = coordSec(2)
+        sec%nb_point     = 0
+     ENDIF 
+
+     !debug
+     CALL write_debug(jsec,"extremities of section in the grid : ")
+     ji=sec%listPoint(1)%I ; jj=sec%listPoint(1)%J
+     IF( sec%nb_point .ne. 0 )THEN
+        ji=sec%listPoint(1)%I ; jj=sec%listPoint(1)%J
+        WRITE(cltmp,'(A15,X,i4.4,X,i4.4,X,f8.3,X,f8.3)')'First point: ',sec%listPoint(1),glamf(ji,jj),gphif(ji,jj) 
+        CALL write_debug(jsec,cltmp)
+        ji=endingPoint%I ; jj=endingPoint%J
+        WRITE(cltmp,'(A15,X,i4.4,X,i4.4,X,f8.3,X,f8.3)')'Last  point: ',endingPoint,glamf(ji,jj),gphif(ji,jj)
+        CALL write_debug(jsec,cltmp)
+        !
+        coord_a=pointToCoordF(sec%listPoint(1)) ; coord_b=pointToCoordF(endingPoint)
+        ll_test = .FALSE.
+        IF ( ll_date_domain .AND. ABS( coord_a%lon - coord_b%lon ).GT. 180) ll_test= .TRUE.
+        zdistante=distance2(coord_a,coord_b ,ll_test )
+        WRITE(cltmp,'(A20,f10.3)' )'distance between IJ-extremities : ',zdistante
+        CALL write_debug(jsec,cltmp)
+        !
+        CALL write_debug(jsec,"Initial extremities : ") 
+        WRITE(cltmp,'( 2(f9.3),A3,2(f9.3) )')coordFirst,'---',coordLast
+        CALL write_debug(jsec,cltmp)
+        ll_test = .FALSE.
+        IF( ll_date_domain .AND. ABS(coordFirst%lon - coordLast%lon).GT. 180)ll_test= .TRUE.
+        zdistante=distance2(coordFirst,coordLast,ll_test)
+        WRITE(cltmp,'(A30,f10.3)')' distance between initial extremities : ',zdistante
+        CALL write_debug(jsec,cltmp)
+        CALL write_debug(jsec,"                  ")
+     ELSE
+        WRITE(cltmp,'(A50)' )"no intersection between section and mesh"
+     ENDIF
+
+     !==========================================================!
+     ! IV. Find the series of mesh points that form the section !
+     !==========================================================!
+     CALL write_debug(jsec,"Find the serie of mesh's points that form the section")
+
+     IF( sec%nb_point .ne. 0 )THEN
+
+        !The series of mesh points that form the section will 'link' 
+        !sec%listPoint(1) to endingPoint: it will be stored in 
+        !sec%listPoint(jseg)
+        !
+        !We take place on the first point (sec%listPoint(1)) 
+        ! a.  We find the 4 adjacent points (North, South, East, West)
+        ! b.  Compute distance between current point and endingPoint
+        ! c.  Compute distance between the 4 adjacent points and endingPoint
+        ! d.  Select the points which are closer to end-point than current point
+        ! e.1 If at least one point is selected, select the point which is closest to original section among selected points 
+        ! e.2 If no point is selected, select the point which is the closest to end-point 
+        ! f. save next point and direction of velocity.
+        ! g. Save nextPoint and go to nextPoint
+        !
+        !We get out of this loop if:
+        !    - we are on endingPoint
+        !    - the number of points (jseg) that link sec%listPoint(1) to endingPoint is 
+        !      twice greater than number of section/mesh intersection (nb_inmesh):
+        !      it could be possible if thr algorithm can't link endingPoint (bug).
+
+        !initialize distnew value (with distance between section's extremities) 
+        zdistnew  = distance2(coordFirst,coordLast,sec%ll_date_line) 
+        prevPoint  = POINT_SECTION(0,0)
+        jseg       = 1
+
+        DO WHILE ( (  sec%listPoint(jseg)%I .NE.  endingPoint%I    &
+                 .OR. sec%listPoint(jseg)%J .NE. endingPoint%J   ) &
+                 .AND. jseg .LT. nb_inmesh + 10 .AND. sec%listPoint(jseg)%I .GT. 0  )         
+   
+           ! a. find the 4 adjacent points (North, South, East, West)
+           !---------------------------------------------------------
+           SouthPoint = POINT_SECTION(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J-1)
+           NorthPoint = POINT_SECTION(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J+1)
+           WestPoint  = POINT_SECTION(sec%listPoint(jseg)%I-1,sec%listPoint(jseg)%J)
+           EstPoint   = POINT_SECTION(sec%listPoint(jseg)%I+1,sec%listPoint(jseg)%J)
+
+           !debug
+           CALL write_debug(jsec,"---------------")
+           WRITE(cltmp,100)'Current points: ',sec%listPoint(jseg), & 
+                         glamf(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J), &
+                         gphif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)
+           CALL write_debug(jsec,cltmp)
+           CALL write_debug(jsec,"E/W/N/S points")
+           WRITE(cltmp,102)EstPoint,WestPoint,NorthPoint,SouthPoint
+           CALL write_debug(jsec,cltmp)
+           itest=MIN(MAX(EstPoint%I,0),jpi+1) ; jtest=MIN(MAX(EstPoint%J,0),jpj+1)
+           IF( itest .NE. 0 .AND. itest .NE. jpi+1 .AND. jtest .NE. 0 .AND. jtest .NE. jpj+1 )THEN 
+              WRITE(cltmp,101)'Est',glamf(itest,jtest),gphif(itest,jtest)
+              CALL write_debug(jsec,cltmp)
+           ELSE
+              CALL write_debug(jsec,"Est point out of domain")
+           ENDIF
+           !
+           itest=MIN(MAX(WestPoint%I,0),jpi+1) ; jtest=MIN(MAX(WestPoint%J,0),jpj+1)
+           IF( itest .NE. 0 .AND. itest .NE. jpi+1 .AND. jtest .NE. 0 .AND. jtest .NE. jpj+1 )THEN 
+              WRITE(cltmp,101)'West',glamf(itest,jtest),gphif(itest,jtest)
+              CALL write_debug(jsec,cltmp)
+           ELSE
+              CALL write_debug(jsec,"West point out of domain")
+           ENDIF
+           !
+           itest=MIN(MAX(NorthPoint%I,0),jpi+1) ; jtest=MIN(MAX(NorthPoint%J,0),jpj+1)
+           IF( itest .NE. 0 .AND. itest .NE. jpi+1 .AND. jtest .NE. 0 .AND. jtest .NE. jpj+1 )THEN 
+              WRITE(cltmp,101)'North',glamf(itest,jtest),gphif(itest,jtest)
+              CALL write_debug(jsec,cltmp)
+           ELSE
+              CALL write_debug(jsec,"North point out of domain")
+           ENDIF
+           !
+           itest=MIN(MAX(SouthPoint%I,0),jpi+1) ; jtest=MIN(MAX(SouthPoint%J,0),jpj+1)
+           IF( itest .NE. 0 .AND. itest .NE. jpi+1 .AND. jtest .NE. 0 .AND. jtest .NE. jpj+1 )THEN 
+              WRITE(cltmp,101)'South',glamf(itest,jtest),gphif(itest,jtest)
+              CALL write_debug(jsec,cltmp)
+           ELSE
+              CALL write_debug(jsec,"South point out of domain")
+           ENDIF
+           !
+           !
+100 FORMAT ( A15,2(i4.4," "),2(f8.3," ") )
+101 FORMAT ( A6,2(f7.3," "))
+102 FORMAT ( "E ",i4.4,' ',i4.4,"//W ",i4.4,' ',i4.4,"//N ",i4.4,' ',i4.4,"//S ",i4.4,' ',i4.4 )
+
+               
+           !Either we are at an end-point
+           !--------------------
+           IF(      SouthPoint%I==endingPoint%I .AND. SouthPoint%J==endingPoint%J )THEN 
+               sec%direction(jseg)=2 ; jseg = jseg+1 ; sec%listPoint(jseg) = SouthPoint
+           ELSE IF( NorthPoint%I==endingPoint%I .AND. NorthPoint%J==endingPoint%J )THEN
+               sec%direction(jseg)=3 ; jseg = jseg+1 ; sec%listPoint(jseg) = NorthPoint
+           ELSE IF(  WestPoint%I==endingPoint%I .AND.  WestPoint%J==endingPoint%J )THEN
+               sec%direction(jseg)=0 ; jseg = jseg+1 ; sec%listPoint(jseg) = WestPoint
+           ELSE IF(   EstPoint%I==endingPoint%I .AND.   EstPoint%J==endingPoint%J )THEN
+               sec%direction(jseg)=1 ; jseg = jseg+1 ; sec%listPoint(jseg) = EstPoint
+
+           ELSE
+           !Else we are NOT on end-point
+           !------------------------
+
+              ! b. distance between current point and endingPoint
+              !--------------------------------------------------
+              zdistante = zdistnew
+
+              ! c. compute distance between the 4 adjacent points and endingPoint
+              !------------------------------------------------------------------
+              ! BE CAREFUL! When the domain crosses the date line (ll_date_domain):
+              !
+              ! When we will compute distances between W/E/S/N points and endingPoint,
+              ! we have to check if theses 4 lines crosses the date line
+              ! (test: ABS(coordTemp%lon - coordLast%lon).GT. 180)
+              !
+              ! If one of these lines crosses the date line, we have to add 360° 
+              ! to the longitudes of the extremities to compute the distance through
+              ! the date line and not around the Earth.
+       
+              ! c.1 compute distWest: distance between west point and endingPoint
+              !----------------------
+              zdistWest2 = 99999999.9 ;  zdistWest3 = 99999999.9 
+              IF( sec%listPoint(jseg)%I .NE. 1 )THEN
+                 !When we are on the west side of the mesh (i=1),we can't go to the west.
+                 coordTemp = pointToCoordF(WestPoint) 
+                 ll_test = .FALSE.
+                 IF( ll_date_domain .AND. ABS(coordTemp%lon - coordLast%lon).GT. 180 )ll_test = .TRUE.
+                 zdistWest2  = distance2(pointToCoordF(WestPoint) ,coordLast ,ll_test)
+              ENDIF
+
+              ! c.2 compute distEst: distance between east point and endingPoint
+              !---------------------
+              zdistEst2 = 99999999.9 ;  zdistEst3 = 99999999.9
+              IF( sec%listPoint(jseg)%I .EQ. jpi )THEN
+                 !We test if the current point is on the east side of the mesh
+                 ! The method is done such that we go toward east to link
+                 ! sec%listPoint(1) to endingPoint.
+                 ! So, if the section crosses the overlapping band (ll_overlap_sec=T),
+                 ! we won't have to stop if the current point is on the EAST side of the mesh:
+                 ! we have to follow the construction of the section on the
+                 ! WEST side of the mesh
+                 IF( ll_overlap_sec  )THEN
+                    !section crosses the overlapping band 
+                    !So EastPoint is on the west side of the mesh
+                    EstPoint = POINT_SECTION(3,sec%listPoint(jseg)%J)
+                    zdistEst2= distance2(pointToCoordF(EstPoint)  ,coordLast ,.FALSE.)
+                 ENDIF 
+              ELSE
+                 coordTemp = pointToCoordF(EstPoint) 
+                 ll_test = .FALSE.
+                 IF( ll_date_domain .AND. ABS(coordTemp%lon - coordLast%lon).GT. 180 )ll_test= .TRUE.
+                 zdistEst2 = distance2(pointToCoordF(EstPoint)  ,coordLast ,ll_test )
+              ENDIF
+
+              ! c.3 compute distSouth: distance between south point and endingPoint
+              !-----------------------
+              zdistSouth2 = 99999999.9 ; zdistSouth3 = 99999999.9
+              IF( sec%listPoint(jseg)%J .NE. 1 )THEN
+                 !When we are on the south side of the mesh (j=1),we can't go to the south. 
+                 coordTemp=pointToCoordF(SouthPoint)
+                 ll_test = .FALSE.
+                 IF( ll_date_domain .AND. ABS(coordTemp%lon - coordLast%lon).GT. 180 )ll_test= .TRUE.
+                    zdistSouth2 = distance2(pointToCoordF(SouthPoint),coordlast ,ll_test )
+              ENDIF
+
+              ! c.4 compute distNorth: distance between north and endingPoint
+              !-----------------------
+              zdistNorth2 = 99999999.9 ; zdistNorth3 = 99999999.9 
+              IF( sec%listPoint(jseg)%J .NE. jpj )THEN
+                 !When we are on the north side of the mesh (j=jpj),we can't go to the south. 
+                 coordTemp=pointToCoordF(NorthPoint)
+                 ll_test = .FALSE.
+                 IF( ll_date_domain .AND. ABS(coordTemp%lon - coordLast%lon).GT. 180 )ll_test= .TRUE.
+                 zdistNorth2 = distance2(pointToCoordF(NorthPoint),coordlast ,ll_test )
+              ENDIF
+
+              ! d. select the points which are closer to end-point than current point
+              !----------------------------------------------------------------------
+              zdistref=distance2(pointToCoordF(sec%listPoint(jseg)),coordlast ,ll_test )
+              WRITE(cltmp,'( A56,f10.3 )' )'distance between actual point and last point: zdistref = ',zdistref
+              CALL write_debug(jsec,cltmp)
+              lest   = .FALSE. ; IF( zdistEst2   .LE. zdistref ) lest  = .TRUE.
+              lwest  = .FALSE. ; IF( zdistwest2  .LE. zdistref ) lwest = .TRUE.
+              lnorth = .FALSE. ; IF( zdistnorth2 .LE. zdistref ) lnorth= .TRUE.
+              lsouth = .FALSE. ; IF( zdistsouth2 .LE. zdistref ) lsouth= .TRUE.
+
+              !debug
+              IF( .NOT. lest   )CALL write_debug(jsec,'Est   point eliminated')
+              IF( .NOT. lwest  )CALL write_debug(jsec,'West  point eliminated')
+              IF( .NOT. lnorth )CALL write_debug(jsec,'North point eliminated')
+              IF( .NOT. lsouth )CALL write_debug(jsec,'South point eliminated')
+
+              l_oldmethod = .FALSE.
+
+              IF( ( COUNT((/lest/))+COUNT((/lwest/))+COUNT((/lnorth/))+COUNT((/lsouth/)) ) .NE. 0 )THEN
+
+                 ! e.1 If at least one point is selected, select the point 
+                 !     which is the closest to original section among selected points 
+                 !-------------------------------------------------------------------
+
+                 zdistWest3  = 9999999.9
+                 IF( lwest )zdistWest3  = &
+                    distance3(pointToCoordF(sec%listPoint(1)),pointToCoordF(WestPoint) ,pointToCoordF(endingPoint) ,lkdebug )
+                 zdistEst3   = 9999999.9
+                 IF( lest )zdistEst3   =  &
+                    distance3(pointToCoordF(sec%listPoint(1)),pointToCoordF(EstPoint)  ,pointToCoordF(endingPoint) ,lkdebug )
+                 zdistSouth3 = 9999999.9
+                 IF( lsouth )zdistSouth3 = &
+                    distance3(pointToCoordF(sec%listPoint(1)),pointToCoordF(SouthPoint),pointToCoordF(endingPoint) ,lkdebug )
+                 zdistNorth3 = 9999999.9
+                 IF( lnorth )zdistNorth3 = &
+                    distance3(pointToCoordF(sec%listPoint(1)),pointToCoordF(NorthPoint),pointToCoordF(endingPoint) ,lkdebug )
+
+                 zdistEst3   = zdistEst3   + (1-COUNT((/lest/))  )*9999999.9
+                 zdistWest3  = zdistWest3  + (1-COUNT((/lwest/)) )*9999999.9
+                 zdistNorth3 = zdistNorth3 + (1-COUNT((/lnorth/)))*9999999.9
+                 zdistSouth3 = zdistSouth3 + (1-COUNT((/lsouth/)))*9999999.9
+
+                 zdistnew = MIN(zdistEst3,zdistWest3,zdistnorth3,zdistSouth3)
+
+              ELSE 
+
+                 ! e.2 If no point is selected, select the point which is the closest to end-point 
+                 !--------------------------------------------------------------------------------
+                 l_oldmethod = .TRUE.
+
+                 !debug
+                 WRITE(cltmp,'(A30,i3.3)' )'SEARCH NEW POINT WITH OLD METHOD: ',jsec
+                 CALL write_debug(jsec,cltmp)
+                   
+                 !be careful! we can't go backward.
+                 zdistNorth = zdistNorth2    ; zdistSouth = zdistSouth2
+                 zdistEst   = zdistEst2      ; zdistWest  = zdistWest2 
+
+                 IF(     prevPoint%I .EQ. NorthPoint%I .AND. prevPoint%J .EQ. NorthPoint%J) THEN
+                     zdistnew = MIN(zdistEst,zdistWest,zdistSouth)
+                 ELSE IF(prevPoint%I .EQ. SouthPoint%I .AND. prevPoint%J .EQ. SouthPoint%J) THEN
+                    zdistnew = MIN(zdistEst,zdistWest,zdistNorth)
+                 ELSE IF(prevPoint%I .EQ. WestPoint%I  .AND. prevPoint%J .EQ. WestPoint%J ) THEN
+                    zdistnew = MIN(zdistEst,zdistNorth,zdistSouth)
+                 ELSE IF(prevPoint%I .EQ. EstPoint%I   .AND. prevPoint%J .EQ. EstPoint%J  ) THEN
+                    zdistnew = MIN(zdistWest,zdistNorth,zdistSouth)
+                 ELSE 
+                    zdistnew = MIN(zdistEst,zdistWest,zdistNorth,zdistSouth)
+                 ENDIF              
+
+              ENDIF
+
+              !debug
+              WRITE(cltmp,'(A11, f8.3)')'zdistref = ',zdistref
+              CALL write_debug(jsec,cltmp)
+              WRITE(cltmp, 103         )'distance2 :',zdistEst2,zdistWest2,zdistNorth2,zdistSouth2 
+              CALL write_debug(jsec,cltmp)
+              WRITE(cltmp, 103         )'distance3 :',zdistEst3,zdistWest3,zdistNorth3,zdistSouth3
+              CALL write_debug(jsec,cltmp)
+              WRITE(cltmp,'(A11, f8.3)')"zdistnew = ",zdistnew
+              CALL write_debug(jsec,cltmp)
+
+103 FORMAT (A12,"E",f12.3," W",f12.3," N",f12.3," S",f12.3)
+
+              !f. save next point and direction of velocity.
+              !--------------------------------------------- 
+              !nextPoint will be the one which is the closest to endingPoint.
+              !sec%direction will be direction between current point and nextPoint:
+              !It will be used to compute velocity through the segment [CurrentPoint,nextPoint}:
+              !                 
+              !A:Current Point    NorthPoint(I,J+1)   Nextpoint=NorthPoint(I,J+1) => sec%direction=3
+              !                   |                   Nextpoint=SouthPoint(I,J-1) => sec%direction=2   
+              !                   |                   Nextpoint=WestPoint(I-1,J)  => sec%direction=0   
+              !                   |==>V(I,J+1)        Nextpoint=EastPoint(I+1,J)  => sec%direction=1
+              !            U(I,J) |       U(I+1,J)
+              !            ^      |       ^
+              !   West_____|______A_______|_____EstPoint 
+              !   Point           |(I,J)        (I+1,J)  
+              !   (I-1,J)         |               
+              !                   |==>V(I,J)
+              !                   |
+              !              SoutPoint(I,J-1)
+              IF( l_oldmethod )THEN
+                 IF( zdistnew == zdistWest )      THEN
+                      sec%direction(jseg)=0 ; nextPoint = WestPoint
+                 ELSE IF( zdistnew == zdistEst )  THEN
+                      sec%direction(jseg)=1 ; nextPoint = EstPoint
+                 ELSE IF( zdistnew == zdistSouth )THEN
+                      sec%direction(jseg)=2 ; nextPoint = SouthPoint
+                 ELSE IF( zdistnew == zdistNorth )THEN
+                      sec%direction(jseg)=3 ; nextPoint= NorthPoint
+                 ENDIF
+              ELSE 
+                 IF( zdistnew == zdistWest3 )      THEN
+                      sec%direction(jseg)=0 ; nextPoint = WestPoint
+                 ELSE IF( zdistnew == zdistEst3 )  THEN
+                      sec%direction(jseg)=1 ; nextPoint = EstPoint
+                 ELSE IF( zdistnew == zdistSouth3 )THEN
+                      sec%direction(jseg)=2 ; nextPoint = SouthPoint
+                 ELSE IF( zdistnew == zdistNorth3 )THEN
+                      sec%direction(jseg)=3 ; nextPoint= NorthPoint
+                 ENDIF 
+              ENDIF
+
+              WRITE(cltmp,'(A11, 2(i4.4,1X) )')'nextPoint = ', nextPoint
+              CALL write_debug(jsec,cltmp)
+        
+              !f. Save nextPoint and go to nextPoint
+              !-------------------------------------
+              prevPoint = sec%listPoint(jseg)
+              jseg = jseg+1                   !increment of number of segments that form the section
+              sec%listPoint(jseg) = nextPoint !Save next point
+   
+           ENDIF ! southP/northP/WestP/EstP == endingpoint ?
+
+        ENDDO                  !End of loop on jseg
+        sec%nb_point = jseg    !Save the number of segments that form the section
+
+
+     ELSE ! isec%nb_point == 0
+        DO jseg=1,nb_point_max 
+           sec%listPoint(:)=POINT_SECTION(0,0)
+        ENDDO
+        sec%direction(:)=0.
+        sec%nb_point = 0
+     ENDIF
+
+     !debug     
+     IF( sec%nb_point .ne. 0 )THEN
+        CALL write_debug(jsec,"-------------------------------------")
+        CALL write_debug(jsec,"list of points in the grid : ")
+        DO jseg=1,sec%nb_point 
+           ji=sec%listPoint(jseg)%I ; jj=sec%listPoint(jseg)%J
+           WRITE(cltmp, '(i4.4,X,i4.4,X,i4.4,X,f8.3,X,f8.3)' )jseg,ji,jj,glamf(ji,jj),gphif(ji,jj)
+           CALL write_debug(jsec,cltmp)
+        ENDDO
+    
+        !test if we are an end-point
+        IF( sec%listPoint(sec%nb_point)%I .NE. endingPoint%J .AND. sec%listPoint(sec%nb_point)%J .NE. endingPoint%J )THEN   
+           PRINT*,TRIM(sec%name)," NOT ARRIVED TO endingPoint FOR jsec =  ",jsec
+        ENDIF
+     ENDIF
+
+     !now compute new slopeSection with ij-coordinates of first and last point 
+     sec%slopeSection = 0  ! default value
+     IF( sec%nb_point .ne. 0 )THEN
+        IF (  sec%listPoint(sec%nb_point)%I .NE.  sec%listPoint(1)%I ) THEN
+           sec%slopeSection = REAL( ( sec%listPoint(sec%nb_point)%J - sec%listPoint(1)%J ) , wp )/  &
+                              REAL( ( sec%listPoint(sec%nb_point)%I - sec%listPoint(1)%I ) , wp )     
+        ELSE
+           sec%slopeSection = 10000._wp
+        ENDIF
+     ENDIF
+ 
+  END SUBROUTINE compsec
+
+END MODULE compute_sections 
Index: /utils/tools_ticket2413/SECTIONS_DIADCT/src/declarations.f90
===================================================================
--- /utils/tools_ticket2413/SECTIONS_DIADCT/src/declarations.f90	(revision 12863)
+++ /utils/tools_ticket2413/SECTIONS_DIADCT/src/declarations.f90	(revision 12863)
@@ -0,0 +1,61 @@
+MODULE declarations 
+  !!----------------------------------------------------------------------------
+  !!             *** declarations global varibles 
+  !!
+  !! History: 2011: Clement Bricaud, Mercator-Ocean
+  !!
+  !!----------------------------------------------------------------------------
+
+  IMPLICIT NONE
+  PUBLIC
+
+  !! * Shared module variables 
+  INTEGER, PUBLIC, PARAMETER   :: dp=8 , sp=4, wp=dp
+  INTEGER, PUBLIC, PARAMETER   :: nb_class_max  = 10            ! Max number of classes
+  INTEGER, PUBLIC, PARAMETER   :: nb_sec_max    = 150           ! Max number of sections
+  INTEGER, PUBLIC, PARAMETER   :: nb_point_max  = 2000          ! Max number of segments per section
+  INTEGER, PUBLIC, PARAMETER   :: nb_type_class = 10            ! Max number of types of classes
+  INTEGER, PUBLIC, PARAMETER   :: numnam=3                      ! Unit for namelist
+  INTEGER, PUBLIC, PARAMETER   :: numdctin=1                    ! Unit for input file
+  INTEGER, PUBLIC, PARAMETER   :: numdctout=2                   ! Unit for output file
+
+  INTEGER, PUBLIC              :: jpi,jpj                       ! domain dimensions
+  INTEGER, PUBLIC              :: nb_sec                        ! Number of sections read from input file
+  INTEGER, PUBLIC              :: nsecdebug = 0                 ! Number of the section to debug
+
+  REAL(wp), PUBLIC ,DIMENSION(:,:)  , ALLOCATABLE :: glamf,gphif,glamt,gphit,e1t
+  INTEGER,  PUBLIC ,DIMENSION(nb_sec_max)         :: num_sec_debug
+
+  TYPE POINT_SECTION
+     INTEGER :: I,J
+  END TYPE POINT_SECTION
+
+  TYPE COORD_SECTION
+     REAL(wp) :: lon,lat
+  END TYPE COORD_SECTION
+
+  TYPE SECTION
+     CHARACTER(len=60)                              :: name                ! name of the sec
+     LOGICAL                                        :: llstrpond           ! true if you want the computation of salt 
+                                                                           ! and heat transport
+     LOGICAL                                        :: ll_ice_section      ! ice surface and icevolume transport computation
+     LOGICAL                                        :: ll_date_line        ! = T if the section crosses the date-line
+     TYPE(COORD_SECTION), DIMENSION(2)              :: coordSec            ! longitude and latitude of the extremities of the section
+     INTEGER                                        :: nb_class            ! number of boundaries for density classes
+     INTEGER, DIMENSION(nb_point_max)               :: direction           ! vector direction of the point in the section
+     CHARACTER(len=40),DIMENSION(nb_class_max)      :: classname           ! characteristics of the class
+     REAL(wp), DIMENSION(nb_class_max)              :: zsigi             ,&! insitu density classes    (99 if you don't want)
+                                                       zsigp             ,&! potential density classes    (99 if you don't want)
+                                                       zsal              ,&! salinity classes   (99 if you don't want)
+                                                       ztem              ,&! temperature classes(99 if you don't want)
+                                                       zlay                ! depth level classes      (99 if you don't want)
+     REAL(wp)                                       :: slopeSection        ! slope of the section 
+     INTEGER                                        :: nb_point            ! number of points in the section
+     TYPE(POINT_SECTION),DIMENSION(nb_point_max)    :: listPoint           ! list of points in the section
+  END TYPE SECTION
+
+  TYPE(SECTION),DIMENSION(nb_sec_max) :: secs ! Array of sections
+
+
+
+END MODULE declarations
Index: /utils/tools_ticket2413/SECTIONS_DIADCT/src/diadct_sections.f90
===================================================================
--- /utils/tools_ticket2413/SECTIONS_DIADCT/src/diadct_sections.f90	(revision 12863)
+++ /utils/tools_ticket2413/SECTIONS_DIADCT/src/diadct_sections.f90	(revision 12863)
@@ -0,0 +1,114 @@
+PROGRAM generate_sections
+     !!==============================================================================
+     !!                       ***  PROGRAM generate_sections    ***
+     !!
+     !! create a binary file containig the IJ positions of sections in global 
+     !! coordinates for the diagnostic routine diadct.F90 of NEMO
+     !!
+     !!
+     !! History: 09/2011: Clement Bricaud ( Mercator-Ocean )
+     !!
+     !!==============================================================================
+     !! * Modules used
+     USE declarations
+     USE sections_tools
+     USE readcoordmesh 
+     USE readsections
+     USE compute_sections
+     USE writesections    
+
+     IMPLICIT NONE
+ 
+     !! * Module Variables used
+     INTEGER            :: iargc, narg
+     CHARACTER(LEN=80)  :: cdum
+     INTEGER            :: jsec ,&! loop on sections
+                           jseg   ! loop on segments (parts of the section)
+     CHARACTER(len=40)  :: clname
+     LOGICAL            :: llok
+
+     NAMELIST/namdct/nsecdebug
+     !!==============================================================================     
+ 
+     PRINT*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+     PRINT*,'CREATION OF SECTIONS FOR NEMO diadct.F90 ROUTINE'
+     PRINT*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+ 
+     !-------------------!
+     !1. Read namelist   !
+     !-------------------!
+     PRINT*,'              '
+     PRINT*,'READ NAMELIST'
+     PRINT*,'--------------'
+
+     !!open, read and close namelist
+     nsecdebug=0
+     clname='namelist'
+     CALL file_open(numnam,clname,llok,cdform="FORMATTED",cdstatus="OLD",cdaction="READ")
+     IF ( llok ) THEN
+          REWIND( numnam )
+          READ  ( numnam, namdct )
+          PRINT*,'  '
+          PRINT*,'read namelist'
+          IF( nsecdebug==-1      )THEN ; PRINT*,' Debug all sections'
+          ELSE IF ( nsecdebug==0 )THEN ; PRINT*,' No section to debug'
+          ELSE IF ( nsecdebug .GE. 1 .AND. nsecdebug .LE. nb_sec_max )THEN
+              PRINT*,' Debug section number ',nsecdebug
+          ELSE
+              PRINT*,'Wrong number for nsecdebug = ',nsecdebug
+          ENDIF
+     ENDIF
+     CLOSE(numnam)
+     PRINT*,'read namelist ok'
+
+     !-------------------------------------!
+     !2. Read coordinates and meshmask     !
+     !-------------------------------------!
+     CALL read_coord_mesh
+ 
+     PRINT*,'domain sizes: '
+     PRINT*,'jpi    jpj    = ',jpi   ,jpj 
+     PRINT*,'domain boundaries: '
+     PRINT*,' 1   1   ',glamt(1,1),gphit(1,1)
+     PRINT*,' 1   jpj ',glamt(1,jpj),gphit(1,jpj)
+     PRINT*,' jpi 1   ',glamt(jpi,1),gphit(jpi,1)
+     PRINT*,'jpi jpj  ',glamt(jpi,jpj),gphit(jpi,jpj)
+
+
+
+     !----------------------!
+     !3. Read list_sections !
+     !----------------------!
+     num_sec_debug(:)=0     ! Unit numbers for debug files
+     CALL read_list_sections
+
+     !----------------------!
+     !4.Compute sections    !
+     !----------------------!
+     DO jsec=1,nb_sec
+          !we use compsec to generate the series of grid points making the section
+          IF(jsec == nsecdebug .OR. nsecdebug ==-1)THEN
+             CALL compsec(jsec,secs(jsec),.true.)
+          ELSE
+             CALL compsec(jsec,secs(jsec),.false.)
+          ENDIF
+          IF (jsec == nb_sec)PRINT*,'compute section ok '
+     ENDDO
+
+     !--------------------------------!
+     !5.Write section_ijglobal.diadct !
+     !--------------------------------!
+     CALL write_sections
+
+     !----------------------! 
+     !END                   !
+     !----------------------!
+    
+     !close debug files
+     DO jsec=1,nb_sec
+        IF( num_sec_debug(jsec) .NE. 0 )CLOSE(num_sec_debug(jsec))
+     ENDDO
+
+     PRINT*,'END END END END END END END END END END END END'
+
+END PROGRAM generate_sections
Index: /utils/tools_ticket2413/SECTIONS_DIADCT/src/readcoordmesh.f90
===================================================================
--- /utils/tools_ticket2413/SECTIONS_DIADCT/src/readcoordmesh.f90	(revision 12863)
+++ /utils/tools_ticket2413/SECTIONS_DIADCT/src/readcoordmesh.f90	(revision 12863)
@@ -0,0 +1,199 @@
+MODULE readcoordmesh
+  !!=====================================================================
+  !!                       ***  MODULE  readcoordmesh  ***
+  !! 
+  !! History: 2011: Clement Bricaud, Mercator-Ocean
+  !! 
+  !!=====================================================================
+  !! * Modules used
+  USE netcdf
+  USE declarations
+
+  IMPLICIT NONE
+  PRIVATE
+  
+  PUBLIC  read_coord_mesh
+
+CONTAINS
+
+  SUBROUTINE read_coord_mesh
+  !!---------------------------------------------------------------------
+  !!              ***  ROUTINE coord_mesh_read  ***
+  !!
+  !! ** Purpose :   Read a coordinate file and a meshmask file in NetCDF format 
+  !!
+  !!---------------------------------------------------------------------      
+  PRINT*,'              '
+  PRINT*,'READ COORDINATES AND MESHMASK'
+  PRINT*,'-----------------------------'
+
+  ! Get coordinates dimensions
+  CALL getdim(cdfile="coordinates.nc")
+
+  !Allocate coordinates array with domain size
+  ALLOCATE(glamt(jpi,jpj)) ; ALLOCATE(gphit(jpi,jpj))
+  ALLOCATE(glamf(jpi,jpj)) ; ALLOCATE(gphif(jpi,jpj))
+  ALLOCATE(e1t(jpi,jpj)  )   
+
+  !Read glamt
+  CALL read_ncdf(cdfile="coordinates.nc",cdvar="glamt",ksize=(/jpi,jpj,1,1/),ptab=glamt)
+
+  !Read gphit
+  CALL read_ncdf(cdfile="coordinates.nc",cdvar="gphit",ksize=(/jpi,jpj,1,1/),ptab=gphit)
+
+  !Read glamf
+  CALL read_ncdf(cdfile="coordinates.nc",cdvar="glamf",ksize=(/jpi,jpj,1,1/),ptab=glamf)
+
+  !Read gphif
+  CALL read_ncdf(cdfile="coordinates.nc",cdvar="gphif",ksize=(/jpi,jpj,1,1/),ptab=gphif)
+
+  !Read e1t
+  CALL read_ncdf(cdfile="coordinates.nc",cdvar="e1t",ksize=(/jpi,jpj,1,1/),ptab=e1t)
+
+  END SUBROUTINE read_coord_mesh
+
+  SUBROUTINE getdim(cdfile)
+  !!----------------------------------------------------------------------
+  !!              ***  ROUTINE getdim  ***
+  !!
+  !! ** Purpose :   get dimensions of a netcdf file
+  !!
+  !!----------------------------------------------------------------------
+  !! * Arguments
+  CHARACTER(*),INTENT(IN):: cdfile
+
+  !! * Local declarations
+  INTEGER           :: ncid                 ! file unit
+  INTEGER           :: idims                ! number of dimensions
+  INTEGER           :: istatus, id_var      ! dummy variable
+  CHARACTER(len=30) :: clname               ! dimension name   
+  INTEGER, ALLOCATABLE,DIMENSION(:) :: ndim ! dimension value
+  !!----------------------------------------------------------------------
+
+  !Open file
+  istatus=NF90_OPEN(TRIM(cdfile),nf90_nowrite,ncid)
+
+  IF( istatus/= NF90_NOERR )THEN
+     PRINT*,TRIM(cdfile),' not found.stop ' ; STOP
+  ELSE
+ 
+     ! read number of dimensions   
+     istatus=NF90_INQUIRE(ncid,ndimensions=idims)
+
+     ALLOCATE( ndim(idims) )
+
+     ! read each dimension
+     PRINT*,'     File dimensions: '
+     DO id_var=1,idims
+        istatus=NF90_Inquire_Dimension(ncid,id_var,clname,ndim(id_var))
+        PRINT*,'       ',id_var,clname,ndim(id_var)
+     ENDDO
+
+     !close
+     istatus=NF90_CLOSE( ncid )              
+     IF( istatus/=NF90_NOERR )THEN 
+        PRINT*,'Problem for closing ',TRIM(cdfile);STOP
+     ELSE
+        PRINT*,'     close ',TRIM(cdfile),' OK'
+     ENDIF
+
+  ENDIF
+
+  !domain dimensions
+  jpi = ndim(1)
+  jpj = ndim(2)
+
+  DEALLOCATE( ndim )
+  END SUBROUTINE getdim
+
+  SUBROUTINE read_ncdf(cdfile,cdvar,ksize,ptab,kstart,kcount)
+  !!----------------------------------------------------------------------
+  !!              ***  ROUTINE coord_mesh_read  ***
+  !!
+  !! ** Purpose :   Read a coordinate and a meshmask file in NetCDF format
+  !!
+  !!----------------------------------------------------------------------
+  !! * Arguments
+  CHARACTER(*),        INTENT(IN)                                    :: cdfile
+  CHARACTER(*),        INTENT(IN)                                    :: cdvar
+  INTEGER,DIMENSION(4),INTENT(IN)                                    :: ksize
+  INTEGER,DIMENSION(4),INTENT(IN),OPTIONAL                           :: kstart,kcount
+  REAL(wp),DIMENSION(ksize(1),ksize(2),ksize(3),ksize(4)),INTENT(OUT):: ptab
+
+  !! * Local declarations
+  INTEGER                                 ::istatus,ncid,id_var,len
+  CHARACTER(len=30) :: clname , cdvar2
+
+  INTEGER :: idims
+  INTEGER,DIMENSION(3)::idimids 
+  !!----------------------------------------------------------------------
+  ptab=0.
+  PRINT*,'read ',TRIM(cdvar),' in ',TRIM(cdfile)
+  
+  !OPEN
+  !----
+  istatus=NF90_OPEN(TRIM(cdfile),nf90_nowrite,ncid)
+  IF( istatus/= NF90_NOERR )THEN
+     PRINT*,TRIM(cdfile),' not found.stop ' ; STOP
+  ENDIF
+
+  !READ
+  !----
+  !search variable
+  istatus=NF90_INQ_VARID (ncid,TRIM(cdvar),id_var)
+  IF( istatus/=NF90_NOERR )THEN
+      PRINT*,TRIM(cdvar),' not found in ',TRIM(cdfile),'.stop';STOP
+  ENDIF
+
+  !get variable
+  !------------
+  istatus=nf90_inquire_variable(ncid,id_var, cdvar2, ndims=idims, dimids=idimids)
+  IF ( PRESENT(kstart) .AND. PRESENT(kcount) )THEN  
+      istatus=NF90_GET_VAR(ncid,id_var,ptab,start=kstart,count=kcount)
+  ELSE
+      istatus=NF90_GET_VAR(ncid,id_var,ptab)
+  ENDIF
+
+  CALL ERR_HDL(istatus)
+
+  IF( istatus/=NF90_NOERR )THEN
+           PRINT*,'Problem for reading ',TRIM(cdvar),' in ',TRIM(cdfile); STOP
+  ELSE
+      PRINT*,'     read ',TRIM(cdvar),' OK'
+  ENDIF
+
+  !CLOSE
+  !-----
+  istatus=NF90_CLOSE( ncid )
+  IF( istatus/=NF90_NOERR )THEN
+      PRINT*,'Problem for closing ',TRIM(cdfile);stop
+  ELSE
+      PRINT*,'     close ',TRIM(cdfile),' OK'
+  ENDIF
+
+
+  END SUBROUTINE read_ncdf
+
+  SUBROUTINE ERR_HDL(kstatus)
+  !! ----------------------------------------------------------
+  !!   ***  SUBROUTINE err_hdl
+  !!
+  !!   ** Purpose :  Error handle for NetCDF routine.
+  !!          Stop if kstatus indicates error conditions.
+  !!
+  !! History :
+  !!     Original: J.M. Molines (01/99)
+  !!
+  !! -----------------------------------------------------------
+  INTEGER, INTENT(in) ::  kstatus
+
+  !! -----------------------------------------------------------
+  IF( kstatus /=  NF90_NOERR ) THEN
+     PRINT *, 'ERROR in NETCDF routine, status=',kstatus
+     PRINT *,NF90_STRERROR(kstatus)
+     STOP
+  END IF
+
+  END SUBROUTINE ERR_HDL
+
+END MODULE readcoordmesh
Index: /utils/tools_ticket2413/SECTIONS_DIADCT/src/readsections.f90
===================================================================
--- /utils/tools_ticket2413/SECTIONS_DIADCT/src/readsections.f90	(revision 12863)
+++ /utils/tools_ticket2413/SECTIONS_DIADCT/src/readsections.f90	(revision 12863)
@@ -0,0 +1,200 @@
+MODULE readsections 
+   !!=====================================================================
+   !!                       ***  MODULE  readsections  ***
+   !! 
+   !! History: 2011: Clement Bricaud, Mercator-Ocean
+   !! 
+   !!=====================================================================
+   !! * Modules used
+   USE declarations   
+   USE sections_tools
+ 
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC read_list_sections 
+ 
+CONTAINS
+
+  SUBROUTINE read_list_sections
+     !!---------------------------------------------------------------------
+     !!         ***  ROUTINE read_list_sections ***
+     !!
+     !! ** Purpose: read ascii file 'list_sections.ascii' that contains
+     !!             section descriptions
+     !!
+     !!---------------------------------------------------------------------
+     !! * arguments
+
+     !! * Local declarations
+     INTEGER             :: jsec !loop on section number
+     INTEGER             :: iost,ji
+     INTEGER             :: iclass , jclass
+     LOGICAL             :: llok,llstrpond,llice,lldate
+     REAL(wp)            :: plon1,plat1,plon2,plat2
+     REAL(wp)            :: zslope
+     CHARACTER(len=5)    :: clclass
+     CHARACTER(len=5)    :: cdice
+     CHARACTER(len=9)    :: cdstrpond
+     CHARACTER(len=110)  :: clname,cdsecname,cltmp
+     REAL,DIMENSION(nb_type_class)     :: zclass_value
+     TYPE(COORD_SECTION)               :: coord_point1,coord_point2,coordTemp
+     TYPE(COORD_SECTION), DIMENSION(2) :: coord_sec
+     !!---------------------------------------------------------------------
+     PRINT*,'              '
+     PRINT*,'READ list_sections'
+     PRINT*,'------------------'
+     PRINT*,'               '
+
+     nb_sec=0 !initialize number of sections read in list_sections.ascii
+
+     !open and read input file
+     clname='list_sections.ascii'
+     PRINT*,'               '
+     CALL file_open(numdctin,clname,llok,cdform="FORMATTED",cdstatus="OLD",cdaction="READ")
+
+     IF ( llok ) THEN
+          PRINT*,'list_sections.ascii open '
+           PRINT*,'nb_sec_max = ',nb_sec_max
+          PRINT*,'                         '
+     
+          DO jsec=1,nb_sec_max
+
+                 !read a line corresponding to one section
+                 READ(numdctin,'(F7.2,1X,F7.2,1X,F7.2,1X,F7.2,1X,I2,1X,A9,1X,A5,1X,A40)',iostat=iost) & 
+                 &    plon1,plat1,plon2,plat2,iclass,cdstrpond,cdice,cdsecname
+                 IF (iost /= 0) EXIT  ! end of file
+
+                 ! cdsecname: change space to underscore for cdsecname
+                 cdsecname=ADJUSTL(cdsecname)
+                 ji = SCAN(TRIM(cdsecname)," ")
+                 DO WHILE(ji .NE. 0)
+                    cdsecname(ji:ji) = "_"
+                    ji = SCAN(TRIM(cdsecname)," ")
+                 ENDDO
+
+                 !computation of heat and salt transport ?
+                 llstrpond=.FALSE. ; IF( cdstrpond .EQ. 'okstrpond' ) llstrpond=.TRUE.
+
+                 !computation of ice tranpsort ?
+                 llice=.FALSE. ; IF( cdice .EQ. 'okice' ) llice=.TRUE.
+
+                 !store coordinates of the extremities
+                 coord_point1=COORD_SECTION(plon1,plat1)
+                 coord_point2=COORD_SECTION(plon2,plat2)
+                 coord_sec=(/coord_point1,coord_point2/)
+
+                 !Extremities of the section are classed
+                 lldate=.FALSE.
+                 IF(  coord_sec(2)%lon .LT. coord_sec(1)%lon  .OR.   &
+                    ((coord_sec(2)%lon .EQ. coord_sec(1)%lon) .AND.  &
+                     (coord_sec(2)%lat .LT. coord_sec(1)%lat)) ) THEN
+                      coordTemp   =coord_sec(1)
+                      coord_sec(1)=coord_sec(2)
+                      coord_sec(2)=coordTemp
+                 ENDIF
+                 IF((coord_sec(2)%lon - coord_sec(1)%lon) .GT. 180) THEN
+                      coordTemp   =coord_sec(1)
+                      coord_sec(1)=coord_sec(2)
+                      coord_sec(2)=coordTemp
+                      lldate=.TRUE.
+                 ENDIF
+
+                 !slope of the section (equidistant cylindric projection)
+                 zslope=slope_coeff(coord_sec(1),coord_sec(2),lldate)
+
+                 !!initialise global array secs
+                 secs(jsec)%llstrpond=.FALSE.  
+                 secs(jsec)%ll_date_line=.FALSE. ; secs(jsec)%nb_class=0
+                 secs(jsec)%zsigi=99.            ; secs(jsec)%zsigp=99.
+                 secs(jsec)%zsal=99.             ; secs(jsec)%ztem=99.
+                 secs(jsec)%zlay=99.
+                 secs(jsec)%nb_point=0
+
+                 !store all information in global array secs
+                 secs(jsec)%name           = cdsecname
+                 secs(jsec)%llstrpond      = llstrpond
+                 secs(jsec)%ll_ice_section = llice
+                 secs(jsec)%coordSec       = (/ coord_sec(1) , coord_sec(2) /)
+                 secs(jsec)%slopeSection   = zslope
+                 secs(jsec)%ll_date_line   = lldate
+
+                 !debug information
+                 CALL write_debug(jsec,'Informations read in ascii file:')
+                 CALL write_debug(jsec,'--------------------------------')
+                 CALL write_debug(jsec,'section name: '//secs(jsec)%name )
+                 IF( secs(jsec)%llstrpond )THEN ; CALL write_debug(jsec,'salt/heat transport computing' )
+                 ELSE                           ; CALL write_debug(jsec,'no salt/heat transport computing' )
+                 ENDIF
+                 IF( secs(jsec)%ll_ice_section )THEN ; CALL write_debug(jsec,'Ice transport computing' )
+                 ELSE                                ; CALL write_debug(jsec,'no Ice transport computing' )
+                 ENDIF
+                 WRITE(cltmp,'(A20,2f8.3)')'Extremity 1 :',secs(jsec)%coordSec(1)
+                 CALL write_debug(jsec,cltmp)
+                 WRITE(cltmp,'(A20,2f8.3)')'Extremity 2 :',secs(jsec)%coordSec(2)
+                 CALL write_debug(jsec,cltmp)
+                 WRITE(cltmp,'(A20,f8.3)')'Slope coefficient :',secs(jsec)%slopeSection
+                 CALL write_debug(jsec,cltmp)
+                 WRITE(cltmp,'(A20,i3.3)')'number of classes : ',iclass
+                 CALL write_debug(jsec,cltmp)
+                 IF( secs(jsec)%ll_date_line ) THEN ;  CALL write_debug(jsec,'section crosses date line')
+                 ELSE                                ; CALL write_debug(jsec,'section don t crosse date line')
+                 ENDIF
+                 CALL write_debug(jsec,'                        ')
+
+                 !verify number of sections and store it
+                 IF ( iclass .GT. nb_class_max) THEN
+                     PRINT*,"WARNING:  nb_class_max needs to be greater than ", iclass ; STOP
+                 ENDIF
+                 secs(jsec)%nb_class=iclass
+
+                 !read classes
+                 IF ( iclass .NE. 0 )THEN
+
+                      !classname=zsigi/zsigp/zsal/ztem/zlay
+                      READ(numdctin,'(A5)')clclass
+                      DO jclass = 1,iclass
+                         READ(numdctin,'(F9.3)',iostat=iost) zclass_value(jclass) 
+                      ENDDO 
+                      IF      ( TRIM(clclass) .EQ. 'zsigi' )THEN
+                           secs(jsec)%zsigi(1:iclass)=zclass_value(1:iclass) 
+                      ELSE IF ( TRIM(clclass) .EQ. 'zsigp' )THEN
+                           secs(jsec)%zsigp(1:iclass)=zclass_value(1:iclass) 
+                      ELSE IF ( TRIM(clclass) .EQ. 'zsal'  )THEN
+                           secs(jsec)%zsal(1:iclass)=zclass_value(1:iclass) 
+                      ELSE IF ( TRIM(clclass) .EQ. 'ztem'  )THEN
+                           secs(jsec)%ztem(1:iclass)=zclass_value(1:iclass)
+                      ELSE IF ( TRIM(clclass) .EQ. 'zlay'  )THEN
+                           secs(jsec)%zlay(1:iclass)=zclass_value(1:iclass)
+                      ELSE
+                          PRINT*,'Wrong name of class for section/clclass: ', cdsecname,TRIM(clclass)
+                      ENDIF
+
+                      IF ( jsec==nsecdebug .OR. nsecdebug==-1)THEN
+                           PRINT*,'class type = ',clclass
+                           PRINT*,'class values = ',zclass_value(1:iclass)
+                      ENDIF
+
+                 ENDIF
+
+          ENDDO !end of loop on sections
+         
+          CLOSE(numdctin) !Close file
+          IF( jsec .EQ. nb_sec_max)THEN
+              PRINT*,'   '
+              PRINT*,' nb_sec_max is less than the number of sections written in list_sections.ascii'
+              STOP
+          ELSE 
+             nb_sec=jsec-1 !number of read sections
+             PRINT*,'   '
+             PRINT*,'Number of sections read in list_sections.ascii: ',nb_sec 
+             PRINT*,'Reading of list_sections.ascii ok'
+             PRINT*,'   '
+          ENDIF
+
+     ENDIF
+
+  END SUBROUTINE  read_list_sections
+
+END MODULE readsections 
Index: /utils/tools_ticket2413/SECTIONS_DIADCT/src/sections_tools.f90
===================================================================
--- /utils/tools_ticket2413/SECTIONS_DIADCT/src/sections_tools.f90	(revision 12863)
+++ /utils/tools_ticket2413/SECTIONS_DIADCT/src/sections_tools.f90	(revision 12863)
@@ -0,0 +1,563 @@
+MODULE sections_tools
+   !!=====================================================================
+   !!                       ***  MODULE  sections_tools  ***
+   !! 
+   !! History: 2011: Clement Bricaud, Mercator-Ocean
+   !! 
+   !!=====================================================================
+   !! * Modules used
+   USE declarations
+ 
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC pointToCoordF         ! define a point with geographical coordinates
+   PUBLIC distance2             ! compute distance between 2 points
+   PUBLIC distance3             ! compute distance between a point and a line
+   PUBLIC intersec              ! intersection between 2 lines
+   PUBLIC slope_coeff           ! slope coefficient of a line
+   PUBLIC qcksrt                ! organize a list of point
+   PUBLIC write_debug           ! write debug messages
+   PUBLIC file_open             ! open a file ( ascii, bin)
+ 
+CONTAINS
+
+  TYPE(COORD_SECTION) FUNCTION pointToCoordF(p)
+     !!---------------------------------------------------------------------
+     !!         ***  FUNCTION pointToCoordF  ***
+     !!           
+     !! ** Purpose: define a point with geographical coordinates
+     !!
+     !!---------------------------------------------------------------------
+     !! * arguments
+     TYPE(POINT_SECTION), INTENT(IN) ::  p
+
+     !!---------------------------------------------------------------------
+
+     pointToCoordF = COORD_SECTION(glamf(p%I,p%J),gphif(p%I,p%J))
+
+     RETURN
+
+  END FUNCTION pointToCoordF
+
+  REAL(wp) FUNCTION distance2(coordA,coordB,ld_date_line)
+     !!---------------------------------------------------------------------
+     !!         ***  FUNCTION distance  ***
+     !!
+     !! ** Purpose:compute distance between coordA and coordB
+     !!            We add 360 to coordB%long if the line (coordA,coordB)
+     !!            crosses the date-line.
+     !!
+     !!---------------------------------------------------------------------
+     !! * arguments
+     TYPE(COORD_SECTION), INTENT(IN) :: coordA,coordB
+     LOGICAL,INTENT(IN),OPTIONAL     :: ld_date_line
+
+     !! * Local declarations 
+     REAL(wp) :: zrad, zrayon
+     REAL(wp) :: zpi = 3.141592653589793
+     REAL(wp) :: zlam1, zlam2, zphi1, zphi2
+
+     !-----------------------------------------------
+     zrayon = 6367000.0
+     zrad   = zpi/180.
+     zlam1  = coordA%lon*zrad
+     zlam2  = coordB%lon*zrad
+     zphi1  = coordA%lat*zrad
+     zphi2  = coordB%lat*zrad
+     !
+     !function output
+     distance2=0.001*2.*zrayon *ASIN(SQRT(SIN((zphi2-zphi1)/2.0)**2.0+COS(zphi1)*COS(zphi2)*SIN((zlam2-zlam1)/2.0)**2.0) )
+     !
+     RETURN
+  END FUNCTION distance2
+
+  REAL(wp) FUNCTION distance3(coordA,coordB,coordC,ll_debug) 
+     !!---------------------------------------------------------------------
+     !!         ***  FUNCTION cosinus  ***
+     !!
+     !! ** Purpose: compute distance between a point B and a line (AC)
+     !!
+     !! ** Methode: use Al-Kashi theorem
+     !!
+     !!              B                   A first point of the section
+     !!             / \                  B intermediate point on the section
+     !!            / | \                 C last point of the section
+     !!           /  |  \               
+     !!          /   |   \               angle=ACB
+     !!         /    |    \              
+     !!        /     |     \             distance3=Bd
+     !!       /      |      \
+     !!    C  -------d------- A  
+     !!
+     !!---------------------------------------------------------------------
+     !! * arguments
+     TYPE(COORD_SECTION), INTENT(IN) :: coordA,coordB,coordC
+     LOGICAL                         :: ll_debug
+
+     !! * Local declarations
+     REAL(wp)                        :: ztmp
+     REAL(wp)                        :: za, zb, zc, zangle
+
+     !-----------------------------------------------
+     za = SQRT( (coordB%lon-coordC%lon)**2 + (coordB%lat-coordC%lat)**2 )
+     zb = SQRT( (coordA%lon-coordC%lon)**2 + (coordA%lat-coordC%lat)**2 )
+     zc = SQRT( (coordA%lon-coordB%lon)**2 + (coordA%lat-coordB%lat)**2 )
+     !
+     IF( za /= 0. .AND. zb /= 0. )THEN
+        ztmp = ( za**2 + zb**2  - zc**2 ) / ( 2.0*za*zb )
+        ztmp = MIN(ztmp,1.00_wp)
+        IF( ztmp==1.00_wp )THEN ; zangle = 0.0 
+        ELSE                    ; zangle = ABS(acos(ztmp)) 
+        ENDIF
+     ELSE
+        PRINT*,'You should not have this situation: za zb =',za,zb ; STOP
+     ENDIF
+     !
+     distance3 = za*ABS(sin(zangle)) 
+     !
+     !function output
+     RETURN
+  END FUNCTION distance3
+
+  REAL(wp) FUNCTION slope_coeff(coordA,coordB,ld_dateline)
+     !!---------------------------------------------------------------------
+     !!         ***  Function slope_coeff  ***
+     !!
+     !! ** Purpose: Compute slope coefficient of the line (coordA,coordB)
+     !!
+     !! ** Method:
+     !!           Usual method :
+     !!                   slope_coeff = (latB-latA)/(lonB-lonA)
+     !!           Special case: the segment [A,B] crosses the date-line (lddate=T)
+     !!                   slope_coeff = (latB-latA)/(360+lonB-lonA)
+     !!---------------------------------------------------------------------
+     !! * arguments
+     TYPE(COORD_SECTION), INTENT(IN) :: coordA, coordB
+     LOGICAL,INTENT(IN),OPTIONAL     :: ld_dateline
+
+     !! * Local declarations
+     REAL(wp)                        :: zcoeff
+     INTEGER                         :: idateline
+
+     !!---------------------------------------------------------
+     !initialization
+     zcoeff = 1.e20
+     idateline=0
+     IF( PRESENT( ld_dateline))THEN
+       IF( ld_dateline )idateline=1
+     ENDIF
+
+     !compute slope coefficient
+     IF ( coordB%lon-coordA%lon .NE. 0.) &
+         zcoeff=(coordB%lat-coordA%lat)/(360*idateline+coordB%lon-coordA%lon)
+
+     !output
+     slope_coeff = zcoeff
+     RETURN
+
+  END FUNCTION slope_coeff 
+
+  TYPE(COORD_SECTION) FUNCTION intersec(sec,coord_a,coord_b)
+     !!---------------------------------------------------------------------
+     !!         ***  Function intersec  ***
+     !!
+     !! ** Purpose:Return the coordinates of the intersection point, 
+     !!            between segment [a,b] and the section.
+     !!            If no intersection the point = -9999.
+     !!
+     !! ** Method:(coord_a,coord_b) => y=za2*x+zb2  (2)
+     !!            sec              => y=za1*x+zb1  (1)
+     !!    Intersection = (X,Y) solves (1) and (2)
+     !!    Vefify that (X,Y) is in [coord_a,coord_b] AND in the section
+     !!         
+     !! ** Action: 1. compute za1, za1 
+     !!            2. compute zb1, zb2
+     !!            3. compute X and Y
+     !!            4.Verify that (zX,zY) is in [coord_a,coord_b] 
+     !!              and in [sec%coordSec(1),sec%coordSec(2)]    
+     !!
+     !! History: Author: 10/05 Matthieu Laborie
+     !!          Additions:
+     !!           05-2007: (C Bricaud) add special cases
+     !!                                (crossing date line)
+     !----------------------------------------------------------------------------- 
+     !! * arguments
+     TYPE(SECTION), INTENT(IN)        :: sec
+     TYPE(COORD_SECTION)  , INTENT(IN):: coord_a, coord_b
+
+     !! * Local declarations
+     TYPE(COORD_SECTION) :: coordInter
+     REAL(wp)            :: za1,za2, &! slope coefficient
+                            zb1,zb2, &! 
+                            zX,zY     ! coordinates of intersection
+     LOGICAL             :: ll_date_line=.FALSE. !segment [a,b] crosses the date-line ?
+
+     !----------------------------------------------------------------------------
+
+     !=================!
+     !0. INITALIZATION !
+     !=================!
+     coordInter=COORD_SECTION(-9999.,-9999.) 
+     ll_date_line=.FALSE.    
+     !we need to know if [coord_a,coord_b] crosses the date-line 
+     if(coord_a%lon-coord_b%lon .GT. 180)ll_date_line=.TRUE.
+
+     !=======================!
+     !1. compute za1 and za2 !
+     !=======================!
+     za1=sec%slopeSection
+     za2=slope_coeff(coord_a,coord_b,ll_date_line)
+ 
+     !=======================!
+     !2. compute zb1 and zb2 !
+     !=======================!
+
+     ! Compute coefficient b for a straight line y=a*x+b
+     !        Usual method:  knowing value of a, we compute b with coordinates of 1 point:
+     !                       b=latA-a.lonA or b=latB-a.lonB
+     !        Particular case: the straight line crosses the date line; so it is in 2 parts:
+     !                         one on the left of the date-line and one the right
+     !                         then,b can could have 2 values:
+     ! As the date-line can be crossed by the section and the segment of the mesh [a,b],
+     ! we have to check if the segment [a,b] crosses the date-line (we know it already for the
+     ! section(sec%ll_date_line): ll_date_line
+     ! Then, there are 4 cases for computing b1 and b2 ( sec%ll_date_line=T/F AND ll_date_line=T/F )
+     !=========================================================================================!
+     ! CASE A :                               !CASE C:
+     ! sec%ll_date_line=T AND ll_date_line =T !sec%ll_date_line=F AND ll_date_line =T
+     !                                        !     |  -180 !+180   |
+     ! this case doesn't exist                !     |       !       |
+     !========================================! a___|_______!_______|__b
+     !CASE B:                                 !     |       !       |
+     !sec%ll_date_line=T AND ll_date_line=F   !     |       !       |
+     !     \     |                            ! section  date-line  section
+     !   a__\__b |                            ! b1: usual method
+     !       \   |                            ! b2: depend of longitude of
+     !        \  |                            !     sec%coordSec(1) et de  sec%coordSec(2)
+     !         \ |                            !=================================================!
+     !          \|                            !CASE D:
+     !     +180  \  -180                      !sec%ll_date_line=F AND ll_date_line =F
+     !           |\                           !      |       !       |
+     !           | \                          !      | +180  ! -180  |
+     !           |  \                         !  a___|___b   !   a___|___b
+     !           |a__\__b                     !      |       !       |
+     !           |    \                       !      |       !       |
+     !    date-line   section                 !   section date-line section
+     !b2: usual method                        !b1: usual method
+     !b1: depend of longitude of a and b.     !b2: usual method
+     !==========================================================================================!
+
+     IF( sec%ll_date_line )THEN
+          IF( ll_date_line )THEN
+              !CASE A: this case doesn't exist
+              !-------
+              zb1=1.e20
+              zb2=1.e20
+          ELSE 
+              !CASE B:
+              !-------
+              !compute zb2: 
+              !zb2 = coord_b%lat - za2 * coord_b%lon = coord_a%lat - za2 * coord_a%lon 
+              zb2=coord_b%lat - za2 * coord_b%lon  
+
+              !compute zb1:
+              IF( coord_a%lon .GT. 0 .AND. coord_b%lon .GT. 0  )THEN
+                  zb1 = sec%coordSec(1)%lat - za1 * sec%coordSec(1)%lon
+              ELSE  
+                  zb1 = sec%coordSec(2)%lat - za1 * sec%coordSec(2)%lon
+              ENDIF 
+          ENDIF
+     ELSE
+          IF( ll_date_line )THEN
+              !CASE C:
+              !-------
+              !Compute zb1: 
+              !zb1 = sec%coordSec(1)%lat - za1 * sec%coordSec(1)%lon 
+              !    = sec%coordSec(2)%lat - za1 * sec%coordSec(2)%lon 
+              zb1 = sec%coordSec(1)%lat - za1 * sec%coordSec(1)%lon
+
+              !Compute zb2:
+              IF( sec%coordSec(1)%lon .GT. 0 .AND. sec%coordSec(2)%lon .GT. 0 )THEN
+                  zb2 = coord_a%lat - za2 * coord_a%lon
+              ELSE  
+                  zb2 = coord_b%lat - za2 * coord_b%lon
+              ENDIF
+          ELSE
+              !CASE D:
+              !-------
+              !compute zb1:
+              !zb1 = sec%coordSec(1)%lat - za1 * sec%coordSec(1)%lon  
+              !    = sec%coordSec(2)%lat - za1 * sec%coordSec(2)%lon
+              zb1 = sec%coordSec(1)%lat - za1 * sec%coordSec(1)%lon
+
+              !compute zb2:
+              !zb2 = coord_b%lat - za2 * coord_b%lon = coord_a%lat - za2 * coord_a%lon
+              zb2 = coord_b%lat - za2 * coord_b%lon  
+          ENDIF
+     ENDIF 
+
+     IF( (za1 - za2) .NE. 0) THEN
+          !================================!
+          !3. Compute intersection (zX,zY) !
+          !================================!
+          IF( za1 == 1.e20 ) THEN ! Case X=constant
+              zX = sec%coordSec(1)%lon
+              zY = za2 * zX + zb2
+          ELSE IF ( za2 == 1.e20) THEN ! Case X=constant
+              zX = coord_b%lon
+              zY = za1 * zX + zb1
+          ELSE ! Case zY=A*zX+B
+              zX = (zb2 - zb1) / (za1 - za2)
+              zY = (za1 * zX ) + zb1
+          ENDIF
+           
+          !==============================================!
+          !4.Verify that (zX,zY) is in [coord_a,coord_b] !
+          !  and in [sec%coordSec(1),sec%coordSec(2)]    !
+          !==============================================!
+          !Be careful! The test is not the same for all configurations
+          IF( sec%ll_date_line )THEN
+
+              IF( ll_date_line )THEN
+                  !CASE A: this case doesn't exist
+                  !-------
+                  coordInter=COORD_SECTION(-9999.,-9999.)
+              ELSE
+                  !CASE B:
+                  !-------   
+                  IF( zX .GE. MIN(coord_a%lon,coord_b%lon ) .AND. &
+                      zX .LE. MAX(coord_a%lon,coord_b%lon ) .AND. &
+                      zY .GE. MIN(coord_a%lat,coord_b%lat ) .AND. &
+                      zY .LE. MAX(coord_a%lat,coord_b%lat ) .AND. &
+                    ((zX .LE. MIN(sec%coordSec(1)%lon,sec%coordSec(2)%lon ) .AND. &
+                      zX .GE. -180) .OR.  &
+                     (zX .GE. MAX(sec%coordSec(1)%lon,sec%coordSec(2)%lon ) .AND. &
+                      zX .LE. 180)) .AND. &
+                      zY .GE. MIN(sec%coordSec(1)%lat,sec%coordSec(2)%lat ) .AND. &
+                      zY .LE. MAX(sec%coordSec(1)%lat,sec%coordSec(2)%lat ) ) THEN
+                     coordInter = COORD_SECTION(zX, zY)
+                  ENDIF
+              ENDIF
+          ELSE
+
+              IF( ll_date_line )THEN
+                  !CASE C:
+                  !-------
+                  IF( ((zX .LE. MIN(coord_a%lon,coord_b%lon ) .AND. &
+                        zX .GE. -180 )  .OR. &
+                       (zX .GE. MAX(coord_a%lon,coord_b%lon ) .AND. &
+                        zX .LE. 180 )) .AND. & 
+                        zY .GE. MIN(coord_a%lat,coord_b%lat ) .AND. &
+                        zY .LE. MAX(coord_a%lat,coord_b%lat ) .AND. &
+                        zX .GE. MIN(sec%coordSec(1)%lon,sec%coordSec(2)%lon ) .AND. &
+                        zX .LE. MAX(sec%coordSec(1)%lon,sec%coordSec(2)%lon ) .AND. &
+                        zY .GE. MIN(sec%coordSec(1)%lat,sec%coordSec(2)%lat ) .AND. &
+                        zY .LE. MAX(sec%coordSec(1)%lat,sec%coordSec(2)%lat ) ) THEN 
+                        coordInter = COORD_SECTION(zX, zY)   
+                  ENDIF 
+              ELSE
+                  !CASE D:
+                  !-------
+                  IF( zX .GE. MIN(coord_a%lon,coord_b%lon ) .AND. &
+                      zX .LE. MAX(coord_a%lon,coord_b%lon ) .AND. &
+                      zY .GE. MIN(coord_a%lat,coord_b%lat ) .AND. &
+                      zY .LE. MAX(coord_a%lat,coord_b%lat ) .AND. &
+                      zX .GE. MIN(sec%coordSec(1)%lon,sec%coordSec(2)%lon ) .AND. &
+                      zX .LE. MAX(sec%coordSec(1)%lon,sec%coordSec(2)%lon ) .AND. &
+                      zY .GE. MIN(sec%coordSec(1)%lat,sec%coordSec(2)%lat ) .AND. &
+                      zY .LE. MAX(sec%coordSec(1)%lat,sec%coordSec(2)%lat ) ) THEN
+                      coordInter = COORD_SECTION(zX, zY)
+                  ENDIF             
+              ENDIF
+          ENDIF   
+            
+     ENDIF
+      
+     !output
+     intersec = coordInter
+     RETURN
+   
+  END FUNCTION intersec
+
+  SUBROUTINE qcksrt(arr1,arr2,n)
+     !!---------------------------------------------------------------------
+     !!         ***  SUBROUTINE qcksrt  ***
+     !!
+     !! ** Purpose : organize a list point by latitude , and after by longitude
+     !!              using "numerical recipies " routine.
+     !!---------------------------------------------------------------------
+     !! * arguments
+     INTEGER,INTENT(IN)                 :: n           ! number of points
+     REAL(wp),DIMENSION(n),INTENT(INOUT):: arr1,arr2   ! longitude and latitude
+
+     !! * Local declarations
+     INTEGER , PARAMETER                :: m = 7, nstack = 500
+     REAL(wp), PARAMETER                :: fm=7875.,fa=211.,fc=1663.,fmi=1./fm
+     INTEGER                            :: il, ir, i, iq, ist    !local integers
+     INTEGER                            :: jj                    !loop indices
+     REAL(wp)                           :: zfx, za, zb           !local real
+     INTEGER,DIMENSION(nstack)          :: istack(nstack)        !temp array
+     !---------------------------------------------------
+     ist=0
+     il=1
+     ir=n
+     zfx=0.
+     !
+ 10  IF( ir-il .LT. m )THEN
+
+        DO jj = il+1,ir
+           za = arr1(jj)
+           zb = arr2(jj)
+           DO i = jj-1,1,-1
+              IF( arr1(i) .LE. za )GOTO 12
+              arr1(i+1) = arr1(i)
+              arr2(i+1) = arr2(i)
+           ENDDO
+           i=0
+ 12        arr1(i+1) = za
+           arr2(i+1) = zb
+        ENDDO
+        IF( ist .EQ. 0 )RETURN
+        ir  = istack(ist)
+        il  = istack(ist-1)
+        ist = ist-2
+     ELSE
+        i  = il
+        jj = ir
+        zfx = MOD(zfx*fa+fc,fm)
+        iq = il+(ir-il+1)*(zfx*fmi)
+        za  = arr1(iq)
+        arr1(iq) = arr1(il)
+        zb = arr2(iq)
+        arr2(iq) = arr2(il)
+ 20     CONTINUE
+ 21     IF( jj .GT. 0 )THEN
+           IF( za .LT. arr1(jj) )THEN
+              jj = jj-1
+              GOTO 21
+           ENDIF
+        ENDIF
+        IF( jj .LE. i )THEN
+           arr1(i) = za
+           arr2(i) = zb
+           GOTO 30
+        ENDIF
+        arr1(i) = arr1(jj)
+        arr2(i) = arr2(jj)
+        i=i+1
+ 22     IF( i .LE. n )THEN
+           IF( za .GT. arr1(i) )THEN
+              i = i+1
+              GOTO 22
+           ENDIF
+        ENDIF 
+        IF( jj .LE.i )THEN
+           arr1(jj) = za
+           arr2(jj) = zb
+           i        = jj
+           GOTO 30
+        ENDIF
+        arr1(jj) = arr1(i)
+        arr2(jj) = arr2(i)
+        jj = jj - 1
+        GOTO 20
+ 30     ist = ist + 2
+        IF( ist .GT. nstack )PAUSE 'nstack too small'
+        IF( ir-i .GE. i-1 )THEN
+           istack(ist  ) = ir
+           istack(ist-1) = i + 1
+           ir = i-1
+        ELSE
+           istack(ist  ) = i-1
+           istack(ist-1) = il
+           il = i+1
+        ENDIF
+     ENDIF
+     GOTO 10
+  END SUBROUTINE qcksrt
+
+  SUBROUTINE write_debug(ksec,cd_write)
+     !!---------------------------------------------------------------------
+     !!         ***  SUBROUTINE write_debug  ***
+     !!
+     !! ** Purpose: write debug messages
+     !!
+     !!---------------------------------------------------------------------
+     !! * arguments
+     INTEGER           :: ksec       !number of section
+     CHARACTER(len=*)  :: cd_write   !message to write
+
+     !! * Local declarations
+     INTEGER           :: iunit
+     LOGICAL           :: llok
+     CHARACTER(len=80) :: clfilename
+   
+     !!---------------------------------------------------------------------
+     IF( ksec == nsecdebug .OR. nsecdebug == -1 )THEN
+
+
+        !open / verify is debug output file is open
+
+        clfilename=TRIM(secs(ksec)%name)//"_debug"
+        iunit = num_sec_debug(ksec)
+
+        IF( iunit .EQ. 0 )THEN
+           PRINT*,"Open debug file: "//TRIM(clfilename)
+           iunit = 100 + ksec
+           num_sec_debug(ksec) = iunit 
+ 
+           CALL file_open(iunit,clfilename,llok,cdform="FORMATTED",cdstatus="REPLACE",cdaction="WRITE")
+        
+           IF( .NOT. llok )THEN 
+               PRINT*,"Can not open TRIM(clfilename)." ; STOP
+           ENDIF   
+        ENDIF
+      
+       WRITE(iunit,*)TRIM(cd_write)
+
+     ENDIF
+
+  END SUBROUTINE write_debug
+
+  SUBROUTINE file_open(knum,cdfile,ldok,cdform,cdstatus,cdaction)
+     !!---------------------------------------------------------------------
+     !!         ***  ROUTINE file_open ***
+     !!
+     !! ** Purpose: open a file
+     !!
+     !!---------------------------------------------------------------------
+     !! * arguments
+     INTEGER          ,INTENT(IN)  :: knum       ! file unit number
+     CHARACTER(len=*),INTENT(IN)   :: cdfile     ! file name to open
+     LOGICAL          ,INTENT(OUT) :: ldok       ! =.TRUE. if file exists and is corectly opened
+     CHARACTER(len=*),INTENT(IN)   :: cdform,   &! FORM arguments for OPEN function
+                                      cdstatus, &! STATUS arguments for OPEN function
+                                      cdaction   ! ACTION arguments for OPEN function
+                                      
+     !! * Local declarations
+     INTEGER :: iost
+     LOGICAL :: llbon=.FALSE. !check existence of file
+     !!---------------------------------------------------------------------
+     ldok = .FALSE.                        ! initialization; file not found and not opened
+
+     !check presence of file
+     IF( cdstatus .EQ. "OLD" ) THEN
+        INQUIRE( FILE=cdfile, EXIST=llbon ) ! check presence of namelist
+        IF( llbon )THEN ;  PRINT*,TRIM(cdfile)//' EXISTS'
+        ELSE            ;  PRINT*,TRIM(cdfile)//' NOT EXISTS' ; STOP
+        ENDIF
+     ENDIF
+
+     !open file
+     OPEN(UNIT=knum,FILE=TRIM(cdfile),FORM=cdform,status=cdstatus,action=cdaction,iostat=iost)
+     IF ( iost == 0 )THEN
+          ldok=.TRUE.
+     ELSE
+          PRINT*,TRIM(cdfile)//' bad opening. STOP.'; STOP
+     ENDIF
+
+  END SUBROUTINE file_open
+
+END MODULE sections_tools 
Index: /utils/tools_ticket2413/SECTIONS_DIADCT/src/writesections.f90
===================================================================
--- /utils/tools_ticket2413/SECTIONS_DIADCT/src/writesections.f90	(revision 12863)
+++ /utils/tools_ticket2413/SECTIONS_DIADCT/src/writesections.f90	(revision 12863)
@@ -0,0 +1,91 @@
+MODULE writesections 
+   !!=====================================================================
+   !!                       ***  MODULE  writesections  ***
+   !! 
+   !! History: 2011: Clement Bricaud, Mercator-Ocean
+   !! 
+   !!=====================================================================
+   !! * Modules used
+   USE declarations   
+   USE sections_tools
+ 
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC  write_sections 
+   PRIVATE file_open 
+ 
+CONTAINS
+
+  SUBROUTINE write_sections
+     !!---------------------------------------------------------------------
+     !!         ***  ROUTINE read_list_sections ***
+     !!
+     !! ** Purpose
+     !!
+     !! ** Method
+     !!
+     !! ** Input
+     !!
+     !! ** Action
+     !!
+     !! History
+     !!---------------------------------------------------------------------
+     !! * arguments
+
+     !! * Local declarations
+     INTEGER             :: jsec ,&!loop on sections 
+                            jseg   !loop on segments
+     INTEGER             :: i1, i2 !temporary integers
+     LOGICAL             :: llok   !
+     CHARACTER(len=40)   :: clname !
+     TYPE(POINT_SECTION) :: point  !coordinates of a point
+
+     !!---------------------------------------------------------------------
+
+     PRINT*,'              '
+     PRINT*,'WRITE SECTIONS'
+     PRINT*,'--------------'
+
+     !open output file
+     llok=.FALSE.
+     clname='section_ijglobal.diadct'
+     CALL file_open(numdctout,clname,llok,cdform="UNFORMATTED",cdstatus="REPLACE",cdaction="WRITE")
+
+     !print informations
+     IF ( llok ) THEN
+          PRINT*,TRIM(clname),' open. '
+
+          DO jsec=1,nb_sec
+  
+             WRITE(numdctout)jsec
+             WRITE(numdctout)secs(jsec)%name
+             WRITE(numdctout)secs(jsec)%llstrpond
+             WRITE(numdctout)secs(jsec)%ll_ice_section
+             WRITE(numdctout)secs(jsec)%ll_date_line
+             WRITE(numdctout)secs(jsec)%coordSec
+             WRITE(numdctout)secs(jsec)%nb_class
+             WRITE(numdctout)secs(jsec)%zsigi
+             WRITE(numdctout)secs(jsec)%zsigp
+             WRITE(numdctout)secs(jsec)%zsal
+             WRITE(numdctout)secs(jsec)%ztem
+             WRITE(numdctout)secs(jsec)%zlay
+             WRITE(numdctout)secs(jsec)%slopeSection
+             WRITE(numdctout)secs(jsec)%nb_point
+             IF( secs(jsec)%nb_point .NE. 0 )THEN
+                DO jseg=1,secs(jsec)%nb_point
+                   i1 = secs(jsec)%listPoint(jseg)%I  ; i2 = secs(jsec)%listPoint(jseg)%J
+                   WRITE(numdctout)i1,i2
+                ENDDO
+                WRITE(numdctout)secs(jsec)%direction(1:secs(jsec)%nb_point)
+             ENDIF
+
+          ENDDO !end of loop on sections
+         
+          CLOSE(numdctout) !Close file
+     ENDIF
+
+  END SUBROUTINE  write_sections
+
+END MODULE writesections 
Index: /utils/tools_ticket2413/SIREN/Doxyfile
===================================================================
--- /utils/tools_ticket2413/SIREN/Doxyfile	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/Doxyfile	(revision 12863)
@@ -0,0 +1,2493 @@
+# Doxyfile 1.8.15
+
+# This file describes the settings to be used by the documentation system
+# doxygen (www.doxygen.org) for a project.
+#
+# All text after a double hash (##) is considered a comment and is placed in
+# front of the TAG it is preceding.
+#
+# All text after a single hash (#) is considered a comment and will be ignored.
+# The format is:
+# TAG = value [value, ...]
+# For lists, items can also be appended using:
+# TAG += value [value, ...]
+# Values that contain spaces should be placed between quotes (\" \").
+
+#---------------------------------------------------------------------------
+# Project related configuration options
+#---------------------------------------------------------------------------
+
+# This tag specifies the encoding used for all characters in the configuration
+# file that follow. The default is UTF-8 which is also the encoding used for all
+# text before the first occurrence of this tag. Doxygen uses libiconv (or the
+# iconv built into libc) for the transcoding. See
+# https://www.gnu.org/software/libiconv/ for the list of possible encodings.
+# The default value is: UTF-8.
+
+DOXYFILE_ENCODING      = UTF-8
+
+# The PROJECT_NAME tag is a single word (or a sequence of words surrounded by
+# double-quotes, unless you are using Doxywizard) that should identify the
+# project for which the documentation is generated. This name is used in the
+# title of most generated pages and in a few other places.
+# The default value is: My Project.
+
+PROJECT_NAME           = "SIREN"
+
+# The PROJECT_NUMBER tag can be used to enter a project or revision number. This
+# could be handy for archiving the generated documentation or if some version
+# control system is used.
+
+PROJECT_NUMBER         = "$Rev$"
+
+# Using the PROJECT_BRIEF tag one can provide an optional one line description
+# for a project that appears at the top of each page and should give viewer a
+# quick idea about the purpose of the project. Keep the description short.
+
+PROJECT_BRIEF          = "System and Interface for oceanic RElocatable Nesting"
+
+# With the PROJECT_LOGO tag one can specify a logo or an icon that is included
+# in the documentation. The maximum height of the logo should not exceed 55
+# pixels and the maximum width should not exceed 200 pixels. Doxygen will copy
+# the logo to the output directory.
+
+PROJECT_LOGO           = ./src/docsrc/Image/logoSirenNemo.png
+
+# The OUTPUT_DIRECTORY tag is used to specify the (relative or absolute) path
+# into which the generated documentation will be written. If a relative path is
+# entered, it will be relative to the location where doxygen was started. If
+# left blank the current directory will be used.
+
+OUTPUT_DIRECTORY       = ./doc
+
+# If the CREATE_SUBDIRS tag is set to YES then doxygen will create 4096 sub-
+# directories (in 2 levels) under the output directory of each output format and
+# will distribute the generated files over these directories. Enabling this
+# option can be useful when feeding doxygen a huge amount of source files, where
+# putting all generated files in the same directory would otherwise causes
+# performance problems for the file system.
+# The default value is: NO.
+
+CREATE_SUBDIRS         = NO
+
+# If the ALLOW_UNICODE_NAMES tag is set to YES, doxygen will allow non-ASCII
+# characters to appear in the names of generated files. If set to NO, non-ASCII
+# characters will be escaped, for example _xE3_x81_x84 will be used for Unicode
+# U+3044.
+# The default value is: NO.
+
+ALLOW_UNICODE_NAMES    = NO
+
+# The OUTPUT_LANGUAGE tag is used to specify the language in which all
+# documentation generated by doxygen is written. Doxygen will use this
+# information to generate all constant output in the proper language.
+# Possible values are: Afrikaans, Arabic, Armenian, Brazilian, Catalan, Chinese,
+# Chinese-Traditional, Croatian, Czech, Danish, Dutch, English (United States),
+# Esperanto, Farsi (Persian), Finnish, French, German, Greek, Hungarian,
+# Indonesian, Italian, Japanese, Japanese-en (Japanese with English messages),
+# Korean, Korean-en (Korean with English messages), Latvian, Lithuanian,
+# Macedonian, Norwegian, Persian (Farsi), Polish, Portuguese, Romanian, Russian,
+# Serbian, Serbian-Cyrillic, Slovak, Slovene, Spanish, Swedish, Turkish,
+# Ukrainian and Vietnamese.
+# The default value is: English.
+
+OUTPUT_LANGUAGE        = English
+
+# The OUTPUT_TEXT_DIRECTION tag is used to specify the direction in which all
+# documentation generated by doxygen is written. Doxygen will use this
+# information to generate all generated output in the proper direction.
+# Possible values are: None, LTR, RTL and Context.
+# The default value is: None.
+
+OUTPUT_TEXT_DIRECTION  = None
+
+# If the BRIEF_MEMBER_DESC tag is set to YES, doxygen will include brief member
+# descriptions after the members that are listed in the file and class
+# documentation (similar to Javadoc). Set to NO to disable this.
+# The default value is: YES.
+
+BRIEF_MEMBER_DESC      = YES
+
+# If the REPEAT_BRIEF tag is set to YES, doxygen will prepend the brief
+# description of a member or function before the detailed description
+#
+# Note: If both HIDE_UNDOC_MEMBERS and BRIEF_MEMBER_DESC are set to NO, the
+# brief descriptions will be completely suppressed.
+# The default value is: YES.
+
+REPEAT_BRIEF           = YES
+
+# This tag implements a quasi-intelligent brief description abbreviator that is
+# used to form the text in various listings. Each string in this list, if found
+# as the leading text of the brief description, will be stripped from the text
+# and the result, after processing the whole list, is used as the annotated
+# text. Otherwise, the brief description is used as-is. If left blank, the
+# following values are used ($name is automatically replaced with the name of
+# the entity):The $name class, The $name widget, The $name file, is, provides,
+# specifies, contains, represents, a, an and the.
+
+ABBREVIATE_BRIEF       =
+
+# If the ALWAYS_DETAILED_SEC and REPEAT_BRIEF tags are both set to YES then
+# doxygen will generate a detailed section even if there is only a brief
+# description.
+# The default value is: NO.
+
+ALWAYS_DETAILED_SEC    = NO
+
+# If the INLINE_INHERITED_MEMB tag is set to YES, doxygen will show all
+# inherited members of a class in the documentation of that class as if those
+# members were ordinary class members. Constructors, destructors and assignment
+# operators of the base classes will not be shown.
+# The default value is: NO.
+
+INLINE_INHERITED_MEMB  = NO
+
+# If the FULL_PATH_NAMES tag is set to YES, doxygen will prepend the full path
+# before files name in the file list and in the header files. If set to NO the
+# shortest path that makes the file name unique will be used
+# The default value is: YES.
+
+FULL_PATH_NAMES        = YES
+
+# The STRIP_FROM_PATH tag can be used to strip a user-defined part of the path.
+# Stripping is only done if one of the specified strings matches the left-hand
+# part of the path. The tag can be used to show relative paths in the file list.
+# If left blank the directory from which doxygen is run is used as the path to
+# strip.
+#
+# Note that you can specify absolute paths here, but also relative paths, which
+# will be relative from the directory where doxygen is started.
+# This tag requires that the tag FULL_PATH_NAMES is set to YES.
+
+STRIP_FROM_PATH        =
+
+# The STRIP_FROM_INC_PATH tag can be used to strip a user-defined part of the
+# path mentioned in the documentation of a class, which tells the reader which
+# header file to include in order to use a class. If left blank only the name of
+# the header file containing the class definition is used. Otherwise one should
+# specify the list of include paths that are normally passed to the compiler
+# using the -I flag.
+
+STRIP_FROM_INC_PATH    =
+
+# If the SHORT_NAMES tag is set to YES, doxygen will generate much shorter (but
+# less readable) file names. This can be useful is your file systems doesn't
+# support long names like on DOS, Mac, or CD-ROM.
+# The default value is: NO.
+
+SHORT_NAMES            = NO
+
+# If the JAVADOC_AUTOBRIEF tag is set to YES then doxygen will interpret the
+# first line (until the first dot) of a Javadoc-style comment as the brief
+# description. If set to NO, the Javadoc-style will behave just like regular Qt-
+# style comments (thus requiring an explicit @brief command for a brief
+# description.)
+# The default value is: NO.
+
+JAVADOC_AUTOBRIEF      = NO
+
+# If the QT_AUTOBRIEF tag is set to YES then doxygen will interpret the first
+# line (until the first dot) of a Qt-style comment as the brief description. If
+# set to NO, the Qt-style will behave just like regular Qt-style comments (thus
+# requiring an explicit \brief command for a brief description.)
+# The default value is: NO.
+
+QT_AUTOBRIEF           = NO
+
+# The MULTILINE_CPP_IS_BRIEF tag can be set to YES to make doxygen treat a
+# multi-line C++ special comment block (i.e. a block of //! or /// comments) as
+# a brief description. This used to be the default behavior. The new default is
+# to treat a multi-line C++ comment block as a detailed description. Set this
+# tag to YES if you prefer the old behavior instead.
+#
+# Note that setting this tag to YES also means that rational rose comments are
+# not recognized any more.
+# The default value is: NO.
+
+MULTILINE_CPP_IS_BRIEF = NO
+
+# If the INHERIT_DOCS tag is set to YES then an undocumented member inherits the
+# documentation from any documented member that it re-implements.
+# The default value is: YES.
+
+INHERIT_DOCS           = YES
+
+# If the SEPARATE_MEMBER_PAGES tag is set to YES then doxygen will produce a new
+# page for each member. If set to NO, the documentation of a member will be part
+# of the file/class/namespace that contains it.
+# The default value is: NO.
+
+SEPARATE_MEMBER_PAGES  = NO
+
+# The TAB_SIZE tag can be used to set the number of spaces in a tab. Doxygen
+# uses this value to replace tabs by spaces in code fragments.
+# Minimum value: 1, maximum value: 16, default value: 4.
+
+TAB_SIZE               = 3
+
+# This tag can be used to specify a number of aliases that act as commands in
+# the documentation. An alias has the form:
+# name=value
+# For example adding
+# "sideeffect=@par Side Effects:\n"
+# will allow you to put the command \sideeffect (or @sideeffect) in the
+# documentation, which will result in a user-defined paragraph with heading
+# "Side Effects:". You can put \n's in the value part of an alias to insert
+# newlines (in the resulting output). You can put ^^ in the value part of an
+# alias to insert a newline as if a physical newline was in the original file.
+# When you need a literal { or } or , in the value part of an alias you have to
+# escape them by means of a backslash (\), this can lead to conflicts with the
+# commands \{ and \} for these it is advised to use the version @{ and @} or use
+# a double escape (\\{ and \\})
+
+ALIASES                =
+
+# This tag can be used to specify a number of word-keyword mappings (TCL only).
+# A mapping has the form "name=value". For example adding "class=itcl::class"
+# will allow you to use the command class in the itcl::class meaning.
+
+TCL_SUBST              =
+
+# Set the OPTIMIZE_OUTPUT_FOR_C tag to YES if your project consists of C sources
+# only. Doxygen will then generate output that is more tailored for C. For
+# instance, some of the names that are used will be different. The list of all
+# members will be omitted, etc.
+# The default value is: NO.
+
+OPTIMIZE_OUTPUT_FOR_C  = NO
+
+# Set the OPTIMIZE_OUTPUT_JAVA tag to YES if your project consists of Java or
+# Python sources only. Doxygen will then generate output that is more tailored
+# for that language. For instance, namespaces will be presented as packages,
+# qualified scopes will look different, etc.
+# The default value is: NO.
+
+OPTIMIZE_OUTPUT_JAVA   = NO
+
+# Set the OPTIMIZE_FOR_FORTRAN tag to YES if your project consists of Fortran
+# sources. Doxygen will then generate output that is tailored for Fortran.
+# The default value is: NO.
+
+OPTIMIZE_FOR_FORTRAN   = NO
+
+# Set the OPTIMIZE_OUTPUT_VHDL tag to YES if your project consists of VHDL
+# sources. Doxygen will then generate output that is tailored for VHDL.
+# The default value is: NO.
+
+OPTIMIZE_OUTPUT_VHDL   = NO
+
+# Set the OPTIMIZE_OUTPUT_SLICE tag to YES if your project consists of Slice
+# sources only. Doxygen will then generate output that is more tailored for that
+# language. For instance, namespaces will be presented as modules, types will be
+# separated into more groups, etc.
+# The default value is: NO.
+
+OPTIMIZE_OUTPUT_SLICE  = NO
+
+# Doxygen selects the parser to use depending on the extension of the files it
+# parses. With this tag you can assign which parser to use for a given
+# extension. Doxygen has a built-in mapping, but you can override or extend it
+# using this tag. The format is ext=language, where ext is a file extension, and
+# language is one of the parsers supported by doxygen: IDL, Java, Javascript,
+# Csharp (C#), C, C++, D, PHP, md (Markdown), Objective-C, Python, Slice,
+# Fortran (fixed format Fortran: FortranFixed, free formatted Fortran:
+# FortranFree, unknown formatted Fortran: Fortran. In the later case the parser
+# tries to guess whether the code is fixed or free formatted code, this is the
+# default for Fortran type files), VHDL, tcl. For instance to make doxygen treat
+# .inc files as Fortran files (default is PHP), and .f files as C (default is
+# Fortran), use: inc=Fortran f=C.
+#
+# Note: For files without extension you can use no_extension as a placeholder.
+#
+# Note that for custom extensions you also need to set FILE_PATTERNS otherwise
+# the files are not read by doxygen.
+
+EXTENSION_MAPPING      =
+
+# If the MARKDOWN_SUPPORT tag is enabled then doxygen pre-processes all comments
+# according to the Markdown format, which allows for more readable
+# documentation. See https://daringfireball.net/projects/markdown/ for details.
+# The output of markdown processing is further processed by doxygen, so you can
+# mix doxygen, HTML, and XML commands with Markdown formatting. Disable only in
+# case of backward compatibilities issues.
+# The default value is: YES.
+
+MARKDOWN_SUPPORT       = YES
+
+# When the TOC_INCLUDE_HEADINGS tag is set to a non-zero value, all headings up
+# to that level are automatically included in the table of contents, even if
+# they do not have an id attribute.
+# Note: This feature currently applies only to Markdown headings.
+# Minimum value: 0, maximum value: 99, default value: 0.
+# This tag requires that the tag MARKDOWN_SUPPORT is set to YES.
+
+TOC_INCLUDE_HEADINGS   = 0
+
+# When enabled doxygen tries to link words that correspond to documented
+# classes, or namespaces to their corresponding documentation. Such a link can
+# be prevented in individual cases by putting a % sign in front of the word or
+# globally by setting AUTOLINK_SUPPORT to NO.
+# The default value is: YES.
+
+AUTOLINK_SUPPORT       = YES
+
+# If you use STL classes (i.e. std::string, std::vector, etc.) but do not want
+# to include (a tag file for) the STL sources as input, then you should set this
+# tag to YES in order to let doxygen match functions declarations and
+# definitions whose arguments contain STL classes (e.g. func(std::string);
+# versus func(std::string) {}). This also make the inheritance and collaboration
+# diagrams that involve STL classes more complete and accurate.
+# The default value is: NO.
+
+BUILTIN_STL_SUPPORT    = NO
+
+# If you use Microsoft's C++/CLI language, you should set this option to YES to
+# enable parsing support.
+# The default value is: NO.
+
+CPP_CLI_SUPPORT        = NO
+
+# Set the SIP_SUPPORT tag to YES if your project consists of sip (see:
+# https://www.riverbankcomputing.com/software/sip/intro) sources only. Doxygen
+# will parse them like normal C++ but will assume all classes use public instead
+# of private inheritance when no explicit protection keyword is present.
+# The default value is: NO.
+
+SIP_SUPPORT            = NO
+
+# For Microsoft's IDL there are propget and propput attributes to indicate
+# getter and setter methods for a property. Setting this option to YES will make
+# doxygen to replace the get and set methods by a property in the documentation.
+# This will only work if the methods are indeed getting or setting a simple
+# type. If this is not the case, or you want to show the methods anyway, you
+# should set this option to NO.
+# The default value is: YES.
+
+IDL_PROPERTY_SUPPORT   = YES
+
+# If member grouping is used in the documentation and the DISTRIBUTE_GROUP_DOC
+# tag is set to YES then doxygen will reuse the documentation of the first
+# member in the group (if any) for the other members of the group. By default
+# all members of a group must be documented explicitly.
+# The default value is: NO.
+
+DISTRIBUTE_GROUP_DOC   = NO
+
+# If one adds a struct or class to a group and this option is enabled, then also
+# any nested class or struct is added to the same group. By default this option
+# is disabled and one has to add nested compounds explicitly via \ingroup.
+# The default value is: NO.
+
+GROUP_NESTED_COMPOUNDS = NO
+
+# Set the SUBGROUPING tag to YES to allow class member groups of the same type
+# (for instance a group of public functions) to be put as a subgroup of that
+# type (e.g. under the Public Functions section). Set it to NO to prevent
+# subgrouping. Alternatively, this can be done per class using the
+# \nosubgrouping command.
+# The default value is: YES.
+
+SUBGROUPING            = YES
+
+# When the INLINE_GROUPED_CLASSES tag is set to YES, classes, structs and unions
+# are shown inside the group in which they are included (e.g. using \ingroup)
+# instead of on a separate page (for HTML and Man pages) or section (for LaTeX
+# and RTF).
+#
+# Note that this feature does not work in combination with
+# SEPARATE_MEMBER_PAGES.
+# The default value is: NO.
+
+INLINE_GROUPED_CLASSES = NO
+
+# When the INLINE_SIMPLE_STRUCTS tag is set to YES, structs, classes, and unions
+# with only public data fields or simple typedef fields will be shown inline in
+# the documentation of the scope in which they are defined (i.e. file,
+# namespace, or group documentation), provided this scope is documented. If set
+# to NO, structs, classes, and unions are shown on a separate page (for HTML and
+# Man pages) or section (for LaTeX and RTF).
+# The default value is: NO.
+
+INLINE_SIMPLE_STRUCTS  = NO
+
+# When TYPEDEF_HIDES_STRUCT tag is enabled, a typedef of a struct, union, or
+# enum is documented as struct, union, or enum with the name of the typedef. So
+# typedef struct TypeS {} TypeT, will appear in the documentation as a struct
+# with name TypeT. When disabled the typedef will appear as a member of a file,
+# namespace, or class. And the struct will be named TypeS. This can typically be
+# useful for C code in case the coding convention dictates that all compound
+# types are typedef'ed and only the typedef is referenced, never the tag name.
+# The default value is: NO.
+
+TYPEDEF_HIDES_STRUCT   = NO
+
+# The size of the symbol lookup cache can be set using LOOKUP_CACHE_SIZE. This
+# cache is used to resolve symbols given their name and scope. Since this can be
+# an expensive process and often the same symbol appears multiple times in the
+# code, doxygen keeps a cache of pre-resolved symbols. If the cache is too small
+# doxygen will become slower. If the cache is too large, memory is wasted. The
+# cache size is given by this formula: 2^(16+LOOKUP_CACHE_SIZE). The valid range
+# is 0..9, the default is 0, corresponding to a cache size of 2^16=65536
+# symbols. At the end of a run doxygen will report the cache usage and suggest
+# the optimal cache size from a speed point of view.
+# Minimum value: 0, maximum value: 9, default value: 0.
+
+LOOKUP_CACHE_SIZE      = 0
+
+#---------------------------------------------------------------------------
+# Build related configuration options
+#---------------------------------------------------------------------------
+
+# If the EXTRACT_ALL tag is set to YES, doxygen will assume all entities in
+# documentation are documented, even if no documentation was available. Private
+# class members and static file members will be hidden unless the
+# EXTRACT_PRIVATE respectively EXTRACT_STATIC tags are set to YES.
+# Note: This will also disable the warnings about undocumented members that are
+# normally produced when WARNINGS is set to YES.
+# The default value is: NO.
+
+EXTRACT_ALL            = NO
+
+# If the EXTRACT_PRIVATE tag is set to YES, all private members of a class will
+# be included in the documentation.
+# The default value is: NO.
+
+EXTRACT_PRIVATE        = NO
+
+# If the EXTRACT_PACKAGE tag is set to YES, all members with package or internal
+# scope will be included in the documentation.
+# The default value is: NO.
+
+EXTRACT_PACKAGE        = NO
+
+# If the EXTRACT_STATIC tag is set to YES, all static members of a file will be
+# included in the documentation.
+# The default value is: NO.
+
+EXTRACT_STATIC         = NO
+
+# If the EXTRACT_LOCAL_CLASSES tag is set to YES, classes (and structs) defined
+# locally in source files will be included in the documentation. If set to NO,
+# only classes defined in header files are included. Does not have any effect
+# for Java sources.
+# The default value is: YES.
+
+EXTRACT_LOCAL_CLASSES  = YES
+
+# This flag is only useful for Objective-C code. If set to YES, local methods,
+# which are defined in the implementation section but not in the interface are
+# included in the documentation. If set to NO, only methods in the interface are
+# included.
+# The default value is: NO.
+
+EXTRACT_LOCAL_METHODS  = NO
+
+# If this flag is set to YES, the members of anonymous namespaces will be
+# extracted and appear in the documentation as a namespace called
+# 'anonymous_namespace{file}', where file will be replaced with the base name of
+# the file that contains the anonymous namespace. By default anonymous namespace
+# are hidden.
+# The default value is: NO.
+
+EXTRACT_ANON_NSPACES   = NO
+
+# If the HIDE_UNDOC_MEMBERS tag is set to YES, doxygen will hide all
+# undocumented members inside documented classes or files. If set to NO these
+# members will be included in the various overviews, but no documentation
+# section is generated. This option has no effect if EXTRACT_ALL is enabled.
+# The default value is: NO.
+
+HIDE_UNDOC_MEMBERS     = NO
+
+# If the HIDE_UNDOC_CLASSES tag is set to YES, doxygen will hide all
+# undocumented classes that are normally visible in the class hierarchy. If set
+# to NO, these classes will be included in the various overviews. This option
+# has no effect if EXTRACT_ALL is enabled.
+# The default value is: NO.
+
+HIDE_UNDOC_CLASSES     = NO
+
+# If the HIDE_FRIEND_COMPOUNDS tag is set to YES, doxygen will hide all friend
+# (class|struct|union) declarations. If set to NO, these declarations will be
+# included in the documentation.
+# The default value is: NO.
+
+HIDE_FRIEND_COMPOUNDS  = NO
+
+# If the HIDE_IN_BODY_DOCS tag is set to YES, doxygen will hide any
+# documentation blocks found inside the body of a function. If set to NO, these
+# blocks will be appended to the function's detailed documentation block.
+# The default value is: NO.
+
+HIDE_IN_BODY_DOCS      = NO
+
+# The INTERNAL_DOCS tag determines if documentation that is typed after a
+# \internal command is included. If the tag is set to NO then the documentation
+# will be excluded. Set it to YES to include the internal documentation.
+# The default value is: NO.
+
+INTERNAL_DOCS          = NO
+
+# If the CASE_SENSE_NAMES tag is set to NO then doxygen will only generate file
+# names in lower-case letters. If set to YES, upper-case letters are also
+# allowed. This is useful if you have classes or files whose names only differ
+# in case and if your file system supports case sensitive file names. Windows
+# and Mac users are advised to set this option to NO.
+# The default value is: system dependent.
+
+CASE_SENSE_NAMES       = YES
+
+# If the HIDE_SCOPE_NAMES tag is set to NO then doxygen will show members with
+# their full class and namespace scopes in the documentation. If set to YES, the
+# scope will be hidden.
+# The default value is: NO.
+
+HIDE_SCOPE_NAMES       = NO
+
+# If the HIDE_COMPOUND_REFERENCE tag is set to NO (default) then doxygen will
+# append additional text to a page's title, such as Class Reference. If set to
+# YES the compound reference will be hidden.
+# The default value is: NO.
+
+HIDE_COMPOUND_REFERENCE= NO
+
+# If the SHOW_INCLUDE_FILES tag is set to YES then doxygen will put a list of
+# the files that are included by a file in the documentation of that file.
+# The default value is: YES.
+
+SHOW_INCLUDE_FILES     = YES
+
+# If the SHOW_GROUPED_MEMB_INC tag is set to YES then Doxygen will add for each
+# grouped member an include statement to the documentation, telling the reader
+# which file to include in order to use the member.
+# The default value is: NO.
+
+SHOW_GROUPED_MEMB_INC  = NO
+
+# If the FORCE_LOCAL_INCLUDES tag is set to YES then doxygen will list include
+# files with double quotes in the documentation rather than with sharp brackets.
+# The default value is: NO.
+
+FORCE_LOCAL_INCLUDES   = NO
+
+# If the INLINE_INFO tag is set to YES then a tag [inline] is inserted in the
+# documentation for inline members.
+# The default value is: YES.
+
+INLINE_INFO            = YES
+
+# If the SORT_MEMBER_DOCS tag is set to YES then doxygen will sort the
+# (detailed) documentation of file and class members alphabetically by member
+# name. If set to NO, the members will appear in declaration order.
+# The default value is: YES.
+
+SORT_MEMBER_DOCS       = YES
+
+# If the SORT_BRIEF_DOCS tag is set to YES then doxygen will sort the brief
+# descriptions of file, namespace and class members alphabetically by member
+# name. If set to NO, the members will appear in declaration order. Note that
+# this will also influence the order of the classes in the class list.
+# The default value is: NO.
+
+SORT_BRIEF_DOCS        = NO
+
+# If the SORT_MEMBERS_CTORS_1ST tag is set to YES then doxygen will sort the
+# (brief and detailed) documentation of class members so that constructors and
+# destructors are listed first. If set to NO the constructors will appear in the
+# respective orders defined by SORT_BRIEF_DOCS and SORT_MEMBER_DOCS.
+# Note: If SORT_BRIEF_DOCS is set to NO this option is ignored for sorting brief
+# member documentation.
+# Note: If SORT_MEMBER_DOCS is set to NO this option is ignored for sorting
+# detailed member documentation.
+# The default value is: NO.
+
+SORT_MEMBERS_CTORS_1ST = NO
+
+# If the SORT_GROUP_NAMES tag is set to YES then doxygen will sort the hierarchy
+# of group names into alphabetical order. If set to NO the group names will
+# appear in their defined order.
+# The default value is: NO.
+
+SORT_GROUP_NAMES       = NO
+
+# If the SORT_BY_SCOPE_NAME tag is set to YES, the class list will be sorted by
+# fully-qualified names, including namespaces. If set to NO, the class list will
+# be sorted only by class name, not including the namespace part.
+# Note: This option is not very useful if HIDE_SCOPE_NAMES is set to YES.
+# Note: This option applies only to the class list, not to the alphabetical
+# list.
+# The default value is: NO.
+
+SORT_BY_SCOPE_NAME     = NO
+
+# If the STRICT_PROTO_MATCHING option is enabled and doxygen fails to do proper
+# type resolution of all parameters of a function it will reject a match between
+# the prototype and the implementation of a member function even if there is
+# only one candidate or it is obvious which candidate to choose by doing a
+# simple string match. By disabling STRICT_PROTO_MATCHING doxygen will still
+# accept a match between prototype and implementation in such cases.
+# The default value is: NO.
+
+STRICT_PROTO_MATCHING  = NO
+
+# The GENERATE_TODOLIST tag can be used to enable (YES) or disable (NO) the todo
+# list. This list is created by putting \todo commands in the documentation.
+# The default value is: YES.
+
+GENERATE_TODOLIST      = YES
+
+# The GENERATE_TESTLIST tag can be used to enable (YES) or disable (NO) the test
+# list. This list is created by putting \test commands in the documentation.
+# The default value is: YES.
+
+GENERATE_TESTLIST      = YES
+
+# The GENERATE_BUGLIST tag can be used to enable (YES) or disable (NO) the bug
+# list. This list is created by putting \bug commands in the documentation.
+# The default value is: YES.
+
+GENERATE_BUGLIST       = YES
+
+# The GENERATE_DEPRECATEDLIST tag can be used to enable (YES) or disable (NO)
+# the deprecated list. This list is created by putting \deprecated commands in
+# the documentation.
+# The default value is: YES.
+
+GENERATE_DEPRECATEDLIST= YES
+
+# The ENABLED_SECTIONS tag can be used to enable conditional documentation
+# sections, marked by \if <section_label> ... \endif and \cond <section_label>
+# ... \endcond blocks.
+
+ENABLED_SECTIONS       =
+
+# The MAX_INITIALIZER_LINES tag determines the maximum number of lines that the
+# initial value of a variable or macro / define can have for it to appear in the
+# documentation. If the initializer consists of more lines than specified here
+# it will be hidden. Use a value of 0 to hide initializers completely. The
+# appearance of the value of individual variables and macros / defines can be
+# controlled using \showinitializer or \hideinitializer command in the
+# documentation regardless of this setting.
+# Minimum value: 0, maximum value: 10000, default value: 30.
+
+MAX_INITIALIZER_LINES  = 30
+
+# Set the SHOW_USED_FILES tag to NO to disable the list of files generated at
+# the bottom of the documentation of classes and structs. If set to YES, the
+# list will mention the files that were used to generate the documentation.
+# The default value is: YES.
+
+SHOW_USED_FILES        = YES
+
+# Set the SHOW_FILES tag to NO to disable the generation of the Files page. This
+# will remove the Files entry from the Quick Index and from the Folder Tree View
+# (if specified).
+# The default value is: YES.
+
+SHOW_FILES             = YES
+
+# Set the SHOW_NAMESPACES tag to NO to disable the generation of the Namespaces
+# page. This will remove the Namespaces entry from the Quick Index and from the
+# Folder Tree View (if specified).
+# The default value is: YES.
+
+SHOW_NAMESPACES        = YES
+
+# The FILE_VERSION_FILTER tag can be used to specify a program or script that
+# doxygen should invoke to get the current version for each file (typically from
+# the version control system). Doxygen will invoke the program by executing (via
+# popen()) the command command input-file, where command is the value of the
+# FILE_VERSION_FILTER tag, and input-file is the name of an input file provided
+# by doxygen. Whatever the program writes to standard output is used as the file
+# version. For an example see the documentation.
+
+FILE_VERSION_FILTER    =
+
+# The LAYOUT_FILE tag can be used to specify a layout file which will be parsed
+# by doxygen. The layout file controls the global structure of the generated
+# output files in an output format independent way. To create the layout file
+# that represents doxygen's defaults, run doxygen with the -l option. You can
+# optionally specify a file name after the option, if omitted DoxygenLayout.xml
+# will be used as the name of the layout file.
+#
+# Note that if you run doxygen from a directory containing a file called
+# DoxygenLayout.xml, doxygen will parse it automatically even if the LAYOUT_FILE
+# tag is left empty.
+
+LAYOUT_FILE            =
+
+# The CITE_BIB_FILES tag can be used to specify one or more bib files containing
+# the reference definitions. This must be a list of .bib files. The .bib
+# extension is automatically appended if omitted. This requires the bibtex tool
+# to be installed. See also https://en.wikipedia.org/wiki/BibTeX for more info.
+# For LaTeX the style of the bibliography can be controlled using
+# LATEX_BIB_STYLE. To use this feature you need bibtex and perl available in the
+# search path. See also \cite for info how to create references.
+
+CITE_BIB_FILES         =
+
+#---------------------------------------------------------------------------
+# Configuration options related to warning and progress messages
+#---------------------------------------------------------------------------
+
+# The QUIET tag can be used to turn on/off the messages that are generated to
+# standard output by doxygen. If QUIET is set to YES this implies that the
+# messages are off.
+# The default value is: NO.
+
+QUIET                  = NO
+
+# The WARNINGS tag can be used to turn on/off the warning messages that are
+# generated to standard error (stderr) by doxygen. If WARNINGS is set to YES
+# this implies that the warnings are on.
+#
+# Tip: Turn warnings on while writing the documentation.
+# The default value is: YES.
+
+WARNINGS               = YES
+
+# If the WARN_IF_UNDOCUMENTED tag is set to YES then doxygen will generate
+# warnings for undocumented members. If EXTRACT_ALL is set to YES then this flag
+# will automatically be disabled.
+# The default value is: YES.
+
+WARN_IF_UNDOCUMENTED   = YES
+
+# If the WARN_IF_DOC_ERROR tag is set to YES, doxygen will generate warnings for
+# potential errors in the documentation, such as not documenting some parameters
+# in a documented function, or documenting parameters that don't exist or using
+# markup commands wrongly.
+# The default value is: YES.
+
+WARN_IF_DOC_ERROR      = YES
+
+# This WARN_NO_PARAMDOC option can be enabled to get warnings for functions that
+# are documented, but have no documentation for their parameters or return
+# value. If set to NO, doxygen will only warn about wrong or incomplete
+# parameter documentation, but not about the absence of documentation. If
+# EXTRACT_ALL is set to YES then this flag will automatically be disabled.
+# The default value is: NO.
+
+WARN_NO_PARAMDOC       = NO
+
+# If the WARN_AS_ERROR tag is set to YES then doxygen will immediately stop when
+# a warning is encountered.
+# The default value is: NO.
+
+WARN_AS_ERROR          = NO
+
+# The WARN_FORMAT tag determines the format of the warning messages that doxygen
+# can produce. The string should contain the $file, $line, and $text tags, which
+# will be replaced by the file and line number from which the warning originated
+# and the warning text. Optionally the format may contain $version, which will
+# be replaced by the version of the file (if it could be obtained via
+# FILE_VERSION_FILTER)
+# The default value is: $file:$line: $text.
+
+WARN_FORMAT            = "$file:$line: $text"
+
+# The WARN_LOGFILE tag can be used to specify a file to which warning and error
+# messages should be written. If left blank the output is written to standard
+# error (stderr).
+
+WARN_LOGFILE           =
+
+#---------------------------------------------------------------------------
+# Configuration options related to the input files
+#---------------------------------------------------------------------------
+
+# The INPUT tag is used to specify the files and/or directories that contain
+# documented source files. You may enter file names like myfile.cpp or
+# directories like /usr/src/myproject. Separate the files or directories with
+# spaces. See also FILE_PATTERNS and EXTENSION_MAPPING
+# Note: If this tag is empty the current directory is searched.
+
+INPUT                  = ./src \
+                         ./src/docsrc
+
+# This tag can be used to specify the character encoding of the source files
+# that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses
+# libiconv (or the iconv built into libc) for the transcoding. See the libiconv
+# documentation (see: https://www.gnu.org/software/libiconv/) for the list of
+# possible encodings.
+# The default value is: UTF-8.
+
+INPUT_ENCODING         = UTF-8
+
+# If the value of the INPUT tag contains directories, you can use the
+# FILE_PATTERNS tag to specify one or more wildcard patterns (like *.cpp and
+# *.h) to filter out the source-files in the directories.
+#
+# Note that for custom extensions or not directly supported extensions you also
+# need to set EXTENSION_MAPPING for the extension otherwise the files are not
+# read by doxygen.
+#
+# If left blank the following patterns are tested:*.c, *.cc, *.cxx, *.cpp,
+# *.c++, *.java, *.ii, *.ixx, *.ipp, *.i++, *.inl, *.idl, *.ddl, *.odl, *.h,
+# *.hh, *.hxx, *.hpp, *.h++, *.cs, *.d, *.php, *.php4, *.php5, *.phtml, *.inc,
+# *.m, *.markdown, *.md, *.mm, *.dox, *.py, *.pyw, *.f90, *.f95, *.f03, *.f08,
+# *.f, *.for, *.tcl, *.vhd, *.vhdl, *.ucf, *.qsf and *.ice.
+
+FILE_PATTERNS          = *.f90 \
+                         *.F90 \
+                         *.md \
+                         *.dox
+
+# The RECURSIVE tag can be used to specify whether or not subdirectories should
+# be searched for input files as well.
+# The default value is: NO.
+
+RECURSIVE              = NO
+
+# The EXCLUDE tag can be used to specify files and/or directories that should be
+# excluded from the INPUT source files. This way you can easily exclude a
+# subdirectory from a directory tree whose root is specified with the INPUT tag.
+#
+# Note that relative paths are relative to the directory from which doxygen is
+# run.
+
+EXCLUDE                =
+
+# The EXCLUDE_SYMLINKS tag can be used to select whether or not files or
+# directories that are symbolic links (a Unix file system feature) are excluded
+# from the input.
+# The default value is: NO.
+
+EXCLUDE_SYMLINKS       = NO
+
+# If the value of the INPUT tag contains directories, you can use the
+# EXCLUDE_PATTERNS tag to specify one or more wildcard patterns to exclude
+# certain files from those directories.
+#
+# Note that the wildcards are matched against the file with absolute path, so to
+# exclude all test directories for example use the pattern */test/*
+
+EXCLUDE_PATTERNS       =
+
+# The EXCLUDE_SYMBOLS tag can be used to specify one or more symbol names
+# (namespaces, classes, functions, etc.) that should be excluded from the
+# output. The symbol name can be a fully qualified name, a word, or if the
+# wildcard * is used, a substring. Examples: ANamespace, AClass,
+# AClass::ANamespace, ANamespace::*Test
+#
+# Note that the wildcards are matched against the file with absolute path, so to
+# exclude all test directories use the pattern */test/*
+
+EXCLUDE_SYMBOLS        =
+
+# The EXAMPLE_PATH tag can be used to specify one or more files or directories
+# that contain example code fragments that are included (see the \include
+# command).
+
+EXAMPLE_PATH           = ./src/docsrc/include/ \
+                         ./src/docsrc/include/namlog \
+                         ./src/docsrc/include/namcfg \
+                         ./src/docsrc/include/namsrc \
+                         ./src/docsrc/include/namtgt \
+                         ./src/docsrc/include/namvar \
+                         ./src/docsrc/include/namnst \
+                         ./src/docsrc/include/namout
+
+# If the value of the EXAMPLE_PATH tag contains directories, you can use the
+# EXAMPLE_PATTERNS tag to specify one or more wildcard pattern (like *.cpp and
+# *.h) to filter out the source-files in the directories. If left blank all
+# files are included.
+
+EXAMPLE_PATTERNS       =
+
+# If the EXAMPLE_RECURSIVE tag is set to YES then subdirectories will be
+# searched for input files to be used with the \include or \dontinclude commands
+# irrespective of the value of the RECURSIVE tag.
+# The default value is: NO.
+
+EXAMPLE_RECURSIVE      = NO
+
+# The IMAGE_PATH tag can be used to specify one or more files or directories
+# that contain images that are to be included in the documentation (see the
+# \image command).
+
+IMAGE_PATH             = ./src/docsrc/Image
+
+# The INPUT_FILTER tag can be used to specify a program that doxygen should
+# invoke to filter for each input file. Doxygen will invoke the filter program
+# by executing (via popen()) the command:
+#
+# <filter> <input-file>
+#
+# where <filter> is the value of the INPUT_FILTER tag, and <input-file> is the
+# name of an input file. Doxygen will then use the output that the filter
+# program writes to standard output. If FILTER_PATTERNS is specified, this tag
+# will be ignored.
+#
+# Note that the filter must not add or remove lines; it is applied before the
+# code is scanned, but not when the output code is generated. If lines are added
+# or removed, the anchors will not be placed correctly.
+#
+# Note that for custom extensions or not directly supported extensions you also
+# need to set EXTENSION_MAPPING for the extension otherwise the files are not
+# properly processed by doxygen.
+
+INPUT_FILTER           =
+
+# The FILTER_PATTERNS tag can be used to specify filters on a per file pattern
+# basis. Doxygen will compare the file name with each pattern and apply the
+# filter if there is a match. The filters are a list of the form: pattern=filter
+# (like *.cpp=my_cpp_filter). See INPUT_FILTER for further information on how
+# filters are used. If the FILTER_PATTERNS tag is empty or if none of the
+# patterns match the file name, INPUT_FILTER is applied.
+#
+# Note that for custom extensions or not directly supported extensions you also
+# need to set EXTENSION_MAPPING for the extension otherwise the files are not
+# properly processed by doxygen.
+
+FILTER_PATTERNS        =
+
+# If the FILTER_SOURCE_FILES tag is set to YES, the input filter (if set using
+# INPUT_FILTER) will also be used to filter the input files that are used for
+# producing the source files to browse (i.e. when SOURCE_BROWSER is set to YES).
+# The default value is: NO.
+
+FILTER_SOURCE_FILES    = NO
+
+# The FILTER_SOURCE_PATTERNS tag can be used to specify source filters per file
+# pattern. A pattern will override the setting for FILTER_PATTERN (if any) and
+# it is also possible to disable source filtering for a specific pattern using
+# *.ext= (so without naming a filter).
+# This tag requires that the tag FILTER_SOURCE_FILES is set to YES.
+
+FILTER_SOURCE_PATTERNS =
+
+# If the USE_MDFILE_AS_MAINPAGE tag refers to the name of a markdown file that
+# is part of the input, its contents will be placed on the main page
+# (index.html). This can be useful if you have a project on for instance GitHub
+# and want to reuse the introduction page also for the doxygen output.
+
+USE_MDFILE_AS_MAINPAGE =
+
+#---------------------------------------------------------------------------
+# Configuration options related to source browsing
+#---------------------------------------------------------------------------
+
+# If the SOURCE_BROWSER tag is set to YES then a list of source files will be
+# generated. Documented entities will be cross-referenced with these sources.
+#
+# Note: To get rid of all source code in the generated output, make sure that
+# also VERBATIM_HEADERS is set to NO.
+# The default value is: NO.
+
+SOURCE_BROWSER         = NO
+
+# Setting the INLINE_SOURCES tag to YES will include the body of functions,
+# classes and enums directly into the documentation.
+# The default value is: NO.
+
+INLINE_SOURCES         = NO
+
+# Setting the STRIP_CODE_COMMENTS tag to YES will instruct doxygen to hide any
+# special comment blocks from generated source code fragments. Normal C, C++ and
+# Fortran comments will always remain visible.
+# The default value is: YES.
+
+STRIP_CODE_COMMENTS    = YES
+
+# If the REFERENCED_BY_RELATION tag is set to YES then for each documented
+# entity all documented functions referencing it will be listed.
+# The default value is: NO.
+
+REFERENCED_BY_RELATION = NO
+
+# If the REFERENCES_RELATION tag is set to YES then for each documented function
+# all documented entities called/used by that function will be listed.
+# The default value is: NO.
+
+REFERENCES_RELATION    = NO
+
+# If the REFERENCES_LINK_SOURCE tag is set to YES and SOURCE_BROWSER tag is set
+# to YES then the hyperlinks from functions in REFERENCES_RELATION and
+# REFERENCED_BY_RELATION lists will link to the source code. Otherwise they will
+# link to the documentation.
+# The default value is: YES.
+
+REFERENCES_LINK_SOURCE = YES
+
+# If SOURCE_TOOLTIPS is enabled (the default) then hovering a hyperlink in the
+# source code will show a tooltip with additional information such as prototype,
+# brief description and links to the definition and documentation. Since this
+# will make the HTML file larger and loading of large files a bit slower, you
+# can opt to disable this feature.
+# The default value is: YES.
+# This tag requires that the tag SOURCE_BROWSER is set to YES.
+
+SOURCE_TOOLTIPS        = YES
+
+# If the USE_HTAGS tag is set to YES then the references to source code will
+# point to the HTML generated by the htags(1) tool instead of doxygen built-in
+# source browser. The htags tool is part of GNU's global source tagging system
+# (see https://www.gnu.org/software/global/global.html). You will need version
+# 4.8.6 or higher.
+#
+# To use it do the following:
+# - Install the latest version of global
+# - Enable SOURCE_BROWSER and USE_HTAGS in the configuration file
+# - Make sure the INPUT points to the root of the source tree
+# - Run doxygen as normal
+#
+# Doxygen will invoke htags (and that will in turn invoke gtags), so these
+# tools must be available from the command line (i.e. in the search path).
+#
+# The result: instead of the source browser generated by doxygen, the links to
+# source code will now point to the output of htags.
+# The default value is: NO.
+# This tag requires that the tag SOURCE_BROWSER is set to YES.
+
+USE_HTAGS              = NO
+
+# If the VERBATIM_HEADERS tag is set the YES then doxygen will generate a
+# verbatim copy of the header file for each class for which an include is
+# specified. Set to NO to disable this.
+# See also: Section \class.
+# The default value is: YES.
+
+VERBATIM_HEADERS       = YES
+
+#---------------------------------------------------------------------------
+# Configuration options related to the alphabetical class index
+#---------------------------------------------------------------------------
+
+# If the ALPHABETICAL_INDEX tag is set to YES, an alphabetical index of all
+# compounds will be generated. Enable this if the project contains a lot of
+# classes, structs, unions or interfaces.
+# The default value is: YES.
+
+ALPHABETICAL_INDEX     = NO
+
+# The COLS_IN_ALPHA_INDEX tag can be used to specify the number of columns in
+# which the alphabetical index list will be split.
+# Minimum value: 1, maximum value: 20, default value: 5.
+# This tag requires that the tag ALPHABETICAL_INDEX is set to YES.
+
+COLS_IN_ALPHA_INDEX    = 5
+
+# In case all classes in a project start with a common prefix, all classes will
+# be put under the same header in the alphabetical index. The IGNORE_PREFIX tag
+# can be used to specify a prefix (or a list of prefixes) that should be ignored
+# while generating the index headers.
+# This tag requires that the tag ALPHABETICAL_INDEX is set to YES.
+
+IGNORE_PREFIX          =
+
+#---------------------------------------------------------------------------
+# Configuration options related to the HTML output
+#---------------------------------------------------------------------------
+
+# If the GENERATE_HTML tag is set to YES, doxygen will generate HTML output
+# The default value is: YES.
+
+GENERATE_HTML          = YES
+
+# The HTML_OUTPUT tag is used to specify where the HTML docs will be put. If a
+# relative path is entered the value of OUTPUT_DIRECTORY will be put in front of
+# it.
+# The default directory is: html.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_OUTPUT            = html
+
+# The HTML_FILE_EXTENSION tag can be used to specify the file extension for each
+# generated HTML page (for example: .htm, .php, .asp).
+# The default value is: .html.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_FILE_EXTENSION    = .html
+
+# The HTML_HEADER tag can be used to specify a user-defined HTML header file for
+# each generated HTML page. If the tag is left blank doxygen will generate a
+# standard header.
+#
+# To get valid HTML the header file that includes any scripts and style sheets
+# that doxygen needs, which is dependent on the configuration options used (e.g.
+# the setting GENERATE_TREEVIEW). It is highly recommended to start with a
+# default header using
+# doxygen -w html new_header.html new_footer.html new_stylesheet.css
+# YourConfigFile
+# and then modify the file new_header.html. See also section "Doxygen usage"
+# for information on how to generate the default header that doxygen normally
+# uses.
+# Note: The header is subject to change so you typically have to regenerate the
+# default header when upgrading to a newer version of doxygen. For a description
+# of the possible markers and block names see the documentation.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_HEADER            =
+
+# The HTML_FOOTER tag can be used to specify a user-defined HTML footer for each
+# generated HTML page. If the tag is left blank doxygen will generate a standard
+# footer. See HTML_HEADER for more information on how to generate a default
+# footer and what special commands can be used inside the footer. See also
+# section "Doxygen usage" for information on how to generate the default footer
+# that doxygen normally uses.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_FOOTER            =
+
+# The HTML_STYLESHEET tag can be used to specify a user-defined cascading style
+# sheet that is used by each HTML page. It can be used to fine-tune the look of
+# the HTML output. If left blank doxygen will generate a default style sheet.
+# See also section "Doxygen usage" for information on how to generate the style
+# sheet that doxygen normally uses.
+# Note: It is recommended to use HTML_EXTRA_STYLESHEET instead of this tag, as
+# it is more robust and this tag (HTML_STYLESHEET) will in the future become
+# obsolete.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_STYLESHEET        =
+
+# The HTML_EXTRA_STYLESHEET tag can be used to specify additional user-defined
+# cascading style sheets that are included after the standard style sheets
+# created by doxygen. Using this option one can overrule certain style aspects.
+# This is preferred over using HTML_STYLESHEET since it does not replace the
+# standard style sheet and is therefore more robust against future updates.
+# Doxygen will copy the style sheet files to the output directory.
+# Note: The order of the extra style sheet files is of importance (e.g. the last
+# style sheet in the list overrules the setting of the previous ones in the
+# list). For an example see the documentation.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_EXTRA_STYLESHEET  =
+
+# The HTML_EXTRA_FILES tag can be used to specify one or more extra images or
+# other source files which should be copied to the HTML output directory. Note
+# that these files will be copied to the base HTML output directory. Use the
+# $relpath^ marker in the HTML_HEADER and/or HTML_FOOTER files to load these
+# files. In the HTML_STYLESHEET file, use the file name only. Also note that the
+# files will be copied as-is; there are no commands or markers available.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_EXTRA_FILES       =
+
+# The HTML_COLORSTYLE_HUE tag controls the color of the HTML output. Doxygen
+# will adjust the colors in the style sheet and background images according to
+# this color. Hue is specified as an angle on a colorwheel, see
+# https://en.wikipedia.org/wiki/Hue for more information. For instance the value
+# 0 represents red, 60 is yellow, 120 is green, 180 is cyan, 240 is blue, 300
+# purple, and 360 is red again.
+# Minimum value: 0, maximum value: 359, default value: 220.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_COLORSTYLE_HUE    = 220
+
+# The HTML_COLORSTYLE_SAT tag controls the purity (or saturation) of the colors
+# in the HTML output. For a value of 0 the output will use grayscales only. A
+# value of 255 will produce the most vivid colors.
+# Minimum value: 0, maximum value: 255, default value: 100.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_COLORSTYLE_SAT    = 100
+
+# The HTML_COLORSTYLE_GAMMA tag controls the gamma correction applied to the
+# luminance component of the colors in the HTML output. Values below 100
+# gradually make the output lighter, whereas values above 100 make the output
+# darker. The value divided by 100 is the actual gamma applied, so 80 represents
+# a gamma of 0.8, The value 220 represents a gamma of 2.2, and 100 does not
+# change the gamma.
+# Minimum value: 40, maximum value: 240, default value: 80.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_COLORSTYLE_GAMMA  = 80
+
+# If the HTML_TIMESTAMP tag is set to YES then the footer of each generated HTML
+# page will contain the date and time when the page was generated. Setting this
+# to YES can help to show when doxygen was last run and thus if the
+# documentation is up to date.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_TIMESTAMP         = YES
+
+# If the HTML_DYNAMIC_MENUS tag is set to YES then the generated HTML
+# documentation will contain a main index with vertical navigation menus that
+# are dynamically created via Javascript. If disabled, the navigation index will
+# consists of multiple levels of tabs that are statically embedded in every HTML
+# page. Disable this option to support browsers that do not have Javascript,
+# like the Qt help browser.
+# The default value is: YES.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_DYNAMIC_MENUS     = YES
+
+# If the HTML_DYNAMIC_SECTIONS tag is set to YES then the generated HTML
+# documentation will contain sections that can be hidden and shown after the
+# page has loaded.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_DYNAMIC_SECTIONS  = NO
+
+# With HTML_INDEX_NUM_ENTRIES one can control the preferred number of entries
+# shown in the various tree structured indices initially; the user can expand
+# and collapse entries dynamically later on. Doxygen will expand the tree to
+# such a level that at most the specified number of entries are visible (unless
+# a fully collapsed tree already exceeds this amount). So setting the number of
+# entries 1 will produce a full collapsed tree by default. 0 is a special value
+# representing an infinite number of entries and will result in a full expanded
+# tree by default.
+# Minimum value: 0, maximum value: 9999, default value: 100.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+HTML_INDEX_NUM_ENTRIES = 100
+
+# If the GENERATE_DOCSET tag is set to YES, additional index files will be
+# generated that can be used as input for Apple's Xcode 3 integrated development
+# environment (see: https://developer.apple.com/xcode/), introduced with OSX
+# 10.5 (Leopard). To create a documentation set, doxygen will generate a
+# Makefile in the HTML output directory. Running make will produce the docset in
+# that directory and running make install will install the docset in
+# ~/Library/Developer/Shared/Documentation/DocSets so that Xcode will find it at
+# startup. See https://developer.apple.com/library/archive/featuredarticles/Doxy
+# genXcode/_index.html for more information.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+GENERATE_DOCSET        = NO
+
+# This tag determines the name of the docset feed. A documentation feed provides
+# an umbrella under which multiple documentation sets from a single provider
+# (such as a company or product suite) can be grouped.
+# The default value is: Doxygen generated docs.
+# This tag requires that the tag GENERATE_DOCSET is set to YES.
+
+DOCSET_FEEDNAME        = "Doxygen generated docs"
+
+# This tag specifies a string that should uniquely identify the documentation
+# set bundle. This should be a reverse domain-name style string, e.g.
+# com.mycompany.MyDocSet. Doxygen will append .docset to the name.
+# The default value is: org.doxygen.Project.
+# This tag requires that the tag GENERATE_DOCSET is set to YES.
+
+DOCSET_BUNDLE_ID       = org.doxygen.Project
+
+# The DOCSET_PUBLISHER_ID tag specifies a string that should uniquely identify
+# the documentation publisher. This should be a reverse domain-name style
+# string, e.g. com.mycompany.MyDocSet.documentation.
+# The default value is: org.doxygen.Publisher.
+# This tag requires that the tag GENERATE_DOCSET is set to YES.
+
+DOCSET_PUBLISHER_ID    = org.doxygen.Publisher
+
+# The DOCSET_PUBLISHER_NAME tag identifies the documentation publisher.
+# The default value is: Publisher.
+# This tag requires that the tag GENERATE_DOCSET is set to YES.
+
+DOCSET_PUBLISHER_NAME  = Publisher
+
+# If the GENERATE_HTMLHELP tag is set to YES then doxygen generates three
+# additional HTML index files: index.hhp, index.hhc, and index.hhk. The
+# index.hhp is a project file that can be read by Microsoft's HTML Help Workshop
+# (see: https://www.microsoft.com/en-us/download/details.aspx?id=21138) on
+# Windows.
+#
+# The HTML Help Workshop contains a compiler that can convert all HTML output
+# generated by doxygen into a single compiled HTML file (.chm). Compiled HTML
+# files are now used as the Windows 98 help format, and will replace the old
+# Windows help format (.hlp) on all Windows platforms in the future. Compressed
+# HTML files also contain an index, a table of contents, and you can search for
+# words in the documentation. The HTML workshop also contains a viewer for
+# compressed HTML files.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+GENERATE_HTMLHELP      = NO
+
+# The CHM_FILE tag can be used to specify the file name of the resulting .chm
+# file. You can add a path in front of the file if the result should not be
+# written to the html output directory.
+# This tag requires that the tag GENERATE_HTMLHELP is set to YES.
+
+CHM_FILE               =
+
+# The HHC_LOCATION tag can be used to specify the location (absolute path
+# including file name) of the HTML help compiler (hhc.exe). If non-empty,
+# doxygen will try to run the HTML help compiler on the generated index.hhp.
+# The file has to be specified with full path.
+# This tag requires that the tag GENERATE_HTMLHELP is set to YES.
+
+HHC_LOCATION           =
+
+# The GENERATE_CHI flag controls if a separate .chi index file is generated
+# (YES) or that it should be included in the master .chm file (NO).
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTMLHELP is set to YES.
+
+GENERATE_CHI           = NO
+
+# The CHM_INDEX_ENCODING is used to encode HtmlHelp index (hhk), content (hhc)
+# and project file content.
+# This tag requires that the tag GENERATE_HTMLHELP is set to YES.
+
+CHM_INDEX_ENCODING     =
+
+# The BINARY_TOC flag controls whether a binary table of contents is generated
+# (YES) or a normal table of contents (NO) in the .chm file. Furthermore it
+# enables the Previous and Next buttons.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTMLHELP is set to YES.
+
+BINARY_TOC             = NO
+
+# The TOC_EXPAND flag can be set to YES to add extra items for group members to
+# the table of contents of the HTML help documentation and to the tree view.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTMLHELP is set to YES.
+
+TOC_EXPAND             = NO
+
+# If the GENERATE_QHP tag is set to YES and both QHP_NAMESPACE and
+# QHP_VIRTUAL_FOLDER are set, an additional index file will be generated that
+# can be used as input for Qt's qhelpgenerator to generate a Qt Compressed Help
+# (.qch) of the generated HTML documentation.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+GENERATE_QHP           = NO
+
+# If the QHG_LOCATION tag is specified, the QCH_FILE tag can be used to specify
+# the file name of the resulting .qch file. The path specified is relative to
+# the HTML output folder.
+# This tag requires that the tag GENERATE_QHP is set to YES.
+
+QCH_FILE               =
+
+# The QHP_NAMESPACE tag specifies the namespace to use when generating Qt Help
+# Project output. For more information please see Qt Help Project / Namespace
+# (see: http://doc.qt.io/archives/qt-4.8/qthelpproject.html#namespace).
+# The default value is: org.doxygen.Project.
+# This tag requires that the tag GENERATE_QHP is set to YES.
+
+QHP_NAMESPACE          = org.doxygen.Project
+
+# The QHP_VIRTUAL_FOLDER tag specifies the namespace to use when generating Qt
+# Help Project output. For more information please see Qt Help Project / Virtual
+# Folders (see: http://doc.qt.io/archives/qt-4.8/qthelpproject.html#virtual-
+# folders).
+# The default value is: doc.
+# This tag requires that the tag GENERATE_QHP is set to YES.
+
+QHP_VIRTUAL_FOLDER     = doc
+
+# If the QHP_CUST_FILTER_NAME tag is set, it specifies the name of a custom
+# filter to add. For more information please see Qt Help Project / Custom
+# Filters (see: http://doc.qt.io/archives/qt-4.8/qthelpproject.html#custom-
+# filters).
+# This tag requires that the tag GENERATE_QHP is set to YES.
+
+QHP_CUST_FILTER_NAME   =
+
+# The QHP_CUST_FILTER_ATTRS tag specifies the list of the attributes of the
+# custom filter to add. For more information please see Qt Help Project / Custom
+# Filters (see: http://doc.qt.io/archives/qt-4.8/qthelpproject.html#custom-
+# filters).
+# This tag requires that the tag GENERATE_QHP is set to YES.
+
+QHP_CUST_FILTER_ATTRS  =
+
+# The QHP_SECT_FILTER_ATTRS tag specifies the list of the attributes this
+# project's filter section matches. Qt Help Project / Filter Attributes (see:
+# http://doc.qt.io/archives/qt-4.8/qthelpproject.html#filter-attributes).
+# This tag requires that the tag GENERATE_QHP is set to YES.
+
+QHP_SECT_FILTER_ATTRS  =
+
+# The QHG_LOCATION tag can be used to specify the location of Qt's
+# qhelpgenerator. If non-empty doxygen will try to run qhelpgenerator on the
+# generated .qhp file.
+# This tag requires that the tag GENERATE_QHP is set to YES.
+
+QHG_LOCATION           =
+
+# If the GENERATE_ECLIPSEHELP tag is set to YES, additional index files will be
+# generated, together with the HTML files, they form an Eclipse help plugin. To
+# install this plugin and make it available under the help contents menu in
+# Eclipse, the contents of the directory containing the HTML and XML files needs
+# to be copied into the plugins directory of eclipse. The name of the directory
+# within the plugins directory should be the same as the ECLIPSE_DOC_ID value.
+# After copying Eclipse needs to be restarted before the help appears.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+GENERATE_ECLIPSEHELP   = NO
+
+# A unique identifier for the Eclipse help plugin. When installing the plugin
+# the directory name containing the HTML and XML files should also have this
+# name. Each documentation set should have its own identifier.
+# The default value is: org.doxygen.Project.
+# This tag requires that the tag GENERATE_ECLIPSEHELP is set to YES.
+
+ECLIPSE_DOC_ID         = org.doxygen.Project
+
+# If you want full control over the layout of the generated HTML pages it might
+# be necessary to disable the index and replace it with your own. The
+# DISABLE_INDEX tag can be used to turn on/off the condensed index (tabs) at top
+# of each HTML page. A value of NO enables the index and the value YES disables
+# it. Since the tabs in the index contain the same information as the navigation
+# tree, you can set this option to YES if you also set GENERATE_TREEVIEW to YES.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+DISABLE_INDEX          = NO
+
+# The GENERATE_TREEVIEW tag is used to specify whether a tree-like index
+# structure should be generated to display hierarchical information. If the tag
+# value is set to YES, a side panel will be generated containing a tree-like
+# index structure (just like the one that is generated for HTML Help). For this
+# to work a browser that supports JavaScript, DHTML, CSS and frames is required
+# (i.e. any modern browser). Windows users are probably better off using the
+# HTML help feature. Via custom style sheets (see HTML_EXTRA_STYLESHEET) one can
+# further fine-tune the look of the index. As an example, the default style
+# sheet generated by doxygen has an example that shows how to put an image at
+# the root of the tree instead of the PROJECT_NAME. Since the tree basically has
+# the same information as the tab index, you could consider setting
+# DISABLE_INDEX to YES when enabling this option.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+GENERATE_TREEVIEW      = NO
+
+# The ENUM_VALUES_PER_LINE tag can be used to set the number of enum values that
+# doxygen will group on one line in the generated HTML documentation.
+#
+# Note that a value of 0 will completely suppress the enum values from appearing
+# in the overview section.
+# Minimum value: 0, maximum value: 20, default value: 4.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+ENUM_VALUES_PER_LINE   = 4
+
+# If the treeview is enabled (see GENERATE_TREEVIEW) then this tag can be used
+# to set the initial width (in pixels) of the frame in which the tree is shown.
+# Minimum value: 0, maximum value: 1500, default value: 250.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+TREEVIEW_WIDTH         = 250
+
+# If the EXT_LINKS_IN_WINDOW option is set to YES, doxygen will open links to
+# external symbols imported via tag files in a separate window.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+EXT_LINKS_IN_WINDOW    = NO
+
+# Use this tag to change the font size of LaTeX formulas included as images in
+# the HTML documentation. When you change the font size after a successful
+# doxygen run you need to manually remove any form_*.png images from the HTML
+# output directory to force them to be regenerated.
+# Minimum value: 8, maximum value: 50, default value: 10.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+FORMULA_FONTSIZE       = 10
+
+# Use the FORMULA_TRANSPARENT tag to determine whether or not the images
+# generated for formulas are transparent PNGs. Transparent PNGs are not
+# supported properly for IE 6.0, but are supported on all modern browsers.
+#
+# Note that when changing this option you need to delete any form_*.png files in
+# the HTML output directory before the changes have effect.
+# The default value is: YES.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+FORMULA_TRANSPARENT    = YES
+
+# Enable the USE_MATHJAX option to render LaTeX formulas using MathJax (see
+# https://www.mathjax.org) which uses client side Javascript for the rendering
+# instead of using pre-rendered bitmaps. Use this if you do not have LaTeX
+# installed or if you want to formulas look prettier in the HTML output. When
+# enabled you may also need to install MathJax separately and configure the path
+# to it using the MATHJAX_RELPATH option.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+USE_MATHJAX            = NO
+
+# When MathJax is enabled you can set the default output format to be used for
+# the MathJax output. See the MathJax site (see:
+# http://docs.mathjax.org/en/latest/output.html) for more details.
+# Possible values are: HTML-CSS (which is slower, but has the best
+# compatibility), NativeMML (i.e. MathML) and SVG.
+# The default value is: HTML-CSS.
+# This tag requires that the tag USE_MATHJAX is set to YES.
+
+MATHJAX_FORMAT         = HTML-CSS
+
+# When MathJax is enabled you need to specify the location relative to the HTML
+# output directory using the MATHJAX_RELPATH option. The destination directory
+# should contain the MathJax.js script. For instance, if the mathjax directory
+# is located at the same level as the HTML output directory, then
+# MATHJAX_RELPATH should be ../mathjax. The default value points to the MathJax
+# Content Delivery Network so you can quickly see the result without installing
+# MathJax. However, it is strongly recommended to install a local copy of
+# MathJax from https://www.mathjax.org before deployment.
+# The default value is: https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/.
+# This tag requires that the tag USE_MATHJAX is set to YES.
+
+MATHJAX_RELPATH        = http://cdn.mathjax.org/mathjax/latest
+
+# The MATHJAX_EXTENSIONS tag can be used to specify one or more MathJax
+# extension names that should be enabled during MathJax rendering. For example
+# MATHJAX_EXTENSIONS = TeX/AMSmath TeX/AMSsymbols
+# This tag requires that the tag USE_MATHJAX is set to YES.
+
+MATHJAX_EXTENSIONS     =
+
+# The MATHJAX_CODEFILE tag can be used to specify a file with javascript pieces
+# of code that will be used on startup of the MathJax code. See the MathJax site
+# (see: http://docs.mathjax.org/en/latest/output.html) for more details. For an
+# example see the documentation.
+# This tag requires that the tag USE_MATHJAX is set to YES.
+
+MATHJAX_CODEFILE       =
+
+# When the SEARCHENGINE tag is enabled doxygen will generate a search box for
+# the HTML output. The underlying search engine uses javascript and DHTML and
+# should work on any modern browser. Note that when using HTML help
+# (GENERATE_HTMLHELP), Qt help (GENERATE_QHP), or docsets (GENERATE_DOCSET)
+# there is already a search function so this one should typically be disabled.
+# For large projects the javascript based search engine can be slow, then
+# enabling SERVER_BASED_SEARCH may provide a better solution. It is possible to
+# search using the keyboard; to jump to the search box use <access key> + S
+# (what the <access key> is depends on the OS and browser, but it is typically
+# <CTRL>, <ALT>/<option>, or both). Inside the search box use the <cursor down
+# key> to jump into the search results window, the results can be navigated
+# using the <cursor keys>. Press <Enter> to select an item or <escape> to cancel
+# the search. The filter options can be selected when the cursor is inside the
+# search box by pressing <Shift>+<cursor down>. Also here use the <cursor keys>
+# to select a filter and <Enter> or <escape> to activate or cancel the filter
+# option.
+# The default value is: YES.
+# This tag requires that the tag GENERATE_HTML is set to YES.
+
+SEARCHENGINE           = YES
+
+# When the SERVER_BASED_SEARCH tag is enabled the search engine will be
+# implemented using a web server instead of a web client using Javascript. There
+# are two flavors of web server based searching depending on the EXTERNAL_SEARCH
+# setting. When disabled, doxygen will generate a PHP script for searching and
+# an index file used by the script. When EXTERNAL_SEARCH is enabled the indexing
+# and searching needs to be provided by external tools. See the section
+# "External Indexing and Searching" for details.
+# The default value is: NO.
+# This tag requires that the tag SEARCHENGINE is set to YES.
+
+SERVER_BASED_SEARCH    = NO
+
+# When EXTERNAL_SEARCH tag is enabled doxygen will no longer generate the PHP
+# script for searching. Instead the search results are written to an XML file
+# which needs to be processed by an external indexer. Doxygen will invoke an
+# external search engine pointed to by the SEARCHENGINE_URL option to obtain the
+# search results.
+#
+# Doxygen ships with an example indexer (doxyindexer) and search engine
+# (doxysearch.cgi) which are based on the open source search engine library
+# Xapian (see: https://xapian.org/).
+#
+# See the section "External Indexing and Searching" for details.
+# The default value is: NO.
+# This tag requires that the tag SEARCHENGINE is set to YES.
+
+EXTERNAL_SEARCH        = NO
+
+# The SEARCHENGINE_URL should point to a search engine hosted by a web server
+# which will return the search results when EXTERNAL_SEARCH is enabled.
+#
+# Doxygen ships with an example indexer (doxyindexer) and search engine
+# (doxysearch.cgi) which are based on the open source search engine library
+# Xapian (see: https://xapian.org/). See the section "External Indexing and
+# Searching" for details.
+# This tag requires that the tag SEARCHENGINE is set to YES.
+
+SEARCHENGINE_URL       =
+
+# When SERVER_BASED_SEARCH and EXTERNAL_SEARCH are both enabled the unindexed
+# search data is written to a file for indexing by an external tool. With the
+# SEARCHDATA_FILE tag the name of this file can be specified.
+# The default file is: searchdata.xml.
+# This tag requires that the tag SEARCHENGINE is set to YES.
+
+SEARCHDATA_FILE        = searchdata.xml
+
+# When SERVER_BASED_SEARCH and EXTERNAL_SEARCH are both enabled the
+# EXTERNAL_SEARCH_ID tag can be used as an identifier for the project. This is
+# useful in combination with EXTRA_SEARCH_MAPPINGS to search through multiple
+# projects and redirect the results back to the right project.
+# This tag requires that the tag SEARCHENGINE is set to YES.
+
+EXTERNAL_SEARCH_ID     =
+
+# The EXTRA_SEARCH_MAPPINGS tag can be used to enable searching through doxygen
+# projects other than the one defined by this configuration file, but that are
+# all added to the same external search index. Each project needs to have a
+# unique id set via EXTERNAL_SEARCH_ID. The search mapping then maps the id of
+# to a relative location where the documentation can be found. The format is:
+# EXTRA_SEARCH_MAPPINGS = tagname1=loc1 tagname2=loc2 ...
+# This tag requires that the tag SEARCHENGINE is set to YES.
+
+EXTRA_SEARCH_MAPPINGS  =
+
+#---------------------------------------------------------------------------
+# Configuration options related to the LaTeX output
+#---------------------------------------------------------------------------
+
+# If the GENERATE_LATEX tag is set to YES, doxygen will generate LaTeX output.
+# The default value is: YES.
+
+GENERATE_LATEX         = YES
+
+# The LATEX_OUTPUT tag is used to specify where the LaTeX docs will be put. If a
+# relative path is entered the value of OUTPUT_DIRECTORY will be put in front of
+# it.
+# The default directory is: latex.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+LATEX_OUTPUT           = latex
+
+# The LATEX_CMD_NAME tag can be used to specify the LaTeX command name to be
+# invoked.
+#
+# Note that when not enabling USE_PDFLATEX the default is latex when enabling
+# USE_PDFLATEX the default is pdflatex and when in the later case latex is
+# chosen this is overwritten by pdflatex. For specific output languages the
+# default can have been set differently, this depends on the implementation of
+# the output language.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+LATEX_CMD_NAME         = latex
+
+# The MAKEINDEX_CMD_NAME tag can be used to specify the command name to generate
+# index for LaTeX.
+# Note: This tag is used in the Makefile / make.bat.
+# See also: LATEX_MAKEINDEX_CMD for the part in the generated output file
+# (.tex).
+# The default file is: makeindex.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+MAKEINDEX_CMD_NAME     = makeindex
+
+# The LATEX_MAKEINDEX_CMD tag can be used to specify the command name to
+# generate index for LaTeX.
+# Note: This tag is used in the generated output file (.tex).
+# See also: MAKEINDEX_CMD_NAME for the part in the Makefile / make.bat.
+# The default value is: \makeindex.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+LATEX_MAKEINDEX_CMD    = \makeindex
+
+# If the COMPACT_LATEX tag is set to YES, doxygen generates more compact LaTeX
+# documents. This may be useful for small projects and may help to save some
+# trees in general.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+COMPACT_LATEX          = NO
+
+# The PAPER_TYPE tag can be used to set the paper type that is used by the
+# printer.
+# Possible values are: a4 (210 x 297 mm), letter (8.5 x 11 inches), legal (8.5 x
+# 14 inches) and executive (7.25 x 10.5 inches).
+# The default value is: a4.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+PAPER_TYPE             = a4
+
+# The EXTRA_PACKAGES tag can be used to specify one or more LaTeX package names
+# that should be included in the LaTeX output. The package can be specified just
+# by its name or with the correct syntax as to be used with the LaTeX
+# \usepackage command. To get the times font for instance you can specify :
+# EXTRA_PACKAGES=times or EXTRA_PACKAGES={times}
+# To use the option intlimits with the amsmath package you can specify:
+# EXTRA_PACKAGES=[intlimits]{amsmath}
+# If left blank no extra packages will be included.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+EXTRA_PACKAGES         =
+
+# The LATEX_HEADER tag can be used to specify a personal LaTeX header for the
+# generated LaTeX document. The header should contain everything until the first
+# chapter. If it is left blank doxygen will generate a standard header. See
+# section "Doxygen usage" for information on how to let doxygen write the
+# default header to a separate file.
+#
+# Note: Only use a user-defined header if you know what you are doing! The
+# following commands have a special meaning inside the header: $title,
+# $datetime, $date, $doxygenversion, $projectname, $projectnumber,
+# $projectbrief, $projectlogo. Doxygen will replace $title with the empty
+# string, for the replacement values of the other commands the user is referred
+# to HTML_HEADER.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+LATEX_HEADER           =
+
+# The LATEX_FOOTER tag can be used to specify a personal LaTeX footer for the
+# generated LaTeX document. The footer should contain everything after the last
+# chapter. If it is left blank doxygen will generate a standard footer. See
+# LATEX_HEADER for more information on how to generate a default footer and what
+# special commands can be used inside the footer.
+#
+# Note: Only use a user-defined footer if you know what you are doing!
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+LATEX_FOOTER           =
+
+# The LATEX_EXTRA_STYLESHEET tag can be used to specify additional user-defined
+# LaTeX style sheets that are included after the standard style sheets created
+# by doxygen. Using this option one can overrule certain style aspects. Doxygen
+# will copy the style sheet files to the output directory.
+# Note: The order of the extra style sheet files is of importance (e.g. the last
+# style sheet in the list overrules the setting of the previous ones in the
+# list).
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+LATEX_EXTRA_STYLESHEET =
+
+# The LATEX_EXTRA_FILES tag can be used to specify one or more extra images or
+# other source files which should be copied to the LATEX_OUTPUT output
+# directory. Note that the files will be copied as-is; there are no commands or
+# markers available.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+LATEX_EXTRA_FILES      =
+
+# If the PDF_HYPERLINKS tag is set to YES, the LaTeX that is generated is
+# prepared for conversion to PDF (using ps2pdf or pdflatex). The PDF file will
+# contain links (just like the HTML output) instead of page references. This
+# makes the output suitable for online browsing using a PDF viewer.
+# The default value is: YES.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+PDF_HYPERLINKS         = YES
+
+# If the USE_PDFLATEX tag is set to YES, doxygen will use pdflatex to generate
+# the PDF file directly from the LaTeX files. Set this option to YES, to get a
+# higher quality PDF documentation.
+# The default value is: YES.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+USE_PDFLATEX           = YES
+
+# If the LATEX_BATCHMODE tag is set to YES, doxygen will add the \batchmode
+# command to the generated LaTeX files. This will instruct LaTeX to keep running
+# if errors occur, instead of asking the user for help. This option is also used
+# when generating formulas in HTML.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+LATEX_BATCHMODE        = NO
+
+# If the LATEX_HIDE_INDICES tag is set to YES then doxygen will not include the
+# index chapters (such as File Index, Compound Index, etc.) in the output.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+LATEX_HIDE_INDICES     = NO
+
+# If the LATEX_SOURCE_CODE tag is set to YES then doxygen will include source
+# code with syntax highlighting in the LaTeX output.
+#
+# Note that which sources are shown also depends on other settings such as
+# SOURCE_BROWSER.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+LATEX_SOURCE_CODE      = NO
+
+# The LATEX_BIB_STYLE tag can be used to specify the style to use for the
+# bibliography, e.g. plainnat, or ieeetr. See
+# https://en.wikipedia.org/wiki/BibTeX and \cite for more info.
+# The default value is: plain.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+LATEX_BIB_STYLE        = plain
+
+# If the LATEX_TIMESTAMP tag is set to YES then the footer of each generated
+# page will contain the date and time when the page was generated. Setting this
+# to NO can help when comparing the output of multiple runs.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+LATEX_TIMESTAMP        = NO
+
+# The LATEX_EMOJI_DIRECTORY tag is used to specify the (relative or absolute)
+# path from which the emoji images will be read. If a relative path is entered,
+# it will be relative to the LATEX_OUTPUT directory. If left blank the
+# LATEX_OUTPUT directory will be used.
+# This tag requires that the tag GENERATE_LATEX is set to YES.
+
+LATEX_EMOJI_DIRECTORY  =
+
+#---------------------------------------------------------------------------
+# Configuration options related to the RTF output
+#---------------------------------------------------------------------------
+
+# If the GENERATE_RTF tag is set to YES, doxygen will generate RTF output. The
+# RTF output is optimized for Word 97 and may not look too pretty with other RTF
+# readers/editors.
+# The default value is: NO.
+
+GENERATE_RTF           = NO
+
+# The RTF_OUTPUT tag is used to specify where the RTF docs will be put. If a
+# relative path is entered the value of OUTPUT_DIRECTORY will be put in front of
+# it.
+# The default directory is: rtf.
+# This tag requires that the tag GENERATE_RTF is set to YES.
+
+RTF_OUTPUT             = rtf
+
+# If the COMPACT_RTF tag is set to YES, doxygen generates more compact RTF
+# documents. This may be useful for small projects and may help to save some
+# trees in general.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_RTF is set to YES.
+
+COMPACT_RTF            = NO
+
+# If the RTF_HYPERLINKS tag is set to YES, the RTF that is generated will
+# contain hyperlink fields. The RTF file will contain links (just like the HTML
+# output) instead of page references. This makes the output suitable for online
+# browsing using Word or some other Word compatible readers that support those
+# fields.
+#
+# Note: WordPad (write) and others do not support links.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_RTF is set to YES.
+
+RTF_HYPERLINKS         = NO
+
+# Load stylesheet definitions from file. Syntax is similar to doxygen's
+# configuration file, i.e. a series of assignments. You only have to provide
+# replacements, missing definitions are set to their default value.
+#
+# See also section "Doxygen usage" for information on how to generate the
+# default style sheet that doxygen normally uses.
+# This tag requires that the tag GENERATE_RTF is set to YES.
+
+RTF_STYLESHEET_FILE    =
+
+# Set optional variables used in the generation of an RTF document. Syntax is
+# similar to doxygen's configuration file. A template extensions file can be
+# generated using doxygen -e rtf extensionFile.
+# This tag requires that the tag GENERATE_RTF is set to YES.
+
+RTF_EXTENSIONS_FILE    =
+
+# If the RTF_SOURCE_CODE tag is set to YES then doxygen will include source code
+# with syntax highlighting in the RTF output.
+#
+# Note that which sources are shown also depends on other settings such as
+# SOURCE_BROWSER.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_RTF is set to YES.
+
+RTF_SOURCE_CODE        = NO
+
+#---------------------------------------------------------------------------
+# Configuration options related to the man page output
+#---------------------------------------------------------------------------
+
+# If the GENERATE_MAN tag is set to YES, doxygen will generate man pages for
+# classes and files.
+# The default value is: NO.
+
+GENERATE_MAN           = NO
+
+# The MAN_OUTPUT tag is used to specify where the man pages will be put. If a
+# relative path is entered the value of OUTPUT_DIRECTORY will be put in front of
+# it. A directory man3 will be created inside the directory specified by
+# MAN_OUTPUT.
+# The default directory is: man.
+# This tag requires that the tag GENERATE_MAN is set to YES.
+
+MAN_OUTPUT             = man
+
+# The MAN_EXTENSION tag determines the extension that is added to the generated
+# man pages. In case the manual section does not start with a number, the number
+# 3 is prepended. The dot (.) at the beginning of the MAN_EXTENSION tag is
+# optional.
+# The default value is: .3.
+# This tag requires that the tag GENERATE_MAN is set to YES.
+
+MAN_EXTENSION          = .3
+
+# The MAN_SUBDIR tag determines the name of the directory created within
+# MAN_OUTPUT in which the man pages are placed. If defaults to man followed by
+# MAN_EXTENSION with the initial . removed.
+# This tag requires that the tag GENERATE_MAN is set to YES.
+
+MAN_SUBDIR             =
+
+# If the MAN_LINKS tag is set to YES and doxygen generates man output, then it
+# will generate one additional man file for each entity documented in the real
+# man page(s). These additional files only source the real man page, but without
+# them the man command would be unable to find the correct page.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_MAN is set to YES.
+
+MAN_LINKS              = NO
+
+#---------------------------------------------------------------------------
+# Configuration options related to the XML output
+#---------------------------------------------------------------------------
+
+# If the GENERATE_XML tag is set to YES, doxygen will generate an XML file that
+# captures the structure of the code including all documentation.
+# The default value is: NO.
+
+GENERATE_XML           = NO
+
+# The XML_OUTPUT tag is used to specify where the XML pages will be put. If a
+# relative path is entered the value of OUTPUT_DIRECTORY will be put in front of
+# it.
+# The default directory is: xml.
+# This tag requires that the tag GENERATE_XML is set to YES.
+
+XML_OUTPUT             = xml
+
+# If the XML_PROGRAMLISTING tag is set to YES, doxygen will dump the program
+# listings (including syntax highlighting and cross-referencing information) to
+# the XML output. Note that enabling this will significantly increase the size
+# of the XML output.
+# The default value is: YES.
+# This tag requires that the tag GENERATE_XML is set to YES.
+
+XML_PROGRAMLISTING     = YES
+
+# If the XML_NS_MEMB_FILE_SCOPE tag is set to YES, doxygen will include
+# namespace members in file scope as well, matching the HTML output.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_XML is set to YES.
+
+XML_NS_MEMB_FILE_SCOPE = NO
+
+#---------------------------------------------------------------------------
+# Configuration options related to the DOCBOOK output
+#---------------------------------------------------------------------------
+
+# If the GENERATE_DOCBOOK tag is set to YES, doxygen will generate Docbook files
+# that can be used to generate PDF.
+# The default value is: NO.
+
+GENERATE_DOCBOOK       = NO
+
+# The DOCBOOK_OUTPUT tag is used to specify where the Docbook pages will be put.
+# If a relative path is entered the value of OUTPUT_DIRECTORY will be put in
+# front of it.
+# The default directory is: docbook.
+# This tag requires that the tag GENERATE_DOCBOOK is set to YES.
+
+DOCBOOK_OUTPUT         = docbook
+
+# If the DOCBOOK_PROGRAMLISTING tag is set to YES, doxygen will include the
+# program listings (including syntax highlighting and cross-referencing
+# information) to the DOCBOOK output. Note that enabling this will significantly
+# increase the size of the DOCBOOK output.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_DOCBOOK is set to YES.
+
+DOCBOOK_PROGRAMLISTING = NO
+
+#---------------------------------------------------------------------------
+# Configuration options for the AutoGen Definitions output
+#---------------------------------------------------------------------------
+
+# If the GENERATE_AUTOGEN_DEF tag is set to YES, doxygen will generate an
+# AutoGen Definitions (see http://autogen.sourceforge.net/) file that captures
+# the structure of the code including all documentation. Note that this feature
+# is still experimental and incomplete at the moment.
+# The default value is: NO.
+
+GENERATE_AUTOGEN_DEF   = NO
+
+#---------------------------------------------------------------------------
+# Configuration options related to the Perl module output
+#---------------------------------------------------------------------------
+
+# If the GENERATE_PERLMOD tag is set to YES, doxygen will generate a Perl module
+# file that captures the structure of the code including all documentation.
+#
+# Note that this feature is still experimental and incomplete at the moment.
+# The default value is: NO.
+
+GENERATE_PERLMOD       = NO
+
+# If the PERLMOD_LATEX tag is set to YES, doxygen will generate the necessary
+# Makefile rules, Perl scripts and LaTeX code to be able to generate PDF and DVI
+# output from the Perl module output.
+# The default value is: NO.
+# This tag requires that the tag GENERATE_PERLMOD is set to YES.
+
+PERLMOD_LATEX          = NO
+
+# If the PERLMOD_PRETTY tag is set to YES, the Perl module output will be nicely
+# formatted so it can be parsed by a human reader. This is useful if you want to
+# understand what is going on. On the other hand, if this tag is set to NO, the
+# size of the Perl module output will be much smaller and Perl will parse it
+# just the same.
+# The default value is: YES.
+# This tag requires that the tag GENERATE_PERLMOD is set to YES.
+
+PERLMOD_PRETTY         = YES
+
+# The names of the make variables in the generated doxyrules.make file are
+# prefixed with the string contained in PERLMOD_MAKEVAR_PREFIX. This is useful
+# so different doxyrules.make files included by the same Makefile don't
+# overwrite each other's variables.
+# This tag requires that the tag GENERATE_PERLMOD is set to YES.
+
+PERLMOD_MAKEVAR_PREFIX =
+
+#---------------------------------------------------------------------------
+# Configuration options related to the preprocessor
+#---------------------------------------------------------------------------
+
+# If the ENABLE_PREPROCESSING tag is set to YES, doxygen will evaluate all
+# C-preprocessor directives found in the sources and include files.
+# The default value is: YES.
+
+ENABLE_PREPROCESSING   = YES
+
+# If the MACRO_EXPANSION tag is set to YES, doxygen will expand all macro names
+# in the source code. If set to NO, only conditional compilation will be
+# performed. Macro expansion can be done in a controlled way by setting
+# EXPAND_ONLY_PREDEF to YES.
+# The default value is: NO.
+# This tag requires that the tag ENABLE_PREPROCESSING is set to YES.
+
+MACRO_EXPANSION        = NO
+
+# If the EXPAND_ONLY_PREDEF and MACRO_EXPANSION tags are both set to YES then
+# the macro expansion is limited to the macros specified with the PREDEFINED and
+# EXPAND_AS_DEFINED tags.
+# The default value is: NO.
+# This tag requires that the tag ENABLE_PREPROCESSING is set to YES.
+
+EXPAND_ONLY_PREDEF     = NO
+
+# If the SEARCH_INCLUDES tag is set to YES, the include files in the
+# INCLUDE_PATH will be searched if a #include is found.
+# The default value is: YES.
+# This tag requires that the tag ENABLE_PREPROCESSING is set to YES.
+
+SEARCH_INCLUDES        = YES
+
+# The INCLUDE_PATH tag can be used to specify one or more directories that
+# contain include files that are not input files but should be processed by the
+# preprocessor.
+# This tag requires that the tag SEARCH_INCLUDES is set to YES.
+
+INCLUDE_PATH           =
+
+# You can use the INCLUDE_FILE_PATTERNS tag to specify one or more wildcard
+# patterns (like *.h and *.hpp) to filter out the header-files in the
+# directories. If left blank, the patterns specified with FILE_PATTERNS will be
+# used.
+# This tag requires that the tag ENABLE_PREPROCESSING is set to YES.
+
+INCLUDE_FILE_PATTERNS  =
+
+# The PREDEFINED tag can be used to specify one or more macro names that are
+# defined before the preprocessor is started (similar to the -D option of e.g.
+# gcc). The argument of the tag is a list of macros of the form: name or
+# name=definition (no spaces). If the definition and the "=" are omitted, "=1"
+# is assumed. To prevent a macro definition from being undefined via #undef or
+# recursively expanded use the := operator instead of the = operator.
+# This tag requires that the tag ENABLE_PREPROCESSING is set to YES.
+
+PREDEFINED             =
+
+# If the MACRO_EXPANSION and EXPAND_ONLY_PREDEF tags are set to YES then this
+# tag can be used to specify a list of macro names that should be expanded. The
+# macro definition that is found in the sources will be used. Use the PREDEFINED
+# tag if you want to use a different macro definition that overrules the
+# definition found in the source code.
+# This tag requires that the tag ENABLE_PREPROCESSING is set to YES.
+
+EXPAND_AS_DEFINED      =
+
+# If the SKIP_FUNCTION_MACROS tag is set to YES then doxygen's preprocessor will
+# remove all references to function-like macros that are alone on a line, have
+# an all uppercase name, and do not end with a semicolon. Such function macros
+# are typically used for boiler-plate code, and will confuse the parser if not
+# removed.
+# The default value is: YES.
+# This tag requires that the tag ENABLE_PREPROCESSING is set to YES.
+
+SKIP_FUNCTION_MACROS   = YES
+
+#---------------------------------------------------------------------------
+# Configuration options related to external references
+#---------------------------------------------------------------------------
+
+# The TAGFILES tag can be used to specify one or more tag files. For each tag
+# file the location of the external documentation should be added. The format of
+# a tag file without this location is as follows:
+# TAGFILES = file1 file2 ...
+# Adding location for the tag files is done as follows:
+# TAGFILES = file1=loc1 "file2 = loc2" ...
+# where loc1 and loc2 can be relative or absolute paths or URLs. See the
+# section "Linking to external documentation" for more information about the use
+# of tag files.
+# Note: Each tag file must have a unique name (where the name does NOT include
+# the path). If a tag file is not located in the directory in which doxygen is
+# run, you must also specify the path to the tagfile here.
+
+TAGFILES               =
+
+# When a file name is specified after GENERATE_TAGFILE, doxygen will create a
+# tag file that is based on the input files it reads. See section "Linking to
+# external documentation" for more information about the usage of tag files.
+
+GENERATE_TAGFILE       =
+
+# If the ALLEXTERNALS tag is set to YES, all external class will be listed in
+# the class index. If set to NO, only the inherited external classes will be
+# listed.
+# The default value is: NO.
+
+ALLEXTERNALS           = NO
+
+# If the EXTERNAL_GROUPS tag is set to YES, all external groups will be listed
+# in the modules index. If set to NO, only the current project's groups will be
+# listed.
+# The default value is: YES.
+
+EXTERNAL_GROUPS        = YES
+
+# If the EXTERNAL_PAGES tag is set to YES, all external pages will be listed in
+# the related pages index. If set to NO, only the current project's pages will
+# be listed.
+# The default value is: YES.
+
+EXTERNAL_PAGES         = YES
+
+# The PERL_PATH should be the absolute path and name of the perl script
+# interpreter (i.e. the result of 'which perl').
+# The default file (with absolute path) is: /usr/bin/perl.
+
+PERL_PATH              = /usr/bin/perl
+
+#---------------------------------------------------------------------------
+# Configuration options related to the dot tool
+#---------------------------------------------------------------------------
+
+# If the CLASS_DIAGRAMS tag is set to YES, doxygen will generate a class diagram
+# (in HTML and LaTeX) for classes with base or super classes. Setting the tag to
+# NO turns the diagrams off. Note that this option also works with HAVE_DOT
+# disabled, but it is recommended to install and use dot, since it yields more
+# powerful graphs.
+# The default value is: YES.
+
+CLASS_DIAGRAMS         = YES
+
+# You can define message sequence charts within doxygen comments using the \msc
+# command. Doxygen will then run the mscgen tool (see:
+# http://www.mcternan.me.uk/mscgen/)) to produce the chart and insert it in the
+# documentation. The MSCGEN_PATH tag allows you to specify the directory where
+# the mscgen tool resides. If left empty the tool is assumed to be found in the
+# default search path.
+
+MSCGEN_PATH            =
+
+# You can include diagrams made with dia in doxygen documentation. Doxygen will
+# then run dia to produce the diagram and insert it in the documentation. The
+# DIA_PATH tag allows you to specify the directory where the dia binary resides.
+# If left empty dia is assumed to be found in the default search path.
+
+DIA_PATH               =
+
+# If set to YES the inheritance and collaboration graphs will hide inheritance
+# and usage relations if the target is undocumented or is not a class.
+# The default value is: YES.
+
+HIDE_UNDOC_RELATIONS   = YES
+
+# If you set the HAVE_DOT tag to YES then doxygen will assume the dot tool is
+# available from the path. This tool is part of Graphviz (see:
+# http://www.graphviz.org/), a graph visualization toolkit from AT&T and Lucent
+# Bell Labs. The other options in this section have no effect if this option is
+# set to NO
+# The default value is: NO.
+
+HAVE_DOT               = NO
+
+# The DOT_NUM_THREADS specifies the number of dot invocations doxygen is allowed
+# to run in parallel. When set to 0 doxygen will base this on the number of
+# processors available in the system. You can set it explicitly to a value
+# larger than 0 to get control over the balance between CPU load and processing
+# speed.
+# Minimum value: 0, maximum value: 32, default value: 0.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+DOT_NUM_THREADS        = 0
+
+# When you want a differently looking font in the dot files that doxygen
+# generates you can specify the font name using DOT_FONTNAME. You need to make
+# sure dot is able to find the font, which can be done by putting it in a
+# standard location or by setting the DOTFONTPATH environment variable or by
+# setting DOT_FONTPATH to the directory containing the font.
+# The default value is: Helvetica.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+DOT_FONTNAME           = Helvetica
+
+# The DOT_FONTSIZE tag can be used to set the size (in points) of the font of
+# dot graphs.
+# Minimum value: 4, maximum value: 24, default value: 10.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+DOT_FONTSIZE           = 10
+
+# By default doxygen will tell dot to use the default font as specified with
+# DOT_FONTNAME. If you specify a different font using DOT_FONTNAME you can set
+# the path where dot can find it using this tag.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+DOT_FONTPATH           =
+
+# If the CLASS_GRAPH tag is set to YES then doxygen will generate a graph for
+# each documented class showing the direct and indirect inheritance relations.
+# Setting this tag to YES will force the CLASS_DIAGRAMS tag to NO.
+# The default value is: YES.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+CLASS_GRAPH            = YES
+
+# If the COLLABORATION_GRAPH tag is set to YES then doxygen will generate a
+# graph for each documented class showing the direct and indirect implementation
+# dependencies (inheritance, containment, and class references variables) of the
+# class with other documented classes.
+# The default value is: YES.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+COLLABORATION_GRAPH    = YES
+
+# If the GROUP_GRAPHS tag is set to YES then doxygen will generate a graph for
+# groups, showing the direct groups dependencies.
+# The default value is: YES.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+GROUP_GRAPHS           = YES
+
+# If the UML_LOOK tag is set to YES, doxygen will generate inheritance and
+# collaboration diagrams in a style similar to the OMG's Unified Modeling
+# Language.
+# The default value is: NO.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+UML_LOOK               = YES
+
+# If the UML_LOOK tag is enabled, the fields and methods are shown inside the
+# class node. If there are many fields or methods and many nodes the graph may
+# become too big to be useful. The UML_LIMIT_NUM_FIELDS threshold limits the
+# number of items for each type to make the size more manageable. Set this to 0
+# for no limit. Note that the threshold may be exceeded by 50% before the limit
+# is enforced. So when you set the threshold to 10, up to 15 fields may appear,
+# but if the number exceeds 15, the total amount of fields shown is limited to
+# 10.
+# Minimum value: 0, maximum value: 100, default value: 10.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+UML_LIMIT_NUM_FIELDS   = 10
+
+# If the TEMPLATE_RELATIONS tag is set to YES then the inheritance and
+# collaboration graphs will show the relations between templates and their
+# instances.
+# The default value is: NO.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+TEMPLATE_RELATIONS     = NO
+
+# If the INCLUDE_GRAPH, ENABLE_PREPROCESSING and SEARCH_INCLUDES tags are set to
+# YES then doxygen will generate a graph for each documented file showing the
+# direct and indirect include dependencies of the file with other documented
+# files.
+# The default value is: YES.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+INCLUDE_GRAPH          = YES
+
+# If the INCLUDED_BY_GRAPH, ENABLE_PREPROCESSING and SEARCH_INCLUDES tags are
+# set to YES then doxygen will generate a graph for each documented file showing
+# the direct and indirect include dependencies of the file with other documented
+# files.
+# The default value is: YES.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+INCLUDED_BY_GRAPH      = YES
+
+# If the CALL_GRAPH tag is set to YES then doxygen will generate a call
+# dependency graph for every global function or class method.
+#
+# Note that enabling this option will significantly increase the time of a run.
+# So in most cases it will be better to enable call graphs for selected
+# functions only using the \callgraph command. Disabling a call graph can be
+# accomplished by means of the command \hidecallgraph.
+# The default value is: NO.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+CALL_GRAPH             = NO
+
+# If the CALLER_GRAPH tag is set to YES then doxygen will generate a caller
+# dependency graph for every global function or class method.
+#
+# Note that enabling this option will significantly increase the time of a run.
+# So in most cases it will be better to enable caller graphs for selected
+# functions only using the \callergraph command. Disabling a caller graph can be
+# accomplished by means of the command \hidecallergraph.
+# The default value is: NO.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+CALLER_GRAPH           = NO
+
+# If the GRAPHICAL_HIERARCHY tag is set to YES then doxygen will graphical
+# hierarchy of all classes instead of a textual one.
+# The default value is: YES.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+GRAPHICAL_HIERARCHY    = YES
+
+# If the DIRECTORY_GRAPH tag is set to YES then doxygen will show the
+# dependencies a directory has on other directories in a graphical way. The
+# dependency relations are determined by the #include relations between the
+# files in the directories.
+# The default value is: YES.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+DIRECTORY_GRAPH        = YES
+
+# The DOT_IMAGE_FORMAT tag can be used to set the image format of the images
+# generated by dot. For an explanation of the image formats see the section
+# output formats in the documentation of the dot tool (Graphviz (see:
+# http://www.graphviz.org/)).
+# Note: If you choose svg you need to set HTML_FILE_EXTENSION to xhtml in order
+# to make the SVG files visible in IE 9+ (other browsers do not have this
+# requirement).
+# Possible values are: png, jpg, gif, svg, png:gd, png:gd:gd, png:cairo,
+# png:cairo:gd, png:cairo:cairo, png:cairo:gdiplus, png:gdiplus and
+# png:gdiplus:gdiplus.
+# The default value is: png.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+DOT_IMAGE_FORMAT       = png
+
+# If DOT_IMAGE_FORMAT is set to svg, then this option can be set to YES to
+# enable generation of interactive SVG images that allow zooming and panning.
+#
+# Note that this requires a modern browser other than Internet Explorer. Tested
+# and working are Firefox, Chrome, Safari, and Opera.
+# Note: For IE 9+ you need to set HTML_FILE_EXTENSION to xhtml in order to make
+# the SVG files visible. Older versions of IE do not have SVG support.
+# The default value is: NO.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+INTERACTIVE_SVG        = NO
+
+# The DOT_PATH tag can be used to specify the path where the dot tool can be
+# found. If left blank, it is assumed the dot tool can be found in the path.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+DOT_PATH               =
+
+# The DOTFILE_DIRS tag can be used to specify one or more directories that
+# contain dot files that are included in the documentation (see the \dotfile
+# command).
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+DOTFILE_DIRS           =
+
+# The MSCFILE_DIRS tag can be used to specify one or more directories that
+# contain msc files that are included in the documentation (see the \mscfile
+# command).
+
+MSCFILE_DIRS           =
+
+# The DIAFILE_DIRS tag can be used to specify one or more directories that
+# contain dia files that are included in the documentation (see the \diafile
+# command).
+
+DIAFILE_DIRS           =
+
+# When using plantuml, the PLANTUML_JAR_PATH tag should be used to specify the
+# path where java can find the plantuml.jar file. If left blank, it is assumed
+# PlantUML is not used or called during a preprocessing step. Doxygen will
+# generate a warning when it encounters a \startuml command in this case and
+# will not generate output for the diagram.
+
+PLANTUML_JAR_PATH      =
+
+# When using plantuml, the PLANTUML_CFG_FILE tag can be used to specify a
+# configuration file for plantuml.
+
+PLANTUML_CFG_FILE      =
+
+# When using plantuml, the specified paths are searched for files specified by
+# the !include statement in a plantuml block.
+
+PLANTUML_INCLUDE_PATH  =
+
+# The DOT_GRAPH_MAX_NODES tag can be used to set the maximum number of nodes
+# that will be shown in the graph. If the number of nodes in a graph becomes
+# larger than this value, doxygen will truncate the graph, which is visualized
+# by representing a node as a red box. Note that doxygen if the number of direct
+# children of the root node in a graph is already larger than
+# DOT_GRAPH_MAX_NODES then the graph will not be shown at all. Also note that
+# the size of a graph can be further restricted by MAX_DOT_GRAPH_DEPTH.
+# Minimum value: 0, maximum value: 10000, default value: 50.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+DOT_GRAPH_MAX_NODES    = 50
+
+# The MAX_DOT_GRAPH_DEPTH tag can be used to set the maximum depth of the graphs
+# generated by dot. A depth value of 3 means that only nodes reachable from the
+# root by following a path via at most 3 edges will be shown. Nodes that lay
+# further from the root node will be omitted. Note that setting this option to 1
+# or 2 may greatly reduce the computation time needed for large code bases. Also
+# note that the size of a graph can be further restricted by
+# DOT_GRAPH_MAX_NODES. Using a depth of 0 means no depth restriction.
+# Minimum value: 0, maximum value: 1000, default value: 0.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+MAX_DOT_GRAPH_DEPTH    = 0
+
+# Set the DOT_TRANSPARENT tag to YES to generate images with a transparent
+# background. This is disabled by default, because dot on Windows does not seem
+# to support this out of the box.
+#
+# Warning: Depending on the platform used, enabling this option may lead to
+# badly anti-aliased labels on the edges of a graph (i.e. they become hard to
+# read).
+# The default value is: NO.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+DOT_TRANSPARENT        = NO
+
+# Set the DOT_MULTI_TARGETS tag to YES to allow dot to generate multiple output
+# files in one run (i.e. multiple -o and -T options on the command line). This
+# makes dot run faster, but since only newer versions of dot (>1.8.10) support
+# this, this feature is disabled by default.
+# The default value is: NO.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+DOT_MULTI_TARGETS      = NO
+
+# If the GENERATE_LEGEND tag is set to YES doxygen will generate a legend page
+# explaining the meaning of the various boxes and arrows in the dot generated
+# graphs.
+# The default value is: YES.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+GENERATE_LEGEND        = YES
+
+# If the DOT_CLEANUP tag is set to YES, doxygen will remove the intermediate dot
+# files that are used to generate the various graphs.
+# The default value is: YES.
+# This tag requires that the tag HAVE_DOT is set to YES.
+
+DOT_CLEANUP            = YES
Index: /utils/tools_ticket2413/SIREN/README
===================================================================
--- /utils/tools_ticket2413/SIREN/README	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/README	(revision 12863)
@@ -0,0 +1,7 @@
+
+To create SIREN documentation, run doxygen in TOOLS/SIREN directory
+(http://www.stack.nl/~dimitri/doxygen/index.html version 1.8.5 or upper)
+then
+   open ./TOOLS/SIREN/doc/html/index.html in your web browser
+or 
+   run gmake in ./TOOLS/SIREN/doc/latex directory and open ./TOOLS/SIREN/doc/latex/refman.pdf 
Index: /utils/tools_ticket2413/SIREN/cfg/dimension.cfg
===================================================================
--- /utils/tools_ticket2413/SIREN/cfg/dimension.cfg	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/cfg/dimension.cfg	(revision 12863)
@@ -0,0 +1,10 @@
+&namdim
+   in_dimX=2
+   in_dimY=2
+   in_dimZ=6
+   in_dimT=3
+   cn_dimX="x","xaxis"
+   cn_dimY="y","yaxis"
+   cn_dimZ="z","deptht","depthu","depthv","depthw","ncatice"
+   cn_dimT="t","time","time_counter"
+/
Index: /utils/tools_ticket2413/SIREN/cfg/dummy.cfg
===================================================================
--- /utils/tools_ticket2413/SIREN/cfg/dummy.cfg	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/cfg/dummy.cfg	(revision 12863)
@@ -0,0 +1,8 @@
+&namdum
+   in_ndumvar=4
+   in_ndumdim=0
+   in_ndumatt=1
+   cn_dumvar="orca_lon", "orca_lat", "time_instant", "time_centered"
+   cn_dumdim=""
+   cn_dumatt="history"
+/
Index: /utils/tools_ticket2413/SIREN/cfg/variable.cfg
===================================================================
--- /utils/tools_ticket2413/SIREN/cfg/variable.cfg	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/cfg/variable.cfg	(revision 12863)
@@ -0,0 +1,165 @@
+# name       | units          | axis | pt| interpolation   | long name                             | standard name                                  
+X            | unitless       | X    |   |                 |                                       | projection_x_coordinate               
+Y            | unitless       | Y    |   |                 |                                       | projection_y_coordinate               
+Z            | unitless       | Z    |   |                 |                                       | projection_z_coordinate               
+T            | unitless       | T    |   |                 |                                       | projection_t_coordinate               
+nav_lon      | degrees_east   | XY   | T | cubic           | Longitude                             | longitude                                   
+nav_lat      | degrees_north  | XY   | T | cubic           | Latitude                              | latitude                         
+nav_lev      | model_levels   | Z    | T | cubic           | Model levels                          |                                  
+deptht       | m              | Z    | T |                 | Vertical T levels                     | depth                            
+ncatice      | 1              | Z    | T |                 | Ice category                          | num_icecat_coordinate
+time_counter |                | T    |   |                 | Time axis                             | time                             
+Bathymetry   | m              | XY   | T | cubic           | Bathymetry                            | bathymetry                       
+votemper     | degree_Celsius | XYZT | T | cubic           | Temperature                           | sea_water_potential_temperature  
+vozocrtx     | m s-1          | XYZT | U | cubic           | Zonal velocity                        |                                  
+vomecrty     | m s-1          | XYZT | V | cubic           | Meridional velocity                   |                                  
+vosaline     | PSU            | XYZT | T | cubic           | Salinity                              | sea_water_salinity               
+sossheig     | m              | XYT  | T | cubic           | Sea Surface Height                    | sea_surface_height               
+sotemper     | m              | XYT  | T | cubic           |                                       |                                  
+sossheig     | m              | XYT  | T | cubic           |                                       |                                  
+glamt        | degrees_east   | XY   | T | cubic           | Longitude_T                           |                                  
+glamu        | degrees_east   | XY   | U | cubic           | Longitude_U                           |                                   
+glamv        | degrees_east   | XY   | V | cubic           | Longitude_V                           |                                  
+glamf        | degrees_east   | XY   | F | cubic           | Longitude_F                           |                                  
+gphit        | degrees_north  | XY   | T | cubic           | Latitude_T                            |                                  
+gphiu        | degrees_north  | XY   | U | cubic           | Latitude_U                            |                                  
+gphiv        | degrees_north  | XY   | V | cubic           | Latitude_V                            |                                  
+gphif        | degrees_north  | XY   | F | cubic           | Latitude_F                            |                                  
+e1t          | m              | XY   | T | cubic/rhoi      |                                       |                                  
+e1u          | m              | XY   | U | cubic/rhoi      |                                       |                                  
+e1v          | m              | XY   | V | cubic/rhoi      |                                       |                                  
+e1f          | m              | XY   | F | cubic/rhoi      |                                       |                                  
+e2t          | m              | XY   | T | cubic/rhoj      |                                       |                                  
+e2u          | m              | XY   | U | cubic/rhoj      |                                       |                                  
+e2v          | m              | XY   | V | cubic/rhoj      |                                       |                                  
+e2f          | m              | XY   | F | cubic/rhoj      |                                       |                                  
+tmask        |                | XYZ  | T | nearest         |                                       |                                  
+umask        |                | XYZ  | U | nearest         |                                       |                                  
+vmask        |                | XYZ  | V | nearest         |                                       |                                  
+fmask        |                | XYZ  | F | nearest         |                                       |                                  
+weight       |                | XY   | T |                 |                                       |                                  
+kt           |                |      |   |                 |                                       |                                  
+ndastp       |                |      |   |                 |                                       |                                  
+adatrj       |                |      |   |                 |                                       |                                  
+kt           |                |      |   |                 |                                       |                                  
+rdt          |                |      |   |                 |                                       |                                  
+rdttra1      |                |      |   |                 |                                       |                                  
+utau_b       |                | XY   | U |                 |                                       |surface_downward_eastward_stress  
+vtau_b       |                | XY   | V |                 |                                       |surface_downward_northward_stress 
+qns_b        |                | XY   | T |                 |                                       |                                  
+emp_b        |                | XY   | T |                 |                                       |                                  
+sfx_b        |                | XY   | T |                 |                                       |                                  
+en           |                | XYZ  | T |                 |                                       |                                  
+avt          |                | XYZ  | T |                 | vertical eddy diffusivity             |                                  
+avm          |                | XYZ  | T |                 | vertical eddy viscosity               |                                  
+avmu         |                | XYZ  | T |                 |                                       |                                  
+avmv         |                | XYZ  | T |                 |                                       |                                  
+dissl        |                | XYZ  | T |                 |                                       |                                  
+sbc_hc_b     |                | XY   | T |                 |                                       |                                  
+sbc_sc_b     |                | XY   | T |                 |                                       |                                  
+gcx          |                | XY   | T |                 |                                       |                                  
+gcxb         |                | XY   | T |                 |                                       |                                  
+ub           |                | XYZ  | U |                 |                                       |                                  
+vb           |                | XYZ  | V |                 |                                       |                                  
+tb           |                | XYZ  | T |                 |                                       |                                  
+sb           |                | XYZ  | T |                 |                                       |                                  
+rotb         |                | XYZ  | T |                 |                                       |                                  
+hdivb        |                | XYZ  | T |                 |                                       |                                  
+sshb         |                | XY   | T |                 |                                       |                                  
+un           |                | XYZ  | U |                 |                                       |                                  
+vn           |                | XYZ  | V |                 |                                       |                                  
+tn           |                | XYZ  | T |                 |                                       |                                  
+sn           |                | XYZ  | T |                 |                                       |                                  
+rotn         |                | XYZ  | T |                 |                                       |                                  
+hdivn        |                | XYZ  | T |                 |                                       |                                  
+sshn         |                | XYT  | T |                 |                                       |                                  
+rhop         |                | XYZ  | T |                 |                                       |                                  
+dic          |                | XYZT | T |                 | Dissolved Inorganic Carbon            | mole_concentration_of_dissolved_inorganic_caron_in_sea_water
+alkalini     |                | XYZT | T |                 | Total Alkalinity                      | sea_water_alkalinity_expressed_as_mole_equivalent
+o2           |                | XYZT | T |                 | Dissolved Oxygen                      | mole_concentration_of_dissolved_molecular_oxygen_in_sea_water
+caco3        |                | XYZT | T |                 | Calcite                               |                                  
+po4          |                | XYZT | T |                 | Phosphate                             | mole_concentration_of_phosphate_in_sea_water
+poc          |                | XYZT | T |                 | Small Particulate Organic Carbon      |                                  
+si           |                | XYZT | T |                 | Dissolved Silicate                    | mole_concentration_of_silicate_in_sea_water
+phy          |                | XYZT | T |                 | Nanophytoplankton                     |                                  
+zoo          |                | XYZT | T |                 | Microzooplankton                      | mole_concentration_of_microzooplankton_expressed_as_carbon_in_sea_water
+doc          |                | XYZT | T |                 | Dissolved Organic Carbon              |                                  
+phy2         |                | XYZT | T |                 | Diatoms                               |                                  
+zoo2         |                | XYZT | T |                 | Mesozooplankton                       | mole_concentration_of_mesozooplankton_expressed_as_carbon_in_sea_water
+gsi          |                | XYZT | T |                 | Sinking biogenic Silica               |                                  
+fer          |                | XYZT | T |                 | Dissolved Iron                        | mole_concentration_of_dissolved_iron_in_sea_water
+bfe          |                | XYZT | T |                 | Iron in the big particles             |                                  
+goc          |                | XYZT | T |                 | Big Particulate Organic Carbon        |                                  
+sfe          |                | XYZT | T |                 | Iron in the small particles           |                                  
+dfe          |                | XYZT | T |                 | Iron content of the Diatoms           |                                  
+dsi          |                | XYZT | T |                 | Silicon content of the Diatoms        |                                  
+nfe          |                | XYZT | T |                 | Iron content of the Nanophytoplankton |                                  
+nchl         |                | XYZT | T |                 | Chlorophyll of the Nanophytoplankton  |                                  
+dchl         |                | XYZT | T |                 | Chlorophyll of the Diatoms            |                                  
+no3          |                | XYZT | T |                 | Nitrate                               | mole_concentration_of_nitrate_in_sea_water
+nh4          |                | XYZT | T |                 | Ammonium                              | mole_concentration_of_ammonium_in_sea_water
+ppd          |                | XYZT | T |                 |                                       |                                  
+ppn          |                | XYZT | T |                 |                                       |                                  
+ph           |                | XYZT | T |                 |                                       |                                  
+cflx         |                | XYZT | T |                 |                                       |                                  
+oflx         |                | XYZT | T |                 |                                       |                                  
+kg           |                | XYZT | T |                 |                                       |                                  
+dpco2        |                | XYZT | T |                 |                                       |                                  
+heup         |                | XYZT | T |                 |                                       |                                  
+kz           |                | XYZT | T |                 |                                       |                                  
+irondep      |                | XYZT | T |                 |                                       |                                  
+sivelu       | m/s            | XYT  | T |                 | Ice velocity along i-axis at I-point  | sea_ice_x_velocity
+sivelv       | m/s            | XYT  | T |                 | Ice velocity along j-axis at I-point  | sea_ice_y_velocity
+siconcat     | %              | XYZT | T |                 | Ice concentration for categories      | sea_ice_cat_concentration
+sithicat     | m              | XYZT | T |                 | Ice thickness for categories          | sea_ice_cat_icethickness
+snthicat     | m              | XYZT | T |                 | Snow thickness for categories         | sea_ice_cat_snowthickness
+kt_ice       |                |      |   |                 |                                       |                                  
+hicif        |                |      |   |                 |                                       |                                  
+hsnif        |                |      |   |                 |                                       |                                  
+frld         |                |      |   |                 |                                       |                                  
+sist         |                |      |   |                 |                                       |                                  
+tbif1        |                |      |   |                 |                                       |                                  
+tbif2        |                |      |   |                 |                                       |                                  
+tbif3        |                |      |   |                 |                                       |                                  
+ui_ice       |                |      |   |                 |                                       |                                  
+vi_ice       |                |      |   |                 |                                       |                                  
+qstoif       |                |      |   |                 |                                       |                                  
+fsbbq        |                |      |   |                 |                                       |                                  
+stress1_i    |                |      |   |                 |                                       |                                  
+stress2_i    |                |      |   |                 |                                       |                                  
+stress12_i   |                |      |   |                 |                                       |                                  
+sxice        |                |      |   |                 |                                       |                                  
+syice        |                |      |   |                 |                                       |                                  
+sxxice       |                |      |   |                 |                                       |                                  
+syyice       |                |      |   |                 |                                       |                                  
+sxyice       |                |      |   |                 |                                       |                                  
+sxsn         |                |      |   |                 |                                       |                                  
+sysn         |                |      |   |                 |                                       |                                  
+sxxsn        |                |      |   |                 |                                       |                                  
+syysn        |                |      |   |                 |                                       |                                  
+sxysn        |                |      |   |                 |                                       |                                  
+sxa          |                |      |   |                 |                                       |                                  
+sya          |                |      |   |                 |                                       |                                  
+sxxa         |                |      |   |                 |                                       |                                  
+syya         |                |      |   |                 |                                       |                                  
+sxya         |                |      |   |                 |                                       |                                  
+sxc0         |                |      |   |                 |                                       |                                  
+syc0         |                |      |   |                 |                                       |                                  
+sxxc0        |                |      |   |                 |                                       |                                  
+syyc0        |                |      |   |                 |                                       |                                  
+sxyc0        |                |      |   |                 |                                       |                                  
+sxc1         |                |      |   |                 |                                       |                                  
+syc1         |                |      |   |                 |                                       |                                  
+sxxc1        |                |      |   |                 |                                       |                                  
+syyc1        |                |      |   |                 |                                       |                                  
+sxyc1        |                |      |   |                 |                                       |                                  
+sxc2         |                |      |   |                 |                                       |                                  
+syc2         |                |      |   |                 |                                       |                                  
+sxxc2        |                |      |   |                 |                                       |                                  
+syyc2        |                |      |   |                 |                                       |                                  
+sxyc2        |                |      |   |                 |                                       |                                  
+sxst         |                |      |   |                 |                                       |                                  
+syst         |                |      |   |                 |                                       |                                  
+sxxst        |                |      |   |                 |                                       |                                  
+syyst        |                |      |   |                 |                                       |                                  
+sxyst        |                |      |   |                 |                                       |                                  
Index: /utils/tools_ticket2413/SIREN/src/addline_deg.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/addline_deg.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/addline_deg.f90	(revision 12863)
@@ -0,0 +1,697 @@
+!----------------------------------------------------------------------
+! MERCATOR OCEAN, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!> @file
+!> @brief 
+!> This program add line to all variables of the input file.
+!>
+!> @details
+!> @section sec2 how to
+!>    to add line to file:<br/>
+!> @code{.sh}
+!>    ./SIREN/bin/addline addline.nam
+!> @endcode
+!> the namelist file (**addline.nam**) sets up program parameters.
+!>
+!> to set up program parameters, you just have to fill the namelist file (**add_line.nam**).
+!> @note
+!>    you could find a template of the namelist in templates directory.
+!>
+!>    create_bathy.nam comprise 4 namelists:<br/>
+!>       - **namlog** to set logger parameters
+!>       - **namcfg** to set configuration file parameters
+!>       - **namsrc** to set source grid parameters
+!>       - **namout** to set output parameters
+!>
+!>    here after, each sub-namelist parameters is detailed.
+!>    @note 
+!>       default values are specified between brackets
+!>
+!> @subsection sublog namlog
+!>    the logger sub-namelist parameters are :
+!>
+!>    - **cn_logfile** [@a addline.log]<br/>
+!>       logger filename
+!>
+!>    - **cn_verbosity** [@a warning]<br/>
+!>       verbosity level, choose between :
+!>          - trace
+!>          - debug
+!>          - info
+!>          - warning
+!>          - error
+!>          - fatal
+!>          - none
+!>
+!>    - **in_maxerror** [@a 5]<br/> 
+!>       maximum number of error allowed
+!>
+!> @subsection subcfg namcfg
+!>    the configuration sub-namelist parameters are :
+!>
+!>    - **cn_varcfg** [@a ./cfg/variable.cfg]<br/>
+!>       path to the variable configuration file.<br/>
+!>       the variable configuration file defines standard name, 
+!>       default interpolation method, axis,... 
+!>       to be used for some known variables.<br/> 
+!>
+!>    - **cn_dimcfg** [@a ./cfg/dimension.cfg]<br/> 
+!>       path to the dimension configuration file.<br/> 
+!>       the dimension configuration file defines dimensions allowed.<br/> 
+!>
+!>    - **cn_dumcfg** [@a ./cfg/dummy.cfg]<br/> 
+!>       path to the useless (dummy) configuration file.<br/>
+!>       the dummy configuration file defines useless 
+!>       dimension or variable. these dimension(s) or variable(s) will not be
+!>       processed.<br/>
+!>
+!> @subsection subsrc namsrc 
+!>    the source/coarse grid sub-namelist parameters are :
+!>
+!>    - **cn_coord0** [@a ]<br/> 
+!>       path to the coordinate file
+!>
+!>    - **in_perio0** [@a ]<br/> 
+!>       NEMO periodicity index<br/> 
+!>       the NEMO periodicity could be choose between 0 to 6:
+!>       <dl>
+!>          <dt>in_perio=0</dt>
+!>          <dd>standard regional model</dd>
+!>          <dt>in_perio=1</dt>
+!>          <dd>east-west cyclic model</dd>
+!>          <dt>in_perio=2</dt>
+!>          <dd>model with symmetric boundary condition across the equator</dd>
+!>          <dt>in_perio=3</dt>
+!>          <dd>regional model with North fold boundary and T-point pivot</dd>
+!>          <dt>in_perio=4</dt>
+!>          <dd>global model with a T-point pivot.<br/>
+!>          example: ORCA2, ORCA025, ORCA12</dd>
+!>          <dt>in_perio=5</dt>
+!>          <dd>regional model with North fold boundary and F-point pivot</dd>
+!>          <dt>in_perio=6</dt>
+!>          <dd>global model with a F-point pivot<br/>
+!>          example: ORCA05</dd>
+!>          </dd>
+!>       </dl>
+!>       @sa For more information see @ref md_src_docsrc_6_perio
+!>       and Model Boundary Condition paragraph in the 
+!>       [NEMO documentation](https://forge.ipsl.jussieu.fr/nemo/chrome/site/doc/NEMO/manual/pdf/NEMO_manual.pdf)
+!>
+!> @subsection subvar namvar 
+!>    the variable sub-namelist parameters are :
+!>
+!>    - **cn_varfile** [@a ]<br/> 
+!>       list of variable, and associated file 
+!>
+!>       *cn_varfile* is the path and filename of the file where find
+!>       variable.
+!>       @note 
+!>          *cn_varfile* could be a matrix of value, if you want to handwrite
+!>          variable value.<br/>
+!>          the variable array of value is split into equal subdomain.<br/>
+!>          each subdomain is filled with the corresponding value 
+!>          of the matrix.<br/>          
+!>          separators used to defined matrix are:
+!>             - ',' for line
+!>             - '/' for row
+!>             Example:<br/>
+!>                3,2,3/1,4,5  =>  @f$ \left( \begin{array}{ccc}
+!>                                      3 & 2 & 3 \\
+!>                                      1 & 4 & 5 \end{array} \right) @f$
+!>
+!>       Examples: 
+!>          - 'Bathymetry:gridT.nc'
+!>
+!>       @note 
+!>          Optionnaly, NEMO periodicity could be added following the filename.
+!>          the periodicity must be separated by ';'
+!>
+!>       Example:
+!>          - 'Bathymetry:gridT.nc ; perio=4'<br/>
+!>
+!>    - **cn_varinfo** [@a ]<br/> 
+!>       list of variable and extra information about request(s) to be used<br/>
+!>
+!>       each elements of *cn_varinfo* is a string character (separated by ',').<br/>
+!>       it is composed of the variable name follow by ':', 
+!>       then request(s) to be used on this variable.<br/> 
+!>       request could be:
+!>          - int = interpolation method
+!>          - ext = extrapolation method
+!>          - flt = filter method
+!>          - min = minimum value
+!>          - max = maximum value
+!>          - unt = new units
+!>          - unf = unit scale factor (linked to new units)
+!>
+!>             requests must be separated by ';'.<br/>
+!>             order of requests does not matter.<br/>
+!>
+!>       informations about available method could be find in @ref interp,
+!>       @ref extrap and @ref filter modules.<br/>
+!>       Example: 
+!>          - 'Bathymetry: flt=2*hamming(2,3); min=0'
+!>
+!>       @note 
+!>          If you do not specify a method which is required, 
+!>          default one is apply.
+!>
+!> @subsection subout namout 
+!>    the output sub-namelist parameter is :
+!>
+!>    - **cn_fileout** [@a addline_deg.nc]<br/>
+!>       output filename
+!>    - @b ln_extrap [@a .FALSE.]<br/>
+!>       extrapolate extra line 
+!>    - @b ln_copy [@a .FALSE.]<br/>
+!>       copy extra line from above
+!>    - **in_nproc** [@a 1]<br/>
+!>       number of processor to be used
+!>    - **in_niproc** [@a 1]<br/>
+!>       i-direction number of processor
+!>    - **in_njproc** [@a 1]<br/>
+!>       j-direction numebr of processor
+!>
+!> <hr>
+!> @author J.Paul
+!> @date October, 2015 - Initial Version
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+PROGRAM addline_deg
+
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+   USE date                            ! date manager
+   USE att                             ! attribute manager
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+   USE file                            ! file manager
+   USE multi                           ! multi file manager
+   USE iom                             ! I/O manager
+   USE grid                            ! grid manager
+   USE extrap                          ! extrapolation manager
+   USE interp                          ! interpolation manager
+   USE filter                          ! filter manager
+   USE mpp                             ! MPP manager
+   USE iom_mpp                         ! MPP I/O manager
+
+   IMPLICIT NONE
+
+   ! local variable
+   CHARACTER(LEN=lc)                                  :: cl_namelist
+   CHARACTER(LEN=lc)                                  :: cl_date
+
+   INTEGER(i4)                                        :: il_narg
+   INTEGER(i4)                                        :: il_status
+   INTEGER(i4)                                        :: il_fileid
+   INTEGER(i4)                                        :: il_varid
+   INTEGER(i4)                                        :: il_attid
+   INTEGER(i4)                                        :: il_index
+   INTEGER(i4)                                        :: il_nvar
+
+   LOGICAL                                            :: ll_exist
+
+   TYPE(TMPP)                                         :: tl_coord0
+   TYPE(TMPP)                                         :: tl_mpp
+   TYPE(TMPP)                                         :: tl_mppout
+
+   TYPE(TATT)                                         :: tl_att
+   
+   TYPE(TVAR)                                         :: tl_lon
+   TYPE(TVAR)                                         :: tl_lat
+   TYPE(TVAR)                                         :: tl_depth
+   TYPE(TVAR)                                         :: tl_time
+
+   TYPE(TVAR)                                         :: tl_tmp
+   TYPE(TVAR)       , DIMENSION(:), ALLOCATABLE       :: tl_var
+   
+   TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
+
+   TYPE(TMULTI)                                       :: tl_multi
+
+   ! loop indices
+   INTEGER(i4) :: ji
+   INTEGER(i4) :: jj
+   INTEGER(i4) :: jk
+   INTEGER(i4) :: jvar
+
+   ! namelist variable
+   ! namlog
+   CHARACTER(LEN=lc)                       :: cn_logfile = 'addline.log' 
+   CHARACTER(LEN=lc)                       :: cn_verbosity = 'warning' 
+   INTEGER(i4)                             :: in_maxerror = 5
+
+   ! namcfg
+   CHARACTER(LEN=lc)                       :: cn_varcfg = 'variable.cfg' 
+   CHARACTER(LEN=lc)                       :: cn_dimcfg = 'dimension.cfg' 
+   CHARACTER(LEN=lc)                       :: cn_dumcfg = 'dummy.cfg' 
+
+   ! namsrc
+   CHARACTER(LEN=lc)                       :: cn_coord0 = '' 
+   INTEGER(i4)                             :: in_perio0 = -1
+
+   ! namvar
+   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = ''
+   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = ''
+
+   ! namout
+   CHARACTER(LEN=lc)                       :: cn_fileout = 'addline_deg.nc' 
+   LOGICAL                                 :: ln_extrap  = .FALSE.
+   LOGICAL                                 :: ln_copy    = .FALSE.
+   INTEGER(i4)                             :: in_nproc   = 0
+   INTEGER(i4)                             :: in_niproc  = 0
+   INTEGER(i4)                             :: in_njproc  = 0
+   CHARACTER(LEN=lc)                       :: cn_type    = 'cdf'
+   !-------------------------------------------------------------------
+
+   NAMELIST /namlog/ &   !< logger namelist
+   &  cn_logfile,    &   !< log file
+   &  cn_verbosity,  &   !< log verbosity
+   &  in_maxerror        !< logger maximum error
+
+   NAMELIST /namcfg/ &   !< configuration namelist
+   &  cn_varcfg, &       !< variable configuration file
+   &  cn_dimcfg, &       !< dimension configuration file
+   &  cn_dumcfg          !< dummy configuration file
+
+   NAMELIST /namsrc/ &   !< source/coarse grid namelist
+   &  cn_coord0,  &      !< coordinate file
+   &  in_perio0          !< periodicity index
+   
+   NAMELIST /namvar/ &   !< variable namelist
+   &  cn_varinfo, &      !< list of variable and interpolation method to be used. (ex: 'votemper:linear','vosaline:cubic' )
+   &  cn_varfile         !< list of variable file
+
+   NAMELIST /namout/ &   !< output namlist
+   &  cn_fileout, &      !< fine grid bathymetry file
+   &  ln_extrap, &
+   &  ln_copy,   &
+   &  in_niproc,  &     !< i-direction number of processor
+   &  in_njproc,  &     !< j-direction numebr of processor
+   &  in_nproc,   &     !< number of processor to be used
+   &  cn_type           !< output type format (dimg, cdf)
+   !-------------------------------------------------------------------
+
+   ! namelist
+   ! get namelist
+   il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec
+   IF( il_narg/=1 )THEN
+      PRINT *,"ERROR in addline: need a namelist"
+      STOP
+   ELSE
+      CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec
+   ENDIF
+ 
+   ! read namelist
+   INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist)
+   IF( ll_exist )THEN
+ 
+      il_fileid=fct_getunit()
+
+      OPEN( il_fileid, FILE=TRIM(cl_namelist), &
+      &                FORM='FORMATTED',       &
+      &                ACCESS='SEQUENTIAL',    &
+      &                STATUS='OLD',           &
+      &                ACTION='READ',          &
+      &                IOSTAT=il_status)
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         PRINT *,"ERROR in addline: error opening "//TRIM(cl_namelist)
+         STOP
+      ENDIF
+
+      READ( il_fileid, NML = namlog )
+      ! define log file
+      CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror)
+      CALL logger_header()
+
+      READ( il_fileid, NML = namcfg )
+      ! get variable extra information
+      CALL var_def_extra(TRIM(cn_varcfg))
+
+      ! get dimension allowed
+      CALL dim_def_extra(TRIM(cn_dimcfg))
+
+      ! get dummy variable
+      CALL var_get_dummy(TRIM(cn_dumcfg))
+      ! get dummy dimension
+      CALL dim_get_dummy(TRIM(cn_dumcfg))
+      ! get dummy attribute
+      CALL att_get_dummy(TRIM(cn_dumcfg))
+
+      READ( il_fileid, NML = namsrc )
+      READ( il_fileid, NML = namvar )
+      ! add user change in extra information
+      CALL var_chg_extra( cn_varinfo )
+      ! match variable with file
+      tl_multi=multi_init(cn_varfile)
+      
+      READ( il_fileid, NML = namout )
+
+      CLOSE( il_fileid, IOSTAT=il_status )
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         CALL logger_error("ADD LINE: closing "//TRIM(cl_namelist))
+      ENDIF
+
+   ELSE
+
+      PRINT *,"ERROR in addline: can't find "//TRIM(cl_namelist)
+      STOP
+
+   ENDIF
+
+   CALL multi_print(tl_multi)
+
+   ! open files
+   IF( cn_coord0 /= '' )THEN
+      tl_coord0=mpp_init( file_init(TRIM(cn_coord0)), id_perio=in_perio0)
+      CALL grid_get_info(tl_coord0)
+   ELSE
+      CALL logger_fatal("ADD LINE: no coarse grid coordinate found. "//&
+      &     "check namelist")      
+   ENDIF
+
+   ! check
+   ! check output file do not already exist
+   print *,'cn_fileout ',TRIM(cn_fileout)
+   INQUIRE(FILE=TRIM(cn_fileout), EXIST=ll_exist)
+   IF( ll_exist )THEN
+      CALL logger_fatal("ADD LINE: output file "//TRIM(cn_fileout)//&
+      &  " already exist.")
+   ENDIF
+
+   IF( .NOT. ASSOCIATED(tl_multi%t_mpp) )THEN
+      CALL logger_error("ADD LINE: no mpp file to work on. "//&
+      &                 "check cn_varfile in namelist.")
+   ELSE
+
+      ALLOCATE( tl_var( tl_multi%i_nvar ) )
+      jk=0
+      DO ji=1,tl_multi%i_nmpp
+      
+         IF( .NOT. ASSOCIATED(tl_multi%t_mpp(ji)%t_proc(1)%t_var) )THEN
+
+            CALL logger_fatal("ADD LINE: no variable to work on for "//&
+            &                 "mpp file"//TRIM(tl_multi%t_mpp(ji)%c_name)//&
+            &                 ". check cn_varfile in namelist.")
+         ELSE
+
+            WRITE(*,'(a)') "work on file "//TRIM(tl_multi%t_mpp(ji)%c_name)
+            tl_mpp=mpp_init( file_init(TRIM(tl_multi%t_mpp(ji)%t_proc(1)%c_name)) )
+            CALL grid_get_info(tl_mpp)
+
+            ! open mpp file
+            CALL iom_mpp_open(tl_mpp)
+
+            ! get or check depth value
+            IF( tl_multi%t_mpp(ji)%t_proc(1)%i_depthid /= 0 )THEN
+               il_varid=tl_multi%t_mpp(ji)%t_proc(1)%i_depthid
+               IF( ASSOCIATED(tl_depth%d_value) )THEN
+                  tl_tmp=iom_mpp_read_var(tl_mpp,il_varid)
+                  IF( ANY( tl_depth%d_value(:,:,:,:) /= &
+                  &        tl_tmp%d_value(:,:,:,:) ) )THEN
+                     CALL logger_fatal("ADD LINE: depth value from "//&
+                     &  TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//&
+                     &  " to those from former file(s).")
+                  ENDIF
+                  CALL var_clean(tl_tmp)
+               ELSE
+                  tl_depth=iom_mpp_read_var(tl_mpp,il_varid)
+               ENDIF
+            ENDIF
+
+            ! get or check time value
+            IF( tl_multi%t_mpp(ji)%t_proc(1)%i_timeid /= 0 )THEN
+               il_varid=tl_multi%t_mpp(ji)%t_proc(1)%i_timeid
+               IF( ASSOCIATED(tl_time%d_value) )THEN
+                  tl_tmp=iom_mpp_read_var(tl_mpp,il_varid)
+                  IF( ANY( tl_time%d_value(:,:,:,:) /= &
+                  &        tl_tmp%d_value(:,:,:,:) ) )THEN
+                     CALL logger_fatal("ADD LINE: time value from "//&
+                     &  TRIM(tl_multi%t_mpp(ji)%c_name)//" not conform "//&
+                     &  " to those from former file(s).")
+                  ENDIF
+                  CALL var_clean(tl_tmp)
+               ELSE
+                  tl_time=iom_mpp_read_var(tl_mpp,il_varid)
+               ENDIF
+            ENDIF
+
+            ! close mpp file
+            CALL iom_mpp_close(tl_mpp)
+
+            !- add line to input file variable 
+            DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
+               jk=jk+1
+               tl_tmp=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj))
+               WRITE(*,'(2x,a)') "work on variable "//TRIM(tl_tmp%c_name)
+            
+               tl_var(jk)=add_line( tl_tmp, tl_mpp, &
+               &                    tl_coord0 )
+
+               IF( ln_copy )THEN
+                  tl_var(jk)%d_value(:,2,:,:)=tl_var(jk)%d_value(:,3,:,:)
+               ELSEIF( ln_extrap )THEN
+                  ! extrapolate variable
+                  CALL extrap_fill_value( tl_var(jk) )
+               ENDIF
+               ! clean
+               CALL var_clean(tl_tmp)
+
+            ENDDO
+
+         ENDIF
+
+      ENDDO
+
+   ENDIF
+
+   il_nvar=tl_multi%i_nvar
+   ! clean
+   CALL multi_clean(tl_multi)
+
+   ! create file
+   IF( in_niproc == 0 .AND. &
+   &   in_njproc == 0 .AND. &
+   &   in_nproc == 0 )THEN
+      in_niproc = 1
+      in_njproc = 1
+      in_nproc = 1
+   ENDIF
+
+   ! add dimension
+   tl_dim(:)=var_max_dim(tl_var(:))
+
+   DO ji=1,il_nvar
+
+      IF( ALL(tl_var(ji)%t_dim(:)%i_len == tl_dim(:)%i_len) )THEN
+         tl_mppout=mpp_init( TRIM(cn_fileout), tl_var(ji), &
+         &                   in_niproc, in_njproc, in_nproc, &
+         &                   cd_type=cn_type)
+         EXIT
+      ENDIF
+
+   ENDDO
+
+   DO ji=1,ip_maxdim
+
+      IF( tl_dim(ji)%l_use )THEN
+         CALL mpp_move_dim(tl_mppout, tl_dim(ji))
+         SELECT CASE(TRIM(tl_dim(ji)%c_sname))
+         CASE('z','t')
+            DO jj=1,tl_mppout%i_nproc
+               CALL file_add_dim(tl_mppout%t_proc(jj), tl_dim(ji))
+            ENDDO
+         END SELECT 
+      ENDIF
+
+   ENDDO
+
+   ! add variables
+   IF( ALL( tl_dim(1:2)%l_use ) )THEN
+
+      ! open mpp files
+      CALL iom_mpp_open(tl_coord0)
+
+      ! add longitude
+      tl_lon=iom_mpp_read_var(tl_coord0,'longitude')
+      CALL mpp_add_var(tl_mppout, tl_lon)
+      CALL var_clean(tl_lon)
+
+      ! add latitude
+      tl_lat=iom_mpp_read_var(tl_coord0,'latitude')
+      CALL mpp_add_var(tl_mppout, tl_lat)
+      CALL var_clean(tl_lat)
+
+      ! close mpp files
+      CALL iom_mpp_close(tl_coord0)
+
+   ENDIF
+
+   IF( tl_dim(3)%l_use )THEN
+      IF( ASSOCIATED(tl_depth%d_value) )THEN
+         ! add depth
+         CALL mpp_add_var(tl_mppout, tl_depth)
+      ELSE
+         CALL logger_warn("CREATE RESTART: no value for depth variable.")
+      ENDIF
+   ENDIF
+   IF( ASSOCIATED(tl_depth%d_value) ) CALL var_clean(tl_depth)
+
+   IF( tl_dim(4)%l_use )THEN
+      IF( ASSOCIATED(tl_time%d_value) )THEN
+         ! add time
+         CALL mpp_add_var(tl_mppout, tl_time)
+      ELSE
+         CALL logger_warn("CREATE RESTART: no value for time variable.")
+      ENDIF
+   ENDIF
+   IF( ASSOCIATED(tl_time%d_value) ) CALL var_clean(tl_time)
+
+   ! add other variables
+   DO jvar=il_nvar,1,-1
+      ! check if variable already add
+      il_index=var_get_index(tl_mppout%t_proc(1)%t_var(:), tl_var(jvar)%c_name)
+      IF( il_index == 0 )THEN
+         CALL mpp_add_var(tl_mppout, tl_var(jvar))
+         CALL var_clean(tl_var(jvar))
+      ENDIF
+   ENDDO
+
+   ! add some attribute
+   tl_att=att_init("Created_by","SIREN addline_deg")
+   CALL mpp_add_att(tl_mppout, tl_att)
+
+   cl_date=date_print(date_now())
+   tl_att=att_init("Creation_date",cl_date)
+   CALL mpp_add_att(tl_mppout, tl_att)
+
+   ! add attribute periodicity
+   il_attid=0
+   IF( ASSOCIATED(tl_mppout%t_proc(1)%t_att) )THEN
+      il_attid=att_get_id(tl_mppout%t_proc(1)%t_att(:),'periodicity')
+   ENDIF
+   IF( tl_coord0%i_perio >= 0 .AND. il_attid == 0 )THEN
+      tl_att=att_init('periodicity',tl_coord0%i_perio)
+      CALL mpp_add_att(tl_mppout,tl_att)
+   ENDIF
+
+   il_attid=0
+   IF( ASSOCIATED(tl_mppout%t_proc(1)%t_att) )THEN
+      il_attid=att_get_id(tl_mppout%t_proc(1)%t_att(:),'ew_overlap')
+   ENDIF
+   IF( tl_coord0%i_ew >= 0 .AND. il_attid == 0 )THEN
+      tl_att=att_init('ew_overlap',tl_coord0%i_ew)
+      CALL mpp_add_att(tl_mppout,tl_att)
+   ENDIF
+   
+   ! print
+   CALL mpp_print(tl_mppout)
+
+   ! create file
+   CALL iom_mpp_create(tl_mppout)
+
+   ! write file
+   CALL iom_mpp_write_file(tl_mppout)
+   ! close file
+   CALL iom_mpp_close(tl_mppout)
+
+   ! clean
+   CALL att_clean(tl_att)
+   CALL var_clean(tl_var(:))
+   DEALLOCATE(tl_var)
+
+   CALL mpp_clean(tl_mppout)
+   CALL mpp_clean(tl_coord0)
+
+   ! close log file
+   CALL logger_footer()
+   CALL logger_close()
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION add_line(td_var, td_mpp, td_coord) &
+         &  RESULT(tf_var)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function add line to variable and return variable structure
+   !> 
+   !> @author J.Paul
+   !> @date October, 2015 - Initial Version
+   !>
+   !> @param[in] td_var    variable structure 
+   !> @param[in] td_mpp    mpp file structure
+   !> @param[in] td_coord  coordinate file structure
+   !> @return variable structure
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR), INTENT(IN) :: td_var  
+      TYPE(TMPP), INTENT(IN) :: td_mpp
+      TYPE(TMPP), INTENT(IN) :: td_coord
+
+      ! function
+      TYPE(TVAR)             :: tf_var
+
+      ! local variable
+      INTEGER(i4), DIMENSION(2,2) :: il_ghost
+
+      TYPE(TMPP)  :: tl_mpp
+
+      TYPE(TATT)  :: tl_att
+
+      TYPE(TDIM), DIMENSION(ip_maxdim)  :: tl_dim
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+         CALL logger_error("ADD LINE: no processor associated "//&
+         &  "to mpp "//TRIM(td_mpp%c_name))
+      ELSE
+
+         !init
+         tl_mpp=mpp_copy(td_mpp)
+         il_ghost(:,:)=0
+
+         tl_dim(:)=dim_copy(td_coord%t_dim(:))
+
+         ! ghost cell to be added
+         il_ghost(jp_I,:)=(/0,0/)
+         il_ghost(jp_J,:)=(/1,0/)
+
+         ! open mpp files
+         CALL iom_mpp_open(tl_mpp)
+
+         ! read variable
+         tf_var=iom_mpp_read_var(tl_mpp,TRIM(td_var%c_name))
+
+         ! close mpp file
+         CALL iom_mpp_close(tl_mpp)
+
+         ! add ghost cell
+         CALL grid_add_ghost(tf_var,il_ghost(:,:))
+
+         ! add attribute to variable
+         tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name)))
+         CALL var_move_att(tf_var, tl_att)         
+
+         tl_att=att_init('add_i_line',(/il_ghost(jp_I,1), il_ghost(jp_I,2)/))
+         CALL var_move_att(tf_var, tl_att)
+
+         tl_att=att_init('add_j_line',(/il_ghost(jp_J,1), il_ghost(jp_J,2)/))
+         CALL var_move_att(tf_var, tl_att)
+
+         ! clean structure
+         CALL att_clean(tl_att)
+         CALL mpp_clean(tl_mpp)
+      ENDIF
+
+   END FUNCTION add_line
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END PROGRAM 
Index: /utils/tools_ticket2413/SIREN/src/attribute.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/attribute.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/attribute.f90	(revision 12863)
@@ -0,0 +1,1516 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief 
+!> This module manage attribute of variable or file.
+!>
+!> @details
+!>    define type TATT:<br/>
+!> @code
+!>    TYPE(TATT) :: tl_att
+!> @endcode
+!>
+!>    the attribute value inside attribute structure will be
+!>    character or real(8) 1D array.<br/>
+!>    However the attribute value could be initialized with:<br/>
+!>    - character
+!>    - scalar (real(4), real(8), integer(4) or integer(8))
+!>    - array 1D (real(4), real(8), integer(4) or integer(8))
+!>
+!>    to initialize an attribute structure :<br/>
+!> @code
+!>    tl_att=att_init('attname',value)
+!> @endcode
+!>    - value is a character, scalar value or table of value
+!>
+!>    to print attribute information of one or array of attribute structure:<br/>
+!> @code
+!>    CALL att_print(td_att) 
+!> @endcode
+!>
+!>    to clean attribute structure:<br/>
+!> @code
+!>    CALL att_clean(td_att) 
+!> @endcode
+!>
+!>    to copy attribute structure in another one (using different memory cell):<br/>
+!> @code
+!>    tl_att2=att_copy(tl_att1) 
+!> @endcode
+!>    @note as we use pointer for the value array of the attribute structure,
+!>    the use of the assignment operator (=) to copy attribute structure 
+!>    create a pointer on the same array. 
+!>    This is not the case with this copy function.
+!>
+!>    to get attribute index, in an array of attribute structure:<br/>
+!> @code
+!>   il_index=att_get_index( td_att, cd_name )
+!> @endcode
+!>    - td_att array of attribute structure
+!>    - cd_name attribute name
+!> 
+!>    to get attribute id, read from a file:<br/>
+!>@code
+!>  il_id=att_get_id( td_att, cd_name )
+!>@endcode
+!>    - td_att array of attribute structure
+!>    - cd_name attribute name
+!>
+!>    to get attribute name
+!>    - tl_att\%c_name
+!> 
+!>    to get character length or the number of value store in attribute
+!>    - tl_att\%i_len
+!>
+!>    to get attribute value:<br/>
+!>    - tl_att\%c_value    (for character attribute)
+!>    - tl_att\%d_value(i) (otherwise)
+!>    
+!>    to get the type number (based on NETCDF type constants) of the 
+!>    attribute:<br/>
+!>    - tl_att\%i_type
+!>
+!>    to get attribute id (read from file):<br/>
+!>    - tl_att\%i_id
+!>
+!> @author J.Paul
+!>
+!> @date November, 2013 - Initial Version
+!> @date November, 2014 
+!> - Fix memory leaks bug
+!> @date September, 2015
+!> - manage useless (dummy) attributes
+!> @date May, 2019
+!> - read number of element for each dummy array in configuration file
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE att
+
+   USE netcdf                          ! nf90 library
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+
+   IMPLICIT NONE
+
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   PUBLIC :: TATT       !< attribute structure
+
+   PRIVATE :: im_ndumatt   !< number of elt in dummy attribute array
+   PRIVATE :: cm_dumatt    !< dummy attribute array
+
+   ! function and subroutine
+   PUBLIC :: att_init       !< initialize attribute structure
+   PUBLIC :: att_print      !< print attribute structure
+   PUBLIC :: att_clean      !< clean attribute strcuture
+   PUBLIC :: att_copy       !< copy attribute structure
+   PUBLIC :: att_get_index  !< get attribute index, in an array of attribute structure
+   PUBLIC :: att_get_id     !< get attribute id, read from file
+   PUBLIC :: att_get_dummy  !< fill dummy attribute array
+   PUBLIC :: att_is_dummy   !< check if attribute is defined as dummy attribute
+
+   PRIVATE :: att__clean_unit ! clean attribute strcuture
+   PRIVATE :: att__clean_arr  ! clean array of attribute strcuture
+   PRIVATE :: att__print_unit ! print information on one attribute
+   PRIVATE :: att__print_arr  ! print information on a array of attribute
+   PRIVATE :: att__init_c     ! initialize an attribute structure with character value
+   PRIVATE :: att__init_dp    ! initialize an attribute structure with array of real(8) value
+   PRIVATE :: att__init_dp_0d ! initialize an attribute structure with real(8) value
+   PRIVATE :: att__init_sp    ! initialize an attribute structure with array of real(4) value
+   PRIVATE :: att__init_sp_0d ! initialize an attribute structure with real(4) value
+   PRIVATE :: att__init_i1    ! initialize an attribute structure with array of integer(1) value
+   PRIVATE :: att__init_i1_0d ! initialize an attribute structure with integer(1) value
+   PRIVATE :: att__init_i2    ! initialize an attribute structure with array of integer(2) value
+   PRIVATE :: att__init_i2_0d ! initialize an attribute structure with integer(2) value
+   PRIVATE :: att__init_i4    ! initialize an attribute structure with array of integer(4) value
+   PRIVATE :: att__init_i4_0d ! initialize an attribute structure with integer(4) value
+   PRIVATE :: att__init_i8    ! initialize an attribute structure with array of integer(8) value
+   PRIVATE :: att__init_i8_0d ! initialize an attribute structure with integer(8) value
+   PRIVATE :: att__copy_unit  ! copy attribute structure
+   PRIVATE :: att__copy_arr   ! copy array of attribute structure
+
+   TYPE TATT !< attribute structure
+      CHARACTER(LEN=lc) :: c_name = ''       !< attribute name
+      INTEGER(i4)       :: i_id   = 0        !< attribute id
+      INTEGER(i4)       :: i_type = 0        !< attribute type
+      INTEGER(i4)       :: i_len  = 0        !< number of value store in attribute
+      CHARACTER(LEN=lc) :: c_value = 'none'  !< attribute value if type CHAR
+      REAL(dp), DIMENSION(:), POINTER :: d_value => NULL() !< attribute value if type SHORT,INT,FLOAT or DOUBLE
+   END TYPE TATT
+
+   INTEGER(i4)                               , SAVE :: im_ndumatt !< number of elt in dummy attribute array
+   CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg), SAVE :: cm_dumatt  !< dummy attribute
+
+   INTERFACE att_init
+      MODULE PROCEDURE att__init_c    
+      MODULE PROCEDURE att__init_dp
+      MODULE PROCEDURE att__init_dp_0d
+      MODULE PROCEDURE att__init_sp
+      MODULE PROCEDURE att__init_sp_0d
+      MODULE PROCEDURE att__init_i1
+      MODULE PROCEDURE att__init_i1_0d
+      MODULE PROCEDURE att__init_i2
+      MODULE PROCEDURE att__init_i2_0d
+      MODULE PROCEDURE att__init_i4
+      MODULE PROCEDURE att__init_i4_0d
+      MODULE PROCEDURE att__init_i8
+      MODULE PROCEDURE att__init_i8_0d
+   END INTERFACE att_init
+
+   INTERFACE att_print
+      MODULE PROCEDURE att__print_unit ! print information on one attribute
+      MODULE PROCEDURE att__print_arr  ! print information on a array of attribute
+   END INTERFACE att_print
+
+   INTERFACE att_clean
+      MODULE PROCEDURE att__clean_unit  
+      MODULE PROCEDURE att__clean_arr   
+   END INTERFACE
+
+   INTERFACE att_copy
+      MODULE PROCEDURE att__copy_unit  ! copy attribute structure
+      MODULE PROCEDURE att__copy_arr   ! copy array of attribute structure
+   END INTERFACE
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION att__copy_arr(td_att) &
+         & RESULT(tf_att)      
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy a array of attribute structure in another one
+   !> @details 
+   !> see att__copy_unit
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> attribute (ex: tl_att=att_copy(att_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2014
+   !> - use function instead of overload assignment operator 
+   !> (to avoid memory leak) 
+   !
+   !> @param[in] td_att   array of attribute structure
+   !> @return copy of input array of attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TATT), DIMENSION(:)  , INTENT(IN) :: td_att
+      ! function
+      TYPE(TATT), DIMENSION(SIZE(td_att(:))) :: tf_att
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=1,SIZE(td_att(:))
+         tf_att(ji)=att_copy(td_att(ji))
+      ENDDO
+
+   END FUNCTION att__copy_arr
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION att__copy_unit(td_att) &
+         & RESULT (tf_att)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy an attribute structure in another one.
+   !> @details 
+   !> attribute value are copied in a temporary array, so input and output
+   !> attribute structure value do not point on the same "memory cell", and so
+   !> on are independant. 
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> attribute (ex: tl_att=att_copy(att_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2014
+   !> - use function instead of overload assignment operator (to avoid memory leak) 
+   !>
+   !> @param[in] td_att   attribute structure
+   !> @return copy of input attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TATT), INTENT(IN)  :: td_att
+
+      ! function
+      TYPE(TATT)              :: tf_att
+
+      ! local variable
+      REAL(dp)         , DIMENSION(:), ALLOCATABLE :: dl_value
+      !----------------------------------------------------------------
+
+      ! copy attribute variable
+      tf_att%c_name  = TRIM(td_att%c_name)
+      tf_att%i_id    = td_att%i_id
+      tf_att%i_type  = td_att%i_type
+      tf_att%i_len   = td_att%i_len
+      tf_att%c_value = TRIM(td_att%c_value)
+
+      ! copy attribute pointer in an independant variable
+      IF( ASSOCIATED(tf_att%d_value) ) DEALLOCATE(tf_att%d_value)
+      IF( ASSOCIATED(td_att%d_value) )THEN
+         ALLOCATE( dl_value(td_att%i_len) )
+         dl_value(:) = td_att%d_value(:)
+
+         ALLOCATE( tf_att%d_value(tf_att%i_len) )
+         tf_att%d_value(:) = dl_value(:)
+
+         DEALLOCATE( dl_value )
+      ENDIF
+
+   END FUNCTION att__copy_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION att_get_index(td_att, cd_name) &
+         & RESULT(if_idx)
+   !-------------------------------------------------------------------
+   !> @brief This function return attribute index, in a array of attribute structure,
+   !> given attribute name.<br/>
+   !> @details
+   !> if attribute name do not exist, return 0.
+   !>
+   !> @author J.Paul
+   !> @date Septempber, 2014 - Initial Version
+   !
+   !> @param[in] td_att    array of attribute structure
+   !> @param[in] cd_name   attribute name
+   !> @return attribute index
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TATT),       DIMENSION(:), INTENT(IN) :: td_att
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+
+      ! function
+      INTEGER(i4)                                :: if_idx
+
+      ! local variable
+      INTEGER(i4) :: il_size
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      if_idx=0
+
+      il_size=SIZE(td_att(:))
+      DO ji=1,il_size
+         IF( TRIM(td_att(ji)%c_name) == TRIM(cd_name) )THEN
+            if_idx=ji
+            EXIT
+         ENDIF
+      ENDDO
+
+   END FUNCTION att_get_index
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION att_get_id(td_att, cd_name) &
+         & RESULT (if_id)
+   !-------------------------------------------------------------------
+   !> @brief This function return attribute id, read from a file.<br/>
+   !> @details
+   !> if attribute name do not exist, return 0.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014 
+   !> - bug fix with use of id read from attribute structure
+   !>
+   !> @param[in] td_att    array of attribute structure
+   !> @param[in] cd_name   attribute name
+   !> @return attribute id
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TATT),       DIMENSION(:), INTENT(IN) :: td_att
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+
+      ! function
+      INTEGER(i4)                                :: if_id
+
+      ! local variable
+      INTEGER(i4) :: il_size
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      if_id=0
+
+      il_size=SIZE(td_att(:))
+      DO ji=1,il_size
+         IF( TRIM(td_att(ji)%c_name) == TRIM(cd_name) )THEN
+            if_id=td_att(ji)%i_id
+            EXIT
+         ENDIF
+      ENDDO
+
+   END FUNCTION att_get_id
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION att__init_c(cd_name, cd_value) &
+         & RESULT (tf_att)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize an attribute structure with character
+   !> value. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_name   attribute name
+   !> @param[in] cd_value  attribute value
+   !> @return attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+      CHARACTER(LEN=*), INTENT(IN) :: cd_value
+
+      ! function
+      TYPE(TATT)                   :: tf_att
+      !----------------------------------------------------------------
+ 
+      ! clean attribute
+      CALL att_clean(tf_att)
+
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
+      &  " attribute value "//TRIM(ADJUSTL(cd_value)) )
+
+      tf_att%c_name=TRIM(ADJUSTL(cd_name))
+      tf_att%i_type=NF90_CHAR
+
+      tf_att%c_value=TRIM(ADJUSTL(cd_value))
+      tf_att%i_len=LEN( TRIM(ADJUSTL(cd_value)) )
+
+   END FUNCTION att__init_c
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION att__init_dp(cd_name, dd_value, id_type) &
+         & RESULT (tf_att)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize an attribute structure with array 
+   !> of real(8) value.
+   !> @details
+   !> Optionaly you could specify the type of the variable to be saved.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_name   attribute name
+   !> @param[in] dd_value  attribute value
+   !> @param[in] id_type   type of the variable to be saved
+   !> @return attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+      REAL(dp),         DIMENSION(:), INTENT(IN) :: dd_value
+      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type
+
+      ! function
+      TYPE(TATT)                                 :: tf_att
+
+      ! local value
+      INTEGER(i4)       :: il_len
+      CHARACTER(LEN=lc) :: cl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! clean attribute
+      CALL att_clean(tf_att)
+
+      ! array size
+      il_len=size(dd_value(:))
+
+      cl_value="(/"
+      DO ji=1,il_len-1
+         cl_value=TRIM(cl_value)//TRIM(fct_str(dd_value(ji)))//","
+      ENDDO
+      cl_value=TRIM(cl_value)//TRIM(fct_str(dd_value(il_len)))//"/)"
+
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
+      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )
+
+      tf_att%c_name=TRIM(ADJUSTL(cd_name))
+
+      IF( PRESENT(id_type) )THEN
+         tf_att%i_type=id_type
+      ELSE
+         tf_att%i_type=NF90_DOUBLE
+      ENDIF
+
+      IF( ASSOCIATED(tf_att%d_value) )THEN
+         DEALLOCATE(tf_att%d_value)
+      ENDIF
+      ALLOCATE(tf_att%d_value(il_len))
+
+      tf_att%d_value(:)=dd_value(:)
+      tf_att%i_len=il_len
+
+   END FUNCTION att__init_dp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION att__init_dp_0d(cd_name, dd_value, id_type) &
+         & RESULT (tf_att)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize an attribute structure with 
+   !> real(8) value 
+   !> @details
+   !> Optionaly you could specify the type of the variable to be saved.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_name   attribute name
+   !> @param[in] dd_value  attribute value
+   !> @param[in] id_type   type of the variable to be saved
+   !> @return attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+      REAL(dp),         INTENT(IN) :: dd_value
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type
+
+      ! function
+      TYPE(TATT)                   :: tf_att
+
+      ! local value
+      CHARACTER(LEN=lc) :: cl_value
+      !----------------------------------------------------------------
+
+      ! clean attribute
+      CALL att_clean(tf_att)
+      
+      cl_value="(/"//TRIM(fct_str(dd_value))//"/)"
+
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
+      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )
+
+      tf_att%c_name=TRIM(ADJUSTL(cd_name))
+
+      IF( PRESENT(id_type) )THEN
+         tf_att%i_type=id_type
+      ELSE
+         tf_att%i_type=NF90_DOUBLE
+      ENDIF
+
+      IF( ASSOCIATED(tf_att%d_value) )THEN
+         DEALLOCATE(tf_att%d_value)
+      ENDIF
+      ALLOCATE(tf_att%d_value(1))
+
+      tf_att%d_value(1)=dd_value
+      tf_att%i_len=1
+
+   END FUNCTION att__init_dp_0d
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION att__init_sp(cd_name, rd_value, id_type) &
+         & RESULT (tf_att)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize an attribute structure with array 
+   !> of real(4) value.
+   !> @details
+   !> Optionaly you could specify the type of the variable to be saved.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_name   attribute name
+   !> @param[in] rd_value  attribute value
+   !> @param[in] id_type   type of the variable to be saved
+   !> @return attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+      REAL(sp),         DIMENSION(:), INTENT(IN) :: rd_value
+      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type
+
+      ! function
+      TYPE(TATT)                                 :: tf_att
+
+      ! local value
+      INTEGER(i4)       :: il_len
+      CHARACTER(LEN=lc) :: cl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! clean attribute
+      CALL att_clean(tf_att)
+      
+      ! array size
+      il_len=size(rd_value(:))
+
+      cl_value="(/"
+      DO ji=1,il_len-1
+         cl_value=TRIM(cl_value)//TRIM(fct_str(rd_value(ji)))//","
+      ENDDO
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: il_len "//fct_str(il_len)&
+      )
+      cl_value=TRIM(cl_value)//TRIM(fct_str(rd_value(il_len)))//"/)"
+
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
+      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )      
+
+      tf_att%c_name=TRIM(ADJUSTL(cd_name))
+
+      IF( PRESENT(id_type) )THEN
+         tf_att%i_type=id_type
+      ELSE
+         tf_att%i_type=NF90_FLOAT
+      ENDIF
+
+      IF( ASSOCIATED(tf_att%d_value) )THEN
+         DEALLOCATE(tf_att%d_value)
+      ENDIF
+      ALLOCATE(tf_att%d_value(il_len))
+
+      tf_att%d_value(:)=REAL(rd_value(:),dp)
+      tf_att%i_len=il_len
+
+   END FUNCTION att__init_sp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION att__init_sp_0d(cd_name, rd_value, id_type) &
+         & RESULT (tf_att)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize an attribute structure with 
+   !> real(4) value. 
+   !> @details
+   !> Optionaly you could specify the type of the variable to be saved.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_name   attribute name
+   !> @param[in] rd_value  attribute value
+   !> @param[in] id_type   type of the variable to be saved
+   !> @return attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+      REAL(sp),         INTENT(IN) :: rd_value
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type
+
+      ! function
+      TYPE(TATT)                   :: tf_att
+
+      ! local value
+      CHARACTER(LEN=lc) :: cl_value
+      !----------------------------------------------------------------
+
+      ! clean attribute
+      CALL att_clean(tf_att)
+      
+      cl_value="(/"//TRIM(fct_str(rd_value))//"/)"
+
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
+      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )      
+
+      tf_att%c_name=TRIM(ADJUSTL(cd_name))
+
+      IF( PRESENT(id_type) )THEN
+         tf_att%i_type=id_type
+      ELSE
+         tf_att%i_type=NF90_FLOAT
+      ENDIF
+
+      IF( ASSOCIATED(tf_att%d_value) )THEN
+         DEALLOCATE(tf_att%d_value)
+      ENDIF
+      ALLOCATE(tf_att%d_value(1))
+
+      tf_att%d_value(1)=REAL(rd_value,dp)
+      tf_att%i_len=1
+
+   END FUNCTION att__init_sp_0d
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION att__init_i1(cd_name, bd_value, id_type) &
+         & RESULT (tf_att)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize an attribute structure with array 
+   !> of integer(1) value.
+   !> @details
+   !> Optionaly you could specify the type of the variable to be saved.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_name   attribute name
+   !> @param[in] bd_value  attribute value
+   !> @param[in] id_type   type of the variable to be saved
+   !> @return attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+      INTEGER(i1),      DIMENSION(:), INTENT(IN) :: bd_value
+      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type
+
+      ! function
+      TYPE(TATT)                                 :: tf_att
+
+      ! local value
+      INTEGER(i4)       :: il_len
+      CHARACTER(LEN=lc) :: cl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! clean attribute
+      CALL att_clean(tf_att)
+      
+      ! array size
+      il_len=size(bd_value(:))
+
+      cl_value="(/"
+      DO ji=1,il_len-1
+         cl_value=TRIM(cl_value)//TRIM(fct_str(bd_value(ji)))//","
+      ENDDO
+      cl_value=TRIM(cl_value)//TRIM(fct_str(bd_value(il_len)))//"/)"
+
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
+      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )      
+
+      tf_att%c_name=TRIM(ADJUSTL(cd_name))
+
+      IF( PRESENT(id_type) )THEN
+         tf_att%i_type=id_type
+      ELSE
+         tf_att%i_type=NF90_BYTE
+      ENDIF
+
+      IF( ASSOCIATED(tf_att%d_value) )THEN
+         DEALLOCATE(tf_att%d_value)
+      ENDIF
+      ALLOCATE(tf_att%d_value(il_len))
+
+      tf_att%d_value(:)=REAL(bd_value(:),dp)
+      tf_att%i_len=il_len
+
+   END FUNCTION att__init_i1
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION att__init_i1_0d(cd_name, bd_value, id_type) &
+         & RESULT (tf_att)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize an attribute structure with 
+   !> integer(1) value. 
+   !> @details
+   !> Optionaly you could specify the type of the variable to be saved.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_name   attribute name
+   !> @param[in] bd_value  attribute value
+   !> @param[in] id_type   type of the variable to be saved
+   !> @return attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+      INTEGER(i1),      INTENT(IN) :: bd_value
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type
+
+      ! function
+      TYPE(TATT)                   :: tf_att
+
+      !local value
+      CHARACTER(LEN=lc) :: cl_value
+      !----------------------------------------------------------------
+
+      ! clean attribute
+      CALL att_clean(tf_att)
+      
+      cl_value="(/"//TRIM(fct_str(bd_value))//"/)"
+
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
+      &  " attibute value "//TRIM(ADJUSTL(cl_value)) )      
+
+      tf_att%c_name=TRIM(ADJUSTL(cd_name))
+
+      IF( PRESENT(id_type) )THEN
+         tf_att%i_type=id_type
+      ELSE
+         tf_att%i_type=NF90_BYTE
+      ENDIF      
+
+      IF( ASSOCIATED(tf_att%d_value) )THEN
+         DEALLOCATE(tf_att%d_value)
+      ENDIF
+      ALLOCATE(tf_att%d_value(1))
+
+      tf_att%d_value(1)=REAL(bd_value,dp)
+      tf_att%i_len=1
+
+   END FUNCTION att__init_i1_0d
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION att__init_i2(cd_name, sd_value, id_type) &
+         & RESULT (tf_att)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize an attribute structure with array 
+   !> of integer(2) value.
+   !> @details
+   !> Optionaly you could specify the type of the variable to be saved.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_name   attribute name
+   !> @param[in] sd_value  attribute value
+   !> @param[in] id_type   type of the variable to be saved
+   !> @return attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+      INTEGER(i2),      DIMENSION(:), INTENT(IN) :: sd_value
+      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type
+
+      ! function
+      TYPE(TATT)                                 :: tf_att
+
+      ! local value
+      INTEGER(i4)       :: il_len
+      CHARACTER(LEN=lc) :: cl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! clean attribute
+      CALL att_clean(tf_att)
+      
+      ! array size
+      il_len=size(sd_value(:))
+
+      cl_value="(/"
+      DO ji=1,il_len-1
+         cl_value=TRIM(cl_value)//TRIM(fct_str(sd_value(ji)))//","
+      ENDDO
+      cl_value=TRIM(cl_value)//TRIM(fct_str(sd_value(il_len)))//"/)"
+
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
+      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )      
+
+      tf_att%c_name=TRIM(ADJUSTL(cd_name))
+
+      IF( PRESENT(id_type) )THEN
+         tf_att%i_type=id_type
+      ELSE
+         tf_att%i_type=NF90_SHORT
+      ENDIF
+
+      IF( ASSOCIATED(tf_att%d_value) )THEN
+         DEALLOCATE(tf_att%d_value)
+      ENDIF
+      ALLOCATE(tf_att%d_value(il_len))
+
+      tf_att%d_value(:)=REAL(sd_value(:),dp)
+      tf_att%i_len=il_len
+
+   END FUNCTION att__init_i2
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION att__init_i2_0d(cd_name, sd_value, id_type) &
+         & RESULT (tf_att)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize an attribute structure with 
+   !> integer(2) value. 
+   !> @details
+   !> Optionaly you could specify the type of the variable to be saved.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_name   attribute name
+   !> @param[in] sd_value  attribute value
+   !> @param[in] id_type   type of the variable to be saved
+   !> @return attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+      INTEGER(i2),      INTENT(IN) :: sd_value
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type
+
+      ! function
+      TYPE(TATT)                   :: tf_att
+
+      !local value
+      CHARACTER(LEN=lc) :: cl_value
+      !----------------------------------------------------------------
+
+      ! clean attribute
+      CALL att_clean(tf_att)
+      
+      cl_value="(/"//TRIM(fct_str(sd_value))//"/)"
+
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
+      &  " attibute value "//TRIM(ADJUSTL(cl_value)) )      
+
+      tf_att%c_name=TRIM(ADJUSTL(cd_name))
+
+      IF( PRESENT(id_type) )THEN
+         tf_att%i_type=id_type
+      ELSE
+         tf_att%i_type=NF90_SHORT
+      ENDIF
+
+      IF( ASSOCIATED(tf_att%d_value) )THEN
+         DEALLOCATE(tf_att%d_value)
+      ENDIF
+      ALLOCATE(tf_att%d_value(1))
+
+      tf_att%d_value(1)=REAL(sd_value,dp)
+      tf_att%i_len=1
+
+   END FUNCTION att__init_i2_0d
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION att__init_i4(cd_name, id_value, id_type) &
+         & RESULT(tf_att)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize an attribute structure with array 
+   !> of integer(4) value.
+   !> @details
+   !> Optionaly you could specify the type of the variable to be saved.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_name   attribute name
+   !> @param[in] id_value  attribute value
+   !> @param[in] id_type   type of the variable to be saved
+   !> @return attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+      INTEGER(i4),      DIMENSION(:), INTENT(IN) :: id_value
+      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type
+
+      ! function
+      TYPE(TATT)                                 :: tf_att
+
+      ! local value
+      INTEGER(i4)       :: il_len
+      CHARACTER(LEN=lc) :: cl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! clean attribute
+      CALL att_clean(tf_att)
+      
+      ! array size
+      il_len=size(id_value(:))
+
+      cl_value="(/"
+      DO ji=1,il_len-1
+         cl_value=TRIM(cl_value)//TRIM(fct_str(id_value(ji)))//","
+      ENDDO
+      cl_value=TRIM(cl_value)//TRIM(fct_str(id_value(il_len)))//"/)"
+
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
+      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )      
+
+      tf_att%c_name=TRIM(ADJUSTL(cd_name))
+
+      IF( PRESENT(id_type) )THEN
+         tf_att%i_type=id_type
+      ELSE
+         tf_att%i_type=NF90_INT
+      ENDIF
+
+      IF( ASSOCIATED(tf_att%d_value) )THEN
+         DEALLOCATE(tf_att%d_value)
+      ENDIF
+      ALLOCATE(tf_att%d_value(il_len))
+
+      tf_att%d_value(:)=REAL(id_value(:),dp)
+      tf_att%i_len=il_len
+
+   END FUNCTION att__init_i4
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION att__init_i4_0d(cd_name, id_value, id_type) &
+         & RESULT (tf_att)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize an attribute structure with 
+   !> integer(4) value. 
+   !> @details
+   !> Optionaly you could specify the type of the variable to be saved.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] cd_name   attribute name
+   !> @param[in] id_value  attribute value
+   !> @param[in] id_type   type of the variable to be saved
+   !> @return attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+      INTEGER(i4),      INTENT(IN) :: id_value
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type
+
+      ! function
+      TYPE(TATT)                   :: tf_att
+
+      !local value
+      CHARACTER(LEN=lc) :: cl_value
+      !----------------------------------------------------------------
+
+      ! clean attribute
+      CALL att_clean(tf_att)
+      
+      cl_value="(/"//TRIM(fct_str(id_value))//"/)"
+
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
+      &  " attibute value "//TRIM(ADJUSTL(cl_value)) )      
+
+      tf_att%c_name=TRIM(ADJUSTL(cd_name))
+
+      IF( PRESENT(id_type) )THEN
+         tf_att%i_type=id_type
+      ELSE
+         tf_att%i_type=NF90_INT
+      ENDIF
+
+      IF( ASSOCIATED(tf_att%d_value) )THEN
+         DEALLOCATE(tf_att%d_value)
+      ENDIF
+      ALLOCATE(tf_att%d_value(1))
+
+      tf_att%d_value(1)=REAL(id_value,dp)
+      tf_att%i_len=1
+
+   END FUNCTION att__init_i4_0d
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION att__init_i8(cd_name, kd_value, id_type) &
+         & RESULT (tf_att)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize an attribute structure with array 
+   !> of integer(8) value.
+   !> @details
+   !> Optionaly you could specify the type of the variable to be saved.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_name   attribute name
+   !> @param[in] kd_value  attribute value
+   !> @param[in] id_type   type of the variable to be saved
+   !> @return attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+      INTEGER(i8),      DIMENSION(:), INTENT(IN) :: kd_value
+      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type
+
+      ! function
+      TYPE(TATT)                                 :: tf_att
+
+      ! local value
+      INTEGER(i4)       :: il_len
+      CHARACTER(LEN=lc) :: cl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! clean attribute
+      CALL att_clean(tf_att)
+      
+      ! array size
+      il_len=size(kd_value(:))
+
+      cl_value="(/"
+      DO ji=1,il_len
+         cl_value=TRIM(cl_value)//TRIM(fct_str(kd_value(ji)))//","
+      ENDDO
+      cl_value=TRIM(cl_value)//TRIM(fct_str(kd_value(il_len)))//"/)"
+
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
+      &  " attibute value "//TRIM(ADJUSTL(cl_value)) )      
+
+      tf_att%c_name=TRIM(ADJUSTL(cd_name))
+
+      IF( PRESENT(id_type) )THEN
+         tf_att%i_type=id_type
+      ELSE
+         tf_att%i_type=NF90_INT
+      ENDIF
+
+      IF( ASSOCIATED(tf_att%d_value) )THEN
+         DEALLOCATE(tf_att%d_value)
+      ENDIF
+      ALLOCATE(tf_att%d_value(il_len))
+
+      tf_att%d_value(:)=REAL(kd_value(:),dp)
+      tf_att%i_len=il_len
+
+   END FUNCTION att__init_i8
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION att__init_i8_0d(cd_name, kd_value, id_type) &
+         & RESULT (tf_att)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize an attribute structure with 
+   !> integer(8) value. 
+   !> @details
+   !> Optionaly you could specify the type of the variable to be saved.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_name   attribute name
+   !> @param[in] kd_value  attribute value
+   !> @param[in] id_type   type of the variable to be saved
+   !> @return attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+      INTEGER(i8),      INTENT(IN) :: kd_value
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type
+
+      ! function
+      TYPE(TATT)                   :: tf_att
+
+      ! local value
+      CHARACTER(LEN=lc) :: cl_value
+      !----------------------------------------------------------------
+
+      ! clean attribute
+      CALL att_clean(tf_att)
+      
+      cl_value="(/"//TRIM(fct_str(kd_value))//"/)"
+
+      CALL logger_trace( &
+      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//&
+      &  " attibute value "//TRIM(ADJUSTL(cl_value)) )      
+
+      tf_att%c_name=TRIM(ADJUSTL(cd_name))
+
+      IF( PRESENT(id_type) )THEN
+         tf_att%i_type=id_type
+      ELSE
+         tf_att%i_type=NF90_INT
+      ENDIF
+
+      IF( ASSOCIATED(tf_att%d_value) )THEN
+         DEALLOCATE(tf_att%d_value)
+      ENDIF
+      ALLOCATE(tf_att%d_value(1))
+
+      tf_att%d_value(1)=REAL(kd_value,dp)
+      tf_att%i_len=1
+
+   END FUNCTION att__init_i8_0d
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE att__print_arr(td_att)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine print informations of an array of attribute. 
+   !>
+   !> @author J.Paul
+   !> @date June, 2014 - Initial Version
+   !>
+   !> @param[in] td_att array of attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TATT), DIMENSION(:), INTENT(IN) :: td_att
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=1,SIZE(td_att(:))
+         CALL att_print(td_att(ji))
+      ENDDO
+
+   END SUBROUTINE att__print_arr
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE att__print_unit(td_att)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine print attribute information.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014 
+   !> - take into account type of attribute.
+   !
+   !> @param[in] td_att attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TATT), INTENT(IN) :: td_att
+
+      ! local vairbale
+      CHARACTER(LEN=lc) :: cl_type
+      CHARACTER(LEN=lc) :: cl_value
+
+      INTEGER(i8)       :: kl_tmp
+      INTEGER(i2)       :: sl_tmp
+      INTEGER(i1)       :: bl_tmp
+      REAL(sp)          :: rl_tmp
+      REAL(dp)          :: dl_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+         SELECT CASE( td_att%i_type )
+
+            CASE(NF90_CHAR)
+               cl_type='CHAR'
+            CASE(NF90_BYTE)
+               cl_type='BYTE'
+            CASE(NF90_SHORT)
+               cl_type='SHORT'
+            CASE(NF90_INT)
+               cl_type='INT'
+            CASE(NF90_FLOAT)
+               cl_type='FLOAT'
+            CASE(NF90_DOUBLE)
+               cl_type='DOUBLE'
+            CASE DEFAULT
+               cl_type=''
+
+         END SELECT
+
+         SELECT CASE( td_att%i_type )
+
+            CASE(NF90_CHAR)
+
+               cl_value=td_att%c_value
+
+            CASE(NF90_BYTE)   
+               IF( td_att%i_len > 1 )THEN
+                  cl_value='(/'
+                  DO ji=1,td_att%i_len-1
+                     bl_tmp=INT(td_att%d_value(ji),i1)
+                     cl_value=TRIM(cl_value)//TRIM(fct_str(bl_tmp))//','
+                  ENDDO
+                  bl_tmp=INT(td_att%d_value(td_att%i_len),i1)
+                  cl_value=TRIM(cl_value)//TRIM(fct_str(bl_tmp))//'/)'
+               ELSE
+                  cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)'
+               ENDIF
+
+            CASE(NF90_SHORT)   
+               IF( td_att%i_len > 1 )THEN
+                  cl_value='(/'
+                  DO ji=1,td_att%i_len-1
+                     sl_tmp=INT(td_att%d_value(ji),i2)
+                     cl_value=TRIM(cl_value)//TRIM(fct_str(sl_tmp))//','
+                  ENDDO
+                  sl_tmp=INT(td_att%d_value(td_att%i_len),i2)
+                  cl_value=TRIM(cl_value)//TRIM(fct_str(sl_tmp))//'/)'
+               ELSE
+                  cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)'
+               ENDIF
+
+            CASE(NF90_INT)   
+               IF( td_att%i_len > 1 )THEN
+                  cl_value='(/'
+                  DO ji=1,td_att%i_len-1
+                     kl_tmp=INT(td_att%d_value(ji),i8)
+                     cl_value=TRIM(cl_value)//TRIM(fct_str(kl_tmp))//','
+                  ENDDO
+                  kl_tmp=INT(td_att%d_value(td_att%i_len),i8)
+                  cl_value=TRIM(cl_value)//TRIM(fct_str(kl_tmp))//'/)'
+               ELSE
+                  cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)'
+               ENDIF
+
+            CASE(NF90_FLOAT)   
+               IF( td_att%i_len > 1 )THEN
+                  cl_value='(/'
+                  DO ji=1,td_att%i_len-1
+                     rl_tmp=REAL(td_att%d_value(ji),sp)
+                     cl_value=TRIM(cl_value)//TRIM(fct_str(rl_tmp))//','
+                  ENDDO
+                  rl_tmp=REAL(td_att%d_value(td_att%i_len),sp)
+                  cl_value=TRIM(cl_value)//TRIM(fct_str(rl_tmp))//'/)'
+               ELSE
+                  cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)'
+               ENDIF
+
+            CASE(NF90_DOUBLE)   
+               IF( td_att%i_len > 1 )THEN
+                  cl_value='(/'
+                  DO ji=1,td_att%i_len-1
+                     dl_tmp=REAL(td_att%d_value(ji),dp)
+                     cl_value=TRIM(cl_value)//TRIM(fct_str(dl_tmp))//','
+                  ENDDO
+                  dl_tmp=REAL(td_att%d_value(td_att%i_len),dp)
+                  cl_value=TRIM(cl_value)//TRIM(fct_str(dl_tmp))//'/)'
+               ELSE
+                  cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)'
+               ENDIF
+
+            CASE DEFAULT
+               cl_value="none"
+
+         END SELECT
+
+         WRITE(*,'((3x,a,a),(/6x,a,i2.2),(a,a),(a,a))')&
+         &        " attribute : ",TRIM(ADJUSTL(td_att%c_name)),      &
+         &        " id : ",td_att%i_id,                         &
+         &        " type : ",TRIM(ADJUSTL(cl_type)),            &
+         &        " value : ",TRIM(ADJUSTL(cl_value))
+
+   END SUBROUTINE att__print_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE att__clean_unit(td_att)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine clean attribute strcuture.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2019 
+   !> - nullify array inside attribute structure
+   !>
+   !> @param[inout] td_att attribute strcuture
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TATT),  INTENT(INOUT) :: td_att
+
+      ! local variable
+      TYPE(TATT) :: tl_att ! empty attribute structure
+      !----------------------------------------------------------------
+
+      CALL logger_trace( &
+      &  " CLEAN: reset attribute "//TRIM(td_att%c_name) )
+
+      IF( ASSOCIATED(td_att%d_value) )THEN
+         ! clean value
+         DEALLOCATE(td_att%d_value)
+         NULLIFY(td_att%d_value)
+      ENDIF
+
+      ! replace by empty structure
+      td_att=att_copy(tl_att)
+
+   END SUBROUTINE att__clean_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE att__clean_arr(td_att)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine clean array of attribute strcuture.
+   !
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !
+   !> @param[inout] td_att attribute strcuture
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TATT), DIMENSION(:), INTENT(INOUT) :: td_att
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=SIZE(td_att(:)),1,-1
+         CALL att_clean(td_att(ji) )
+      ENDDO
+
+   END SUBROUTINE att__clean_arr
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE att_get_dummy(cd_dummy)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill dummy attribute array
+   !
+   !> @author J.Paul
+   !> @date September, 2015 - Initial Version
+   !> @date Marsh, 2016
+   !> - close file (bugfix)
+   !> @date May, 2019
+   !> - read number of dummy element 
+   !>
+   !> @param[in] cd_dummy dummy configuration file
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_dummy
+
+      ! local variable
+      INTEGER(i4)   :: il_fileid
+      INTEGER(i4)   :: il_status
+
+      LOGICAL       :: ll_exist
+
+      ! namelist
+      INTEGER(i4)                                :: in_ndumvar
+      INTEGER(i4)                                :: in_ndumdim
+      INTEGER(i4)                                :: in_ndumatt
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumvar
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumdim
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumatt
+      !----------------------------------------------------------------
+      NAMELIST /namdum/ &   !< dummy namelist
+      &  in_ndumvar,&       !< number of dummy elt in variable array
+      &  in_ndumdim,&       !< number of dummy elt in dimension array
+      &  in_ndumatt,&       !< number of dummy elt in attribute array
+      &  cn_dumvar, &       !< variable  name
+      &  cn_dumdim, &       !< dimension name
+      &  cn_dumatt          !< attribute name
+      !----------------------------------------------------------------
+
+      ! init
+      cm_dumatt(:)=''
+
+      ! read namelist
+      INQUIRE(FILE=TRIM(cd_dummy), EXIST=ll_exist)
+      IF( ll_exist )THEN
+    
+         il_fileid=fct_getunit()
+   
+         OPEN( il_fileid, FILE=TRIM(cd_dummy), &
+         &                FORM='FORMATTED',       &
+         &                ACCESS='SEQUENTIAL',    &
+         &                STATUS='OLD',           &
+         &                ACTION='READ',          &
+         &                IOSTAT=il_status)
+         CALL fct_err(il_status)
+         IF( il_status /= 0 )THEN
+            CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_dummy))
+         ENDIF
+   
+         READ( il_fileid, NML = namdum )
+         im_ndumatt  = in_ndumatt
+         cm_dumatt(:)= cn_dumatt(:)
+
+         CLOSE( il_fileid )
+
+         IF( im_ndumatt > ip_maxdumcfg )THEN
+            CALL logger_fatal("ATT GET dUMMY : too much dummy attributes &
+            &     ( >"//fct_str(ip_maxdumcfg)//" ). &
+            &     set ip_maxdumcfg to higher value.")
+         ENDIF
+
+      ENDIF
+   
+   END SUBROUTINE att_get_dummy
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION att_is_dummy(td_att) &
+         & RESULT (lf_dummy)
+   !-------------------------------------------------------------------
+   !> @brief This function check if attribute is defined as dummy attribute
+   !> in configuraton file
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial Version
+   !> @date, May, 2019
+   !> - use number of dummy elt in do-loop
+   !>
+   !> @param[in] td_att attribute structure
+   !> @return true if attribute is dummy attribute
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TATT), INTENT(IN) :: td_att
+      
+      ! function
+      LOGICAL                :: lf_dummy
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      CALL logger_trace("ATT IS DUMMY : check if attribute is useless")
+
+      lf_dummy=.FALSE.
+      DO ji=1,im_ndumatt
+         IF( fct_lower(td_att%c_name) == fct_lower(cm_dumatt(ji)) )THEN
+            lf_dummy=.TRUE.
+            EXIT
+         ENDIF
+      ENDDO
+
+      CALL logger_trace("ATT IS DUMMY : check ok")
+
+   END FUNCTION att_is_dummy
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE att
+
Index: /utils/tools_ticket2413/SIREN/src/boundary.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/boundary.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/boundary.f90	(revision 12863)
@@ -0,0 +1,1949 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief
+!> This module manage boundary.
+!>
+!> @details
+!>    define type TBDY:<br/>
+!> @code
+!>    TYPE(TBDY) :: tl_bdy<br/>
+!> @endcode
+!>
+!>    to initialise boundary structure:<br/>
+!> @code
+!>    tl_bdy=boundary_init(td_var, [ld_north,] [ld_south,] [ld_east,] [ld_west,]
+!>    [cd_north,] [cd_south,] [cd_east,] [cd_west,] [ld_oneseg])
+!> @endcode
+!>       - td_var is variable structure
+!>       - ld_north is logical to force used of north boundary [optional]
+!>       - ld_south is logical to force used of north boundary [optional]
+!>       - ld_east  is logical to force used of north boundary [optional]
+!>       - ld_west  is logical to force used of north boundary [optional]
+!>       - cd_north is string character description of north boundary [optional]
+!>       - cd_south is string character description of south boundary [optional]
+!>       - cd_east  is string character description of east  boundary [optional]
+!>       - cd_west  is string character description of west  boundary [optional]
+!>       - ld_oneseg is logical to force to use only one segment for each boundary [optional]
+!>
+!>    to get boundary cardinal:<br/>
+!>    - tl_bdy\%c_card
+!>
+!>    to know if boundary is use:<br/>
+!>    - tl_bdy\%l_use
+!>
+!>    to know if boundary come from namelist (cn_north,..):<br/>
+!>    - tl_bdy\%l_nam
+!>
+!>    to get the number of segment in boundary:<br/>
+!>    - tl_bdy\%i_nseg
+!>
+!>    to get array of segment in boundary:<br/>
+!>    - tl_bdy\%t_seg(:)
+!>
+!>    to get orthogonal segment index of north boundary:<br/>
+!>    - tl_bdy\%t_seg(jp_north)%\i_index
+!>
+!>    to get segment width of south boundary:<br/>
+!>    - tl_bdy\%t_seg(jp_south)%\i_width
+!>
+!>    to get segment first indice of east boundary:<br/>
+!>    - tl_bdy\%t_seg(jp_east)%\i_first
+!>
+!>    to get segment last indice of west boundary:<br/>
+!>    - tl_bdy\%t_seg(jp_west)%\i_last
+!>
+!>    to print information about boundary:<br/>
+!> @code
+!>    CALL boundary_print(td_bdy)
+!> @endcode
+!>       - td_bdy is boundary structure or a array of boundary structure
+!>
+!>    to clean boundary structure:<br/>
+!> @code
+!>    CALL boundary_clean(td_bdy)
+!> @endcode
+!>
+!>    to get indices of each semgent for each boundary:<br/>
+!> @code
+!>    CALL boundary_get_indices( td_bdy, td_var, ld_oneseg)
+!> @endcode
+!>       - td_bdy is boundary structure
+!>       - td_var is variable structure
+!>       - ld_oneseg is logical to force to use only one segment for each boundary [optional]
+!>
+!>    to check boundary indices and corner:<br/>
+!> @code
+!>    CALL boundary_check(td_bdy, td_var)
+!> @endcode
+!>       - td_bdy is boundary structure
+!>       - td_var is variable structure
+!>
+!>    to check boundary corner:<br/>
+!> @code
+!>    CALL boundary_check_corner(td_bdy, td_var)
+!> @endcode
+!>       - td_bdy is boundary structure
+!>       - td_var is variable structure
+!>
+!>    to create filename with cardinal name inside:<br/>
+!> @code
+!>    cl_filename=boundary_set_filename(cd_file, cd_card)
+!> @endcode
+!>       - cd_file = original file name
+!>       - cd_card = cardinal name
+!>
+!>    to swap array for east and north boundary:<br/>
+!> @code
+!>    CALL boundary_swap( td_var, td_bdy )
+!> @endcode
+!>       - td_var is variable strucutre
+!>       - td_bdy is boundary strucutre
+!>
+!> @author J.Paul
+!>
+!> @date November, 2013 - Initial Version
+!> @date September, 2014 
+!> - add boundary description
+!> @date November, 2014 
+!> - Fix memory leaks bug
+!> @date February, 2015 
+!> - Do not change indices read from namelist
+!> - Change string character format of boundary read from namelist, 
+!>  see boundary__get_info
+!> 
+!> @todo add schematic to boundary structure description
+!> 
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE boundary
+
+   USE netcdf                          ! nf90 library                           
+   USE global                          ! global parameter
+   USE phycst                          ! physical constant
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+   USE var                             ! variable manager
+
+   IMPLICIT NONE
+
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   PUBLIC :: TBDY     !< boundary structure
+   PUBLIC :: TSEG     !< segment structure
+
+   PRIVATE :: im_width !< boundary width
+
+   ! function and subroutine
+   PUBLIC :: boundary_copy         !< copy boundary structure
+   PUBLIC :: boundary_init         !< initialise boundary structure
+   PUBLIC :: boundary_print        !< print information about boundary
+   PUBLIC :: boundary_clean        !< clean boundary structure 
+   PUBLIC :: boundary_get_indices  !< get indices of each semgent for each boundary.
+   PUBLIC :: boundary_check        !< check boundary indices and corner.
+   PUBLIC :: boundary_check_corner !< check boundary corner
+   PUBLIC :: boundary_set_filename !< set boundary filename
+   PUBLIC :: boundary_swap         !< swap array for north and east boundary
+
+   PRIVATE :: boundary__clean_unit      ! clean boundary structure 
+   PRIVATE :: boundary__clean_arr       ! clean array of boundary structure 
+   PRIVATE :: boundary__init_wrapper    ! initialise a boundary structure
+   PRIVATE :: boundary__init            ! initialise basically a boundary structure
+   PRIVATE :: boundary__copy_unit       ! copy boundary structure in another
+   PRIVATE :: boundary__copy_arr        ! copy boundary structure in another
+   PRIVATE :: boundary__add_seg         ! add one segment structure to a boundary 
+   PRIVATE :: boundary__del_seg         ! remove all segments of a boundary
+   PRIVATE :: boundary__get_info        ! get boundary information from boundary description string character.
+   PRIVATE :: boundary__get_seg_number  ! compute the number of sea segment for one boundary
+   PRIVATE :: boundary__get_seg_indices ! get segment indices for one boundary 
+   PRIVATE :: boundary__print_unit      ! print information about one boundary
+   PRIVATE :: boundary__print_arr       ! print information about a array of boundary
+   
+   PRIVATE :: seg__init       ! initialise segment structure
+   PRIVATE :: seg__clean      ! clean segment structure
+   PRIVATE :: seg__clean_unit ! clean one segment structure
+   PRIVATE :: seg__clean_arr  ! clean array of segment structure
+   PRIVATE :: seg__copy       ! copy segment structure in another
+   PRIVATE :: seg__copy_unit  ! copy segment structure in another
+   PRIVATE :: seg__copy_arr   ! copy array of segment structure in another
+
+   TYPE TSEG   !< segment structure
+      INTEGER(i4) :: i_index = 0 !< segment index
+      INTEGER(i4) :: i_width = 0 !< segment width
+      INTEGER(i4) :: i_first = 0 !< segment first indice 
+      INTEGER(i4) :: i_last  = 0 !< segment last indices
+   END TYPE TSEG
+
+   TYPE TBDY !< boundary structure
+      CHARACTER(LEN=lc) :: c_card = ''          !< boundary cardinal
+      LOGICAL           :: l_use  = .FALSE.     !< boundary use or not 
+      LOGICAL           :: l_nam  = .FALSE.     !< boundary get from namelist
+      INTEGER(i4)       :: i_nseg = 0           !< number of segment in boundary
+      TYPE(TSEG), DIMENSION(:), POINTER :: t_seg => NULL() !<  array of segment structure
+   END TYPE TBDY
+
+   ! module variable
+   INTEGER(i4), PARAMETER :: im_width=10
+
+   INTERFACE boundary_init
+      MODULE PROCEDURE boundary__init_wrapper 
+   END INTERFACE boundary_init
+
+   INTERFACE boundary_print
+      MODULE PROCEDURE boundary__print_unit 
+      MODULE PROCEDURE boundary__print_arr 
+   END INTERFACE boundary_print
+
+   INTERFACE boundary_clean
+      MODULE PROCEDURE boundary__clean_unit   
+      MODULE PROCEDURE boundary__clean_arr    
+   END INTERFACE
+
+   INTERFACE seg__clean
+      MODULE PROCEDURE seg__clean_unit   
+      MODULE PROCEDURE seg__clean_arr    
+   END INTERFACE
+
+   INTERFACE boundary_copy
+      MODULE PROCEDURE boundary__copy_unit 
+      MODULE PROCEDURE boundary__copy_arr 
+   END INTERFACE   
+
+   INTERFACE seg__copy
+      MODULE PROCEDURE seg__copy_unit   ! copy segment structure
+      MODULE PROCEDURE seg__copy_arr    ! copy array of segment structure
+   END INTERFACE   
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION boundary__copy_arr(td_bdy) &
+         & RESULT (tf_bdy)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy a array of boundary structure in another one
+   !> @details 
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> attribute (ex: tl_bdy=boundary_copy(boundary_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2014
+   !> - use function instead of overload assignment operator 
+   !> (to avoid memory leak)
+   !
+   !> @param[in] td_bdy   array of boundary structure
+   !> @return copy of input array of boundary structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TBDY), DIMENSION(:)   , INTENT(IN) :: td_bdy
+
+      ! function
+      TYPE(TBDY), DIMENSION(SIZE(td_bdy(:)))  :: tf_bdy
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      DO jk=1,SIZE(td_bdy(:))
+         tf_bdy(jk)=boundary_copy(td_bdy(jk))
+      ENDDO
+
+   END FUNCTION boundary__copy_arr
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION boundary__copy_unit(td_bdy) &
+         & RESULT (tf_bdy)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy boundary structure in another one
+   !> @details 
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> attribute (ex: tl_bdy=boundary_copy(boundary_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2014
+   !> - use function instead of overload assignment operator 
+   !> (to avoid memory leak)
+   !
+   !> @param[in] td_bdy   boundary structure
+   !> @return copy of input boundary structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TBDY), INTENT(IN)  :: td_bdy
+
+      ! function
+      TYPE(TBDY)              :: tf_bdy
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! copy variable name, id, ..
+      tf_bdy%c_card     = TRIM(td_bdy%c_card)
+      tf_bdy%i_nseg     = td_bdy%i_nseg
+      tf_bdy%l_use      = td_bdy%l_use
+
+      ! copy segment
+      IF( ASSOCIATED(tf_bdy%t_seg) )THEN
+         CALL seg__clean(tf_bdy%t_seg(:))
+         DEALLOCATE(tf_bdy%t_seg)
+      ENDIF
+      IF( ASSOCIATED(td_bdy%t_seg) .AND. tf_bdy%i_nseg > 0 )THEN
+         ALLOCATE( tf_bdy%t_seg(tf_bdy%i_nseg) )
+         DO ji=1,tf_bdy%i_nseg
+            tf_bdy%t_seg(ji)=td_bdy%t_seg(ji)
+         ENDDO
+      ENDIF
+
+   END FUNCTION boundary__copy_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE boundary__clean_unit(td_bdy)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine clean boundary structure
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2019
+   !> - nullify segment structure inside boundary structure 
+   !
+   !> @param[inout] td_bdy boundary strucutre
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TBDY), INTENT(INOUT) :: td_bdy
+
+      ! local variable
+      TYPE(TBDY) :: tl_bdy ! empty boundary strucutre
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      CALL logger_info( &
+      &  " CLEAN: reset boundary "//TRIM(td_bdy%c_card) )
+
+      ! del segment
+      IF( ASSOCIATED(td_bdy%t_seg) )THEN
+         ! clean each segment
+         CALL seg__clean(td_bdy%t_seg(:) )
+         DEALLOCATE( td_bdy%t_seg )
+         NULLIFY(td_bdy%t_seg)
+      ENDIF
+
+      ! replace by empty structure
+      td_bdy=boundary_copy(tl_bdy)
+
+   END SUBROUTINE boundary__clean_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE boundary__clean_arr(td_bdy)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine clean array of boundary structure
+   !
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !
+   !> @param[inout] td_bdy boundary strucutre
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TBDY), DIMENSION(:), INTENT(INOUT) :: td_bdy
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=SIZE(td_bdy(:)),1,-1
+         CALL boundary_clean( td_bdy(ji) )
+      ENDDO
+
+   END SUBROUTINE boundary__clean_arr
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION boundary_set_filename(cd_file, cd_card, id_seg, cd_date) &
+         &  RESULT (cf_file)
+   !------------------------------------------------------------------- 
+   !> @brief This function put cardinal name and date inside file name.
+   ! 
+   !> @details 
+   !>    Examples :
+   !>       cd_file="boundary.nc"
+   !>       cd_card="west" 
+   !>       id_seg =2
+   !>       cd_date=y2015m07d16
+   !> 
+   !>       function return "boundary_west_2_y2015m07d16.nc"
+   !> 
+   !>       cd_file="boundary.nc"
+   !>       cd_card="west" 
+   !> 
+   !>       function return "boundary_west.nc"
+   !> 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[in] cd_file   file name 
+   !> @param[in] cd_card   cardinal name 
+   !> @param[in] id_seg    segment number 
+   !> @param[in] cd_date   file date (format: y????m??d??) 
+   !> @return file name with cardinal name inside
+   !------------------------------------------------------------------- 
+
+      IMPLICIT NONE 
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_file
+      CHARACTER(LEN=*), INTENT(IN) :: cd_card
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_seg
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_date
+
+      ! function 
+      CHARACTER(LEN=lc)            :: cf_file
+
+      ! local variable 
+      CHARACTER(LEN=lc) :: cl_dirname
+      CHARACTER(LEN=lc) :: cl_basename
+      CHARACTER(LEN=lc) :: cl_base
+      CHARACTER(LEN=lc) :: cl_suffix
+      CHARACTER(LEN=lc) :: cl_segnum
+      CHARACTER(LEN=lc) :: cl_date
+      CHARACTER(LEN=lc) :: cl_name
+
+      INTEGER(i4)       :: il_ind
+      INTEGER(i4)       :: il_indend
+
+      ! loop indices 
+      !---------------------------------------------------------------- 
+      ! init
+      cf_file=''
+
+      IF( TRIM(cd_file) /= '' .AND. TRIM(cd_card) /= '' )THEN
+
+         cl_dirname = fct_dirname( TRIM(cd_file))
+         IF( TRIM(cl_dirname) == '' ) cl_dirname='.'
+
+         cl_basename= fct_basename(TRIM(cd_file))
+
+         cl_base  =fct_split(TRIM(cl_basename),1,'.')
+         cl_suffix=fct_split(TRIM(cl_basename),2,'.')
+         
+         ! add segment number
+         IF( PRESENT(id_seg) )THEN
+            cl_segnum="_"//TRIM(fct_str(id_seg))
+         ELSE
+            cl_segnum=""
+         ENDIF
+
+         ! add date
+         IF( PRESENT(cd_date) )THEN
+            cl_date="_"//TRIM(ADJUSTL(cd_date))
+         ELSE
+            cl_date=""
+         ENDIF
+
+         ! special case for obcdta
+         il_ind=INDEX(cl_base,'_obcdta_')
+         IF( il_ind/=0 )THEN
+            il_ind=il_ind-1+8
+            il_indend=LEN_TRIM(cl_base)
+
+            cl_name=TRIM(cl_base(1:il_ind))//TRIM(cd_card)//&
+               &     TRIM(cl_segnum)//"_"//TRIM(cl_base(il_ind+1:il_indend))//&
+               &     TRIM(cl_date)//"."//TRIM(cl_suffix)
+         ELSE
+            cl_name=TRIM(cl_base)//"_"//TRIM(cd_card)//TRIM(cl_segnum)//&
+               &     TRIM(cl_date)//"."//TRIM(cl_suffix)
+         ENDIF
+
+         cf_file=TRIM(cl_dirname)//"/"//TRIM(cl_name)
+      ELSE
+         CALL logger_error("BOUNDARY SET FILENAME: file or cardinal name "//&
+         &  " are empty")
+      ENDIF
+ 
+   END FUNCTION boundary_set_filename 
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION boundary__init_wrapper(td_var,                               &
+         &                         ld_north, ld_south, ld_east, ld_west, &
+         &                         cd_north, cd_south, cd_east, cd_west, &
+         &                         ld_oneseg) &
+         &  RESULT (tf_bdy)
+   !------------------------------------------------------------------- 
+   !> @brief This function initialise a boundary structure.
+   ! 
+   !> @details 
+   !>  Boundaries for each cardinal will be compute with variable structure.
+   !>  It means that orthogonal index, first and last indices of each 
+   !>  sea segment will be compute automatically.
+   !>  However you could specify which boundary to use or not with
+   !>  arguments ln_north, ln_south, ln_east, ln_west.
+   !>  And boundary description could be specify with argument
+   !>  cn_north, cn_south, cn_east, cn_west.
+   !>  For each cardinal you could specify orthogonal index, 
+   !>  first and last indices (in this order) and boundary width (between
+   !>  parentheses).
+   !> ex : cn_north='index,first,last(width)'
+   !> You could specify more than one segment for each boundary. 
+   !> However each segment will have the same width. So you do not need to
+   !> specify it for each segment.
+   !> ex : cn_north='index1,first1,last1(width)|index2,first2,last2'
+   !>
+   !> @warn Boundaries are compute on T point, but expressed on U,V point.
+   !> change will be done to get data on other point when need be. 
+   !>
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   !> @date September, 2014
+   !> - add boolean to use only one segment for each boundary
+   !> - check boundary width
+   ! 
+   !> @param[in] td_var    variable structure 
+   !> @param[in] ld_north  use north boundary or not 
+   !> @param[in] ld_south  use south boundary or not 
+   !> @param[in] ld_east   use east  boundary or not 
+   !> @param[in] ld_west   use west  boundary or not 
+   !> @param[in] cd_north  north boundary description 
+   !> @param[in] cd_south  south boundary description 
+   !> @param[in] cd_east   east  boundary description 
+   !> @param[in] cd_west   west  boundary description 
+   !> @param[in] ld_oneseg force to use only one segment for each boundary 
+   !> @return boundary structure
+   !------------------------------------------------------------------- 
+
+      IMPLICIT NONE 
+
+      ! Argument
+      TYPE(TVAR)       , INTENT(IN) :: td_var
+      LOGICAL          , INTENT(IN), OPTIONAL :: ld_north
+      LOGICAL          , INTENT(IN), OPTIONAL :: ld_south
+      LOGICAL          , INTENT(IN), OPTIONAL :: ld_east 
+      LOGICAL          , INTENT(IN), OPTIONAL :: ld_west 
+      CHARACTER(LEN=lc), INTENT(IN), OPTIONAL :: cd_north
+      CHARACTER(LEN=lc), INTENT(IN), OPTIONAL :: cd_south
+      CHARACTER(LEN=lc), INTENT(IN), OPTIONAL :: cd_east 
+      CHARACTER(LEN=lc), INTENT(IN), OPTIONAL :: cd_west
+      LOGICAL          , INTENT(IN), OPTIONAL :: ld_oneseg 
+
+      ! function 
+      TYPE(TBDY)       , DIMENSION(ip_ncard)  :: tf_bdy
+
+      ! local variable 
+      INTEGER(i4)                            :: il_width
+      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_max_width
+      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_index
+      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_min
+      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_max
+
+      CHARACTER(LEN=lc), DIMENSION(ip_ncard) :: cl_card
+
+      TYPE(TBDY)                             :: tl_tmp
+
+      TYPE(TSEG)                             :: tl_seg
+
+      LOGICAL                                :: ll_oneseg
+
+      ! loop indices 
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jk
+      !---------------------------------------------------------------- 
+      IF( .NOT. ASSOCIATED(td_var%d_value) )THEN
+         CALL logger_error("BOUNDARY INIT: no value associated to variable "//&
+         &              TRIM(td_var%c_name) )
+      ELSEIF( TRIM(td_var%c_point) /= 'T' )THEN
+         CALL logger_error("BOUNDARY INIT: can not compute boundary with "//&
+         &                 "variable "//TRIM(td_var%c_name)//&
+         &                 ". need a variable on T point." )
+      ELSE
+         ll_oneseg=.TRUE.
+         IF( PRESENT(ld_oneseg) ) ll_oneseg=ld_oneseg
+
+         ! init
+         tf_bdy(jp_north)=boundary__init('north',ld_north)
+         tf_bdy(jp_south)=boundary__init('south',ld_south)
+         tf_bdy(jp_east )=boundary__init('east ',ld_east )
+         tf_bdy(jp_west )=boundary__init('west ',ld_west )
+
+         ! if EW cyclic no east west boundary and force to use one segment
+         IF( td_var%i_ew >= 0 )THEN
+            CALL logger_info("BOUNDARY INIT: cyclic domain, "//&
+            &  "no East West boundary")
+            tf_bdy(jp_east )%l_use=.FALSE.
+            tf_bdy(jp_west )%l_use=.FALSE.
+
+            CALL logger_info("BOUNDARY INIT: force to use one segment due"//&
+            &  " to EW cyclic domain")
+            ll_oneseg=.TRUE.
+         ENDIF
+
+         il_index(jp_north)=td_var%t_dim(2)%i_len-ip_ghost
+         il_index(jp_south)=1+ip_ghost
+         il_index(jp_east )=td_var%t_dim(1)%i_len-ip_ghost
+         il_index(jp_west )=1+ip_ghost
+
+         il_min(jp_north)=1
+         il_min(jp_south)=1
+         il_min(jp_east )=1
+         il_min(jp_west )=1
+
+         il_max(jp_north)=td_var%t_dim(1)%i_len
+         il_max(jp_south)=td_var%t_dim(1)%i_len
+         il_max(jp_east )=td_var%t_dim(2)%i_len
+         il_max(jp_west )=td_var%t_dim(2)%i_len
+ 
+         cl_card=(/'','','',''/)
+         IF( PRESENT(cd_north) ) cl_card(jp_north)=TRIM(cd_north)
+         IF( PRESENT(cd_south) ) cl_card(jp_south)=TRIM(cd_south)
+         IF( PRESENT(cd_east ) ) cl_card(jp_east )=TRIM(cd_east )
+         IF( PRESENT(cd_west ) ) cl_card(jp_west )=TRIM(cd_west )
+
+         il_max_width(jp_north)=INT(0.5*(td_var%t_dim(2)%i_len-2*ip_ghost))
+         il_max_width(jp_south)=INT(0.5*(td_var%t_dim(2)%i_len-2*ip_ghost))
+         il_max_width(jp_east )=INT(0.5*(td_var%t_dim(1)%i_len-2*ip_ghost))
+         il_max_width(jp_west )=INT(0.5*(td_var%t_dim(1)%i_len-2*ip_ghost))
+
+         DO jk=1,ip_ncard
+
+            ! check boundary width
+            IF( il_max_width(jk) <= im_width )THEN
+               IF( il_max_width(jk) <= 0 )THEN
+                  CALL logger_fatal("BOUNDARY INIT: domain too small to define"//&
+                  &                " boundaries.")
+               ELSE
+                  CALL logger_warn("BOUNDARY INIT: default boundary width too "//&
+                  &                "large for boundaries. force to use boundary"//&
+                  &                " on one point")
+                  il_width=1
+               ENDIF
+            ELSE
+               il_width=im_width
+            ENDIF
+
+            ! define default segment
+            tl_seg=seg__init(il_index(jk),il_width,il_min(jk),il_max(jk))
+
+            IF( tf_bdy(jk)%l_use )THEN
+
+               ! get namelist information
+               tl_tmp=boundary__get_info(cl_card(jk),jk)
+
+               ! get segments indices
+               DO ji=1,tl_tmp%i_nseg
+                  CALL boundary__add_seg(tf_bdy(jk),tl_tmp%t_seg(ji))
+               ENDDO
+               ! indices from namelist or not
+               tf_bdy(jk)%l_nam=tl_tmp%l_nam
+
+               CALL boundary_clean(tl_tmp)
+
+               IF( tf_bdy(jk)%i_nseg == 0 )THEN
+                  ! add default segment
+                  CALL boundary__add_seg(tf_bdy(jk),tl_seg)
+               ELSE
+                  ! fill undefined value
+                  WHERE( tf_bdy(jk)%t_seg(:)%i_index == 0 ) 
+                     tf_bdy(jk)%t_seg(:)%i_index = tl_seg%i_index
+                  END WHERE               
+                  WHERE( tf_bdy(jk)%t_seg(:)%i_width == 0 ) 
+                     tf_bdy(jk)%t_seg(:)%i_width = tl_seg%i_width
+                  END WHERE
+                  WHERE( tf_bdy(jk)%t_seg(:)%i_first == 0 ) 
+                     tf_bdy(jk)%t_seg(:)%i_first = tl_seg%i_first
+                  END WHERE
+                  WHERE( tf_bdy(jk)%t_seg(:)%i_last == 0 ) 
+                     tf_bdy(jk)%t_seg(:)%i_last = tl_seg%i_last
+                  END WHERE
+               ENDIF
+
+            ENDIF
+            ! clean
+            CALL seg__clean(tl_seg)
+
+         ENDDO
+
+         CALL boundary_get_indices(tf_bdy(:), td_var, ll_oneseg)
+
+         CALL boundary_check(tf_bdy, td_var)
+
+      ENDIF
+ 
+   END FUNCTION boundary__init_wrapper 
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION boundary__init(cd_card, ld_use, ld_nam, td_seg) &
+         &  RESULT (tf_bdy)
+   !------------------------------------------------------------------- 
+   !> @brief This function initialise basically a boundary structure with
+   !> cardinal name.
+   ! 
+   !> @details 
+   !> optionnaly you could specify if this boundary is used or not, 
+   !> and add one segment structure.
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[in]  cd_card  cardinal name
+   !> @param[in]  ld_use   boundary use or not
+   !> @param[in]  td_seg   segment structure
+   !> @return boundary structure
+   !------------------------------------------------------------------- 
+
+      IMPLICIT NONE 
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_card
+      LOGICAL         , INTENT(IN), OPTIONAL :: ld_use 
+      LOGICAL         , INTENT(IN), OPTIONAL :: ld_nam 
+      TYPE(TSEG)      , INTENT(IN), OPTIONAL :: td_seg
+
+      ! function 
+      TYPE(TBDY)                   :: tf_bdy
+
+      ! local variable 
+      ! loop indices 
+      !---------------------------------------------------------------- 
+
+      SELECT CASE(TRIM(cd_card))
+         CASE ('north','south','east','west')
+         
+            tf_bdy%c_card=TRIM(cd_card)
+
+            tf_bdy%l_use=.TRUE.
+            IF( PRESENT(ld_use) ) tf_bdy%l_use=ld_use
+
+            tf_bdy%l_nam=.FALSE.
+            IF( PRESENT(ld_nam) ) tf_bdy%l_nam=ld_nam
+
+            IF( PRESENT(td_seg) )THEN
+               CALL boundary__add_seg(tf_bdy, td_seg)
+            ENDIF
+
+         CASE DEFAULT
+            CALL logger_error("BOUNDARY INIT: invalid cardinal name")
+      END SELECT
+
+   END FUNCTION boundary__init
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE boundary__add_seg(td_bdy, td_seg) 
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine add one segment structure to a boundary structure 
+   ! 
+   !> @details 
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[inout] td_bdy boundary structure  
+   !> @param[in] td_seg    segment structure  
+   !------------------------------------------------------------------- 
+
+      IMPLICIT NONE 
+
+      ! Argument 
+      TYPE(TBDY), INTENT(INOUT) :: td_bdy
+      TYPE(TSEG), INTENT(IN   ) :: td_seg
+
+      ! local variable 
+      INTEGER(i4)                            :: il_status
+      TYPE(TSEG) , DIMENSION(:), ALLOCATABLE :: tl_seg
+
+      ! loop indices 
+      !---------------------------------------------------------------- 
+
+      IF( td_bdy%i_nseg > 0 )THEN
+         ! already other segment in boundary structure
+         ALLOCATE( tl_seg(td_bdy%i_nseg), stat=il_status )
+         IF(il_status /= 0 )THEN
+            CALL logger_error( &
+            &  " BOUNDARY ADD SEG: not enough space to put segments ")
+         ELSE
+            ! save temporary segment
+            tl_seg(:)=seg__copy(td_bdy%t_seg(:))
+
+            CALL seg__clean(td_bdy%t_seg(:))
+            DEALLOCATE( td_bdy%t_seg )
+            ALLOCATE( td_bdy%t_seg(td_bdy%i_nseg+1), stat=il_status )
+            IF(il_status /= 0 )THEN
+               CALL logger_error( &
+               &  " BOUNDARY ADD SEG: not enough space to put segments ")
+            ENDIF
+
+            ! copy segment in boundary before
+            td_bdy%t_seg(1:td_bdy%i_nseg)=seg__copy(tl_seg(:))
+
+            ! clean
+            CALL seg__clean(tl_seg(:))
+            DEALLOCATE(tl_seg)            
+            
+         ENDIF
+      ELSE
+         ! no segment in boundary structure
+         IF( ASSOCIATED(td_bdy%t_seg) )THEN
+            CALL seg__clean(td_bdy%t_seg(:))
+            DEALLOCATE(td_bdy%t_seg)
+         ENDIF
+         ALLOCATE( td_bdy%t_seg(td_bdy%i_nseg+1), stat=il_status )
+         IF(il_status /= 0 )THEN
+            CALL logger_error( &
+            &  " BOUNDARY ADD SEG: not enough space to put segments ")
+         ENDIF         
+      ENDIF
+ 
+      ! update number of segment
+      td_bdy%i_nseg=td_bdy%i_nseg+1
+
+      ! add new segment
+      td_bdy%t_seg(td_bdy%i_nseg)=seg__copy(td_seg)
+
+   END SUBROUTINE boundary__add_seg 
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE boundary__del_seg(td_bdy) 
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine remove all segments of a boundary structure 
+   ! 
+   !> @details 
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[inout]  td_bdy   boundary structure
+   !------------------------------------------------------------------- 
+
+      IMPLICIT NONE 
+
+      ! Argument 
+      TYPE(TBDY), INTENT(INOUT) :: td_bdy
+
+      ! local variable 
+      ! loop indices 
+      !---------------------------------------------------------------- 
+
+      IF( ASSOCIATED(td_bdy%t_seg) )THEN
+         CALL seg__clean(td_bdy%t_seg(:))
+         DEALLOCATE(td_bdy%t_seg)
+      ENDIF
+      !update number of segment
+      td_bdy%i_nseg=0
+
+   END SUBROUTINE boundary__del_seg 
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION boundary__get_info(cd_card, id_jcard) &
+         & RESULT (tf_bdy)
+   !------------------------------------------------------------------- 
+   !> @brief This function get information about boundary from string character. 
+   ! 
+   !> @details
+   !> This string character that will be passed through namelist could contains
+   !> orthogonal index, first and last indices, of each segment. 
+   !> And also the width of all segments of this boundary.
+   !>   cn_north='index1,first1:last1(width)|index2,first2:last2'
+   !> 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   !> @date february, 2015 
+   !> - do not change indices read from namelist
+   !> - change format cn_north
+   ! 
+   !> @param[in] cd_card   boundary description
+   !> @param[in] id_jcard  boundary index
+   !> @return boundary structure
+   !------------------------------------------------------------------- 
+
+      IMPLICIT NONE 
+
+      ! Argument 
+      CHARACTER(LEN=lc), INTENT(IN) :: cd_card
+      INTEGER(i4)      , INTENT(IN) :: id_jcard
+
+      ! function 
+      TYPE(TBDY)                    :: tf_bdy
+
+      ! local variable 
+      INTEGER(i4)       :: il_width
+      INTEGER(i4)       :: il_ind1
+      INTEGER(i4)       :: il_ind2
+
+      CHARACTER(LEN=lc) :: cl_seg
+      CHARACTER(LEN=lc) :: cl_index
+      CHARACTER(LEN=lc) :: cl_width
+      CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_first
+      CHARACTER(LEN=lc) :: cl_last 
+
+      TYPE(TSEG)        :: tl_seg
+
+      ! loop indices 
+      INTEGER(i4) :: ji
+      !---------------------------------------------------------------- 
+ 
+      ji=1
+      cl_seg=fct_split(cd_card,ji)
+
+      il_width=0
+      ! look for segment width 
+      ! width should be the same for all segment of one boundary
+      IF( TRIM(cl_seg)   /= '' )THEN
+
+         ! initialise boundary
+         ! temporaty boundary, so it doesn't matter which caridnal is used
+         tf_bdy=boundary__init('north',ld_nam=.TRUE.)
+
+         il_ind1=SCAN(fct_lower(cl_seg),'(')
+         IF( il_ind1 /=0 )THEN
+            cl_width=TRIM(cl_seg(il_ind1+1:))
+
+            il_ind2=SCAN(fct_lower(cl_width),')')
+            IF( il_ind2 /=0 )THEN
+               cl_width=TRIM(cl_width(1:il_ind2-1))
+               READ(cl_width,*) il_width
+            ELSE
+               CALL logger_error("BOUNDARY INIT: unclosed parentheses."//&
+               &  " check namelist. ")
+            ENDIF
+         ENDIF
+
+      ENDIF 
+
+      DO WHILE( TRIM(cl_seg) /= '' )
+
+         cl_index=fct_split(cl_seg,1,',')
+         ! remove potential width information
+         il_ind1=SCAN(fct_lower(cl_index),'(')
+         IF( il_ind1 /=0 )THEN
+            il_ind2=SCAN(fct_lower(cl_index),')')
+            IF( il_ind2 /=0 )THEN
+               cl_index=TRIM(cl_index(:il_ind1-1))//TRIM(cl_index(il_ind2+1:))
+            ELSE
+               CALL logger_error("BOUNDARY INIT: unclosed parentheses."//&
+               &  " check namelist. ")
+            ENDIF
+         ENDIF
+      
+         
+         cl_tmp=fct_split(cl_seg,2,',')
+
+
+         cl_first=fct_split(cl_tmp,1,':')
+         ! remove potential width information
+         il_ind1=SCAN(fct_lower(cl_first),'(')
+         IF( il_ind1 /=0 )THEN
+            il_ind2=SCAN(fct_lower(cl_first),')')
+            IF( il_ind2 /=0 )THEN
+               cl_first=TRIM(cl_first(:il_ind1-1))//TRIM(cl_first(il_ind2+1:))
+            ELSE
+               CALL logger_error("BOUNDARY INIT: unclosed parentheses."//&
+               &  " check namelist. ")
+            ENDIF
+         ENDIF         
+         
+         cl_last =fct_split(cl_tmp,2,':')
+         ! remove potential width information
+         il_ind1=SCAN(fct_lower(cl_last),'(')
+         IF( il_ind1 /=0 )THEN
+            il_ind2=SCAN(fct_lower(cl_last),')')
+            IF( il_ind2 /=0 )THEN
+               cl_last=TRIM(cl_last(:il_ind1-1))//TRIM(cl_last(il_ind2+1:))
+            ELSE
+               CALL logger_error("BOUNDARY INIT: unclosed parentheses."//&
+               &  " check namelist. ")
+            ENDIF
+         ENDIF
+
+         IF( il_width /= 0 ) tl_seg%i_width=il_width
+
+         IF( TRIM(cl_index) /= '' ) READ(cl_index,*) tl_seg%i_index
+         IF( TRIM(cl_first) /= '' ) READ(cl_first,*) tl_seg%i_first
+         IF( TRIM(cl_last)  /= '' ) READ(cl_last ,*) tl_seg%i_last
+
+         ! index expressed on U,V point, move on T point.
+         SELECT CASE(id_jcard)
+            CASE(jp_north, jp_east)
+               tl_seg%i_index=tl_seg%i_index+1
+         END SELECT
+
+         IF( (tl_seg%i_first == 0 .AND.  tl_seg%i_last == 0) .OR. &
+         &   (tl_seg%i_first /= 0 .AND.  tl_seg%i_last /= 0) )THEN
+            CALL boundary__add_seg(tf_bdy, tl_seg)
+         ELSE
+            CALL logger_error("BOUNDARY INIT: first or last segment indices "//&
+            &              "are missing . check namelist.")
+         ENDIF
+
+         ji=ji+1
+         cl_seg=fct_split(cd_card,ji)
+
+         ! clean
+         CALL seg__clean(tl_seg)
+      ENDDO 
+
+   END FUNCTION boundary__get_info 
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE boundary_get_indices(td_bdy, td_var, ld_oneseg) 
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine get indices of each semgent for each boundary.
+   ! 
+   !> @details 
+   !> indices are compute from variable value, actually variable fill value,
+   !> which is assume to be land mask. 
+   !> Boundary structure should have been initialized before running 
+   !> this subroutine. Segment indices will be search between first and last
+   !> indies, at this orthogonal index.
+   !> 
+   !> Optionnally you could forced to use only one segment for each boundary.
+   !> 
+   !> @warning number of segment (i_nseg) will be change, before the number 
+   !> of segment structure
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[inout] td_bdy boundary structure  
+   !> @param[in] td_var    variable structure 
+   !> @param[in] ld_onseg  use only one sgment for each boundary 
+   !------------------------------------------------------------------- 
+
+      IMPLICIT NONE 
+
+      ! Argument
+      TYPE(TBDY) , DIMENSION(ip_ncard), INTENT(INOUT) :: td_bdy
+      TYPE(TVAR)                      , INTENT(IN   ) :: td_var
+      LOGICAL                         , INTENT(IN   ), OPTIONAL :: ld_oneseg
+
+      ! local variable 
+      INTEGER(i4) :: il_index
+      INTEGER(i4) :: il_width
+      INTEGER(i4) :: il_first
+      INTEGER(i4) :: il_last 
+
+      LOGICAL     :: ll_oneseg
+
+      TYPE(TSEG)  :: tl_seg
+
+      ! loop indices
+      INTEGER(i4) :: jk
+      !---------------------------------------------------------------- 
+ 
+      ll_oneseg=.TRUE.
+      IF( PRESENT(ld_oneseg) ) ll_oneseg=ld_oneseg
+
+      DO jk=1,ip_ncard
+         IF( .NOT. td_bdy(jk)%l_use .OR. td_bdy(jk)%l_nam )THEN
+            ! nothing to be done
+         ELSE
+
+            IF( .NOT. ASSOCIATED(td_bdy(jk)%t_seg) )THEN
+               CALL logger_error("BOUNDARY GET INDICES: no segment "//&
+               &  " associated to "//TRIM(td_bdy(jk)%c_card)//&
+               &  " boundary. you should have run boundary_init before"//&
+               &  " running boundary_get_indices" )
+            ELSE
+               il_index=td_bdy(jk)%t_seg(1)%i_index
+               il_width=td_bdy(jk)%t_seg(1)%i_width
+               il_first=td_bdy(jk)%t_seg(1)%i_first
+               il_last =td_bdy(jk)%t_seg(1)%i_last
+ 
+               CALL boundary__get_seg_number( td_bdy(jk), td_var)
+
+               CALL boundary__get_seg_indices( td_bdy(jk), td_var, &
+               &                               il_index, il_width, &
+               &                               il_first, il_last )
+
+               IF( ll_oneseg .AND. td_bdy(jk)%l_use )THEN
+                  tl_seg=seg__copy(td_bdy(jk)%t_seg(1))
+                  ! use last indice of last segment
+                  tl_seg%i_last=td_bdy(jk)%t_seg(td_bdy(jk)%i_nseg)%i_last
+
+                  ! remove all segment from boundary
+                  CALL boundary__del_seg(td_bdy(jk))
+
+                  ! add one segment
+                  CALL boundary__add_seg(td_bdy(jk),tl_seg)
+
+                  ! clean
+                  CALL seg__clean(tl_seg)
+               ENDIF
+
+            ENDIF
+
+         ENDIF
+
+      ENDDO
+
+   END SUBROUTINE boundary_get_indices 
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE boundary__get_seg_number(td_bdy, td_var) 
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine compute the number of sea segment. 
+   ! 
+   !> @details 
+   !> It use variable value, actually variable fill value
+   !> (which is assume to be land mask), to compute the number of segment between
+   !> first and last indices at boundary orthogonal index.
+   !> @warning number of segment (i_nseg) will be change, before the number 
+   !> of segment structure
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[inout] td_bdy boundary structure 
+   !> @param[in] td_var    variable structure 
+   !------------------------------------------------------------------- 
+
+      IMPLICIT NONE 
+
+      ! Argument
+      TYPE(TBDY) , INTENT(INOUT) :: td_bdy
+      TYPE(TVAR) , INTENT(IN   ) :: td_var
+
+      ! local variable 
+      REAL(dp)   , DIMENSION(:)        , ALLOCATABLE :: dl_value
+      LOGICAL                                        :: ll_sea
+      INTEGER(i4)                                    :: il_index
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !---------------------------------------------------------------- 
+ 
+      IF( td_bdy%l_use .AND. td_bdy%i_nseg == 1 )THEN
+
+         il_index=td_bdy%t_seg(1)%i_index
+
+         SELECT CASE(TRIM(td_bdy%c_card))
+            CASE('north','south')
+
+               ALLOCATE( dl_value(td_var%t_dim(1)%i_len) )
+               dl_value(:)=td_var%d_value(:,il_index,1,1)
+
+               IF( ANY(dl_value(:) /= td_var%d_fill) )THEN
+                  
+                  td_bdy%l_use=.TRUE.
+                  td_bdy%i_nseg=0
+
+                  ll_sea=.FALSE.
+                  DO ji=1,td_var%t_dim(1)%i_len
+                     IF( dl_value(ji)/= td_var%d_fill )THEN
+                        IF( .NOT. ll_sea )THEN
+                           td_bdy%i_nseg=td_bdy%i_nseg+1
+                        ENDIF
+                        ll_sea=.TRUE.
+                     ELSE
+                        ll_sea=.FALSE.
+                     ENDIF
+                  ENDDO
+
+               ELSE
+                  td_bdy%l_use=.FALSE.
+                  td_bdy%i_nseg=0
+               ENDIF
+
+               DEALLOCATE( dl_value )
+
+            CASE('east','west')
+
+               ALLOCATE( dl_value(td_var%t_dim(2)%i_len) )
+               dl_value(:)=td_var%d_value(il_index,:,1,1)
+
+               IF( ANY(dl_value(:) /= td_var%d_fill) )THEN
+                  
+                  td_bdy%l_use=.TRUE.
+                  td_bdy%i_nseg=0
+
+                  ll_sea=.FALSE.
+                  DO ji=1,td_var%t_dim(2)%i_len
+                     IF( dl_value(ji)/= td_var%d_fill )THEN
+                        IF( .NOT. ll_sea )THEN
+                           td_bdy%i_nseg=td_bdy%i_nseg+1
+                        ENDIF
+                        ll_sea=.TRUE.
+                     ELSE
+                        ll_sea=.FALSE.
+                     ENDIF
+                  ENDDO
+
+               ELSE
+                  td_bdy%l_use=.FALSE.
+                  td_bdy%i_nseg=0
+               ENDIF
+
+               DEALLOCATE( dl_value )
+
+         END SELECT
+      ENDIF
+ 
+   END SUBROUTINE boundary__get_seg_number 
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE boundary__get_seg_indices(td_bdy, td_var, &
+         &                              id_index, id_width, id_first, id_last) 
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine get segment indices for one boundary.
+   ! 
+   !> @details 
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[inout] td_bdy boundary structure  
+   !> @param[in] td_var    variable structure  
+   !> @param[in] id_index  boundary orthogonal index  
+   !> @param[in] id_width  bounary width 
+   !> @param[in] id_first  boundary first indice
+   !> @param[in] id_last   boundary last  indice
+   !------------------------------------------------------------------- 
+
+      IMPLICIT NONE 
+
+      ! Argument
+      TYPE(TBDY) , INTENT(INOUT) :: td_bdy
+      TYPE(TVAR) , INTENT(IN   ) :: td_var
+      INTEGER(i4), INTENT(IN   ) :: id_index
+      INTEGER(i4), INTENT(IN   ) :: id_width
+      INTEGER(i4), INTENT(IN   ) :: id_first
+      INTEGER(i4), INTENT(IN   ) :: id_last
+
+      ! local variable 
+      INTEGER(i4)                                    :: il_nseg
+      INTEGER(i4), DIMENSION(ip_ncard)               :: il_max
+      INTEGER(i4), DIMENSION(ip_ncard)               :: il_min
+
+      REAL(dp)   , DIMENSION(:)        , ALLOCATABLE :: dl_value
+
+      LOGICAL                                        :: ll_sea
+      LOGICAL                                        :: ll_first
+      LOGICAL                                        :: ll_last
+
+      TYPE(TSEG)                                     :: tl_seg
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !---------------------------------------------------------------- 
+ 
+      SELECT CASE(TRIM(td_bdy%c_card))
+         CASE('north')
+            jk=jp_north
+            
+            ALLOCATE( dl_value(td_var%t_dim(1)%i_len) )
+            dl_value(:)=td_var%d_value(:,id_index,1,1)
+
+         CASE('south')
+            jk=jp_south
+
+            ALLOCATE( dl_value(td_var%t_dim(1)%i_len) )
+            dl_value(:)=td_var%d_value(:,id_index,1,1)
+
+         CASE('east ')
+            jk=jp_east 
+
+            ALLOCATE( dl_value(td_var%t_dim(2)%i_len) )
+            dl_value(:)=td_var%d_value(id_index,:,1,1)
+
+         CASE('west ')
+            jk=jp_west 
+
+            ALLOCATE( dl_value(td_var%t_dim(2)%i_len) )
+            dl_value(:)=td_var%d_value(id_index,:,1,1)
+
+      END SELECT
+
+      il_max(jp_north)=td_var%t_dim(1)%i_len-ip_ghost
+      il_max(jp_south)=td_var%t_dim(1)%i_len-ip_ghost
+      il_max(jp_east )=td_var%t_dim(2)%i_len-ip_ghost
+      il_max(jp_west )=td_var%t_dim(2)%i_len-ip_ghost
+
+      il_min(jp_north)=1+ip_ghost
+      il_min(jp_south)=1+ip_ghost
+      il_min(jp_east )=1+ip_ghost
+      il_min(jp_west )=1+ip_ghost
+         
+      ! special case for EW cyclic 
+      IF( td_var%i_ew >= 0 )THEN
+         il_min(jp_north)=1
+         il_min(jp_south)=1
+
+         il_max(jp_north)=td_var%t_dim(1)%i_len
+         il_max(jp_south)=td_var%t_dim(1)%i_len
+      ENDIF
+      
+      il_nseg=td_bdy%i_nseg
+      ! remove all segment from boundary
+      CALL boundary__del_seg(td_bdy)
+
+      ll_first=.FALSE.
+      ll_last =.FALSE.
+      DO jl=1,il_nseg
+
+         ! init
+         tl_seg=seg__init(id_index,id_width,id_first,id_last)
+
+         IF( .NOT. (ll_first .AND. ll_last) )THEN
+            ! first loop
+            tl_seg%i_first=MAX(id_first,il_min(jk))
+            tl_seg%i_last =MIN(id_last ,il_max(jk))
+         ELSE
+            ! load new min and max
+            tl_seg%i_first=MAX(td_bdy%t_seg(jl-1)%i_last,il_min(jk))
+            tl_seg%i_last =MIN(id_last                  ,il_max(jk))
+         ENDIF
+
+         ll_first=.FALSE.
+         ll_last =.FALSE.
+         ll_sea  =.FALSE.
+
+         DO ji=tl_seg%i_first,tl_seg%i_last
+
+            IF( ll_first .AND. ll_last )THEN
+               ! first and last point already loaded
+               ! look for next segment
+               EXIT
+            ENDIF
+
+            IF( dl_value(ji)/= td_var%d_fill )THEN
+               IF( .NOT. ll_sea )THEN
+                  tl_seg%i_first=MAX(tl_seg%i_first,ji-1)
+                  ll_first=.true.
+               ENDIF
+               ll_sea=.TRUE.
+            ELSE
+               IF( ll_sea )THEN
+                  tl_seg%i_last=ji
+                  ll_last=.TRUE.
+               ENDIF
+               ll_sea=.FALSE.
+            ENDIF
+            
+         ENDDO
+
+         CALL boundary__add_seg(td_bdy,tl_seg)
+
+         ! clean
+         CALL seg__clean(tl_seg)
+         
+      ENDDO
+
+      DEALLOCATE(dl_value)
+      
+   END SUBROUTINE boundary__get_seg_indices 
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE boundary_check_corner(td_bdy, td_var)
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine check if there is boundary at corner, and 
+   !> adjust boundary indices if necessary. 
+   ! 
+   !> @details 
+   !> If there is a north west corner, first indices of north boundary
+   !> should be the same as the west boundary indices. 
+   !> And the last indices of the west boundary should be the same as
+   !> the north indices.
+   !> More over the width of west and north boundary should be the same.
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[inout] td_bdy boundary structure
+   !> @param[in] td_var    variable structure
+   !------------------------------------------------------------------- 
+
+      IMPLICIT NONE 
+
+      ! Argument
+      TYPE(TBDY) , DIMENSION(ip_ncard), INTENT(INOUT) :: td_bdy
+      TYPE(TVAR)                      , INTENT(IN   ) :: td_var
+
+      ! local variable 
+      TYPE(TSEG)  :: tl_north
+      TYPE(TSEG)  :: tl_south
+      TYPE(TSEG)  :: tl_east 
+      TYPE(TSEG)  :: tl_west
+
+      INTEGER(i4) :: il_width
+
+      ! loop indices
+      !---------------------------------------------------------------- 
+ 
+      IF( .NOT. ASSOCIATED(td_var%d_value) )THEN
+         CALL logger_error("BOUNDARY CHEKC CORNER: no value associated "//&
+         &              "to variable "//TRIM(td_var%c_name))
+      ENDIF
+
+      ! check north west corner
+      IF( td_bdy(jp_north)%l_use .AND. td_bdy(jp_west)%l_use )THEN
+         tl_west =seg__copy(td_bdy(jp_west )%t_seg(td_bdy(jp_west)%i_nseg))
+         tl_north=seg__copy(td_bdy(jp_north)%t_seg(1))
+
+         IF( tl_west%i_last  >= tl_north%i_index .AND. &
+         &   tl_west%i_index >= tl_north%i_first ) THEN
+            CALL logger_debug("BOUNDARY CHEKC CORNER: there is "//&
+            &                 "a north west corner")
+
+            tl_west%i_last   = tl_north%i_index
+            tl_north%i_first = tl_west%i_index
+
+            IF( tl_west%i_width /= tl_north%i_width )THEN
+               CALL logger_error("BOUNDARY CHEKC CORNER: discordant "//&
+               &  " width between north and west boundary ")
+
+               il_width=MIN(tl_west%i_width,tl_north%i_width)
+               
+               tl_west%i_width =il_width
+               tl_north%i_width=il_width
+
+            ENDIF
+
+            td_bdy(jp_west )%t_seg(td_bdy(jp_west)%i_nseg)=seg__copy(tl_west)
+            td_bdy(jp_north)%t_seg(1)                     =seg__copy(tl_north)
+
+         ELSE
+
+            IF( td_var%d_value(tl_north%i_first,tl_north%i_index,1,1) /= &
+            &   td_var%d_fill )THEN
+               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
+               &              "north boundary first indice ")
+            ENDIF
+
+            IF( td_var%d_value(tl_west%i_index,tl_west%i_last,1,1) /= &
+            &   td_var%d_fill )THEN
+               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
+               &              "west boundary last indice")
+            ENDIF
+         ENDIF
+      ENDIF
+
+      ! check north east corner
+      IF( td_bdy(jp_north)%l_use .AND. td_bdy(jp_east)%l_use )THEN
+         tl_east =seg__copy(td_bdy(jp_east )%t_seg(td_bdy(jp_east )%i_nseg))
+         tl_north=seg__copy(td_bdy(jp_north)%t_seg(td_bdy(jp_north)%i_nseg))
+
+         IF( tl_east%i_last  >= tl_north%i_index .AND. &
+         &   tl_east%i_index <= tl_north%i_last ) THEN
+            CALL logger_debug("BOUNDARY CHEKC CORNER: there is "//&
+            &              "a north east corner")
+
+            tl_east%i_last  = tl_north%i_index
+            tl_north%i_last = tl_east%i_index
+
+            IF( tl_east%i_width /= tl_north%i_width )THEN
+               CALL logger_error("BOUNDARY CHEKC CORNER: discordant "//&
+               &  " width between north and east boundary ")
+
+               il_width=MIN(tl_east%i_width,tl_north%i_width)
+               
+               tl_east%i_width =il_width
+               tl_north%i_width=il_width
+
+            ENDIF
+
+            td_bdy(jp_east )%t_seg(td_bdy(jp_east )%i_nseg)=seg__copy(tl_east)
+            td_bdy(jp_north)%t_seg(td_bdy(jp_north)%i_nseg)=seg__copy(tl_north)
+         ELSE
+
+            IF( td_var%d_value(tl_north%i_last,tl_north%i_index,1,1) /= &
+            &   td_var%d_fill )THEN
+               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
+               &              "north boundary last indice ")
+            ENDIF
+
+            IF( td_var%d_value(tl_east%i_index,tl_east%i_last,1,1) /= &
+            &   td_var%d_fill )THEN
+               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
+               &              "east boundary last indice")
+            ENDIF
+         ENDIF
+      ENDIF
+
+      ! check south east corner
+      IF( td_bdy(jp_south)%l_use .AND. td_bdy(jp_east)%l_use )THEN
+         tl_east =seg__copy(td_bdy(jp_east )%t_seg(1))
+         tl_south=seg__copy(td_bdy(jp_south)%t_seg(td_bdy(jp_south)%i_nseg))
+
+         IF( tl_east%i_first <= tl_south%i_index .AND. &
+         &   tl_east%i_index <= tl_south%i_last ) THEN
+            CALL logger_debug("BOUNDARY CHEKC CORNER: there is "//&
+            &              "a south east corner")
+
+            tl_east%i_first = tl_south%i_index
+            tl_south%i_last = tl_east%i_index
+
+            IF( tl_east%i_width /= tl_south%i_width )THEN
+               CALL logger_error("BOUNDARY CHEKC CORNER: discordant "//&
+               &  " width between south and east boundary ")
+
+               il_width=MIN(tl_east%i_width,tl_south%i_width)
+               
+               tl_east%i_width =il_width
+               tl_south%i_width=il_width
+
+            ENDIF
+
+            td_bdy(jp_east )%t_seg(1)                      =seg__copy(tl_east)
+            td_bdy(jp_south)%t_seg(td_bdy(jp_south)%i_nseg)=seg__copy(tl_south)
+         ELSE
+
+            IF( td_var%d_value(tl_south%i_last,tl_south%i_index,1,1) /= &
+            &   td_var%d_fill )THEN
+               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
+               &              "south boundary last indice ")
+            ENDIF
+
+            IF( td_var%d_value(tl_east%i_index,tl_east%i_first,1,1) /= &
+            &   td_var%d_fill )THEN
+               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
+               &              "east boundary first indice")
+            ENDIF
+         ENDIF
+      ENDIF
+
+      ! check south west corner
+      IF( td_bdy(jp_south)%l_use .AND. td_bdy(jp_west)%l_use )THEN
+         tl_west =seg__copy(td_bdy(jp_west )%t_seg(1))
+         tl_south=seg__copy(td_bdy(jp_south)%t_seg(1))
+
+         IF( tl_west%i_first <= tl_south%i_index .AND. &
+         &   tl_west%i_index >= tl_south%i_first ) THEN
+            CALL logger_debug("BOUNDARY CHEKC CORNER: there is "//&
+            &              "a south west corner")
+
+            tl_west%i_first = tl_south%i_index
+            tl_south%i_first= tl_west%i_index
+
+            IF( tl_west%i_width /= tl_south%i_width )THEN
+               CALL logger_error("BOUNDARY CHEKC CORNER: discordant "//&
+               &  " width between south and west boundary ")
+
+               il_width=MIN(tl_west%i_width,tl_south%i_width)
+               
+               tl_west%i_width =il_width
+               tl_south%i_width=il_width
+
+            ENDIF
+
+            td_bdy(jp_west )%t_seg(1) = seg__copy(tl_west)
+            td_bdy(jp_south)%t_seg(1) = seg__copy(tl_south)
+         ELSE
+
+            IF( td_var%d_value(tl_south%i_first,tl_south%i_index,1,1) /= &
+            &   td_var%d_fill )THEN
+               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
+               &              "south boundary first indice ")
+            ENDIF
+
+            IF( td_var%d_value(tl_west%i_index,tl_west%i_first,1,1) /= &
+            &   td_var%d_fill )THEN
+               CALL logger_error("BOUNDARY CHEKC CORNER: wrong "//&
+               &              "west boundary first indice")
+            ENDIF
+         ENDIF
+      ENDIF
+
+      ! clean
+      CALL seg__clean(tl_north)
+      CALL seg__clean(tl_south)
+      CALL seg__clean(tl_east )
+      CALL seg__clean(tl_west )
+
+   END SUBROUTINE boundary_check_corner 
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE boundary_check(td_bdy, td_var) 
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine check boundary.
+   ! 
+   !> @details 
+   !> It checks that first and last indices as well as orthogonal index are
+   !> inside domain, and check corner (see boundary_check_corner).
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   !> @date June, 2016
+   !> - Bug fix: take into account that boundaries are compute on T point,
+   !>   but expressed on U,V point
+   !>
+   !> @param[inout] td_bdy boundary structure 
+   !> @param[in] td_var    variable structure 
+   !------------------------------------------------------------------- 
+
+      IMPLICIT NONE 
+
+      ! Argument
+      TYPE(TBDY) , DIMENSION(ip_ncard), INTENT(INOUT) :: td_bdy
+      TYPE(TVAR)                      , INTENT(IN   ) :: td_var
+
+      ! local variable 
+      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_max
+      INTEGER(i4)      , DIMENSION(ip_ncard) :: il_maxindex
+
+      ! loop indices 
+      INTEGER(i4) :: jk
+      !---------------------------------------------------------------- 
+ 
+      il_max(jp_north)=td_var%t_dim(1)%i_len
+      il_max(jp_south)=td_var%t_dim(1)%i_len
+      il_max(jp_east )=td_var%t_dim(2)%i_len
+      il_max(jp_west )=td_var%t_dim(2)%i_len
+ 
+      ! index expressed on U,V point, move on T point.
+      il_maxindex(jp_north)=td_var%t_dim(2)%i_len-ip_ghost+1
+      il_maxindex(jp_south)=td_var%t_dim(2)%i_len-ip_ghost
+      il_maxindex(jp_east )=td_var%t_dim(1)%i_len-ip_ghost+1
+      il_maxindex(jp_west )=td_var%t_dim(1)%i_len-ip_ghost
+
+      DO jk=1,ip_ncard
+         IF( td_bdy(jk)%l_use )THEN
+            IF( .NOT. ASSOCIATED(td_bdy(jk)%t_seg) )THEN
+               CALL logger_error("BOUNDARY CHECK: no segment associted "//&
+               &                 "to "//TRIM(td_bdy(jk)%c_card)//" boundary")
+            ELSE
+               ! check indices
+               IF( ANY(td_bdy(jk)%t_seg(:)%i_first < 1         ) .OR. &
+               &   ANY(td_bdy(jk)%t_seg(:)%i_first > il_max(jk)) .OR. &
+               &   ANY(td_bdy(jk)%t_seg(:)%i_last  < 1         ) .OR. &
+               &   ANY(td_bdy(jk)%t_seg(:)%i_last  > il_max(jk)) .OR. &
+               &   ANY(td_bdy(jk)%t_seg(:)%i_first > td_bdy(jk)%t_seg(:)%i_last)&
+               & )THEN
+                  CALL logger_error("BOUNDARY CHECK: invalid segment "//&
+                  &              "first and/or last indice for "//&
+                  &              TRIM(td_bdy(jk)%c_card)//&
+                  &              " boundary. check namelist")
+               ENDIF
+
+               IF( ANY(td_bdy(jk)%t_seg(:)%i_index < 1         ) .OR. &
+               &   ANY(td_bdy(jk)%t_seg(:)%i_index > il_maxindex(jk)) &
+               & )THEN
+                  CALL logger_error("BOUNDARY CHECK: invalid index "//&
+                  &              "for "//TRIM(td_bdy(jk)%c_card)//&
+                  &              " boundary. check namelist")
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDDO
+ 
+      CALL boundary_check_corner(td_bdy, td_var)
+
+   END SUBROUTINE boundary_check
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE boundary_swap(td_var, td_bdy)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine swap array for east and north boundary.
+   !
+   !> @detail
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_var variable strucutre
+   !> @param[in   ] td_bdy boundary strucutre
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+      TYPE(TBDY), INTENT(IN   ) :: td_bdy
+
+      ! local variable
+      REAL(dp), DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      IF( .NOT. ASSOCIATED(td_var%d_value) )THEN
+         CALL logger_error("BOUNDARY SWAP: no array of value "//&
+         &  "associted to variable "//TRIM(td_var%c_name) )
+      ELSE      
+
+         SELECT CASE(TRIM(td_bdy%c_card))
+         CASE('north')
+            ALLOCATE( dl_value(td_var%t_dim(1)%i_len, &
+            &                  td_var%t_dim(2)%i_len, &
+            &                  td_var%t_dim(3)%i_len, &
+            &                  td_var%t_dim(4)%i_len) )
+
+            dl_value(:,:,:,:)=td_var%d_value(:,:,:,:)
+
+            DO jj=1, td_var%t_dim(2)%i_len
+               td_var%d_value(:,jj,:,:) = &
+               &  dl_value(:,td_var%t_dim(2)%i_len-jj+1,:,:)
+            ENDDO
+
+            DEALLOCATE( dl_value )         
+         CASE('east')
+            ALLOCATE( dl_value(td_var%t_dim(1)%i_len, &
+            &                  td_var%t_dim(2)%i_len, &
+            &                  td_var%t_dim(3)%i_len, &
+            &                  td_var%t_dim(4)%i_len) )
+
+            dl_value(:,:,:,:)=td_var%d_value(:,:,:,:)
+
+            DO ji=1, td_var%t_dim(1)%i_len
+               td_var%d_value(ji,:,:,:) = &
+               &  dl_value(td_var%t_dim(1)%i_len-ji+1,:,:,:)
+            ENDDO
+
+            DEALLOCATE( dl_value )
+         CASE DEFAULT
+         ! nothing to be done
+         END SELECT
+
+      ENDIF
+   END SUBROUTINE boundary_swap
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE boundary__print_unit(td_bdy) 
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine print information about one boundary. 
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[in] td_bdy boundary structure 
+   !------------------------------------------------------------------- 
+
+      IMPLICIT NONE 
+
+      ! Argument
+      TYPE(TBDY), INTENT(IN) :: td_bdy
+
+      ! local variable 
+      ! loop indices 
+      INTEGER(i4) :: ji
+      !---------------------------------------------------------------- 
+
+      WRITE(*,'(a,/1x,a,/1x,a)') "Boundary "//TRIM(td_bdy%c_card), &
+      &  " use  "//TRIM(fct_str(td_bdy%l_use)), &
+      &  " nseg "//TRIM(fct_str(td_bdy%i_nseg))
+      DO ji=1,td_bdy%i_nseg
+         WRITE(*,'(4(/1x,a))') &
+         &  " index "//TRIM(fct_str(td_bdy%t_seg(ji)%i_index)), &
+         &  " width "//TRIM(fct_str(td_bdy%t_seg(ji)%i_width)), &
+         &  " first "//TRIM(fct_str(td_bdy%t_seg(ji)%i_first)), &
+         &  " last  "//TRIM(fct_str(td_bdy%t_seg(ji)%i_last))
+      ENDDO
+ 
+   END SUBROUTINE boundary__print_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE boundary__print_arr(td_bdy) 
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine print information about a array of boundary 
+   ! 
+   !> @details 
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[in] td_bdy boundary structure 
+   !------------------------------------------------------------------- 
+
+      IMPLICIT NONE 
+
+      ! Argument
+      TYPE(TBDY), DIMENSION(:), INTENT(IN) :: td_bdy
+
+      ! local variable 
+      ! loop indices 
+      INTEGER(i4) :: ji
+      !---------------------------------------------------------------- 
+
+      DO ji=1,SIZE(td_bdy(:))
+         CALL boundary_print(td_bdy(ji))
+      ENDDO
+ 
+   END SUBROUTINE boundary__print_arr
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION seg__copy_unit(td_seg) &
+         & RESULT (tf_seg)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy segment structure in another one.
+   !>
+   !> @warning do not use on the output of a function who create or read a
+   !> structure (ex: tl_seg=seg__copy(seg__init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2014
+   !> - use function instead of overload assignment operator 
+   !> (to avoid memory leak)
+   !
+   !> @param[in] td_seg   segment structure
+   !> @return copy of input segment structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TSEG), INTENT(IN)  :: td_seg
+
+      ! function
+      TYPE(TSEG)              :: tf_seg
+
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! copy segment index, width, ..
+      tf_seg%i_index    = td_seg%i_index
+      tf_seg%i_width    = td_seg%i_width
+      tf_seg%i_first    = td_seg%i_first
+      tf_seg%i_last     = td_seg%i_last 
+
+   END FUNCTION seg__copy_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION seg__copy_arr(td_seg) &
+         & RESULT (tf_seg)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy segment structure in another one.
+   !>
+   !> @warning do not use on the output of a function who create or read a
+   !> structure (ex: tl_seg=seg__copy(seg__init()) is forbidden).
+   !> This will create memory leaks.   
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2014
+   !> - use function instead of overload assignment operator 
+   !> (to avoid memory leak)
+   !
+   !> @param[in] td_seg   segment structure
+   !> @return copy of input array of segment structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TSEG), DIMENSION(:), INTENT(IN)   :: td_seg
+
+      ! function
+      TYPE(TSEG), DIMENSION(SIZE(td_seg(:))) :: tf_seg
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=1,SIZE(td_seg(:))
+         tf_seg(ji)=seg__copy(td_seg(ji))
+      ENDDO
+
+   END FUNCTION seg__copy_arr
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION seg__init(id_index, id_width, id_first, id_last) &
+         &  RESULT(tf_seg)
+   !------------------------------------------------------------------- 
+   !> @brief This function  initialise segment structure.
+   ! 
+   !> @details 
+   !> It simply add orthogonal index, and optionnaly width, first
+   !> and last indices of the segment. 
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[in] id_index  orthogonal index
+   !> @param[in] id_width  width of the segment 
+   !> @param[in] id_first  first indices 
+   !> @param[in] id_last   last  indices
+   !> @return segment structure
+   !------------------------------------------------------------------- 
+
+      IMPLICIT NONE 
+
+      ! Argument
+      INTEGER(i4), INTENT(IN) :: id_index
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_width
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_first
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_last 
+
+      ! function 
+      TYPE(TSEG)              :: tf_seg
+
+      ! local variable 
+      
+      ! loop indices 
+      !---------------------------------------------------------------- 
+
+      tf_seg%i_index=id_index
+
+      IF( PRESENT(id_width) ) tf_seg%i_width=id_width
+      IF( PRESENT(id_first) ) tf_seg%i_first=id_first
+      IF( PRESENT(id_last ) ) tf_seg%i_last =id_last
+
+   END FUNCTION seg__init 
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE seg__clean_unit(td_seg) 
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine clean segment structure. 
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[inout] td_seg segment structure
+   !------------------------------------------------------------------- 
+
+      IMPLICIT NONE 
+
+      ! Argument       
+      TYPE(TSEG), INTENT(INOUT) :: td_seg
+
+      ! local variable 
+      TYPE(TSEG) :: tl_seg
+      ! loop indices 
+      !---------------------------------------------------------------- 
+
+      td_seg=seg__copy(tl_seg)
+ 
+   END SUBROUTINE seg__clean_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE seg__clean_arr(td_seg) 
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine clean segment structure. 
+   ! 
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   ! 
+   !> @param[inout] td_seg array of segment structure
+   !------------------------------------------------------------------- 
+
+      IMPLICIT NONE 
+
+      ! Argument       
+      TYPE(TSEG), DIMENSION(:), INTENT(INOUT) :: td_seg
+
+      ! local variable 
+      ! loop indices 
+      INTEGER(i4) :: ji
+      !---------------------------------------------------------------- 
+
+      DO ji=SIZE(td_seg(:)),1,-1
+         CALL seg__clean(td_seg(ji))
+      ENDDO
+ 
+   END SUBROUTINE seg__clean_arr 
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE boundary
Index: /utils/tools_ticket2413/SIREN/src/create_bathy.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/create_bathy.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/create_bathy.f90	(revision 12863)
@@ -0,0 +1,1417 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @file
+!> This program creates fine grid bathymetry file.
+!>
+!> @section sec1 method
+!> This bathymetry could be :
+!> - extracted from a wider fine grid bathymetry file
+!> - interpolated from a wider coarse grid bathymetry file
+!> - handwritten
+!>
+!> @image html  bathy_40.png 
+!> <center>@image latex bathy_30.png
+!> </center>
+!>
+!> @section sec2 how to
+!> USAGE: create_bathy create_bathy.nam [-v] [-h]<br/>
+!>    - positional arguments:<br/>
+!>       - create_bathy.nam<br/>
+!>          namelist of create_bathy
+!>          @note
+!>             a template of the namelist could be created running (in templates directory):
+!>             @code{.sh}
+!>                python create_templates.py create_bathy
+!>             @endcode
+!>
+!>    - optional arguments:<br/>
+!>       - -h, --help<br/>
+!>          show this help message (and exit)<br/>
+!>       - -v, --version<br/>
+!>          show Siren's version   (and exit)
+!>
+!> @section sec_bathy create_bathy.nam
+!>    create_bathy.nam contains 7 sub-namelists:<br/>
+!>       - **namlog** to set logger parameters
+!>       - **namcfg** to set configuration file parameters
+!>       - **namsrc** to set source/coarse grid parameters
+!>       - **namtgt** to set target/fine grid parameters
+!>       - **namvar** to set variable parameters
+!>       - **namnst** to set sub domain and nesting paramters
+!>       - **namout** to set output parameters
+!>
+!>    here after, each sub-namelist parameters is detailed.
+!>    @note 
+!>       default values are specified between brackets
+!>
+!> @subsection sublog namlog
+!>    the logger sub-namelist parameters are :
+!>
+!>    - **cn_logfile** [@a create_bathy.log]<br/>
+!>       logger filename
+!>
+!>    - **cn_verbosity** [@a warning]<br/>
+!>       verbosity level, choose between :
+!>          - trace
+!>          - debug
+!>          - info
+!>          - warning
+!>          - error
+!>          - fatal
+!>          - none
+!>
+!>    - **in_maxerror** [@a 5]<br/> 
+!>       maximum number of error allowed
+!>
+!> @subsection subcfg namcfg
+!>    the configuration sub-namelist parameters are :
+!>
+!>    - **cn_varcfg** [@a ./cfg/variable.cfg]<br/>
+!>       path to the variable configuration file.<br/>
+!>       the variable configuration file defines standard name, 
+!>       default interpolation method, axis,... 
+!>       to be used for some known variables.<br/> 
+!>
+!>    - **cn_dimcfg** [@a ./cfg/dimension.cfg]<br/> 
+!>       path to the dimension configuration file.<br/> 
+!>       the dimension configuration file defines dimensions allowed.<br/> 
+!>
+!>    - **cn_dumcfg** [@a ./cfg/dummy.cfg]<br/> 
+!>       path to the useless (dummy) configuration file.<br/>
+!>       the dummy configuration file defines useless 
+!>       dimension or variable. these dimension(s) or variable(s) will not be
+!>       processed.<br/>
+!>
+!> @subsection subsrc namsrc 
+!>    the source/coarse grid sub-namelist parameters are :
+!>
+!>    - **cn_coord0** [@a ]<br/> 
+!>       path to the coordinate file
+!>
+!>    - **in_perio0** [@a ]<br/> 
+!>       NEMO periodicity index<br/> 
+!>       the NEMO periodicity could be choose between 0 to 6:
+!>       <dl>
+!>          <dt>in_perio=0</dt>
+!>          <dd>standard regional model</dd>
+!>          <dt>in_perio=1</dt>
+!>          <dd>east-west cyclic model</dd>
+!>          <dt>in_perio=2</dt>
+!>          <dd>model with symmetric boundary condition across the equator</dd>
+!>          <dt>in_perio=3</dt>
+!>          <dd>regional model with North fold boundary and T-point pivot</dd>
+!>          <dt>in_perio=4</dt>
+!>          <dd>global model with a T-point pivot.<br/>
+!>          example: ORCA2, ORCA025, ORCA12</dd>
+!>          <dt>in_perio=5</dt>
+!>          <dd>regional model with North fold boundary and F-point pivot</dd>
+!>          <dt>in_perio=6</dt>
+!>          <dd>global model with a F-point pivot<br/>
+!>          example: ORCA05</dd>
+!>          </dd>
+!>       </dl>
+!>       @sa For more information see @ref md_src_docsrc_6_perio
+!>       and Model Boundary Condition paragraph in the 
+!>       [NEMO documentation](https://forge.ipsl.jussieu.fr/nemo/chrome/site/doc/NEMO/manual/pdf/NEMO_manual.pdf)
+!>
+!> @subsection subtgt namtgt 
+!>    the target/fine grid sub-namelist parameters are :
+!>
+!>    - **cn_coord1** [@a ]<br/> 
+!>       path to coordinate file
+!>
+!>    - **in_perio1** [@a ]<br/>
+!>       NEMO periodicity index (see above)
+!>    @note if the fine/target coordinates file (cn_coord1) was created by SIREN, you do
+!>    not need to fill this parameter. SIREN will read it on the global attributes of
+!>    the coordinates file.
+!>
+!>    - **ln_fillclosed** [@a .TRUE.]<br/>
+!>       logical to fill closed sea or not
+!>
+!> @subsection subvar namvar 
+!>    the variable sub-namelist parameters are :
+!>
+!>    - **cn_varfile** [@a ]<br/> 
+!>       list of variable, and associated file 
+!>       @warning 
+!>          variable name must be __Bathymetry__ here.
+!>
+!>       *cn_varfile* is the path and filename of the file where find
+!>       variable.
+!>       @note 
+!>          *cn_varfile* could be a matrix of value, if you want to handwrite
+!>          variable value.<br/>
+!>          the variable array of value is split into equal subdomain.<br/>
+!>          each subdomain is filled with the corresponding value 
+!>          of the matrix.<br/>          
+!>          separators used to defined matrix are:
+!>             - ',' for line
+!>             - '/' for row
+!>             Example:<br/>
+!>                3,2,3/1,4,5  =>  @f$ \left( \begin{array}{ccc}
+!>                                      3 & 2 & 3 \\
+!>                                      1 & 4 & 5 \end{array} \right) @f$
+!>
+!>       Examples: 
+!>          - 'Bathymetry:gridT.nc'
+!>          - 'Bathymetry:5000,5000,5000/5000,3000,5000/5000,5000,5000'<br/>
+!>
+!>       @note 
+!>          Optionnaly, NEMO periodicity could be added following the filename.
+!>          the periodicity must be separated by ';'
+!>
+!>       Example:
+!>          - 'Bathymetry:gridT.nc ; perio=4'<br/>
+!>
+!>    - **cn_varinfo** [@a ]<br/> 
+!>       list of variable and extra information about request(s) to be used<br/>
+!>
+!>       each elements of *cn_varinfo* is a string character (separated by ',').<br/>
+!>       it is composed of the variable name follow by ':', 
+!>       then request(s) to be used on this variable.<br/> 
+!>       request could be:
+!>          - int = interpolation method
+!>          - ext = extrapolation method
+!>          - flt = filter method
+!>          - min = minimum value
+!>          - max = maximum value
+!>          - unt = new units
+!>          - unf = unit scale factor (linked to new units)
+!>
+!>             requests must be separated by ';'.<br/>
+!>             order of requests does not matter.<br/>
+!>
+!>       informations about available method could be find in @ref interp,
+!>       @ref extrap and @ref filter modules.<br/>
+!>       Example: 
+!>          - 'Bathymetry: flt=2*hamming(2,3); min=0'
+!>
+!>       @note 
+!>          If you do not specify a method which is required, 
+!>          default one is apply.
+!>
+!>    - **ln_rand** [@a .False.]<br/> 
+!>          logical to add random value to Bathymetry<br/>
+!>          Only for handmade Bathymetry. 
+!>          A random value (+/- 0.1% of the maximum depth) will
+!>          will be added to avoid flat Bathymetry (which may cause issue).
+!>
+!> @subsection subnst namnst 
+!>    the nesting sub-namelist parameters are :
+!>
+!>    - **in_rhoi**  [@a 1]<br/> 
+!>       refinement factor in i-direction
+!>
+!>    - **in_rhoj**  [@a 1]<br/> 
+!>       refinement factor in j-direction
+!>
+!>    @note 
+!>       coarse grid indices will be deduced from fine grid
+!>       coordinate file.
+!>
+!> @subsection subout namout 
+!>    the output sub-namelist parameter is :
+!>
+!>    - **cn_fileout** [@a bathy_fine.nc]<br/>
+!>       output bathymetry filename
+!>
+!> <hr>
+!> @author J.Paul
+!>
+!> @date November, 2013 - Initial Version
+!> @date Sepember, 2014 
+!> - add header for user
+!> - Bug fix, compute offset depending of grid point
+!> @date June, 2015
+!> - extrapolate all land points.
+!> - allow to change unit.
+!> @date September, 2015
+!> - manage useless (dummy) variable, attributes, and dimension
+!> @date January,2016
+!> - add create_bathy_check_depth as in create_boundary
+!> - add create_bathy_check_time  as in create_boundary
+!> @date February, 2016
+!> - do not closed sea for east-west cyclic domain
+!> @date October, 2016
+!> - dimension to be used select from configuration file
+!> @date July, 2017
+!> - add random value to avoid flat bathymetry
+!> @date January, 2019
+!> - add option to add random value to a flat Bathymetry
+!> - create and clean file structure to avoid memory leaks
+!> - check dimension of matrix for 'handmade' bathymetry
+!> - add url path to global attributes of output file(s)
+!> @date February, 2019
+!> - rename sub namelist namcrs to namsrc
+!> - rename sub namelist namfin to namtgt
+!> @date August, 2019
+!> - use periodicity read from namelist, and store in multi structure
+!> @date Ocober, 2019
+!> - add help and version optional arguments
+!>
+!> @todo
+!> - check tl_multi is not empty
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+PROGRAM create_bathy
+
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+   USE date                            ! date manager
+   USE att                             ! attribute manager
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+   USE file                            ! file manager
+   USE multi                           ! multi file manager
+   USE iom                             ! I/O manager
+   USE grid                            ! grid manager
+   USE extrap                          ! extrapolation manager
+   USE interp                          ! interpolation manager
+   USE filter                          ! filter manager
+   USE mpp                             ! MPP manager
+   USE dom                             ! domain manager
+   USE iom_mpp                         ! MPP I/O manager
+   USE iom_dom                         ! DOM I/O manager
+
+   IMPLICIT NONE
+
+   ! parameters
+   CHARACTER(LEN=lc), PARAMETER  :: cp_myname = "create_bathy"
+
+   ! local variable
+   CHARACTER(LEN=lc)                                  :: cl_arg
+   CHARACTER(LEN=lc)                                  :: cl_namelist
+   CHARACTER(LEN=lc)                                  :: cl_date
+   CHARACTER(LEN=lc)                                  :: cl_data
+   CHARACTER(LEN=lc)                                  :: cl_url
+   CHARACTER(LEN=lc)                                  :: cl_errormsg
+
+   INTEGER(i4)                                        :: il_narg
+   INTEGER(i4)                                        :: il_status
+   INTEGER(i4)                                        :: il_fileid
+   INTEGER(i4)                                        :: il_varid
+   INTEGER(i4)                                        :: il_attid
+   INTEGER(i4)                                        :: il_imin0
+   INTEGER(i4)                                        :: il_imax0
+   INTEGER(i4)                                        :: il_jmin0
+   INTEGER(i4)                                        :: il_jmax0
+   INTEGER(i4)      , DIMENSION(ip_maxdim)            :: il_rho
+   INTEGER(i4)      , DIMENSION(2,2)                  :: il_offset
+   INTEGER(i4)      , DIMENSION(2,2)                  :: il_ind
+   INTEGER(i4)      , DIMENSION(:,:)    , ALLOCATABLE :: il_mask
+
+   LOGICAL                                            :: ll_exist
+   LOGICAL                                            :: ll_fillclosed
+
+   TYPE(TMPP)                                         :: tl_coord0
+   TYPE(TMPP)                                         :: tl_coord1
+   TYPE(TMPP)                                         :: tl_mpp
+   TYPE(TFILE)                                        :: tl_fileout
+
+   TYPE(TATT)                                         :: tl_att
+   
+   TYPE(TVAR)                                         :: tl_lon
+   TYPE(TVAR)                                         :: tl_lat
+   TYPE(TVAR)                                         :: tl_depth
+   TYPE(TVAR)                                         :: tl_time
+
+   TYPE(TVAR)                                         :: tl_tmp
+   TYPE(TVAR)       , DIMENSION(:), ALLOCATABLE       :: tl_var
+   
+   TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
+
+   TYPE(TFILE)                                        :: tl_file
+
+   TYPE(TMULTI)                                       :: tl_multi
+
+   REAL(dp)                                           :: dl_minbat
+
+   ! loop indices
+   INTEGER(i4) :: ji
+   INTEGER(i4) :: jj
+   INTEGER(i4) :: jk
+
+   ! namelist variable
+   ! namlog
+   CHARACTER(LEN=lc)                       :: cn_logfile    = 'create_bathy.log' 
+   CHARACTER(LEN=lc)                       :: cn_verbosity  = 'warning' 
+   INTEGER(i4)                             :: in_maxerror   = 5
+
+   ! namcfg
+   CHARACTER(LEN=lc)                       :: cn_varcfg  = './cfg/variable.cfg' 
+   CHARACTER(LEN=lc)                       :: cn_dimcfg  = './cfg/dimension.cfg'
+   CHARACTER(LEN=lc)                       :: cn_dumcfg  = './cfg/dummy.cfg'
+
+   ! namsrc
+   CHARACTER(LEN=lc)                       :: cn_coord0  = '' 
+   INTEGER(i4)                             :: in_perio0  = -1
+
+   ! namtgt
+   CHARACTER(LEN=lc)                       :: cn_coord1  = ''
+   INTEGER(i4)                             :: in_perio1  = -1
+   LOGICAL                                 :: ln_fillclosed = .TRUE.
+
+   ! namvar
+   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = ''
+   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = ''
+   LOGICAL                                 :: ln_rand    = .FALSE.
+
+   ! namnst
+   INTEGER(i4)                             :: in_rhoi    = 1
+   INTEGER(i4)                             :: in_rhoj    = 1
+
+   ! namout
+   CHARACTER(LEN=lc)                       :: cn_fileout = 'bathy_fine.nc' 
+   !-------------------------------------------------------------------
+
+   NAMELIST /namlog/ &  !< logger namelist
+   &  cn_logfile,    &  !< log file
+   &  cn_verbosity,  &  !< log verbosity
+   &  in_maxerror       !< logger maximum error
+
+   NAMELIST /namcfg/ &  !< configuration namelist
+   &  cn_varcfg,     &  !< variable configuration file
+   &  cn_dimcfg,     &  !< dimension configuration file
+   &  cn_dumcfg         !< dummy configuration file
+
+   NAMELIST /namsrc/ &  !< source/coarse grid namelist
+   &  cn_coord0,     &  !< coordinate file
+   &  in_perio0         !< periodicity index
+
+   NAMELIST /namtgt/ &  !< target/fine grid namelist
+   &  cn_coord1,     &  !< coordinate file
+   &  in_perio1,     &  !< periodicity index
+   &  ln_fillclosed     !< fill closed sea
+ 
+   NAMELIST /namvar/ &  !< variable namelist
+   &  cn_varfile,    &  !< list of variable file
+   &  cn_varinfo,    &  !< list of variable and interpolation method to be used. (ex: 'votemper:linear','vosaline:cubic' )
+   &  ln_rand           !< add random value to avoid flat bathymetry
+ 
+   NAMELIST /namnst/ &  !< nesting namelist
+   &  in_rhoi,       &  !< refinement factor in i-direction
+   &  in_rhoj           !< refinement factor in j-direction
+
+   NAMELIST /namout/ &  !< output namelist
+   &  cn_fileout        !< fine grid bathymetry file
+   !-------------------------------------------------------------------
+
+   !
+   ! Initialisation
+   ! --------------
+   !
+   il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec
+
+   ! Traitement des arguments fournis
+   ! --------------------------------
+   IF( il_narg /= 1 )THEN
+      WRITE(cl_errormsg,*) ' ERROR : one argument is needed '
+      CALL fct_help(cp_myname,cl_errormsg) 
+      CALL EXIT(1)
+   ELSE
+
+      CALL GET_COMMAND_ARGUMENT(1,cl_arg) !f03 intrinsec
+      SELECT CASE (cl_arg)
+         CASE ('-v', '--version')
+
+            CALL fct_version(cp_myname)
+            CALL EXIT(0)
+
+         CASE ('-h', '--help')
+
+            CALL fct_help(cp_myname)
+            CALL EXIT(0)
+
+         CASE DEFAULT
+
+            cl_namelist=cl_arg
+
+            ! read namelist
+            INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist)
+            IF( ll_exist )THEN
+
+               il_fileid=fct_getunit()
+
+               OPEN( il_fileid, FILE=TRIM(cl_namelist),  &
+               &                FORM='FORMATTED',        &
+               &                ACCESS='SEQUENTIAL',     &
+               &                STATUS='OLD',            &
+               &                ACTION='READ',           &
+               &                IOSTAT=il_status)
+               CALL fct_err(il_status)
+               IF( il_status /= 0 )THEN
+                  WRITE(cl_errormsg,*) " ERROR : error opening "//TRIM(cl_namelist)
+                  CALL fct_help(cp_myname,cl_errormsg) 
+                  CALL EXIT(1)
+               ENDIF
+
+               READ( il_fileid, NML = namlog )
+ 
+               ! define logger file
+               CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror)
+               CALL logger_header()
+
+               READ( il_fileid, NML = namcfg )
+               ! get variable extra information on configuration file
+               CALL var_def_extra(TRIM(cn_varcfg))
+
+               ! get dimension allowed
+               CALL dim_def_extra(TRIM(cn_dimcfg))
+
+               ! get dummy variable
+               CALL var_get_dummy(TRIM(cn_dumcfg))
+               ! get dummy dimension
+               CALL dim_get_dummy(TRIM(cn_dumcfg))
+               ! get dummy attribute
+               CALL att_get_dummy(TRIM(cn_dumcfg))
+
+               READ( il_fileid, NML = namsrc )
+               READ( il_fileid, NML = namtgt )
+               READ( il_fileid, NML = namvar )
+               ! add user change in extra information
+               CALL var_chg_extra( cn_varinfo )
+               ! match variable with file
+               tl_multi=multi_init(cn_varfile)
+
+               READ( il_fileid, NML = namnst )
+               READ( il_fileid, NML = namout )
+
+               CLOSE( il_fileid, IOSTAT=il_status )
+               CALL fct_err(il_status)
+               IF( il_status /= 0 )THEN
+                  CALL logger_error("CREATE BATHY: closing "//TRIM(cl_namelist))
+               ENDIF
+
+            ELSE
+
+               WRITE(cl_errormsg,*) " ERROR : can't find "//TRIM(cl_namelist)
+               CALL fct_help(cp_myname,cl_errormsg) 
+               CALL EXIT(1)
+
+            ENDIF
+
+      END SELECT
+   ENDIF
+
+   CALL multi_print(tl_multi)
+
+   ! open files
+   IF( TRIM(cn_coord0) /= '' )THEN
+      tl_file=file_init(TRIM(cn_coord0))
+      tl_coord0=mpp_init( tl_file, id_perio=in_perio0)
+      ! clean
+      CALL file_clean(tl_file)
+      CALL grid_get_info(tl_coord0)
+   ELSE
+      CALL logger_fatal("CREATE BATHY: no coarse grid coordinate found. "//&
+      &     "check namelist")      
+   ENDIF
+
+   IF( TRIM(cn_coord1) /= '' )THEN
+      tl_file=file_init(TRIM(cn_coord1))
+      tl_coord1=mpp_init( tl_file, id_perio=in_perio1)
+      ! clean
+      CALL file_clean(tl_file)
+      CALL grid_get_info(tl_coord1)
+   ELSE
+      CALL logger_fatal("CREATE BATHY: no fine grid coordinate found. "//&
+      &     "check namelist")
+   ENDIF
+
+   ! do not closed sea for east-west cyclic domain
+   ll_fillclosed=ln_fillclosed
+   IF( tl_coord1%i_perio == 1 ) ll_fillclosed=.FALSE.
+
+   ! check
+   ! check output file do not already exist
+   INQUIRE(FILE=TRIM(cn_fileout), EXIST=ll_exist)
+   IF( ll_exist )THEN
+      CALL logger_fatal("CREATE BATHY: output file "//TRIM(cn_fileout)//&
+      &  " already exist.")
+   ENDIF
+
+   ! check namelist
+   ! check refinement factor
+   il_rho(:)=1
+   IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN
+      CALL logger_error("CREATE BATHY: invalid refinement factor."//&
+      &  " check namelist "//TRIM(cl_namelist))
+   ELSE
+      il_rho(jp_I)=in_rhoi
+      il_rho(jp_J)=in_rhoj
+   ENDIF
+
+   ! check domain indices
+   ! compute coarse grid indices around fine grid
+   il_ind(:,:)=grid_get_coarse_index( tl_coord0, tl_coord1, &
+   &                                  id_rho=il_rho(:) )
+
+   il_imin0=il_ind(jp_I,1) ; il_imax0=il_ind(jp_I,2)
+   il_jmin0=il_ind(jp_J,1) ; il_jmax0=il_ind(jp_J,2)
+
+   ! check domain validity
+   CALL grid_check_dom(tl_coord0, il_imin0, il_imax0, il_jmin0, il_jmax0)
+
+   ! check coincidence between coarse and fine grid
+   CALL grid_check_coincidence( tl_coord0, tl_coord1, &
+   &                            il_imin0, il_imax0, &
+   &                            il_jmin0, il_jmax0, &
+   &                            il_rho(:) )
+
+   IF( .NOT. ASSOCIATED(tl_multi%t_mpp) )THEN
+      CALL logger_error("CREATE BATHY: no mpp file to work on. "//&
+      &                 "check cn_varfile in namelist.")
+   ELSE
+
+      ALLOCATE( tl_var( tl_multi%i_nvar ) )
+      jk=0
+      DO ji=1,tl_multi%i_nmpp
+      
+         WRITE(cl_data,'(a,i2.2)') 'data-',jk+1
+         IF( .NOT. ASSOCIATED(tl_multi%t_mpp(ji)%t_proc(1)%t_var) )THEN
+
+            CALL logger_fatal("CREATE BATHY: no variable to work on for "//&
+            &                 "mpp file"//TRIM(tl_multi%t_mpp(ji)%c_name)//&
+            &                 ". check cn_varfile in namelist.")
+
+         ELSEIF( TRIM(tl_multi%t_mpp(ji)%c_name) == TRIM(cl_data) )THEN
+
+            !- use input matrix to initialise variable
+            DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
+               jk=jk+1
+               tl_tmp=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj))
+
+               IF( COUNT(tl_tmp%t_dim(:)%l_use) > 2 )THEN
+                  CALL logger_fatal("CREATE BATHY: input matrix use more "//&
+                     &              "than 2D. Check namelist.")
+               ENDIF
+               tl_var(jk)=create_bathy_matrix(tl_tmp, tl_coord1, ln_rand)
+            ENDDO
+            ! clean
+            CALL var_clean(tl_tmp)
+
+         ELSE
+
+            tl_file=file_init(TRIM(tl_multi%t_mpp(ji)%c_name), &
+               &              id_perio=tl_multi%t_mpp(ji)%i_perio)
+            tl_mpp=mpp_init( tl_file )
+
+            ! clean
+            CALL file_clean(tl_file)
+            CALL grid_get_info(tl_mpp)
+
+            ! open mpp file
+            CALL iom_mpp_open(tl_mpp)
+
+            ! get or check depth value
+            CALL create_bathy_check_depth( tl_mpp, tl_depth )
+
+            ! get or check time value
+            CALL create_bathy_check_time( tl_mpp, tl_time )
+
+            ! close mpp file
+            CALL iom_mpp_close(tl_mpp)
+
+            IF( ANY(tl_mpp%t_dim(1:2)%i_len /= tl_coord0%t_dim(1:2)%i_len).OR.&
+            &   ALL(il_rho(:)==1) )THEN
+               !- extract bathymetry from fine grid bathymetry 
+               DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
+                  jk=jk+1
+                  tl_tmp=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj))
+ 
+                  tl_var(jk)=create_bathy_extract( tl_tmp, tl_mpp, &
+                  &                                tl_coord1 )
+               ENDDO
+               ! clean
+               CALL var_clean(tl_tmp)
+            ELSE
+               !- get bathymetry from coarse grid bathymetry 
+               DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
+                  jk=jk+1
+                  tl_tmp=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj))
+
+                  il_offset(:,:)= grid_get_fine_offset(tl_coord0,    &
+                  &                                    il_imin0, il_jmin0, &
+                  &                                    il_imax0, il_jmax0, &
+                  &                                    tl_coord1,          &
+                  &                                    il_rho(:),          &
+                  &                                    TRIM(tl_tmp%c_point) )
+
+                  tl_var(jk)=create_bathy_get_var( tl_tmp, tl_mpp,     &
+                  &                                il_imin0, il_jmin0, &
+                  &                                il_imax0, il_jmax0, &
+                  &                                il_offset(:,:),  &
+                  &                                il_rho(:) )
+               ENDDO
+               ! clean
+               CALL var_clean(tl_tmp)
+            ENDIF
+
+            ! clean structure
+            CALL mpp_clean(tl_mpp)
+
+         ENDIF
+      ENDDO
+   ENDIF
+
+   ! use additional request
+   DO jk=1,tl_multi%i_nvar
+
+         ! change unit and apply factor
+         CALL var_chg_unit(tl_var(jk))
+
+         ! forced min and max value
+         CALL var_limit_value(tl_var(jk))
+
+         ! fill closed sea
+         IF( ll_fillclosed )THEN
+            ALLOCATE( il_mask(tl_var(jk)%t_dim(1)%i_len, &
+            &                 tl_var(jk)%t_dim(2)%i_len) )
+
+            ! split domain in N sea subdomain
+            il_mask(:,:)=grid_split_domain(tl_var(jk))
+
+            !  fill smallest domain
+            CALL grid_fill_small_dom( tl_var(jk), il_mask(:,:) )
+
+            DEALLOCATE( il_mask )
+         ENDIF
+
+         ! filter
+         CALL filter_fill_value(tl_var(jk))
+
+         ! check bathymetry
+         dl_minbat=MINVAL(tl_var(jk)%d_value(:,:,:,:))
+         IF( TRIM(tl_var(jk)%c_stdname) == 'bathymetry' .AND. &
+         &   dl_minbat <= 0._dp  )THEN
+            CALL logger_debug("CREATE BATHY: min value "//TRIM(fct_str(dl_minbat)))
+            CALL logger_fatal("CREATE BATHY: Bathymetry has value <= 0")
+         ENDIF
+
+   ENDDO
+
+   ! create file
+   tl_fileout=file_init(TRIM(cn_fileout))
+
+   ! add dimension
+   tl_dim(:)=var_max_dim(tl_var(:))
+
+   DO ji=1,ip_maxdim
+      IF( tl_dim(ji)%l_use ) CALL file_add_dim(tl_fileout, tl_dim(ji))
+   ENDDO
+
+   ! add variables
+   IF( ALL( tl_dim(1:2)%l_use ) )THEN
+
+      ! open mpp files
+      CALL iom_mpp_open(tl_coord1)
+
+      ! add longitude
+      il_varid=var_get_id(tl_coord1%t_proc(1)%t_var(:),'longitude')
+      IF( il_varid == 0 )THEN
+         il_varid=var_get_id(tl_coord1%t_proc(1)%t_var(:),'longitude_T')
+      ENDIF
+      tl_lon=iom_mpp_read_var(tl_coord1, il_varid)
+      CALL file_add_var(tl_fileout, tl_lon)
+      CALL var_clean(tl_lon)
+
+      ! add latitude
+      il_varid=var_get_id(tl_coord1%t_proc(1)%t_var(:),'latitude')
+      IF( il_varid == 0 )THEN
+         il_varid=var_get_id(tl_coord1%t_proc(1)%t_var(:),'latitude_T')
+      ENDIF
+      tl_lat=iom_mpp_read_var(tl_coord1, il_varid)
+      CALL file_add_var(tl_fileout, tl_lat)
+      CALL var_clean(tl_lat)
+
+      ! close mpp files
+      CALL iom_mpp_close(tl_coord1)
+
+   ENDIF
+
+   IF( tl_dim(3)%l_use )THEN
+      ! add depth
+      CALL file_add_var(tl_fileout, tl_depth)
+      CALL var_clean(tl_depth)
+   ENDIF
+
+   IF( tl_dim(4)%l_use )THEN
+      ! add time
+      CALL file_add_var(tl_fileout, tl_time)
+      CALL var_clean(tl_time)
+   ENDIF
+
+   ! add other variables
+   DO jk=tl_multi%i_nvar,1,-1
+      CALL file_add_var(tl_fileout, tl_var(jk))
+      CALL var_clean(tl_var(jk))
+   ENDDO
+   DEALLOCATE(tl_var)
+
+   ! clean
+   CALL multi_clean(tl_multi)
+
+   ! add some attribute
+   tl_att=att_init("Created_by","SIREN create_bathy")
+   CALL file_add_att(tl_fileout, tl_att)
+
+   !add source url
+   cl_url=fct_split(fct_split(cp_url,2,'$'),2,'URL:')
+   tl_att=att_init("SIREN_url",cl_url)
+   CALL file_add_att(tl_fileout, tl_att)
+
+   ! add date of creation
+   cl_date=date_print(date_now())
+   tl_att=att_init("Creation_date",cl_date)
+   CALL file_add_att(tl_fileout, tl_att)
+
+   ! add attribute periodicity
+   il_attid=0
+   IF( ASSOCIATED(tl_fileout%t_att) )THEN
+      il_attid=att_get_index(tl_fileout%t_att(:),'periodicity')
+   ENDIF
+   IF( tl_coord1%i_perio >= 0 .AND. il_attid == 0 )THEN
+      tl_att=att_init('periodicity',tl_coord1%i_perio)
+      CALL file_add_att(tl_fileout,tl_att)
+   ENDIF
+
+   ! add attribute east west overlap
+   il_attid=0
+   IF( ASSOCIATED(tl_fileout%t_att) )THEN
+      il_attid=att_get_index(tl_fileout%t_att(:),'ew_overlap')
+   ENDIF
+   IF( tl_coord1%i_ew >= 0 .AND. il_attid == 0 )THEN
+      tl_att=att_init('ew_overlap',tl_coord1%i_ew)
+      CALL file_add_att(tl_fileout,tl_att)
+   ENDIF
+   
+   ! create file
+   CALL iom_create(tl_fileout)
+
+   ! write file
+   CALL iom_write_file(tl_fileout)
+
+   ! close file
+   CALL iom_close(tl_fileout)
+
+   ! clean
+   CALL att_clean(tl_att)
+
+   CALL file_clean(tl_fileout)
+   CALL mpp_clean(tl_coord1)
+   CALL mpp_clean(tl_coord0)
+   CALL var_clean_extra()
+
+   ! close log file
+   CALL logger_footer()
+   CALL logger_close()
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION create_bathy_matrix(td_var, td_coord, ld_rand) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function create variable, filled with matrix value
+   !> 
+   !> @details 
+   !> A variable is create with the same name that the input variable, 
+   !> and with dimension of the coordinate file.<br/> 
+   !> Then the variable array of value is split into equal subdomain.
+   !> Each subdomain is filled with the corresponding value of the matrix.
+   !>
+   !> Optionaly, you could add a random value of 0.1% of maximum depth to each
+   !> points of the bathymetry
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_var    variable structure 
+   !> @param[in] td_coord  coordinate file structure
+   !> @param[in] ld_rand   add random value to bathymetry
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR), INTENT(IN) :: td_var
+      TYPE(TMPP), INTENT(IN) :: td_coord
+      LOGICAL   , INTENT(IN) :: ld_rand
+
+      ! function
+      TYPE(TVAR)             :: tf_var
+
+      ! local variable
+      INTEGER(i4)      , DIMENSION(2,2)                  :: il_xghost
+      INTEGER(i4)      , DIMENSION(2)                    :: il_dim
+      INTEGER(i4)      , DIMENSION(2)                    :: il_size
+      INTEGER(i4)      , DIMENSION(2)                    :: il_rest
+
+      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_ishape
+      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_jshape
+
+      REAL(dp)         , DIMENSION(:,:)    , ALLOCATABLE :: dl_ran
+      REAL(dp)         , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      TYPE(TVAR)                                         :: tl_lon
+      TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
+
+      TYPE(TMPP)                                         :: tl_coord
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      ! copy structure
+      tl_coord=mpp_copy(td_coord)
+
+      ! use only edge processor
+      CALL mpp_get_contour(tl_coord)
+
+      ! open useful processor
+      CALL iom_mpp_open(tl_coord)
+
+      ! read output grid
+      tl_lon=iom_mpp_read_var(tl_coord,'longitude')
+
+      ! look for ghost cell
+      il_xghost(:,:)=grid_get_ghost( tl_coord )
+
+      ! close processor
+      CALL iom_mpp_close(tl_coord)
+      ! clean
+      CALL mpp_clean(tl_coord)
+
+      ! remove ghost cell
+      CALL grid_del_ghost(tl_lon, il_xghost(:,:))
+
+      ! write value on grid
+      ! get matrix dimension
+      il_dim(:)=td_var%t_dim(1:2)%i_len
+      ! output dimension
+      tl_dim(:)=dim_copy(tl_lon%t_dim(:))
+      ! clean
+      CALL var_clean(tl_lon)
+
+      ! split output domain in N subdomain depending of matrix dimension 
+      il_size(:) = tl_dim(1:2)%i_len / il_dim(:)
+      il_rest(:) = MOD(tl_dim(1:2)%i_len, il_dim(:))
+
+      ALLOCATE( il_ishape(il_dim(1)+1) )
+      il_ishape(:)=0
+      DO ji=2,il_dim(1)+1
+         il_ishape(ji)=il_ishape(ji-1)+il_size(1)
+      ENDDO
+      ! add rest to last cell
+      il_ishape(il_dim(1)+1)=il_ishape(il_dim(1)+1)+il_rest(1)
+
+      ALLOCATE( il_jshape(il_dim(2)+1) )
+      il_jshape(:)=0
+      DO jj=2,il_dim(2)+1
+         il_jshape(jj)=il_jshape(jj-1)+il_size(2)
+      ENDDO
+      ! add rest to last cell
+      il_jshape(il_dim(2)+1)=il_jshape(il_dim(2)+1)+il_rest(2)
+
+      ! write ouput array of value 
+      ALLOCATE(dl_value( tl_dim(1)%i_len, &
+      &                  tl_dim(2)%i_len, &
+      &                  tl_dim(3)%i_len, &
+      &                  tl_dim(4)%i_len) )
+
+      dl_value(:,:,:,:)=0
+      DO jj=2,il_dim(2)+1
+         DO ji=2,il_dim(1)+1
+            
+            dl_value( 1+il_ishape(ji-1):il_ishape(ji), &
+            &         1+il_jshape(jj-1):il_jshape(jj), &
+            &         1,1 ) = td_var%d_value(ji-1,jj-1,1,1)
+
+         ENDDO
+      ENDDO
+
+
+      IF( ld_rand )THEN
+         ALLOCATE(dl_ran(tl_dim(1)%i_len, &
+         &               tl_dim(2)%i_len) )
+      
+         ! set random value between 0 and 1
+         CALL RANDOM_NUMBER(dl_ran(:,:))
+         ! set random value between -0.5 and 0.5
+         dl_ran(:,:)=dl_ran(:,:)-0.5
+         ! set random value of 0.1% of maximum depth
+         dl_ran(:,:)=dl_ran(:,:)*1.e-4*MAXVAL(td_var%d_value(:,:,1,1))
+
+         dl_value(:,:,1,1)=dl_value(:,:,1,1)+dl_ran(:,:)
+      
+         DEALLOCATE(dl_ran)
+      ENDIF
+
+      ! initialise variable with value
+      tf_var=var_init(TRIM(td_var%c_name),dl_value(:,:,:,:))
+
+      DEALLOCATE(dl_value)
+
+      ! add ghost cell
+      CALL grid_add_ghost(tf_var, il_xghost(:,:))
+
+      ! clean
+      CALL dim_clean(tl_dim(:))
+
+   END FUNCTION create_bathy_matrix
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION create_bathy_extract(td_var, td_mpp, td_coord) &
+         &  RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function extract variable from file over coordinate domain and
+   !> return variable structure
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_var    variable structure 
+   !> @param[in] td_mpp    mpp file structure
+   !> @param[in] td_coord  coordinate file structure
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR), INTENT(IN) :: td_var  
+      TYPE(TMPP), INTENT(IN) :: td_mpp
+      TYPE(TMPP), INTENT(IN) :: td_coord
+
+      ! function
+      TYPE(TVAR)             :: tf_var
+
+      ! local variable
+      INTEGER(i4), DIMENSION(2,2) :: il_ind
+
+      INTEGER(i4) :: il_imin
+      INTEGER(i4) :: il_jmin
+      INTEGER(i4) :: il_imax
+      INTEGER(i4) :: il_jmax
+
+      TYPE(TMPP)  :: tl_mpp
+
+      TYPE(TATT)  :: tl_att
+
+      TYPE(TDOM)  :: tl_dom
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+         CALL logger_error("CREATE BATHY EXTRACT: no processor associated "//&
+         &  "to mpp "//TRIM(td_mpp%c_name))
+      ELSE
+
+         !init
+         tl_mpp=mpp_copy(td_mpp)
+
+         ! compute file grid indices around coord grid
+         il_ind(:,:)=grid_get_coarse_index(tl_mpp, td_coord )
+
+         il_imin=il_ind(1,1) ; il_imax=il_ind(1,2)
+         il_jmin=il_ind(2,1) ; il_jmax=il_ind(2,2)
+
+         ! check grid coincidence
+         CALL grid_check_coincidence( tl_mpp, td_coord, &
+         &                            il_imin, il_imax, &
+         &                            il_jmin, il_jmax, &
+         &                            (/1, 1, 1/) )
+
+         ! compute domain
+         tl_dom=dom_init(tl_mpp,           &
+         &               il_imin, il_imax, &
+         &               il_jmin, il_jmax)
+
+         ! open mpp files over domain
+         CALL iom_dom_open(tl_mpp, tl_dom)
+
+         ! read variable on domain
+         tf_var=iom_dom_read_var(tl_mpp,TRIM(td_var%c_name),tl_dom)
+
+         ! close mpp file
+         CALL iom_dom_close(tl_mpp)
+
+         ! add ghost cell
+         CALL grid_add_ghost(tf_var,tl_dom%i_ghost(:,:))
+
+         ! check result
+         IF( ANY( tf_var%t_dim(:)%l_use .AND. &
+         &        tf_var%t_dim(:)%i_len /= td_coord%t_dim(:)%i_len) )THEN
+            CALL logger_debug("CREATE BATHY EXTRACT: "//&
+            &        "dimensoin of variable "//TRIM(td_var%c_name)//" "//&
+            &        TRIM(fct_str(tf_var%t_dim(1)%i_len))//","//&
+            &        TRIM(fct_str(tf_var%t_dim(2)%i_len))//","//&
+            &        TRIM(fct_str(tf_var%t_dim(3)%i_len))//","//&
+            &        TRIM(fct_str(tf_var%t_dim(4)%i_len)) )
+            CALL logger_debug("CREATE BATHY EXTRACT: "//&
+            &        "dimensoin of coordinate file "//&
+            &        TRIM(fct_str(td_coord%t_dim(1)%i_len))//","//&
+            &        TRIM(fct_str(td_coord%t_dim(2)%i_len))//","//&
+            &        TRIM(fct_str(td_coord%t_dim(3)%i_len))//","//&
+            &        TRIM(fct_str(td_coord%t_dim(4)%i_len)) )
+            CALL logger_fatal("CREATE BATHY EXTRACT: "//&
+            &  "dimensoin of extracted "//&
+            &  "variable and coordinate file dimension differ")
+         ENDIF
+
+         ! add attribute to variable
+         tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name)))
+         CALL var_move_att(tf_var, tl_att)         
+
+         tl_att=att_init('src_i_indices',(/tl_dom%i_imin, tl_dom%i_imax/))
+         CALL var_move_att(tf_var, tl_att)
+
+         tl_att=att_init('src_j_indices',(/tl_dom%i_jmin, tl_dom%i_jmax/))
+         CALL var_move_att(tf_var, tl_att)
+
+         ! clean structure
+         CALL att_clean(tl_att)
+         CALL mpp_clean(tl_mpp)
+      ENDIF
+
+   END FUNCTION create_bathy_extract
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION create_bathy_get_var(td_var, td_mpp,   &
+         &                       id_imin, id_jmin, &
+         &                       id_imax, id_jmax, &
+         &                       id_offset,        &
+         &                       id_rho) &
+         &  RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function get coarse grid variable, interpolate variable, and return
+   !> variable structure over fine grid
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_var    variable structure
+   !> @param[in] td_mpp    mpp file structure
+   !> @param[in] id_imin   i-direction lower left  corner indice 
+   !> @param[in] id_imax   i-direction upper right corner indice 
+   !> @param[in] id_jmin   j-direction lower left  corner indice
+   !> @param[in] id_jmax   j-direction upper right corner indice 
+   !> @param[in] id_offset offset between fine grid and coarse grid
+   !> @param[in] id_rho    array of refinement factor
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR)                 , INTENT(IN) :: td_var  
+      TYPE(TMPP)                 , INTENT(IN) :: td_mpp 
+      INTEGER(i4)                , INTENT(IN) :: id_imin
+      INTEGER(i4)                , INTENT(IN) :: id_imax
+      INTEGER(i4)                , INTENT(IN) :: id_jmin
+      INTEGER(i4)                , INTENT(IN) :: id_jmax
+      INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_offset
+      INTEGER(i4), DIMENSION(:)  , INTENT(IN) :: id_rho
+
+      ! function
+      TYPE(TVAR)                              :: tf_var
+
+      ! local variable
+      TYPE(TMPP)  :: tl_mpp
+      TYPE(TATT)  :: tl_att
+      TYPE(TDOM)  :: tl_dom
+
+      INTEGER(i4) :: il_size
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho
+
+      ! loop indices
+      !----------------------------------------------------------------
+      IF( ANY(SHAPE(id_offset(:,:)) /= 2) )THEN
+         CALL logger_error("CREATE BATHY GET VAR: invalid dimension of "//&
+         &                 "offset array")
+      ENDIF
+
+      ! copy structure
+      tl_mpp=mpp_copy(td_mpp)
+
+      !- compute domain
+      tl_dom=dom_init(tl_mpp,           &
+      &               id_imin, id_imax, &
+      &               id_jmin, id_jmax)
+
+      !- add extra band (if possible) to compute interpolation
+      CALL dom_add_extra(tl_dom)
+
+      !- open mpp files over domain
+      CALL iom_dom_open(tl_mpp, tl_dom)
+
+      !- read variable value on domain
+      tf_var=iom_dom_read_var(tl_mpp,TRIM(td_var%c_name),tl_dom)
+
+      !- close mpp files
+      CALL iom_dom_close(tl_mpp)
+
+      il_size=SIZE(id_rho(:))
+      ALLOCATE( il_rho(il_size) )
+      il_rho(:)=id_rho(:)
+      
+      !- interpolate variable
+      CALL create_bathy_interp(tf_var, il_rho(:), id_offset(:,:))
+
+      !- remove extraband added to domain
+      CALL dom_del_extra( tf_var, tl_dom, il_rho(:) )
+
+      CALL dom_clean_extra( tl_dom )
+
+      !- add ghost cell
+      CALL grid_add_ghost(tf_var,tl_dom%i_ghost(:,:))
+ 
+      !- add attribute to variable
+      tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name)))
+      CALL var_move_att(tf_var, tl_att)
+
+      tl_att=att_init('src_i_indices',(/tl_dom%i_imin, tl_dom%i_imax/))
+      CALL var_move_att(tf_var, tl_att)
+
+      tl_att=att_init('src_j_indices',(/tl_dom%i_jmin, tl_dom%i_jmax/))
+      CALL var_move_att(tf_var, tl_att)
+
+      IF( .NOT. ALL(id_rho(:)==1) )THEN
+         tl_att=att_init("refinment_factor",(/id_rho(jp_I),id_rho(jp_J)/))
+         CALL var_move_att(tf_var, tl_att)
+      ENDIF
+
+      DEALLOCATE( il_rho )
+
+      !- clean structure
+      CALL att_clean(tl_att)
+      CALL mpp_clean(tl_mpp)
+ 
+   END FUNCTION create_bathy_get_var
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE create_bathy_interp(td_var, id_rho, id_offset, &
+         &                        id_iext, id_jext)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine interpolate variable
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure 
+   !> @param[in] id_rho    array of refinment factor
+   !> @param[in] id_offset array of offset between fine and coarse grid
+   !> @param[in] id_iext   i-direction size of extra bands (default=im_minext)
+   !> @param[in] id_jext   j-direction size of extra bands (default=im_minext)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
+      INTEGER(i4), DIMENSION(:)  , INTENT(IN   ) :: id_rho
+      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ) :: id_offset
+      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_iext
+      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_jext
+
+      ! local variable
+      TYPE(TVAR)  :: tl_mask
+
+      INTEGER(i1), DIMENSION(:,:,:,:), ALLOCATABLE :: bl_mask
+
+      INTEGER(i4) :: il_iext
+      INTEGER(i4) :: il_jext
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      !WARNING: two extrabands are required for cubic interpolation
+      il_iext=3
+      IF( PRESENT(id_iext) ) il_iext=id_iext
+
+      il_jext=3
+      IF( PRESENT(id_jext) ) il_jext=id_jext
+
+      IF( il_iext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
+         CALL logger_warn("CREATE BATHY INTERP: at least extrapolation "//&
+         &  "on two points are required with cubic interpolation ")
+         il_iext=2
+      ENDIF
+
+      IF( il_jext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
+         CALL logger_warn("CREATE BATHY INTERP: at least extrapolation "//&
+         &  "on two points are required with cubic interpolation ")
+         il_jext=2
+      ENDIF
+
+      ! work on mask
+      ! create mask
+      ALLOCATE(bl_mask(td_var%t_dim(1)%i_len, &
+      &                td_var%t_dim(2)%i_len, &
+      &                td_var%t_dim(3)%i_len, &
+      &                td_var%t_dim(4)%i_len) )
+
+      bl_mask(:,:,:,:)=1
+      WHERE(td_var%d_value(:,:,:,:)==td_var%d_fill) bl_mask(:,:,:,:)=0      
+
+      SELECT CASE(TRIM(td_var%c_point))
+      CASE DEFAULT ! 'T'
+         tl_mask=var_init('tmask', bl_mask(:,:,:,:), td_dim=td_var%t_dim(:), &
+         &                id_ew=td_var%i_ew )
+      CASE('U','V','F')
+         CALL logger_fatal("CREATE BATHY INTERP: can not computed "//&
+         &                 "interpolation on "//TRIM(td_var%c_point)//&
+         &                 " grid point (variable "//TRIM(td_var%c_name)//&
+         &                 "). check namelist.")
+      END SELECT
+
+      DEALLOCATE(bl_mask)
+
+      ! interpolate mask
+      CALL interp_fill_value( tl_mask, id_rho(:), &
+      &                       id_offset=id_offset(:,:) )
+
+      ! work on variable
+      ! add extraband
+      CALL extrap_add_extrabands(td_var, il_iext, il_jext)
+
+      ! extrapolate variable
+      CALL extrap_fill_value( td_var )
+
+      ! interpolate Bathymetry
+      CALL interp_fill_value( td_var, id_rho(:), &
+      &                       id_offset=id_offset(:,:) )
+
+      ! remove extraband
+      CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J))
+
+      ! keep original mask 
+      WHERE( tl_mask%d_value(:,:,:,:) == 0 )
+         td_var%d_value(:,:,:,:)=td_var%d_fill
+      END WHERE
+
+      ! clean variable structure
+      CALL var_clean(tl_mask)
+
+   END SUBROUTINE create_bathy_interp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE create_bathy_check_depth(td_mpp, td_depth)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine get depth variable value in an open mpp structure
+   !> and check if agree with already input depth variable.
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date January, 2016 - Initial Version
+   !>
+   !> @param[in] td_mpp       mpp structure
+   !> @param[inout] td_depth  depth variable structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP) , INTENT(IN   ) :: td_mpp
+      TYPE(TVAR) , INTENT(INOUT) :: td_depth
+
+      ! local variable
+      INTEGER(i4) :: il_varid
+      TYPE(TVAR)  :: tl_depth
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! get or check depth value
+      IF( td_mpp%t_proc(1)%i_depthid /= 0 )THEN
+
+         il_varid=td_mpp%t_proc(1)%i_depthid
+         IF( ASSOCIATED(td_depth%d_value) )THEN
+
+            tl_depth=iom_mpp_read_var(td_mpp, il_varid)
+
+            IF( ANY( td_depth%d_value(:,:,:,:) /= &
+            &        tl_depth%d_value(:,:,:,:) ) )THEN
+
+               CALL logger_warn("CREATE BATHY: depth value from "//&
+               &  TRIM(td_mpp%c_name)//" not conform "//&
+               &  " to those from former file(s).")
+
+            ENDIF
+            CALL var_clean(tl_depth)
+
+         ELSE
+            td_depth=iom_mpp_read_var(td_mpp,il_varid)
+         ENDIF
+
+      ENDIF
+      
+   END SUBROUTINE create_bathy_check_depth
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE create_bathy_check_time(td_mpp, td_time)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine get date and time in an open mpp structure
+   !> and check if agree with date and time already read.
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date January, 2016 - Initial Version
+   !>
+   !> @param[in] td_mpp      mpp structure
+   !> @param[inout] td_time  time variable structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP), INTENT(IN   ) :: td_mpp
+      TYPE(TVAR), INTENT(INOUT) :: td_time
+
+      ! local variable
+      INTEGER(i4) :: il_varid
+      TYPE(TVAR)  :: tl_time
+
+      TYPE(TDATE) :: tl_date1
+      TYPE(TDATE) :: tl_date2
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! get or check depth value
+      IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN
+
+         il_varid=td_mpp%t_proc(1)%i_timeid
+         IF( ASSOCIATED(td_time%d_value) )THEN
+
+            tl_time=iom_mpp_read_var(td_mpp, il_varid)
+
+            tl_date1=var_to_date(td_time)
+            tl_date2=var_to_date(tl_time)
+            IF( tl_date1 - tl_date2 /= 0 )THEN
+
+               CALL logger_warn("CREATE BATHY: date from "//&
+               &  TRIM(td_mpp%c_name)//" not conform "//&
+               &  " to those from former file(s).")
+
+            ENDIF
+            CALL var_clean(tl_time)
+
+         ELSE
+            td_time=iom_mpp_read_var(td_mpp,il_varid)
+         ENDIF
+
+      ENDIF
+      
+   END SUBROUTINE create_bathy_check_time
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END PROGRAM create_bathy
Index: /utils/tools_ticket2413/SIREN/src/create_boundary.F90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/create_boundary.F90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/create_boundary.F90	(revision 12863)
@@ -0,0 +1,2178 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @file
+!> @brief 
+!> This program creates boundary files.
+!>
+!> @details
+!> @section sec1 method
+!> Variables are read from coarse grid standard output, 
+!> extracted or interpolated on fine grid. 
+!> Variables could also be manually written.<br/>
+!> @note 
+!>    method could be different for each variable.
+!>
+!>  <br/> 
+!> @image html  boundary_NEATL36_70.png 
+!> <center>@image latex boundary_NEATL36_70.png
+!> </center>
+!>
+!> @section sec2 how to
+!> USAGE: create_boundary create_bounary.nam [-v] [-h]<br/>
+!>    - positional arguments:<br/>
+!>       - create_boundary.nam<br/>
+!>          namelist of create_boundary
+!>          @note
+!>             a template of the namelist could be created running (in templates directory):
+!>             @code{.sh}
+!>                python create_templates.py create_boundary
+!>             @endcode
+!>
+!>    - optional arguments:<br/>
+!>       - -h, --help<br/>
+!>          show this help message (and exit)<br/>
+!>       - -v, --version<br/>
+!>          show Siren's version   (and exit)<br/>
+!>    @note 
+!>       compiled with @a key_mpp_mpi, could be run on multi processor :<br/>
+!>       USAGE: create_boundary create_bounary.nam create_bounary2.nam ... [-v] [-h]<br/>
+!>
+!> @section sec_boundary create_boundary.nam
+!>    create_boundary.nam contains 9 namelists:<br/>
+!>       - **namlog** to set logger parameters
+!>       - **namcfg** to set configuration file parameters
+!>       - **namsrc** to set source/coarse grid parameters
+!>       - **namtgt** to set target/fine grid parameters
+!>       - **namvar** to set variable parameters
+!>       - **namnst** to set sub domain and nesting paramters
+!>       - **nambdy** to set boundary parameters
+!>       - **namzgr** to set vertical grid parameters
+!>       - **namout** to set output parameters
+!>
+!>    here after, each sub-namelist parameters is detailed.
+!>    @note 
+!>       default values are specified between brackets
+!>
+!> @subsection sublog namlog
+!>    the logger sub-namelist parameters are :
+!>
+!>    - **cn_logfile** [@a create_boundary.log]<br/>
+!>       logger filename
+!>
+!>    - **cn_verbosity** [@a warning]<br/>
+!>       verbosity level, choose between :
+!>          - trace
+!>          - debug
+!>          - info
+!>          - warning
+!>          - error
+!>          - fatal
+!>          - none
+!>
+!>    - **in_maxerror** [@a 5]<br/> 
+!>       maximum number of error allowed
+!>
+!> @subsection subcfg namcfg
+!>    the configuration sub-namelist parameters are :
+!>
+!>    - **cn_varcfg** [@a ./cfg/variable.cfg]<br/>
+!>       path to the variable configuration file.<br/>
+!>       the variable configuration file defines standard name, 
+!>       default interpolation method, axis,... 
+!>       to be used for some known variables.<br/> 
+!>
+!>    - **cn_dimcfg** [@a ./cfg/dimension.cfg]<br/> 
+!>       path to the dimension configuration file.<br/> 
+!>       the dimension configuration file defines dimensions allowed.<br/> 
+!>
+!>    - **cn_dumcfg** [@a ./cfg/dummy.cfg]<br/> 
+!>       path to the useless (dummy) configuration file.<br/>
+!>       the dummy configuration file defines useless 
+!>       dimension or variable. these dimension(s) or variable(s) will not be
+!>       processed.<br/>
+!>
+!> @subsection subcrs namcrs 
+!>    the coarse grid sub-namelist parameters are :
+!>
+!>    - **cn_coord0** [@a ]<br/> 
+!>       path to the coordinate file
+!>
+!>    - **in_perio0** [@a ]<br/> 
+!>       NEMO periodicity index<br/> 
+!>       the NEMO periodicity could be choose between 0 to 6:
+!>       <dl>
+!>          <dt>in_perio=0</dt>
+!>          <dd>standard regional model</dd>
+!>          <dt>in_perio=1</dt>
+!>          <dd>east-west cyclic model</dd>
+!>          <dt>in_perio=2</dt>
+!>          <dd>model with symmetric boundary condition across the equator</dd>
+!>          <dt>in_perio=3</dt>
+!>          <dd>regional model with North fold boundary and T-point pivot</dd>
+!>          <dt>in_perio=4</dt>
+!>          <dd>global model with a T-point pivot.<br/>
+!>          example: ORCA2, ORCA025, ORCA12</dd>
+!>          <dt>in_perio=5</dt>
+!>          <dd>regional model with North fold boundary and F-point pivot</dd>
+!>          <dt>in_perio=6</dt>
+!>          <dd>global model with a F-point pivot<br/>
+!>          example: ORCA05</dd>
+!>          </dd>
+!>       </dl>
+!>       @sa For more information see @ref md_src_docsrc_6_perio
+!>       and Model Boundary Condition paragraph in the 
+!>       [NEMO documentation](https://forge.ipsl.jussieu.fr/nemo/chrome/site/doc/NEMO/manual/pdf/NEMO_manual.pdf)
+!>
+!> @subsection subfin namfin 
+!>    the fine grid sub-namelist parameters are :
+!>
+!>    - **cn_coord1** [@a ]<br/> 
+!>       path to coordinate file
+!>
+!>    - **cn_bathy1** [@a ]<br/> 
+!>       path to bathymetry file
+!>       @warning 
+!>
+!>    - **in_perio1** [@a ]<br/>
+!>       NEMO periodicity index (see above)
+!>    @note if the fine/target coordinates file (cn_coord1) was created by SIREN, you do
+!>    not need to fill this parameter. SIREN will read it on the global attributes of
+!>    the coordinates file.
+!>
+!> @subsection subzgr namzgr
+!>    the vertical grid sub-namelist parameters are :
+!>
+!>    - **dn_pp_to_be_computed** [@a 0]<br/>
+!>
+!>    - **dn_ppsur** [@a -3958.951371276829]<br/>
+!>       coefficient to compute vertical grid
+!>
+!>    - **dn_ppa0** [@a 103.953009600000]<br/>
+!>       coefficient to compute vertical grid
+!>
+!>    - **dn_ppa1** [@a 2.415951269000]<br/>
+!>       coefficient to compute vertical grid
+!>
+!>    - **dn_ppa2** [@a 100.760928500000]<br/>
+!>       double tanh function parameter
+!>
+!>    - **dn_ppkth** [@a 15.351013700000]<br/>
+!>       coefficient to compute vertical grid
+!>
+!>    - **dn_ppkth2** [@a 48.029893720000]<br/>
+!>       double tanh function parameter
+!>
+!>    - **dn_ppacr** [@a 7.000000000000]<br/>
+!>       coefficient to compute vertical grid
+!>
+!>    - **dn_ppacr2** [@a 13.000000000000]<br/>
+!>       double tanh function parameter
+!>
+!>    - **dn_ppdzmin** [@a 6.]<br/>
+!>       minimum vertical spacing
+!>
+!>    - **dn_pphmax** [@a 5750.]<br/>
+!>       maximum depth
+!>
+!>    - **in_nlevel** [@a 75]<br/>
+!>       number of vertical level
+!>
+!>     @note 
+!>       If *dn_ppa1*, *dn_ppa0* and *dn_ppsur* are undefined,
+!>       NEMO will compute them from *dn_ppdzmin, dn_pphmax, dn_ppkth, dn_ppacr*
+!>
+!> @subsection subzps namzps
+!>    the partial step sub-namelist parameters are :
+!>
+!>    - **dn_e3zps_min** [@a 25.]<br/>
+!>       minimum thickness of partial step level (meters)
+!>    - **dn_e3zps_rat** [@a 0.2]<br/>
+!>       minimum thickness ratio of partial step level
+!>
+!> @subsection subvar namvar 
+!>    the variable sub-namelist parameters are :
+!>
+!>    - **cn_varfile** [@a ]<br/> 
+!>       list of variable, and associated file 
+!>
+!>       *cn_varfile* is the path and filename of the file where find
+!>       variable.
+!>       @note 
+!>          *cn_varfile* could be a matrix of value, if you want to handwrite
+!>          variable value.<br/>
+!>          the variable array of value is split into equal subdomain.<br/>
+!>          each subdomain is filled with the corresponding value 
+!>          of the matrix.<br/>          
+!>          separators used to defined matrix are:
+!>             - ',' for line
+!>             - '/' for row
+!>             - '\' for level<br/>
+!>             Example:<br/>
+!>                3,2,3/1,4,5  =>  @f$ \left( \begin{array}{ccc}
+!>                                      3 & 2 & 3 \\
+!>                                      1 & 4 & 5 \end{array} \right) @f$
+!>
+!>          @warning 
+!>             the same matrix is used for all boundaries.
+!>
+!>       Examples: 
+!>          - 'votemper:gridT.nc', 'vozocrtx:gridU.nc'
+!>          - 'votemper:10\25', 'vozocrtx:gridU.nc'<br/>
+!>
+!>       @note 
+!>          Optionnaly, NEMO periodicity could be added following the filename.
+!>          the periodicity must be separated by ';'
+!>
+!>       Example:
+!>          - 'votemper:gridT.nc ; perio=4'
+!>
+!>    - **cn_varinfo** [@a ]<br/> 
+!>       list of variable and extra information about request(s) to be used<br/>
+!>
+!>       each elements of *cn_varinfo* is a string character (separated by ',').<br/>
+!>       it is composed of the variable name follow by ':', 
+!>       then request(s) to be used on this variable.<br/> 
+!>       request could be:
+!>          - int = interpolation method
+!>          - ext = extrapolation method
+!>          - flt = filter method
+!>          - min = minimum value
+!>          - max = maximum value
+!>          - unt = new units
+!>          - unf = unit scale factor (linked to new units)
+!>
+!>             requests must be separated by ';'.<br/>
+!>             order of requests does not matter.<br/>
+!>
+!>       informations about available method could be find in @ref interp,
+!>       @ref extrap and @ref filter modules.<br/>
+!>       Example: 
+!>          - 'votemper: int=linear; flt=hann; ext=dist_weight',
+!>            'vosaline: int=cubic'
+!>
+!>       @note 
+!>          If you do not specify a method which is required, 
+!>          default one is apply.
+!>
+!> @subsection subnst namnst 
+!>    the nesting sub-namelist parameters are :
+!>
+!>    - **in_rhoi**  [@a 1]<br/> 
+!>       refinement factor in i-direction
+!>
+!>    - **in_rhoj**  [@a 1]<br/> 
+!>       refinement factor in j-direction
+!>
+!>    @note 
+!>       coarse grid indices will be deduced from fine grid
+!>       coordinate file.
+!>
+!> @subsection subbdy nambdy
+!>    the boundary sub-namelist parameters are :
+!>
+!>    - **ln_north** [@a .TRUE.]<br/> 
+!>       logical to use north boundary or not
+!>    - **ln_south** [@a .TRUE.]<br/>
+!>       logical to use south boundary or not
+!>    - **ln_east**  [@a .TRUE.]<br/>
+!>       logical to use east boundary or not
+!>    - **ln_west**  [@a .TRUE.]<br/>
+!>       logical to use west  boundary or not
+!>    <br/> <br/>
+!>    - **cn_north** [@a ]<br/>
+!>       north boundary indices on fine grid<br/>
+!>    - **cn_south** [@a ]<br/>
+!>       south boundary indices on fine grid<br/>
+!>    - **cn_east**  [@a ]<br/>
+!>       east  boundary indices on fine grid<br/>
+!>    - **cn_west**  [@a ]<br/>
+!>       west  boundary indices on fine grid<br/>
+!>
+!>       *cn_north* is a string character defining boundary
+!>       segmentation.<br/>
+!>       segments are separated by '|'.<br/>
+!>       each segments of the boundary is composed of:
+!>          - indice of velocity (orthogonal to boundary .ie. 
+!>             for north boundary, J-indice). 
+!>          - indice of segment start (I-indice for north boundary) 
+!>          - indice of segment end   (I-indice for north boundary)<br/>
+!>             indices must be separated by ':' .<br/>
+!>          - optionally, boundary size could be added between '(' and ')' 
+!>          in the first segment defined.
+!>             @note 
+!>                boundary size is the same for all segments of one boundary.
+!>
+!>       Examples:
+!>          - cn_north='index1,first1:last1(width)'
+!>          - cn_north='index1(width),first1:last1|index2,first2:last2'
+!>
+!>       @image html  boundary_50.png 
+!>       <center>@image latex boundary_50.png
+!>       </center>
+!>
+!>    - **ln_oneseg** [@a .TRUE.]<br/>
+!>       logical to use only one segment for each boundary or not
+!>
+!>    @note
+!>       the number of point(s) with coarse value save at boundaries is
+!>       defined with the *weight* variable (see @ref merge_bathy)
+!>
+!> @subsection subout namout 
+!>    the output sub-namelist parameter is :
+!>
+!>    - **cn_fileout** [@a boundary.nc]<br/>
+!>       output bathymetry filename
+!>
+!>       @note
+!>          cardinal point and segment number will be automatically added
+!>
+!>    - **ln_extrap** [@a .FALSE.]<br/>
+!>       extrapolate on land point
+!>
+!>    - **dn_dayofs** [@a 0]<br/>
+!>       date offset in day (change only ouput file name)
+!>
+!>       Examples: 
+!>          - cn_fileout='boundary.nc'<br/>
+!>             if time_counter (16/07/2015 00h) is read on input file (see varfile), 
+!>             west boundary will be named boundary_west_y2015m07d16
+!>          - dn_dayofs=-2.<br/>
+!>             if you use day offset you get boundary_west_y2015m07d14
+!>
+!> @subsection sub_nambdy How to fill Lateral Boundary Condition in NEMO namelist
+!>    To use boundary condition within NEMO, you need to fill the NEMO namelist.<br/>
+!>    As this is a little bit messy for lateral boundary condition, here after
+!>    is an explanation of how to do it.
+!>
+!>    This will be done in 3 steps.
+!>
+!>    @subsubsection ss_nambdy nambdy
+!>       The *nambdy* NEMO sub-namelist defines open boundaries.<br/>
+!>       Here we indicate the number of open boundary (**nb_bdy**).
+!>
+!>       @note
+!>          we have to fill most of the parameters with as many elements as there are open boundaries
+!> 
+!>       Regarding the width of the relaxation zone **nn_rimwidth**,
+!>       this information is available as a global attribute (**bdy_width**) 
+!>       in the metadata of boundary files created with SIREN 
+!>
+!> @code{.sh}
+!>    ncdump -h boundary_east.nc
+!> @endcode
+!>       @warning
+!>          The order of the boundaries must stay unchanged, in parameters list as well as 
+!>          in the next sub-namelsits 
+!>
+!>    Example:<br/>
+!>       here is an example for a domain with two boundaries East and North
+!>
+!> @code{.sh}
+!> !-----------------------------------------------------------------------
+!> &nambdy        !  unstructured open boundaries                          ("key_bdy")
+!> !-----------------------------------------------------------------------
+!>   nb_bdy         = 2                    !  number of open boundary sets
+!>   ln_coords_file = .false.,.false.      !  =T : read bdy coordinates from file
+!>   cn_coords_file = '',''                !  bdy coordinates files
+!>   ln_mask_file   = .false.              !  =T : read mask from file
+!>   cn_mask_file   = ''                   !  name of mask file (if ln_mask_file=.TRUE.)
+!>   cn_dyn2d       = 'flather','flather'  !
+!>   nn_dyn2d_dta   = 1,1                  !  = 0, bdy data are equal to the initial state
+!>                                         !  = 1, bdy data are read in 'bdydata   .nc' files
+!>                                         !  = 2, use tidal harmonic forcing data from files
+!>                                         !  = 3, use external data AND tidal harmonic forcing
+!>   cn_dyn3d       = 'specified','specified' !  
+!>   nn_dyn3d_dta   = 1,1                  !  = 0, bdy data are equal to the initial state
+!>                                         !  = 1, bdy data are read in 'bdydata   .nc' files
+!>   cn_tra         = 'specified','specified' ! 
+!>   nn_tra_dta     = 1,1                  !  = 0, bdy data are equal to the initial state
+!>                                         !  = 1, bdy data are read in 'bdydata   .nc' files
+!>                                         !
+!>   ln_tra_dmp    =.true.,.true.          !  open boudaries conditions for tracers
+!>   ln_dyn3d_dmp  =.true.,.true.          !  open boundary condition for baroclinic velocities
+!>   rn_time_dmp     =  1.,1.              ! Damping time scale in days 
+!>   rn_time_dmp_out =  1.,1.              ! Outflow damping time scale
+!>   nn_rimwidth   = 10,10                 !  width of the relaxation zone
+!>   ln_vol        = .false.               !  total volume correction (see nn_volctl parameter)
+!>   nn_volctl     = 1                     !  = 0, the total water flux across open boundaries is zero
+!> /
+!> @endcode
+!>
+!>    @subsubsection ss_nambdy_index nambdy_index
+!>       The *nambdy_index* NEMO sub-namelist describes the boundaries we will use.
+!>
+!>       @warning
+!>          We have to add as many as sub namelist *nambdy_index* than open boundaries (nb_bdy),
+!>          and keep them in the same order as above
+!>
+!>          Here we indicate if the open boundary is North, South, East, or West (**ctypebdy**).<br/>
+!>          We also indicate indice of segment start and end (respectively **nbdybeg**  and **nbdyend**)
+!>          as well as indice of velocity row or column (**nbdyind**).<br/>
+!>
+!>          Those informations are available as global attributes 
+!>          (respectively **bdy_deb, bdy_end, bdy_ind**) in the metadata of our boundary files 
+!>          created with SIREN.
+!>
+!>    Example:<br/>
+!>       here is an example for a domain with two boundaries East and North
+!>
+!> @code{.sh}
+!>    !-----------------------------------------------------------------------
+!>    &nambdy_index  !  structured open boundaries definition     ("key_bdy")
+!>    !-----------------------------------------------------------------------
+!>      ctypebdy ='E'                   ! Open boundary type (W,E,S or N)
+!>      nbdyind  = 407                  ! indice of velocity row or column
+!>                                      ! if ==-1, set obc at the domain boundary
+!>                                      !        , discard start and end indices
+!>      nbdybeg  = 32                   ! indice of segment start
+!>      nbdyend  = 300                  ! indice of segment end
+!>    /
+!>    !-----------------------------------------------------------------------
+!>    &nambdy_index  !  structured open boundaries definition     ("key_bdy")
+!>    !-----------------------------------------------------------------------
+!>      ctypebdy ='N'                   ! Open boundary type (W,E,S or N)
+!>      nbdyind  = 299                  ! indice of velocity row or column
+!>                                      ! if ==-1, set obc at the domain boundary
+!>                                      !        , discard start and end indices
+!>      nbdybeg  = 200                  ! indice of segment start
+!>      nbdyend  = 408                  ! indice of segment end
+!>    /
+!> @endcode
+!>
+!>    @subsubsection ss_nambdy_dat nambdy_dta
+!>       The *nambdy_dta* NEMO sub-namelists describes the boundary data and files to be used.<br/>
+!>       @warning
+!>          We have to add as many as sub namelist *nambdy_dta* than open boundaries (nb_bdy),
+!>          and keep them in the same order as above
+!>
+!>    Example:<br/>
+!>       here is an example for a domain with two boundaries East and North
+!>
+!> @code{.sh}
+!> !-----------------------------------------------------------------------
+!> &nambdy_dta      !  open boundaries - external data           ("key_bdy")
+!> !-----------------------------------------------------------------------
+!> !          ! file name !  freq (hours)   ! variable ! time interp. ! clim  ! 'yearly'/ ! weights...
+!> !          !           ! (if < 0 months) !   name   !   (logical)  ! (T/F) ! 'monthly' ! filename
+!>   bn_ssh = 'boundary_east' , -12   , 'sossheig' , .false. , .true. , 'yearly' , '', '', ''
+!>   bn_u2d = 'boundary_east' , -12   , 'vobtcrtx' , .false. , .true. , 'yearly' , '', '', ''
+!>   bn_v2d = 'boundary_east' , -12   , 'vobtcrty' , .false. , .true. , 'yearly' , '', '', ''
+!>   bn_u3d = 'boundary_east' , -12   , 'vozocrtx' , .false. , .true. , 'yearly' , '', '', ''
+!>   bn_v3d = 'boundary_east' , -12   , 'vomecrty' , .false. , .true. , 'yearly' , '', '', ''
+!>   bn_tem = 'boundary_east' , -12   , 'votemper' , .false. , .true. , 'yearly' , '', '', ''
+!>   bn_sal = 'boundary_east' , -12   , 'vosaline' , .false. , .true. , 'yearly' , '', '', ''
+!>   cn_dir = './'
+!>   ln_full_vel = .true.
+!> /
+!> !-----------------------------------------------------------------------
+!> &nambdy_dta      !  open boundaries - external data           ("key_bdy")
+!> !-----------------------------------------------------------------------
+!> !          ! file name !  freq (hours)   ! variable ! time interp. ! clim  ! 'yearly'/ ! weights...
+!> !          !           ! (if < 0 months) !   name   !   (logical)  ! (T/F) ! 'monthly' ! filename
+!>   bn_ssh = 'boundary_north' , -12   , 'sossheig' ,  .false. , .true. , 'yearly' , '', '', ''
+!>   bn_u2d = 'boundary_north' , -12   , 'vobtcrtx' ,  .false. , .true. , 'yearly' , '', '', ''
+!>   bn_v2d = 'boundary_north' , -12   , 'vobtcrty' ,  .false. , .true. , 'yearly' , '', '', ''
+!>   bn_u3d = 'boundary_north' , -12   , 'vozocrtx' ,  .false. , .true. , 'yearly' , '', '', ''
+!>   bn_v3d = 'boundary_north' , -12   , 'vomecrty' ,  .false. , .true. , 'yearly' , '', '', ''
+!>   bn_tem = 'boundary_north' , -12   , 'votemper' ,  .false. , .true. , 'yearly' , '', '', ''
+!>   bn_sal = 'boundary_north' , -12   , 'vosaline' ,  .false. , .true. , 'yearly' , '', '', ''
+!>   cn_dir = './'
+!>   ln_full_vel = .true.
+!> /
+!> @endcode
+!>
+!> <hr>
+!> @author J.Paul
+!>
+!> @date November, 2013 - Initial Version
+!> @date September, 2014
+!> - add header for user
+!> - take into account grid point to compue boundaries
+!> - reorder output dimension for north and south boundaries
+!> @date June, 2015
+!> - extrapolate all land points, and add ln_extrap in namelist.
+!> - allow to change unit.
+!> @date July, 2015
+!> - add namelist parameter to shift date of output file name.
+!> @date September, 2015
+!> - manage useless (dummy) variable, attributes, and dimension
+!> - allow to run on multi processors with key_mpp_mpi
+!> @date January, 2016
+!> - same process use for variable extracted or interpolated from input file.
+!> @date October, 2016
+!> - dimension to be used select from configuration file
+!> @date January, 2019
+!> - add url path to global attributes of output file(s)
+!> - create and clean file structure to avoid memory leaks
+!> - explain how to fill Lateral Boundary Condition in NEMO namelist
+!> @date February, 2019
+!> - rename sub namelist namcrs to namsrc
+!> - rename sub namelist namfin to namtgt
+!> @date August, 2019
+!> - use periodicity read from namelist, and store in multi structure
+!> @date Ocober, 2019
+!> - add help and version optional arguments
+!>
+!> @todo
+!> - rewitre using meshmask instead of bathymetry and coordinates files.
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+PROGRAM create_boundary
+
+   USE netcdf                          ! nf90 library
+   USE global                          ! global variable
+   USE phycst                          ! physical constant
+   USE kind                            ! F90 kind parameter
+   USE fct                             ! basic useful function
+   USE date                            ! date manager
+   USE att                             ! attribute manager
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+   USE file                            ! file manager
+   USE multi                           ! multi file manager
+   USE boundary                        ! boundary manager
+   USE iom                             ! I/O manager
+   USE dom                             ! domain manager
+   USE grid                            ! grid manager
+   USE vgrid                           ! vertical grid manager
+   USE extrap                          ! extrapolation manager
+   USE interp                          ! interpolation manager
+   USE filter                          ! filter manager
+   USE mpp                             ! MPP manager
+   USE iom_mpp                         ! MPP I/O manager
+
+   IMPLICIT NONE
+
+   ! parameters
+   CHARACTER(LEN=lc), PARAMETER  :: cp_myname = "create_boundary"
+
+   ! local variable
+   CHARACTER(LEN=lc)                                  :: cl_arg
+   CHARACTER(LEN=lc)                                  :: cl_errormsg
+
+   INTEGER(i4)                                        :: il_narg
+
+#if defined key_mpp_mpi
+   ! mpp variable
+   CHARACTER(LEN=lc), DIMENSION(:)      , ALLOCATABLE :: cl_args
+
+   INTEGER(i4)                                        :: ierror
+   INTEGER(i4)                                        :: iproc
+   INTEGER(i4)                                        :: nproc
+   INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_nprog
+
+   ! loop indices
+   INTEGER(i4) :: jm
+#else
+   CHARACTER(LEN=lc)                                  :: cl_namelist
+#endif
+   !-------------------------------------------------------------------
+#if defined key_mpp_mpi
+   INCLUDE 'mpif.h'
+#endif
+   !-------------------------------------------------------------------
+
+   !
+   ! Initialisation
+   ! --------------
+   !
+   il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec
+
+#if ! defined key_mpp_mpi
+
+   ! Traitement des arguments fournis
+   ! --------------------------------
+   IF( il_narg /= 1 )THEN
+      WRITE(cl_errormsg,*) ' ERROR : one argument is needed '
+      CALL fct_help(cp_myname,cl_errormsg) 
+      CALL EXIT(1)
+   ELSE
+
+      CALL GET_COMMAND_ARGUMENT(1,cl_arg) !f03 intrinsec
+      SELECT CASE (cl_arg)
+         CASE ('-v', '--version')
+
+            CALL fct_version(cp_myname)
+            CALL EXIT(0)
+
+         CASE ('-h', '--help')
+
+            CALL fct_help(cp_myname)
+            CALL EXIT(0)
+
+         CASE DEFAULT
+
+            cl_namelist=cl_arg
+            
+            CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec
+            CALL create_boundary__mono(cl_namelist)
+
+      END SELECT
+   ENDIF
+#else
+
+   ! Initialize MPI
+   CALL mpi_init(ierror)
+   CALL mpi_comm_rank(mpi_comm_world,iproc,ierror)
+   CALL mpi_comm_size(mpi_comm_world,nproc,ierror)
+
+   ! Traitement des arguments fournis
+   ! --------------------------------
+   IF( il_narg == 0 )THEN
+      WRITE(cl_errormsg,*) ' ERROR : at least one argument is needed '
+      CALL fct_help(cp_myname,cl_errormsg) 
+      CALL EXIT(1)
+   ELSE
+
+      ALLOCATE(cl_args(il_narg))
+      DO jm=1,il_narg
+
+         CALL GET_COMMAND_ARGUMENT(jm,cl_arg) !f03 intrinsec
+         SELECT CASE (cl_arg)
+            CASE ('-v', '--version')
+
+               CALL fct_version(cp_myname)
+               CALL EXIT(0)
+
+            CASE ('-h', '--help')
+
+               CALL fct_help(cp_myname)
+               CALL EXIT(0)
+
+            CASE DEFAULT
+
+               cl_args(jm)=TRIM(cl_arg)
+
+         END SELECT
+      ENDDO
+   ENDIF
+
+   ALLOCATE(il_nprog(il_narg))
+   DO jm=1, il_narg
+      il_nprog(jm)= MOD(jm,nproc)
+   ENDDO
+
+   DO jm=1, il_narg
+      IF ( il_nprog(jm) .eq. iproc ) THEN
+         CALL create_boundary__mono(cl_args(jm))
+      ENDIF
+   ENDDO
+
+   CALL mpi_finalize(ierror)
+
+   DEALLOCATE(cl_args)
+   DEALLOCATE(il_nprog)
+#endif
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE create_boundary__mono(cd_namelist)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine create boundary files.
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date January, 2016 - Initial Version
+   !>
+   !> @param[in] cd_namelist namelist file 
+   !-------------------------------------------------------------------
+
+   USE logger                          ! log file manager
+
+   IMPLICIT NONE
+   ! Argument
+   CHARACTER(LEN=lc), INTENT(IN) :: cd_namelist 
+
+   ! local variable
+   CHARACTER(LEN=lc)                                  :: cl_date
+   CHARACTER(LEN=lc)                                  :: cl_name
+   CHARACTER(LEN=lc)                                  :: cl_bdyout
+   CHARACTER(LEN=lc)                                  :: cl_data
+   CHARACTER(LEN=lc)                                  :: cl_dimorder
+   CHARACTER(LEN=lc)                                  :: cl_fmt
+   CHARACTER(LEN=lc)                                  :: cl_url
+
+   INTEGER(i4)                                        :: il_status
+   INTEGER(i4)                                        :: il_fileid
+   INTEGER(i4)                                        :: il_imin0
+   INTEGER(i4)                                        :: il_imax0
+   INTEGER(i4)                                        :: il_jmin0
+   INTEGER(i4)                                        :: il_jmax0
+   INTEGER(i4)                                        :: il_shift
+   INTEGER(i4)      , DIMENSION(ip_maxdim)            :: il_rho
+   INTEGER(i4)      , DIMENSION(2,2)                  :: il_offset
+   INTEGER(i4)      , DIMENSION(2,2)                  :: il_ind
+
+   LOGICAL                                            :: ll_exist
+
+   TYPE(TATT)                                         :: tl_att
+   
+   TYPE(TVAR)                                         :: tl_depth   
+   TYPE(TVAR)                                         :: tl_time
+   TYPE(TVAR)                                         :: tl_var1
+   TYPE(TVAR)                                         :: tl_var0
+   TYPE(TVAR)                                         :: tl_lon1
+   TYPE(TVAR)                                         :: tl_lat1
+   TYPE(TVAR)                                         :: tl_lvl1  
+   TYPE(TVAR)       , DIMENSION(:)      , ALLOCATABLE :: tl_level
+   TYPE(TVAR)       , DIMENSION(:,:,:)  , ALLOCATABLE :: tl_seglvl1
+   TYPE(TVAR)       , DIMENSION(:,:,:)  , ALLOCATABLE :: tl_segvar1
+
+   TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
+
+   TYPE(TDATE)                                        :: tl_date
+   
+   TYPE(TBDY)       , DIMENSION(ip_ncard)             :: tl_bdy
+   
+   TYPE(TDOM)                                         :: tl_dom0
+   TYPE(TDOM)                                         :: tl_dom1
+   TYPE(TDOM)       , DIMENSION(:,:,:)  , ALLOCATABLE :: tl_segdom1
+
+   TYPE(TFILE)                                        :: tl_file
+   TYPE(TFILE)                                        :: tl_fileout
+   
+   TYPE(TMPP)                                         :: tl_coord0
+   TYPE(TMPP)                                         :: tl_coord1
+   TYPE(TMPP)                                         :: tl_bathy1
+   TYPE(TMPP)                                         :: tl_mpp
+
+   TYPE(TMULTI)                                       :: tl_multi
+
+   ! loop indices
+   INTEGER(i4) :: jvar
+   INTEGER(i4) :: jpoint
+   INTEGER(i4) :: ji
+   INTEGER(i4) :: jj
+   INTEGER(i4) :: jk
+   INTEGER(i4) :: jl
+
+   ! namelist variable
+   ! namlog
+   CHARACTER(LEN=lc)                       :: cn_logfile    = 'create_boundary.log' 
+   CHARACTER(LEN=lc)                       :: cn_verbosity  = 'warning' 
+   INTEGER(i4)                             :: in_maxerror   = 5
+
+   ! namcfg
+   CHARACTER(LEN=lc)                       :: cn_varcfg  = './cfg/variable.cfg' 
+   CHARACTER(LEN=lc)                       :: cn_dimcfg  = './cfg/dimension.cfg'
+   CHARACTER(LEN=lc)                       :: cn_dumcfg  = './cfg/dummy.cfg'
+
+   ! namsrc
+   CHARACTER(LEN=lc)                       :: cn_coord0  = '' 
+   INTEGER(i4)                             :: in_perio0  = -1
+
+   ! namtgt
+   CHARACTER(LEN=lc)                       :: cn_coord1  = '' 
+   CHARACTER(LEN=lc)                       :: cn_bathy1  = '' 
+   INTEGER(i4)                             :: in_perio1  = -1
+
+   !namzgr
+   REAL(dp)                                :: dn_pp_to_be_computed = 0._dp
+   REAL(dp)                                :: dn_ppsur   = -3958.951371276829_dp
+   REAL(dp)                                :: dn_ppa0    =   103.953009600000_dp
+   REAL(dp)                                :: dn_ppa1    =     2.415951269000_dp
+   REAL(dp)                                :: dn_ppa2    =   100.760928500000_dp
+   REAL(dp)                                :: dn_ppkth   =    15.351013700000_dp
+   REAL(dp)                                :: dn_ppkth2  =    48.029893720000_dp
+   REAL(dp)                                :: dn_ppacr   =     7.000000000000_dp
+   REAL(dp)                                :: dn_ppacr2  =    13.000000000000_dp
+   REAL(dp)                                :: dn_ppdzmin = 6._dp
+   REAL(dp)                                :: dn_pphmax  = 5750._dp
+   INTEGER(i4)                             :: in_nlevel  = 75
+
+   !namzps
+   REAL(dp)                                :: dn_e3zps_min  = 25._dp
+   REAL(dp)                                :: dn_e3zps_rat  = 0.2_dp
+
+   ! namvar
+   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = ''
+   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = ''
+
+   ! namnst
+   INTEGER(i4)                             :: in_rhoi    = 1
+   INTEGER(i4)                             :: in_rhoj    = 1
+
+   ! nambdy
+   LOGICAL                                 :: ln_north   = .TRUE.
+   LOGICAL                                 :: ln_south   = .TRUE.
+   LOGICAL                                 :: ln_east    = .TRUE.
+   LOGICAL                                 :: ln_west    = .TRUE.
+   LOGICAL                                 :: ln_oneseg  = .TRUE.
+   CHARACTER(LEN=lc)                       :: cn_north   = ''
+   CHARACTER(LEN=lc)                       :: cn_south   = ''
+   CHARACTER(LEN=lc)                       :: cn_east    = ''
+   CHARACTER(LEN=lc)                       :: cn_west    = ''
+
+   ! namout
+   CHARACTER(LEN=lc)                       :: cn_fileout = 'boundary.nc' 
+   REAL(dp)                                :: dn_dayofs  = 0._dp
+   LOGICAL                                 :: ln_extrap  = .FALSE.
+   !-------------------------------------------------------------------
+
+   NAMELIST /namlog/ &  !< logger namelist
+   &  cn_logfile,    &  !< log file
+   &  cn_verbosity,  &  !< log verbosity
+   &  in_maxerror       !< logger maximum error
+
+   NAMELIST /namcfg/ &  !< configuration namelist
+   &  cn_varcfg,     &  !< variable configuration file
+   &  cn_dimcfg,     &  !< dimension configuration file
+   &  cn_dumcfg         !< dummy configuration file
+
+   NAMELIST /namsrc/ &  !< source/coarse grid namelist
+   &  cn_coord0,     &  !< coordinate file
+   &  in_perio0         !< periodicity index
+
+   NAMELIST /namtgt/ &  !< target/fine grid namelist
+   &  cn_coord1,     &  !< coordinate file
+   &  cn_bathy1,     &  !< bathymetry file
+   &  in_perio1         !< periodicity index
+ 
+   NAMELIST /namzgr/ &
+   &  dn_pp_to_be_computed, &
+   &  dn_ppsur,      &
+   &  dn_ppa0,       &
+   &  dn_ppa1,       &
+   &  dn_ppa2,       &
+   &  dn_ppkth,      &
+   &  dn_ppkth2,     &
+   &  dn_ppacr,      &
+   &  dn_ppacr2,     &
+   &  dn_ppdzmin,    &
+   &  dn_pphmax,     &
+   &  in_nlevel         !< number of vertical level
+
+   NAMELIST /namzps/ &
+   &  dn_e3zps_min,  &
+   &  dn_e3zps_rat
+
+   NAMELIST /namvar/ &  !< variable namelist
+   &  cn_varfile,    &  !< list of variable and file where find it. (ex: 'votemper:GLORYS_gridT.nc' ) 
+   &  cn_varinfo        !< list of variable and method to apply on. (ex: 'votemper:linear','vosaline:cubic' )
+ 
+   NAMELIST /namnst/ &  !< nesting namelist
+   &  in_rhoi,       &  !< refinement factor in i-direction
+   &  in_rhoj           !< refinement factor in j-direction
+
+   NAMELIST /nambdy/ &  !< boundary namelist
+   &  ln_north,      &  !< use north boundary
+   &  ln_south,      &  !< use south boundary
+   &  ln_east ,      &  !< use east  boundary
+   &  ln_west ,      &  !< use west  boundary
+   &  cn_north,      &  !< north boundary indices on fine grid
+   &  cn_south,      &  !< south boundary indices on fine grid
+   &  cn_east ,      &  !< east  boundary indices on fine grid
+   &  cn_west ,      &  !< west  boundary indices on fine grid
+   &  ln_oneseg         !< use only one segment for each boundary or not
+
+   NAMELIST /namout/ &  !< output namelist
+   &  cn_fileout,    &  !< fine grid boundary file basename   
+   &  dn_dayofs,     &  !< date offset in day (change only ouput file name)
+   &  ln_extrap         !< extrapolate or not
+   !-------------------------------------------------------------------
+
+   ! read namelist
+   INQUIRE(FILE=TRIM(cd_namelist), EXIST=ll_exist)
+
+   IF( ll_exist )THEN
+      
+      il_fileid=fct_getunit()
+
+      OPEN( il_fileid, FILE=TRIM(cd_namelist), &
+      &                FORM='FORMATTED',       &
+      &                ACCESS='SEQUENTIAL',    &
+      &                STATUS='OLD',           &
+      &                ACTION='READ',          &
+      &                IOSTAT=il_status)
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         PRINT *,"CREATE BOUNDARY: ERROR opening "//TRIM(cd_namelist)
+         STOP
+      ENDIF
+
+      READ( il_fileid, NML = namlog )
+      ! define log file
+      CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror)
+      CALL logger_header()
+
+      READ( il_fileid, NML = namcfg )
+      ! get variable extra information
+      CALL var_def_extra(TRIM(cn_varcfg))
+
+      ! get dimension allowed
+      CALL dim_def_extra(TRIM(cn_dimcfg))
+
+      ! get dummy variable
+      CALL var_get_dummy(TRIM(cn_dumcfg))
+      ! get dummy dimension
+      CALL dim_get_dummy(TRIM(cn_dumcfg))
+      ! get dummy attribute
+      CALL att_get_dummy(TRIM(cn_dumcfg))
+
+      READ( il_fileid, NML = namsrc )
+      READ( il_fileid, NML = namtgt )
+      READ( il_fileid, NML = namzgr )
+      READ( il_fileid, NML = namvar )
+      ! add user change in extra information
+      CALL var_chg_extra(cn_varinfo)
+      ! match variable with file
+      tl_multi=multi_init(cn_varfile)
+
+      READ( il_fileid, NML = namnst )
+      READ( il_fileid, NML = nambdy )
+      READ( il_fileid, NML = namout )
+
+      CLOSE( il_fileid, IOSTAT=il_status )
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         CALL logger_error("CREATE BOUNDARY: ERROR closing "//TRIM(cd_namelist))
+      ENDIF
+
+   ELSE
+
+      WRITE(cl_errormsg,*) " ERROR : can't find "//TRIM(cd_namelist)
+      CALL fct_help(cp_myname,cl_errormsg) 
+      CALL EXIT(1)
+
+   ENDIF
+
+   CALL multi_print(tl_multi)
+
+   IF( tl_multi%i_nvar <= 0 )THEN
+      CALL logger_fatal("CREATE BOUNDARY: no variable to be used."//&
+      &  " check namelist.")
+   ENDIF
+
+   ! open files
+   IF( TRIM(cn_coord0) /= '' )THEN
+      tl_file= file_init(TRIM(cn_coord0))
+      tl_coord0=mpp_init( tl_file, id_perio=in_perio0)
+      ! clean
+      CALL file_clean(tl_file)
+      CALL grid_get_info(tl_coord0)
+   ELSE
+      CALL logger_fatal("CREATE BOUNDARY: can not find coarse grid "//&
+      &  "coordinate file. check namelist")
+   ENDIF
+
+   IF( TRIM(cn_coord1) /= '' )THEN
+      tl_file=file_init(TRIM(cn_coord1))
+      tl_coord1=mpp_init( tl_file, id_perio=in_perio1)
+      ! clean
+      CALL file_clean(tl_file)
+      CALL grid_get_info(tl_coord1)
+   ELSE
+      CALL logger_fatal("CREATE BOUNDARY: can not find fine grid coordinate "//&
+      &  "file. check namelist")
+   ENDIF
+
+   IF( TRIM(cn_bathy1) /= '' )THEN
+      tl_file=file_init(TRIM(cn_bathy1))
+      tl_bathy1=mpp_init( tl_file, id_perio=in_perio1)
+      ! clean
+      CALL file_clean(tl_file)
+      CALL grid_get_info(tl_bathy1)
+   ELSE
+      CALL logger_fatal("CREATE BOUNDARY: can not find fine grid bathymetry "//&
+      &  "file. check namelist")
+   ENDIF
+
+   ! check
+   ! check output file do not already exist
+   ! WARNING: do not work when use time to create output file name
+   DO jk=1,ip_ncard
+      cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
+      &                                TRIM(cp_card(jk)), 1 )
+      INQUIRE(FILE=TRIM(cl_bdyout), EXIST=ll_exist)
+      IF( ll_exist )THEN
+         CALL logger_fatal("CREATE BOUNDARY: output file "//TRIM(cl_bdyout)//&
+         &  " already exist.")
+      ENDIF
+
+      cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
+         &                             TRIM(cp_card(jk)) )
+      INQUIRE(FILE=TRIM(cl_bdyout), EXIST=ll_exist)
+      IF( ll_exist )THEN
+         CALL logger_fatal("CREATE BOUNDARY: output file "//TRIM(cl_bdyout)//&
+         &  " already exist.")
+      ENDIF
+   ENDDO
+
+   ! check namelist
+   ! check refinement factor
+   il_rho(:)=1
+   IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN
+      CALL logger_error("CREATE BOUNDARY: invalid refinement factor."//&
+         &  " check namelist "//TRIM(cd_namelist))
+   ELSE
+      il_rho(jp_I)=in_rhoi
+      il_rho(jp_J)=in_rhoj
+   ENDIF
+
+   !
+   ! compute coarse grid indices around fine grid
+   il_ind(:,:)=grid_get_coarse_index(tl_coord0, tl_coord1, &
+      &                              id_rho=il_rho(:))
+
+   il_imin0=il_ind(1,1) ; il_imax0=il_ind(1,2)
+   il_jmin0=il_ind(2,1) ; il_jmax0=il_ind(2,2)
+
+   ! check domain validity
+   CALL grid_check_dom(tl_coord0, il_imin0, il_imax0, il_jmin0, il_jmax0)
+
+   ! check coordinate file
+   CALL grid_check_coincidence( tl_coord0, tl_coord1, &
+      &                         il_imin0, il_imax0, &
+      &                         il_jmin0, il_jmax0, &
+      &                         il_rho(:) )      
+
+   ! read or compute boundary
+   CALL mpp_get_contour(tl_bathy1)
+
+   CALL iom_mpp_open(tl_bathy1)
+ 
+   tl_var1=iom_mpp_read_var(tl_bathy1,'Bathymetry')
+ 
+   CALL iom_mpp_close(tl_bathy1)
+
+   ! get boundaries indices
+   tl_bdy(:)=boundary_init(tl_var1, ln_north, ln_south, ln_east, ln_west, &
+      &                             cn_north, cn_south, cn_east, cn_west, &
+      &                             ln_oneseg ) 
+
+
+   CALL var_clean(tl_var1)
+
+   ! compute level
+   ALLOCATE(tl_level(ip_npoint))
+   tl_level(:)=vgrid_get_level(tl_bathy1, cd_namelist )
+
+   ! get coordinate for each segment of each boundary
+   ALLOCATE( tl_segdom1(ip_npoint,ip_maxseg,ip_ncard) )
+   ALLOCATE( tl_seglvl1(ip_npoint,ip_maxseg,ip_ncard) )
+ 
+   DO jl=1,ip_ncard
+      IF( tl_bdy(jl)%l_use )THEN
+         DO jk=1,tl_bdy(jl)%i_nseg
+
+            ! get fine grid segment domain
+            tl_segdom1(:,jk,jl)=create_boundary_get_dom( tl_bathy1, &
+               &                                         tl_bdy(jl), jk )
+
+            IF( .NOT. ln_extrap )THEN
+               ! get fine grid level
+               tl_seglvl1(:,jk,jl)= &
+                  & create_boundary_get_level( tl_level(:), &
+                  &                            tl_segdom1(:,jk,jl))
+            ENDIF
+
+            ! add extra band to fine grid domain (if possible)
+            ! to avoid dimension of one and so be able to compute offset
+            DO jj=1,ip_npoint
+               CALL dom_add_extra(tl_segdom1(jj,jk,jl), &
+                  &               il_rho(jp_I), il_rho(jp_J))
+            ENDDO
+
+         ENDDO
+      ENDIF
+   ENDDO
+
+   ! clean
+   CALL var_clean(tl_level(:))
+   DEALLOCATE(tl_level)
+
+   ! clean bathy
+   CALL mpp_clean(tl_bathy1)
+
+   ALLOCATE( tl_segvar1(tl_multi%i_nvar,ip_maxseg,ip_ncard) )
+   ! compute boundary for variable to be used (see namelist)
+   IF( .NOT. ASSOCIATED(tl_multi%t_mpp) )THEN
+      CALL logger_error("CREATE BOUNDARY: no file to work on. "//&
+         &              "check cn_varfile in namelist.")
+   ELSE
+
+      jvar=0
+      ! for each file
+      DO ji=1,tl_multi%i_nmpp
+
+         WRITE(cl_data,'(a,i2.2)') 'data-',jvar+1
+         IF( .NOT. ASSOCIATED(tl_multi%t_mpp(ji)%t_proc(1)%t_var) )THEN
+
+            CALL logger_error("CREATE BOUNDARY: no variable to work on for "//&
+               &              "mpp "//TRIM(tl_multi%t_mpp(ji)%c_name)//&
+               &              ". check cn_varfile in namelist.")
+
+         ELSEIF( TRIM(tl_multi%t_mpp(ji)%c_name) == TRIM(cl_data) )THEN
+         !- use input matrix to fill variable
+
+            WRITE(*,'(a)') "work on data"
+            ! for each variable initialise from matrix
+            DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
+
+               jvar=jvar+1
+               WRITE(*,'(2x,a,a)') "work on variable "//&
+               &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
+
+               tl_var1=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj))
+
+               SELECT CASE(TRIM(tl_var1%c_point))
+               CASE DEFAULT !'T'
+                  jpoint=jp_T
+               CASE('U')
+                  jpoint=jp_U
+               CASE('V')
+                  jpoint=jp_V
+               CASE('F')
+                  jpoint=jp_F
+               END SELECT
+
+               WRITE(*,'(4x,a,a)') 'work on '//TRIM(tl_var1%c_name)
+               DO jl=1,ip_ncard
+                  IF( tl_bdy(jl)%l_use )THEN
+
+                     DO jk=1,tl_bdy(jl)%i_nseg
+
+                        ! fill value with matrix data
+                        tl_segvar1(jvar,jk,jl)=create_boundary_matrix( &
+                           &                          tl_var1, &
+                           &                          tl_segdom1(jpoint,jk,jl), &
+                           &                          in_nlevel )
+
+                        !del extra
+                        CALL dom_del_extra( tl_segvar1(jvar,jk,jl), &
+                           &                tl_segdom1(jpoint,jk,jl) )
+
+                     ENDDO
+
+                  ENDIF
+               ENDDO
+
+               ! clean
+               CALL var_clean(tl_var1)
+
+            ENDDO
+
+         !- end of use input matrix to fill variable
+         ELSE
+         !- use mpp file to fill variable
+
+            WRITE(*,'(a)') "work on file "//TRIM(tl_multi%t_mpp(ji)%c_name)
+            ! 
+            tl_file=file_init(TRIM(tl_multi%t_mpp(ji)%t_proc(1)%c_name), &
+               &              id_perio=tl_multi%t_mpp(ji)%i_perio)
+            tl_mpp=mpp_init( tl_file )
+            !tl_mpp=mpp_init( tl_file, id_perio=tl_multi%t_mpp(ji)%t_proc(1)%i_perio)
+            ! clean
+            CALL file_clean(tl_file)
+            CALL grid_get_info(tl_mpp)
+
+            DO jl=1,ip_ncard
+               IF( tl_bdy(jl)%l_use )THEN
+
+                  WRITE(*,'(2x,a,a)') 'work on '//TRIM(tl_bdy(jl)%c_card)//&
+                     &  ' boundary'
+                  DO jk=1,tl_bdy(jl)%i_nseg
+
+                     ! for each variable of this file
+                     DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
+ 
+                        WRITE(*,'(4x,a,a)') "work on variable "//&
+                        &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
+
+                        tl_var0=var_copy(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj))
+
+                        ! open mpp file
+                        CALL iom_mpp_open(tl_mpp)
+
+                        ! get or check depth value
+                        CALL create_boundary_check_depth( tl_var0, tl_mpp, &
+                        &                                 in_nlevel, tl_depth )
+
+                        ! get or check time value
+                        CALL create_boundary_check_time( tl_var0, tl_mpp, &
+                        &                                tl_time )
+
+                        ! close mpp file
+                        CALL iom_mpp_close(tl_mpp)
+
+                        ! open mpp file on domain
+                        SELECT CASE(TRIM(tl_var0%c_point))
+                           CASE DEFAULT !'T'
+                              jpoint=jp_T
+                           CASE('U')
+                              jpoint=jp_U
+                           CASE('V')
+                              jpoint=jp_V
+                           CASE('F')
+                              jpoint=jp_F
+                        END SELECT
+
+                        tl_dom1=dom_copy(tl_segdom1(jpoint,jk,jl))
+
+                        CALL create_boundary_get_coord( tl_coord1, tl_dom1, &
+                        &                               tl_var0%c_point,    &
+                        &                               tl_lon1, tl_lat1 )
+
+                        ! get coarse grid indices of this segment
+                        il_ind(:,:)=grid_get_coarse_index(tl_coord0, &
+                        &                                 tl_lon1, tl_lat1, &
+                        &                                 id_rho=il_rho(:) )
+
+                        IF( ANY(il_ind(:,:)==0) )THEN
+                           CALL logger_error("CREATE BOUNDARY: error "//&
+                           &  "computing coarse grid indices")
+                        ELSE
+                           il_imin0=il_ind(1,1)
+                           il_imax0=il_ind(1,2)
+
+                           il_jmin0=il_ind(2,1)
+                           il_jmax0=il_ind(2,2)
+                        ENDIF
+
+                        il_offset(:,:)= grid_get_fine_offset( &
+                        &                    tl_coord0, &
+                        &                    il_imin0, il_jmin0,&
+                        &                    il_imax0, il_jmax0,&
+                        &                    tl_lon1%d_value(:,:,1,1),&
+                        &                    tl_lat1%d_value(:,:,1,1),&
+                        &                    il_rho(:),&
+                        &                    TRIM(tl_var0%c_point) )
+
+                        ! compute coarse grid segment domain
+                        tl_dom0=dom_init( tl_coord0,         &
+                        &                 il_imin0, il_imax0,&
+                        &                 il_jmin0, il_jmax0 )
+
+                        ! add extra band (if possible) to compute interpolation
+                        CALL dom_add_extra(tl_dom0)
+
+                        ! open mpp files
+                        CALL iom_dom_open(tl_mpp, tl_dom0)
+
+                        cl_name=tl_var0%c_name
+                        ! read variable value on domain
+                        tl_segvar1(jvar+jj,jk,jl)= &
+                        &    iom_dom_read_var(tl_mpp, TRIM(cl_name), tl_dom0)
+
+                        IF( ANY(il_rho(:)/=1) )THEN
+                           WRITE(*,'(4x,a,a)') "interp variable "//TRIM(cl_name)
+                           ! work on variable
+                           CALL create_boundary_interp( &
+                           &                 tl_segvar1(jvar+jj,jk,jl),&
+                           &                 il_rho(:), il_offset(:,:) )
+                        ENDIF
+
+                        ! remove extraband added to domain
+                        CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), &
+                        &                   tl_dom0, il_rho(:) )
+
+                        ! del extra point on fine grid
+                        CALL dom_del_extra( tl_segvar1(jvar+jj,jk,jl), &
+                        &                   tl_dom1 )
+
+                        ! clean extra point information on coarse grid domain
+                        CALL dom_clean_extra( tl_dom0 )
+
+                        ! add attribute to variable
+                        tl_att=att_init('src_file',&
+                        &  TRIM(fct_basename(tl_mpp%c_name)))
+                        CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), &
+                        &                 tl_att)
+
+                        ! 
+                        tl_att=att_init('src_i_indices',&
+                        &  (/tl_dom0%i_imin, tl_dom0%i_imax/))
+                        CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), &
+                        &                 tl_att)
+
+                        tl_att=att_init('src_j_indices', &
+                        &  (/tl_dom0%i_jmin, tl_dom0%i_jmax/))
+                        CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), &
+                        &                 tl_att)
+
+                        IF( ANY(il_rho(:)/=1) )THEN
+                           tl_att=att_init("refinment_factor", &
+                           &               (/il_rho(jp_I),il_rho(jp_J)/))
+                           CALL var_move_att(tl_segvar1(jvar+jj,jk,jl), &
+                           &                 tl_att)
+                        ENDIF
+
+                        ! clean structure
+                        CALL att_clean(tl_att)
+
+                        ! clean
+                        CALL dom_clean(tl_dom0)
+                        CALL dom_clean(tl_dom1)
+
+                        ! close mpp files
+                        CALL iom_dom_close(tl_mpp)
+
+                        ! clean structure
+                        CALL var_clean(tl_lon1)
+                        CALL var_clean(tl_lat1)
+                        CALL var_clean(tl_lvl1)
+
+                     ENDDO ! jj
+
+                     ! clean
+                     CALL var_clean(tl_var0)
+
+                  ENDDO ! jk
+            
+               ENDIF
+            ENDDO ! jl
+
+            jvar=jvar+tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
+
+            ! clean
+            CALL mpp_clean(tl_mpp)
+
+         !- end of use file to fill variable
+         ENDIF
+      ENDDO ! ji
+   ENDIF
+
+   IF( jvar /= tl_multi%i_nvar )THEN
+      CALL logger_error("CREATE BOUNDARY: it seems some variable "//&
+         &  "can not be read")
+   ENDIF
+
+   ! write file for each segment of each boundary
+   DO jl=1,ip_ncard
+      IF( tl_bdy(jl)%l_use )THEN
+
+         DO jk=1,tl_bdy(jl)%i_nseg
+            !- 
+            CALL create_boundary_get_coord( tl_coord1, tl_segdom1(jp_T,jk,jl),&
+               &                           'T', tl_lon1, tl_lat1 )
+
+            ! force to use nav_lon, nav_lat as variable name
+            tl_lon1%c_name='nav_lon'
+            tl_lat1%c_name='nav_lat'
+
+            ! del extra point on fine grid
+            CALL dom_del_extra( tl_lon1, tl_segdom1(jp_T,jk,jl) )
+            CALL dom_del_extra( tl_lat1, tl_segdom1(jp_T,jk,jl) )
+
+            ! clean
+            DO jpoint=1,ip_npoint
+               CALL dom_clean(tl_segdom1(jpoint,jk,jl))
+            ENDDO
+
+            ! swap array
+            CALL boundary_swap(tl_lon1, tl_bdy(jl))
+            CALL boundary_swap(tl_lat1, tl_bdy(jl))
+            DO jvar=1,tl_multi%i_nvar
+
+               ! use additional request
+               ! change unit and apply factor
+               CALL var_chg_unit(tl_segvar1(jvar,jk,jl))
+
+               ! forced min and max value
+               CALL var_limit_value(tl_segvar1(jvar,jk,jl))
+
+               ! filter
+               CALL filter_fill_value(tl_segvar1(jvar,jk,jl))
+
+               IF( .NOT. ln_extrap )THEN
+                  ! use mask
+                  SELECT CASE(TRIM(tl_segvar1(jvar,jk,jl)%c_point))
+                  CASE DEFAULT !'T'
+                     jpoint=jp_T
+                  CASE('U')
+                     jpoint=jp_U
+                  CASE('V')
+                     jpoint=jp_V
+                  CASE('F')
+                     jpoint=jp_F
+                  END SELECT
+
+                  CALL create_boundary_use_mask(tl_segvar1(jvar,jk,jl), &
+                  &                             tl_seglvl1(jpoint,jk,jl))
+               ENDIF
+
+               ! swap dimension order
+               CALL boundary_swap(tl_segvar1(jvar,jk,jl), tl_bdy(jl))
+
+            ENDDO
+
+            ! create file
+            ! create file structure
+            ! set file namearray of level variable structure
+            IF( tl_bdy(jl)%i_nseg > 1 )THEN
+               IF( ASSOCIATED(tl_time%d_value) )THEN
+                  cl_fmt="('y',i0.4,'m',i0.2,'d',i0.2)"
+                  tl_date=var_to_date(tl_time)
+                  tl_date=tl_date+dn_dayofs
+                  cl_date=date_print( tl_date, cl_fmt ) 
+
+                  cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
+                  &                                TRIM(tl_bdy(jl)%c_card), jk,&
+                  &                                cd_date=TRIM(cl_date) )
+               ELSE
+                  cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
+                  &                                TRIM(tl_bdy(jl)%c_card), jk )
+               ENDIF
+            ELSE
+               IF( ASSOCIATED(tl_time%d_value) )THEN
+                  cl_fmt="('y',i0.4,'m',i0.2,'d',i0.2)"
+                  tl_date=var_to_date(tl_time)
+                  tl_date=tl_date+dn_dayofs
+                  cl_date=date_print( tl_date, cl_fmt )
+
+                  cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
+                  &                                TRIM(tl_bdy(jl)%c_card), &
+                  &                                cd_date=TRIM(cl_date) )
+               ELSE
+                  cl_bdyout=boundary_set_filename( TRIM(cn_fileout), &
+                  &                                TRIM(tl_bdy(jl)%c_card) )
+               ENDIF
+            ENDIF
+            ! 
+            tl_fileout=file_init(TRIM(cl_bdyout),id_perio=in_perio1)
+
+            ! add dimension
+            tl_dim(:)=var_max_dim(tl_segvar1(:,jk,jl))
+
+            SELECT CASE(TRIM(tl_bdy(jl)%c_card))
+               CASE DEFAULT ! 'north','south'
+                  cl_dimorder='xyzt'
+               CASE('east','west')
+                  cl_dimorder='yxzt'
+            END SELECT
+
+            DO ji=1,ip_maxdim
+               IF( tl_dim(ji)%l_use ) CALL file_add_dim(tl_fileout, tl_dim(ji))
+            ENDDO
+
+            ! add variables
+            IF( ALL( tl_dim(1:2)%l_use ) )THEN
+               ! add longitude
+               CALL file_add_var(tl_fileout, tl_lon1)
+               CALL var_clean(tl_lon1)
+
+               ! add latitude
+               CALL file_add_var(tl_fileout, tl_lat1)
+               CALL var_clean(tl_lat1)
+            ENDIF
+            
+
+
+            IF( tl_dim(3)%l_use )THEN
+               IF( ASSOCIATED(tl_depth%d_value) )THEN
+                  ! add depth
+                  CALL file_add_var(tl_fileout, tl_depth)
+               ENDIF
+            ENDIF
+
+            IF( tl_dim(4)%l_use )THEN
+               IF( ASSOCIATED(tl_time%d_value) )THEN
+                  ! add time
+                  CALL file_add_var(tl_fileout, tl_time)
+               ENDIF
+            ENDIF
+
+            ! add other variable
+            DO jvar=tl_multi%i_nvar,1,-1
+               CALL file_add_var(tl_fileout, tl_segvar1(jvar,jk,jl))
+               CALL var_clean(tl_segvar1(jvar,jk,jl))
+            ENDDO
+
+            ! add some attribute
+            tl_att=att_init("Created_by","SIREN create_boundary")
+            CALL file_add_att(tl_fileout, tl_att)
+
+            !add source url
+            cl_url=fct_split(fct_split(cp_url,2,'$'),2,'URL:')
+            tl_att=att_init("SIREN_url",cl_url)
+            CALL file_add_att(tl_fileout, tl_att)
+
+            ! add date of creation
+            cl_date=date_print(date_now())
+            tl_att=att_init("Creation_date",cl_date)
+            CALL file_add_att(tl_fileout, tl_att)
+
+            ! add shift on north and east boundary
+            ! boundary compute on T point but express on U or V point
+            SELECT CASE(TRIM(tl_bdy(jl)%c_card))
+            CASE DEFAULT ! 'south','west'
+               il_shift=0
+            CASE('north','east')
+               il_shift=1
+            END SELECT
+
+            ! add indice of velocity row or column
+            tl_att=att_init('bdy_ind',tl_bdy(jl)%t_seg(jk)%i_index-il_shift)
+            CALL file_move_att(tl_fileout, tl_att)
+
+            ! add width of the relaxation zone
+            tl_att=att_init('bdy_width',tl_bdy(jl)%t_seg(jk)%i_width)
+            CALL file_move_att(tl_fileout, tl_att)
+            
+            ! add indice of segment start 
+            tl_att=att_init('bdy_deb',tl_bdy(jl)%t_seg(jk)%i_first)
+            CALL file_move_att(tl_fileout, tl_att)
+            
+            ! add indice of segment end 
+            tl_att=att_init('bdy_end',tl_bdy(jl)%t_seg(jk)%i_last)
+            CALL file_move_att(tl_fileout, tl_att)
+                           
+            ! clean
+            CALL att_clean(tl_att)
+
+            ! create file
+            CALL iom_create(tl_fileout)
+
+            ! write file
+            CALL iom_write_file(tl_fileout, cl_dimorder)
+
+            ! close file
+            CALL iom_close(tl_fileout)
+            CALL file_clean(tl_fileout)
+
+         ENDDO ! jk
+
+      ENDIF
+      ! clean
+      CALL boundary_clean(tl_bdy(jl))
+   ENDDO !jl
+
+   ! clean
+   IF( ASSOCIATED(tl_depth%d_value) ) CALL var_clean(tl_depth)
+   IF( ASSOCIATED(tl_time%d_value) ) CALL var_clean(tl_time)
+   DEALLOCATE( tl_segdom1 )
+   DEALLOCATE( tl_segvar1 )
+   CALL var_clean(tl_seglvl1(:,:,:))
+   DEALLOCATE( tl_seglvl1 )
+
+
+   CALL mpp_clean(tl_coord1)
+   CALL mpp_clean(tl_coord0)
+   CALL var_clean_extra()
+
+   CALL multi_clean(tl_multi)
+
+   ! close log file
+   CALL logger_footer()
+   CALL logger_close()
+   CALL logger_clean()
+
+   END SUBROUTINE create_boundary__mono
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION create_boundary_get_dom(td_bathy1, td_bdy, id_seg) &
+         & RESULT (tf_dom)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute boundary domain for each grid point (T,U,V,F) 
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014
+   !> - take into account grid point to compute boundary indices
+   !>
+   !> @param[in] td_bathy1 file structure 
+   !> @param[in] td_bdy    boundary structure
+   !> @param[in] id_seg    segment indice 
+   !> @return array of domain structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP) , INTENT(IN   ) :: td_bathy1
+      TYPE(TBDY) , INTENT(IN   ) :: td_bdy
+      INTEGER(i4), INTENT(IN   ) :: id_seg
+
+      ! function
+      TYPE(TDOM), DIMENSION(ip_npoint) :: tf_dom
+
+      ! local variable
+      INTEGER(i4) :: il_imin1
+      INTEGER(i4) :: il_imax1
+      INTEGER(i4) :: il_jmin1
+      INTEGER(i4) :: il_jmax1
+
+      INTEGER(i4) :: il_imin
+      INTEGER(i4) :: il_imax
+      INTEGER(i4) :: il_jmin
+      INTEGER(i4) :: il_jmax
+
+      INTEGER(i4), DIMENSION(ip_npoint) :: il_ishift
+      INTEGER(i4), DIMENSION(ip_npoint) :: il_jshift
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+      ! init
+      jk=id_seg
+
+      il_ishift(:)=0
+      il_jshift(:)=0
+
+      ! get boundary definition
+      SELECT CASE(TRIM(td_bdy%c_card))
+         CASE('north')
+
+            il_imin1=td_bdy%t_seg(jk)%i_first
+            il_imax1=td_bdy%t_seg(jk)%i_last 
+            il_jmin1=td_bdy%t_seg(jk)%i_index-(td_bdy%t_seg(jk)%i_width-1)
+            il_jmax1=td_bdy%t_seg(jk)%i_index
+
+            il_jshift(jp_V)=-1
+            il_jshift(jp_F)=-1
+
+         CASE('south')
+
+            il_imin1=td_bdy%t_seg(jk)%i_first
+            il_imax1=td_bdy%t_seg(jk)%i_last 
+            il_jmin1=td_bdy%t_seg(jk)%i_index
+            il_jmax1=td_bdy%t_seg(jk)%i_index+(td_bdy%t_seg(jk)%i_width-1)
+
+         CASE('east')
+
+            il_imin1=td_bdy%t_seg(jk)%i_index-(td_bdy%t_seg(jk)%i_width-1)
+            il_imax1=td_bdy%t_seg(jk)%i_index
+            il_jmin1=td_bdy%t_seg(jk)%i_first
+            il_jmax1=td_bdy%t_seg(jk)%i_last 
+
+            il_ishift(jp_U)=-1
+            il_ishift(jp_F)=-1
+
+         CASE('west')
+
+            il_imin1=td_bdy%t_seg(jk)%i_index
+            il_imax1=td_bdy%t_seg(jk)%i_index+(td_bdy%t_seg(jk)%i_width-1)
+            il_jmin1=td_bdy%t_seg(jk)%i_first
+            il_jmax1=td_bdy%t_seg(jk)%i_last 
+
+      END SELECT         
+
+      !-read fine grid domain
+      DO ji=1,ip_npoint
+
+         ! shift domain
+         il_imin=il_imin1+il_ishift(ji)
+         il_imax=il_imax1+il_ishift(ji)
+
+         il_jmin=il_jmin1+il_jshift(ji)
+         il_jmax=il_jmax1+il_jshift(ji)
+
+         ! compute domain
+         tf_dom(ji)=dom_init(td_bathy1,         &
+            &                il_imin, il_imax,  &
+            &                il_jmin, il_jmax,  &
+            &                TRIM(td_bdy%c_card))
+
+      ENDDO
+
+   END FUNCTION create_boundary_get_dom
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE create_boundary_get_coord(td_coord1, td_dom1, cd_point, &
+      &                                 td_lon1, td_lat1)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine get coordinates over boundary domain
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014 
+   !> - take into account grid point
+   !>
+   !> @param[in] td_coord1 coordinates file structure
+   !> @param[in] td_dom1   boundary domain structure
+   !> @param[in] cd_point  grid point
+   !> @param[out] td_lon1  longitude variable structure
+   !> @param[out] td_lat1  latitude variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP)      , INTENT(IN   ) :: td_coord1
+      TYPE(TDOM)      , INTENT(IN   ) :: td_dom1
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_point
+      TYPE(TVAR)      , INTENT(  OUT) :: td_lon1
+      TYPE(TVAR)      , INTENT(  OUT) :: td_lat1 
+
+      ! local variable
+      TYPE(TMPP)        :: tl_coord1
+      
+      CHARACTER(LEN=lc) :: cl_name
+      ! loop indices
+      !----------------------------------------------------------------
+      !read variables on domain (ugly way to do it, have to work on it)
+      ! init mpp structure
+      tl_coord1=mpp_copy(td_coord1)
+      
+      ! open mpp files
+      CALL iom_dom_open(tl_coord1, td_dom1)
+
+      ! read variable value on domain
+      WRITE(cl_name,*) 'longitude_'//TRIM(cd_point)
+      td_lon1=iom_dom_read_var( tl_coord1, TRIM(cl_name), td_dom1)
+      WRITE(cl_name,*) 'latitude_'//TRIM(cd_point)
+      td_lat1=iom_dom_read_var( tl_coord1, TRIM(cl_name), td_dom1)
+
+      ! close mpp files
+      CALL iom_dom_close(tl_coord1)
+
+      ! clean structure
+      CALL mpp_clean(tl_coord1)
+
+   END SUBROUTINE create_boundary_get_coord
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE create_boundary_interp(td_var, id_rho, id_offset, &
+         &                           id_iext, id_jext)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine interpolate variable on boundary
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure 
+   !> @param[in] id_rho    array of refinment factor
+   !> @param[in] id_offset array of offset between fine and coarse grid
+   !> @param[in] id_iext   i-direction size of extra bands (default=im_minext)
+   !> @param[in] id_jext   j-direction size of extra bands (default=im_minext)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
+      INTEGER(I4), DIMENSION(:)  , INTENT(IN   ) :: id_rho
+      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ) :: id_offset
+
+      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_iext
+      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_jext
+
+
+      ! local variable
+      INTEGER(i4) :: il_iext
+      INTEGER(i4) :: il_jext
+      ! loop indices
+      !----------------------------------------------------------------
+
+      !WARNING: at least two extrabands are required for cubic interpolation
+      il_iext=2
+      IF( PRESENT(id_iext) ) il_iext=id_iext
+
+      il_jext=2
+      IF( PRESENT(id_jext) ) il_jext=id_jext
+
+      IF( il_iext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
+         CALL logger_warn("CREATE BOUNDARY INTERP: at least extrapolation "//&
+         &  "on two points are required with cubic interpolation ")
+         il_iext=2
+      ENDIF
+
+      IF( il_jext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
+         CALL logger_warn("CREATE BOUNDARY INTERP: at least extrapolation "//&
+         &  "on two points are required with cubic interpolation ")
+         il_jext=2
+      ENDIF
+
+      ! work on variable
+      ! add extraband
+      CALL extrap_add_extrabands(td_var, il_iext, il_jext)
+
+      ! extrapolate variable
+      CALL extrap_fill_value( td_var )
+
+      ! interpolate variable
+      CALL interp_fill_value( td_var, id_rho(:), &
+      &                       id_offset=id_offset(:,:) )
+
+      ! remove extraband
+      CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), &
+         &                               il_jext*id_rho(jp_J))
+
+   END SUBROUTINE create_boundary_interp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION create_boundary_matrix(td_var, td_dom, id_nlevel) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function create variable, filled with matrix value
+   !> 
+   !> @details 
+   !> A variable is create with the same name that the input variable, 
+   !> and with dimension of the coordinate file. 
+   !> Then the variable array of value is split into equal subdomain.
+   !> Each subdomain is fill with the associated value of the matrix.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_var    variable structure 
+   !> @param[in] td_dom    domain structure 
+   !> @param[in] id_nlevel number of levels 
+   !> @return variable structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) , INTENT(IN) :: td_var
+      TYPE(TDOM) , INTENT(IN) :: td_dom
+      INTEGER(i4), INTENT(IN) :: id_nlevel
+
+      ! function
+      TYPE(TVAR)              :: tf_var
+
+      ! local variable
+      INTEGER(i4)      , DIMENSION(3)                    :: il_dim
+      INTEGER(i4)      , DIMENSION(3)                    :: il_size
+      INTEGER(i4)      , DIMENSION(3)                    :: il_rest
+
+      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_ishape
+      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_jshape
+      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_kshape
+
+      REAL(dp)         , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      ! write value on grid
+      ! get matrix dimension
+      il_dim(:)=td_var%t_dim(1:3)%i_len
+
+      tl_dim(jp_I:jp_J)=dim_copy(td_dom%t_dim(jp_I:jp_J))
+      tl_dim(jp_K)%i_len=id_nlevel
+
+      ! split output domain in N subdomain depending of matrix dimension 
+      il_size(:) = tl_dim(1:3)%i_len / il_dim(:)
+      il_rest(:) = MOD(tl_dim(1:3)%i_len, il_dim(:))
+
+      ALLOCATE( il_ishape(il_dim(1)+1) )
+      il_ishape(:)=0
+      DO ji=2,il_dim(1)+1
+         il_ishape(ji)=il_ishape(ji-1)+il_size(1)
+      ENDDO
+      ! add rest to last cell
+      il_ishape(il_dim(1)+1)=il_ishape(il_dim(1)+1)+il_rest(1)
+      
+      ALLOCATE( il_jshape(il_dim(2)+1) )
+      il_jshape(:)=0
+      DO jj=2,il_dim(2)+1
+         il_jshape(jj)=il_jshape(jj-1)+il_size(2)
+      ENDDO
+      ! add rest to last cell
+      il_jshape(il_dim(2)+1)=il_jshape(il_dim(2)+1)+il_rest(2)
+
+      ALLOCATE( il_kshape(il_dim(3)+1) )
+      il_kshape(:)=0
+      DO jk=2,il_dim(3)+1
+         il_kshape(jk)=il_kshape(jk-1)+il_size(3)
+      ENDDO
+      ! add rest to last cell
+      il_kshape(il_dim(3)+1)=il_kshape(il_dim(3)+1)+il_rest(3)
+
+      ! write ouput array of value 
+      ALLOCATE(dl_value( tl_dim(1)%i_len, &
+      &                  tl_dim(2)%i_len, &
+      &                  tl_dim(3)%i_len, &
+      &                  tl_dim(4)%i_len) )
+
+      dl_value(:,:,:,:)=0
+
+      DO jk=2,il_dim(3)+1
+         DO jj=2,il_dim(2)+1
+            DO ji=2,il_dim(1)+1
+               
+               dl_value( 1+il_ishape(ji-1):il_ishape(ji), &
+               &         1+il_jshape(jj-1):il_jshape(jj), &
+               &         1+il_kshape(jk-1):il_kshape(jk), &
+               &         1 ) = td_var%d_value(ji-1,jj-1,jk-1,1)
+
+            ENDDO
+         ENDDO
+      ENDDO
+
+      ! initialise variable with value
+      tf_var=var_init(TRIM(td_var%c_name),dl_value(:,:,:,:))
+
+      DEALLOCATE(dl_value)
+
+   END FUNCTION create_boundary_matrix
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE create_boundary_use_mask(td_var, td_mask)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine use mask to filled land point with _FillValue
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure 
+   !> @param[in] td_mask   mask variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+      TYPE(TVAR), INTENT(IN   ) :: td_mask
+
+      ! local variable
+      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_mask
+
+      ! loop indices
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      IF( ANY(td_var%t_dim(1:2)%i_len /= &
+      &       td_mask%t_dim(1:2)%i_len) )THEN
+         CALL logger_debug("     mask dimension ( "//&
+         &              TRIM(fct_str(td_mask%t_dim(1)%i_len))//","//&
+         &              TRIM(fct_str(td_mask%t_dim(2)%i_len))//")" )
+         CALL logger_debug(" variable dimension ( "//&
+         &              TRIM(fct_str(td_var%t_dim(1)%i_len))//","//&
+         &              TRIM(fct_str(td_var%t_dim(2)%i_len))//")" )
+         CALL logger_fatal("CREATE BOUNDARY USE MASK: mask and "//&
+         &                 "variable dimension differ."   )
+      ENDIF
+
+      ALLOCATE( il_mask(td_var%t_dim(1)%i_len, &
+      &                 td_var%t_dim(2)%i_len) )
+
+      il_mask(:,:)=INT(td_mask%d_value(:,:,1,1))
+
+      DO jl=1,td_var%t_dim(4)%i_len
+         DO jk=1,td_var%t_dim(3)%i_len
+            WHERE( il_mask(:,:) < jk ) td_var%d_value(:,:,jk,jl)=td_var%d_fill
+         ENDDO
+      ENDDO
+
+      DEALLOCATE( il_mask )
+
+   END SUBROUTINE create_boundary_use_mask
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION create_boundary_get_level(td_level, td_dom) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function extract level over domain on each grid point, and return
+   !> array of variable structure
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_level  array of level variable structure
+   !> @param[in] td_dom    array of domain structure
+   !> @return array of variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_level
+      TYPE(TDOM), DIMENSION(:), INTENT(IN) :: td_dom
+
+      ! function
+      TYPE(TVAR), DIMENSION(ip_npoint)     :: tf_var
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( SIZE(td_level(:)) /= ip_npoint .OR. &
+      &   SIZE(td_dom(:)) /= ip_npoint )THEN
+         CALL logger_error("CREATE BDY GET LEVEL: invalid dimension. "//&
+         &  "check input array of level and domain.")
+      ELSE
+
+         DO ji=1,ip_npoint
+
+            tf_var(ji)=var_copy(td_level(ji))
+
+            IF( ASSOCIATED(tf_var(ji)%d_value) ) DEALLOCATE(tf_var(ji)%d_value)
+
+            tf_var(ji)%t_dim(1)%i_len=td_dom(ji)%t_dim(1)%i_len
+            tf_var(ji)%t_dim(2)%i_len=td_dom(ji)%t_dim(2)%i_len
+            ALLOCATE(tf_var(ji)%d_value(tf_var(ji)%t_dim(1)%i_len, &
+            &                           tf_var(ji)%t_dim(2)%i_len, &
+            &                           tf_var(ji)%t_dim(3)%i_len, &
+            &                           tf_var(ji)%t_dim(4)%i_len) )
+
+            tf_var(ji)%d_value(:,:,:,:) = &
+            &  td_level(ji)%d_value( td_dom(ji)%i_imin:td_dom(ji)%i_imax, &
+            &                        td_dom(ji)%i_jmin:td_dom(ji)%i_jmax, :, : )
+
+         ENDDO
+
+      ENDIF
+
+   END FUNCTION create_boundary_get_level
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE create_boundary_check_depth(td_var, td_mpp, id_nlevel, td_depth)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine check if variable need depth dimension, 
+   !> get depth variable value in an open mpp structure
+   !> and check if agree with already input depth variable.
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date November, 2014 - Initial Version
+   !> @date January, 2016
+   !> - check if variable need/use depth dimension
+   !>
+   !> @param[in] td_var       variable structure
+   !> @param[in] td_mpp       mpp structure
+   !> @param[in] id_nlevel    mpp structure
+   !> @param[inout] td_depth  depth variable structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) , INTENT(IN   ) :: td_var
+      TYPE(TMPP) , INTENT(IN   ) :: td_mpp
+      INTEGER(i4), INTENT(IN   ) :: id_nlevel
+      TYPE(TVAR) , INTENT(INOUT) :: td_depth
+
+      ! local variable
+      INTEGER(i4) :: il_varid
+      TYPE(TVAR)  :: tl_depth
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( td_var%t_dim(jp_K)%l_use .AND. &
+      &   ( TRIM(td_var%c_axis) == '' .OR. &
+      &     INDEX(TRIM(td_var%c_axis),'Z') /= 0 )&
+      & )THEN
+
+         ! check vertical dimension
+         IF( td_mpp%t_dim(jp_K)%l_use )THEN
+            IF( td_mpp%t_dim(jp_K)%i_len /= id_nlevel .AND. &
+              & td_mpp%t_dim(jp_K)%i_len /= 1 )THEN
+               CALL logger_error("CREATE BOUNDARY: dimension in file "//&
+               &  TRIM(td_mpp%c_name)//" not agree with namelist in_nlevel ")
+            ENDIF
+         ENDIF
+
+         ! get or check depth value
+         IF( td_mpp%t_proc(1)%i_depthid /= 0 )THEN
+
+            il_varid=td_mpp%t_proc(1)%i_depthid
+            IF( ASSOCIATED(td_depth%d_value) )THEN
+
+               tl_depth=iom_mpp_read_var(td_mpp, il_varid)
+
+               IF( ANY( td_depth%d_value(:,:,:,:) /= &
+               &        tl_depth%d_value(:,:,:,:) ) )THEN
+
+                  CALL logger_error("CREATE BOUNDARY: depth value "//&
+                  &  "for variable "//TRIM(td_var%c_name)//&
+                  &  "from "//TRIM(td_mpp%c_name)//" not conform "//&
+                  &  " to those from former file(s).")
+
+               ENDIF
+               CALL var_clean(tl_depth)
+
+            ELSE
+               td_depth=iom_mpp_read_var(td_mpp,il_varid)
+            ENDIF
+
+         ENDIF
+      ELSE
+         CALL logger_debug("CREATE BOUNDARY: no depth dimension use"//&
+         &                 " for variable "//TRIM(td_var%c_name))
+      ENDIF
+      
+   END SUBROUTINE create_boundary_check_depth
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE create_boundary_check_time(td_var, td_mpp, td_time)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine check if variable need time dimension, 
+   !> get date and time in an open mpp structure
+   !> and check if agree with date and time already read.
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date November, 2014 - Initial Version
+   !> @date January, 2016
+   !> - check if variable need/use time dimension
+   !>
+   !> @param[in] td_var       variable structure
+   !> @param[in] td_mpp      mpp structure
+   !> @param[inout] td_time  time variable structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR), INTENT(IN   ) :: td_var
+      TYPE(TMPP), INTENT(IN   ) :: td_mpp
+      TYPE(TVAR), INTENT(INOUT) :: td_time
+
+      ! local variable
+      INTEGER(i4) :: il_varid
+      TYPE(TVAR)  :: tl_time
+
+      TYPE(TDATE) :: tl_date1
+      TYPE(TDATE) :: tl_date2
+      ! loop indices
+      !----------------------------------------------------------------
+      IF( td_var%t_dim(jp_L)%l_use .AND. &
+      &   ( TRIM(td_var%c_axis) == '' .OR. &
+      &     INDEX(TRIM(td_var%c_axis),'T') /= 0 )&
+      & )THEN
+
+         ! get or check time value
+         IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN
+
+            il_varid=td_mpp%t_proc(1)%i_timeid
+            IF( ASSOCIATED(td_time%d_value) )THEN
+
+               tl_time=iom_mpp_read_var(td_mpp, il_varid)
+
+               tl_date1=var_to_date(td_time)
+               tl_date2=var_to_date(tl_time)
+               IF( tl_date1 - tl_date2 /= 0 )THEN
+
+                  CALL logger_warn("CREATE BOUNDARY: date from "//&
+                  &  TRIM(td_mpp%c_name)//" not conform "//&
+                  &  " to those from former file(s).")
+
+               ENDIF
+               CALL var_clean(tl_time)
+
+            ELSE
+               td_time=iom_mpp_read_var(td_mpp,il_varid)
+            ENDIF
+
+         ENDIF
+
+      ELSE
+         CALL logger_debug("CREATE BOUNDARY: no time dimension use"//&
+         &                 " for variable "//TRIM(td_var%c_name))
+      ENDIF
+
+   END SUBROUTINE create_boundary_check_time
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END PROGRAM create_boundary
Index: /utils/tools_ticket2413/SIREN/src/create_coord.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/create_coord.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/create_coord.f90	(revision 12863)
@@ -0,0 +1,834 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @file
+!> @brief 
+!> this program creates fine grid coordinate file.
+!>
+!> @details
+!> @section sec1 method
+!> variables from the input coordinates coarse/source grid file, are extracted
+!> and interpolated to create a fine/taget grid coordinates file.<br/>
+!> @note 
+!>    interpolation method could be different for each variable.
+!>
+!> \image html  header_coord_40.png 
+!> <center> \image latex header_coord_40.png 
+!> </center>
+!>
+!> @section sec2 how to
+!> USAGE: create_coord create_coord.nam [-v] [-h]<br/>
+!>    - positional arguments:<br/>
+!>       - create_coord.nam<br/>
+!>          namelist of create_coord
+!>          @note
+!>             a template of the namelist could be created running (in templates directory):
+!>             @code{.sh}
+!>                python create_templates.py create_coord
+!>             @endcode
+!>
+!>    - optional arguments:<br/>
+!>       - -h, --help<br/>
+!>          show this help message (and exit)<br/>
+!>       - -v, --version<br/>
+!>          show Siren's version   (and exit)
+!>
+!> @section sec_coord create_coord.nam
+!>    create_coord.nam contains 6 sub-namelists:<br/>
+!>       - **namlog** to set logger parameters
+!>       - **namcfg** to set configuration file parameters
+!>       - **namsrc** to set source/coarse grid parameters
+!>       - **namvar** to set variable parameters
+!>       - **namnst** to set sub domain and nesting paramters
+!>       - **namout** to set output parameters
+!>
+!>    here after, each sub-namelist parameters is detailed.
+!>    @note 
+!>       default values are specified between brackets
+!>
+!> @subsection sublog namlog
+!>    the logger sub-namelist parameters are :
+!>
+!>    - **cn_logfile** [@a create_coord.log]<br/>
+!>       logger filename
+!>
+!>    - **cn_verbosity** [@a warning]<br/>
+!>       verbosity level, choose between :
+!>          - trace
+!>          - debug
+!>          - info
+!>          - warning
+!>          - error
+!>          - fatal
+!>          - none
+!>
+!>    - **in_maxerror** [@a 5]<br/> 
+!>       maximum number of error allowed
+!>
+!> @subsection subcfg namcfg
+!>    the configuration sub-namelist parameters are :
+!>
+!>    - **cn_varcfg** [@a ./cfg/variable.cfg]<br/>
+!>       path to the variable configuration file.<br/>
+!>       the variable configuration file defines standard name, 
+!>       default interpolation method, axis,... 
+!>       to be used for some known variables.<br/> 
+!>
+!>    - **cn_dimcfg** [@a ./cfg/dimension.cfg]<br/> 
+!>       path to the dimension configuration file.<br/> 
+!>       the dimension configuration file defines dimensions allowed.<br/> 
+!>
+!>    - **cn_dumcfg** [@a ./cfg/dummy.cfg]<br/> 
+!>       path to the useless (dummy) configuration file.<br/>
+!>       the dummy configuration file defines useless 
+!>       dimension or variable. these dimension(s) or variable(s) will not be
+!>       processed.<br/>
+!>
+!> @subsection subsrc namsrc 
+!>    the source/coarse grid sub-namelist parameters are :
+!>
+!>    - **cn_coord0** [@a ]<br/> 
+!>       path to the coordinate file
+!>
+!>    - **in_perio0** [@a ]<br/> 
+!>       NEMO periodicity index<br/> 
+!>       the NEMO periodicity could be choose between 0 to 6:
+!>       <dl>
+!>          <dt>in_perio=0</dt>
+!>          <dd>standard regional model</dd>
+!>          <dt>in_perio=1</dt>
+!>          <dd>east-west cyclic model</dd>
+!>          <dt>in_perio=2</dt>
+!>          <dd>model with symmetric boundary condition across the equator</dd>
+!>          <dt>in_perio=3</dt>
+!>          <dd>regional model with North fold boundary and T-point pivot</dd>
+!>          <dt>in_perio=4</dt>
+!>          <dd>global model with a T-point pivot.<br/>
+!>          example: ORCA2, ORCA025, ORCA12</dd>
+!>          <dt>in_perio=5</dt>
+!>          <dd>regional model with North fold boundary and F-point pivot</dd>
+!>          <dt>in_perio=6</dt>
+!>          <dd>global model with a F-point pivot<br/>
+!>          example: ORCA05</dd>
+!>          </dd>
+!>       </dl>
+!>       @sa For more information see @ref md_src_docsrc_6_perio
+!>       and Model Boundary Condition paragraph in the 
+!>       [NEMO documentation](https://forge.ipsl.jussieu.fr/nemo/chrome/site/doc/NEMO/manual/pdf/NEMO_manual.pdf)
+!>
+!> @subsection subvar namvar 
+!>    the variable sub-namelist parameters are :
+!>
+!>    - **cn_varinfo** [@a ]<br/> 
+!>       list of variable and extra information about request(s) to be used<br/>
+!>
+!>       each elements of *cn_varinfo* is a string character (separated by ',').<br/>
+!>       it is composed of the variable name follow by ':', 
+!>       then request(s) to be used on this variable.<br/> 
+!>       request could be:
+!>          - int = interpolation method
+!>          - ext = extrapolation method
+!>
+!>             requests must be separated by ';'.<br/>
+!>             order of requests does not matter.<br/>
+!>
+!>       informations about available method could be find in @ref interp,
+!>       @ref extrap and @ref filter modules.<br/>
+!>       Example: 
+!>          - 'glamt: int=linear; ext=dist_weight', 'e1t: int=cubic/rhoi'
+!>
+!>       @note 
+!>          If you do not specify a method which is required, 
+!>          default one is apply.
+!>
+!> @subsection subnst namnst 
+!>    the nesting sub-namelist parameters are :
+!>
+!>    - **in_imin0** [@a ]<br/>
+!>       i-direction lower left  point indice of coarse grid subdomain to be used
+!>    - **in_imax0** [@a ]<br/>
+!>       i-direction upper right point indice of coarse grid subdomain to be used
+!>    - **in_jmin0** [@a ]<br/>
+!>       j-direction lower left  point indice of coarse grid subdomain to be used
+!>    - **in_jmax0** [@a ]<br/>
+!>       j-direction upper right point indice of coarse grid subdomain to be used
+!> <br/>or<br/>
+!>    - **rn_lonmin0** [@a ]<br/>
+!>       lower left  longitude of coarse grid subdomain to be used
+!>    - **rn_lonmax0** [@a ]<br/>
+!>       upper right longitude of coarse grid subdomain to be used
+!>    - **rn_latmin0** [@a ]<br/>
+!>       lower left  latitude  of coarse grid subdomain to be used
+!>    - **rn_latmax0** [@a ]<br/>
+!>       upper right latitude  of coarse grid subdomain to be used
+!>    @note you could define sub domain with 
+!>       - coarse/source grid indices
+!>       <br/>or<br/>
+!>       - coordinates.<br/>
+!>    if coordinates are defined (-180 < lon < 360 and -90 < lat < 90),
+!>    SIREN does not take into account indices.
+!>
+!>    - **in_rhoi**  [@a 1]<br/> 
+!>       refinement factor in i-direction
+!>
+!>    - **in_rhoj**  [@a 1]<br/> 
+!>       refinement factor in j-direction
+!>
+!>       \image html  grid_zoom_60.png 
+!>       <center> \image latex grid_zoom_40.png 
+!>       </center>
+!>
+!> @subsection subout namout 
+!>    the output sub-namelist parameter is :
+!>
+!>    - **cn_fileout** [@a coord_fine.nc]<br/>
+!>       output bathymetry filename
+!>
+!> <hr>
+!> @author J.Paul
+!>
+!> @date November, 2013 - Initial Version
+!> @date September, 2014
+!> - add header for user
+!> - compute offset considering grid point
+!> - add global attributes in output file
+!> @date September, 2015
+!> - manage useless (dummy) variable, attributes, and dimension
+!> @date September, 2016
+!> - allow to use coordinate to define subdomain
+!> @date October, 2016
+!> - dimension to be used select from configuration file
+!> @date January, 2019
+!> - add url path to global attributes of output file(s)
+!> @date February, 2019
+!> - rename sub namelist namcrs to namsrc
+!> - create and clean file structure to avoid memory leaks
+!> @date Ocober, 2019
+!> - add help and version optional arguments
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+PROGRAM create_coord
+
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+   USE date                            ! date manager
+   USE att                             ! attribute manager
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+   USE file                            ! file manager
+   USE iom                             ! I/O manager
+   USE grid                            ! grid manager
+   USE extrap                          ! extrapolation manager
+   USE interp                          ! interpolation manager
+   USE filter                          ! filter manager
+   USE mpp                             ! MPP manager
+   USE dom                             ! domain manager
+   USE iom_mpp                         ! MPP I/O manager
+   USE iom_dom                         ! DOM I/O manager
+
+   IMPLICIT NONE
+
+   ! parameters
+   CHARACTER(LEN=lc), PARAMETER  :: cp_myname = "create_coord"
+
+   ! local variable
+   CHARACTER(LEN=lc)                                    :: cl_arg
+   CHARACTER(LEN=lc)                                    :: cl_namelist
+   CHARACTER(LEN=lc)                                    :: cl_date
+   CHARACTER(LEN=lc)                                    :: cl_url
+   CHARACTER(LEN=lc)                                    :: cl_errormsg
+
+   INTEGER(i4)                                          :: il_narg
+   INTEGER(i4)                                          :: il_status
+   INTEGER(i4)                                          :: il_fileid
+   INTEGER(i4)                                          :: il_attid
+   INTEGER(i4)                                          :: il_ind
+   INTEGER(i4)                                          :: il_nvar
+   INTEGER(i4)                                          :: il_ew
+   INTEGER(i4)                                          :: il_imin0
+   INTEGER(i4)                                          :: il_imax0
+   INTEGER(i4)                                          :: il_jmin0
+   INTEGER(i4)                                          :: il_jmax0
+
+   INTEGER(i4)      , DIMENSION(ip_maxdim)              :: il_rho
+   INTEGER(i4)      , DIMENSION(2)                      :: il_index
+   INTEGER(i4)      , DIMENSION(2,2,ip_npoint)          :: il_offset
+
+   LOGICAL                                              :: ll_exist
+
+   TYPE(TATT)                                           :: tl_att
+
+   TYPE(TDOM)                                           :: tl_dom
+
+   TYPE(TVAR)       , DIMENSION(:)        , ALLOCATABLE :: tl_var
+
+   TYPE(TDIM)       , DIMENSION(ip_maxdim)              :: tl_dim
+
+   TYPE(TFILE)                                          :: tl_file
+
+   TYPE(TMPP)                                           :: tl_coord0
+   TYPE(TFILE)                                          :: tl_fileout
+
+   ! loop indices
+   INTEGER(i4) :: ji
+   INTEGER(i4) :: jj
+
+   ! namelist variable
+   ! namlog
+   CHARACTER(LEN=lc) :: cn_logfile  = 'create_coord.log' 
+   CHARACTER(LEN=lc) :: cn_verbosity= 'warning' 
+   INTEGER(i4)       :: in_maxerror = 5
+
+   ! namcfg
+   CHARACTER(LEN=lc) :: cn_varcfg   = './cfg/variable.cfg' 
+   CHARACTER(LEN=lc) :: cn_dimcfg   = './cfg/dimension.cfg' 
+   CHARACTER(LEN=lc) :: cn_dumcfg   = './cfg/dummy.cfg'
+
+   ! namsrc
+   CHARACTER(LEN=lc) :: cn_coord0   = '' 
+   INTEGER(i4)       :: in_perio0   = -1
+
+   ! namvar
+   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = ''
+
+   !namnst
+   REAL(sp)          :: rn_lonmin0  = -360.
+   REAL(sp)          :: rn_lonmax0  = -360.
+   REAL(sp)          :: rn_latmin0  = -360.
+   REAL(sp)          :: rn_latmax0  = -360.
+   INTEGER(i4)       :: in_imin0 = 0
+   INTEGER(i4)       :: in_imax0 = 0
+   INTEGER(i4)       :: in_jmin0 = 0
+   INTEGER(i4)       :: in_jmax0 = 0
+   INTEGER(i4)       :: in_rhoi  = 1
+   INTEGER(i4)       :: in_rhoj  = 1
+
+   !namout
+   CHARACTER(LEN=lc) :: cn_fileout  = 'coord_fine.nc'
+   !-------------------------------------------------------------------
+
+   NAMELIST /namlog/ &  !  logger namelist
+   &  cn_logfile,    &  !< logger file name
+   &  cn_verbosity,  &  !< logger verbosity
+   &  in_maxerror       !< logger maximum error
+
+   NAMELIST /namcfg/ &  !< configuration namelist
+   &  cn_varcfg,     &  !< variable configuration file
+   &  cn_dimcfg,     &  !< dimension configuration file
+   &  cn_dumcfg         !< dummy configuration file
+
+   NAMELIST /namsrc/ &  !< source/coarse grid namelist
+   &  cn_coord0 ,    &  !< coordinate file
+   &  in_perio0         !< periodicity index
+
+   NAMELIST /namvar/ &  !< variable namelist
+   &  cn_varinfo        !< list of variable and extra information about 
+                        !< interpolation, extrapolation or filter method to be used. 
+                        !< (ex: 'votemper:linear,hann,dist_weight','vosaline:cubic' ) 
+ 
+   NAMELIST /namnst/ &  !< nesting namelist
+   &  rn_lonmin0,    &  !< lower left  coarse grid longitude
+   &  rn_lonmax0,    &  !< upper right coarse grid longitude
+   &  rn_latmin0,    &  !< lower left  coarse grid latitude
+   &  rn_latmax0,    &  !< upper right coarse grid latitude
+   &  in_imin0,      &  !< i-direction lower left  point indice 
+   &  in_imax0,      &  !< i-direction upper right point indice
+   &  in_jmin0,      &  !< j-direction lower left  point indice
+   &  in_jmax0,      &  !< j-direction upper right point indice
+   &  in_rhoi,       &  !< refinement factor in i-direction
+   &  in_rhoj           !< refinement factor in j-direction
+
+   NAMELIST /namout/ &  !< output namelist
+   &  cn_fileout        !< fine grid coordinate file   
+   !-------------------------------------------------------------------
+
+   !
+   ! Initialisation
+   ! --------------
+   !
+   il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec
+
+   ! Traitement des arguments fournis
+   ! --------------------------------
+   IF( il_narg /= 1 )THEN
+      WRITE(cl_errormsg,*) ' ERROR : one argument is needed '
+      CALL fct_help(cp_myname,cl_errormsg) 
+      CALL EXIT(1)
+   ELSE
+
+      CALL GET_COMMAND_ARGUMENT(1,cl_arg) !f03 intrinsec
+      SELECT CASE (cl_arg)
+         CASE ('-v', '--version')
+
+            CALL fct_version(cp_myname)
+            CALL EXIT(0)
+
+         CASE ('-h', '--help')
+
+            CALL fct_help(cp_myname)
+            CALL EXIT(0)
+
+         CASE DEFAULT
+
+            cl_namelist=cl_arg
+
+            ! read namelist
+            INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist)
+            IF( ll_exist )THEN
+
+               il_fileid=fct_getunit()
+
+               OPEN( il_fileid, FILE=TRIM(cl_namelist),  &
+               &                FORM='FORMATTED',        &
+               &                ACCESS='SEQUENTIAL',     &
+               &                STATUS='OLD',            &
+               &                ACTION='READ',           &
+               &                IOSTAT=il_status)
+               CALL fct_err(il_status)
+               IF( il_status /= 0 )THEN
+                  WRITE(cl_errormsg,*) " ERROR : error opening "//TRIM(cl_namelist)
+                  CALL fct_help(cp_myname,cl_errormsg) 
+                  CALL EXIT(1)
+               ENDIF
+
+               READ( il_fileid, NML = namlog )
+ 
+               ! define logger file
+               CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror)
+               CALL logger_header()
+
+               READ( il_fileid, NML = namcfg )
+               ! get variable extra information on configuration file
+               CALL var_def_extra(TRIM(cn_varcfg))
+
+               ! get dimension allowed
+               CALL dim_def_extra(TRIM(cn_dimcfg))
+
+               ! get dummy variable
+               CALL var_get_dummy(TRIM(cn_dumcfg))
+               ! get dummy dimension
+               CALL dim_get_dummy(TRIM(cn_dumcfg))
+               ! get dummy attribute
+               CALL att_get_dummy(TRIM(cn_dumcfg))
+
+               READ( il_fileid, NML = namsrc )
+               READ( il_fileid, NML = namvar )
+               ! add user change in extra information
+               CALL var_chg_extra( cn_varinfo )
+
+               READ( il_fileid, NML = namnst )
+               READ( il_fileid, NML = namout )
+
+               CLOSE( il_fileid, IOSTAT=il_status )
+               CALL fct_err(il_status)
+               IF( il_status /= 0 )THEN
+                  CALL logger_error("CREATE COORD: closing "//TRIM(cl_namelist))
+               ENDIF
+
+            ELSE
+
+               WRITE(cl_errormsg,*) " ERROR : can't find "//TRIM(cl_namelist)
+               CALL fct_help(cp_myname,cl_errormsg) 
+               CALL EXIT(1)
+
+            ENDIF
+
+      END SELECT
+   ENDIF
+
+   ! open files
+   IF( cn_coord0 /= '' )THEN
+      tl_file=file_init(TRIM(cn_coord0))
+      tl_coord0=mpp_init( tl_file, id_perio=in_perio0)
+      ! clean
+      CALL file_clean(tl_file)
+      CALL grid_get_info(tl_coord0)
+   ELSE
+      CALL logger_fatal("CREATE COORD: no coarse grid coordinate found. "//&
+      &     "check namelist")      
+   ENDIF
+
+   ! check
+   ! check output file do not already exist
+   INQUIRE(FILE=TRIM(cn_fileout), EXIST=ll_exist)
+   IF( ll_exist )THEN
+      CALL logger_fatal("CREATE COORD: output file "//TRIM(cn_fileout)//&
+      &  " already exist.")
+   ENDIF
+
+   ! check nesting parameters
+   il_index(:)=0
+   IF( rn_lonmin0 >= -180. .AND. rn_lonmin0 <= 360 .AND. &
+     & rn_latmin0 >= -90.  .AND. rn_latmin0 <= 90. )THEN
+
+      il_index(:)=grid_get_closest(tl_coord0, &
+         &                         REAL(rn_lonmin0,dp), REAL(rn_latmin0,dp), &
+         &                         cd_pos='ll') 
+      il_imin0=il_index(1)
+      il_jmin0=il_index(2)
+   ELSE
+      il_imin0=in_imin0
+      il_jmin0=in_jmin0
+   ENDIF
+
+   il_index(:)=0
+   IF( rn_lonmax0 >= -180. .AND. rn_lonmax0 <= 360 .AND. &
+     & rn_latmax0 >= -90.  .AND. rn_latmax0 <= 90. )THEN
+
+      il_index(:)=grid_get_closest(tl_coord0, &
+         &                         REAL(rn_lonmax0,dp), REAL(rn_latmax0,dp), &
+         &                         cd_pos='ur') 
+      il_imax0=il_index(1)
+      il_jmax0=il_index(2)
+   ELSE
+      il_imax0=in_imax0
+      il_jmax0=in_jmax0
+   ENDIF
+
+   ! forced indices for east west cyclic domain
+   IF( rn_lonmin0 == rn_lonmax0 .AND. &
+     & rn_lonmin0 /= -360. )THEN
+      il_imin0=0
+      il_imax0=0
+   ENDIF
+
+   IF( il_imin0 < 0 .OR. il_imax0 < 0 .OR. il_jmin0 < 0 .OR. il_jmax0 < 0)THEN
+      CALL logger_fatal("CREATE COORD: invalid points indices."//&
+      &  " check namelist "//TRIM(cl_namelist))
+   ENDIF
+
+   il_rho(:)=1
+   IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN
+      CALL logger_error("CREATE COORD: invalid refinement factor."//&
+      &  " check namelist "//TRIM(cl_namelist))
+   ELSE
+      il_rho(jp_I)=in_rhoi
+      il_rho(jp_J)=in_rhoj      
+
+      il_offset(:,:,:)=create_coord_get_offset(il_rho(:))
+   ENDIF
+
+   ! check domain validity
+   CALL grid_check_dom(tl_coord0, il_imin0, il_imax0, il_jmin0, il_jmax0 )
+
+   ! compute domain
+   tl_dom=dom_init( tl_coord0,         &
+   &                il_imin0, il_imax0,&
+   &                il_jmin0, il_jmax0 )
+
+   ! add extra band (if need be) to compute interpolation
+   CALL dom_add_extra(tl_dom)
+
+   ! open mpp files
+   CALL iom_dom_open(tl_coord0, tl_dom)
+
+   il_nvar=tl_coord0%t_proc(1)%i_nvar
+   ALLOCATE( tl_var(il_nvar) )
+   DO ji=1,il_nvar
+
+      tl_var(ji)=iom_dom_read_var(tl_coord0, &
+      &                          TRIM(tl_coord0%t_proc(1)%t_var(ji)%c_name),&
+      &                          tl_dom)
+
+      SELECT CASE(TRIM(tl_var(ji)%c_point))
+         CASE('T')
+            jj=jp_T
+         CASE('U')
+            jj=jp_U
+         CASE('V')
+            jj=jp_V
+         CASE('F')
+            jj=jp_F
+      END SELECT
+
+      ! interpolate variables
+      CALL create_coord_interp( tl_var(ji), il_rho(:), &
+      &                         il_offset(:,:,jj) )
+
+      ! remove extraband added to domain
+      CALL dom_del_extra( tl_var(ji), tl_dom, il_rho(:), .true. )
+
+      ! filter
+      CALL filter_fill_value(tl_var(ji))      
+
+   ENDDO
+
+   ! clean
+   CALL dom_clean_extra( tl_dom )
+
+   ! close mpp files
+   CALL iom_dom_close(tl_coord0)
+
+   ! clean
+   CALL mpp_clean(tl_coord0)
+
+   ! create file
+   tl_fileout=file_init(TRIM(cn_fileout))
+
+   ! add dimension
+   ! save biggest dimension
+   tl_dim(:)=var_max_dim(tl_var(:))
+
+   DO ji=1,ip_maxdim
+      IF( tl_dim(ji)%l_use ) CALL file_add_dim(tl_fileout, tl_dim(ji))
+   ENDDO
+
+   ! add variables
+   DO ji=il_nvar,1,-1
+      CALL file_add_var(tl_fileout, tl_var(ji))
+      CALL var_clean(tl_var(ji))
+   ENDDO
+
+   ! add some attribute
+   tl_att=att_init("Created_by","SIREN create_coord")
+   CALL file_add_att(tl_fileout, tl_att)
+
+   !add source url
+   cl_url=fct_split(fct_split(cp_url,2,'$'),2,'URL:')
+   tl_att=att_init("SIREN_url",cl_url)
+   CALL file_add_att(tl_fileout, tl_att)
+
+   ! add date of creation
+   cl_date=date_print(date_now())
+   tl_att=att_init("Creation_date",cl_date)
+   CALL file_add_att(tl_fileout, tl_att)
+
+   tl_att=att_init("src_file",TRIM(fct_basename(cn_coord0)))
+   CALL file_add_att(tl_fileout, tl_att)   
+
+   tl_att=att_init("src_i_indices",(/tl_dom%i_imin,tl_dom%i_imax/))
+   CALL file_add_att(tl_fileout, tl_att)   
+   tl_att=att_init("src_j_indices",(/tl_dom%i_jmin,tl_dom%i_jmax/))
+   CALL file_add_att(tl_fileout, tl_att)
+   IF( .NOT. ALL(il_rho(:)==1) )THEN
+      tl_att=att_init("refinment_factor",(/il_rho(jp_I),il_rho(jp_J)/))
+      CALL file_add_att(tl_fileout, tl_att)
+   ENDIF
+
+   ! add attribute periodicity
+   il_attid=0
+   IF( ASSOCIATED(tl_fileout%t_att) )THEN
+      il_attid=att_get_index(tl_fileout%t_att(:),'periodicity')
+   ENDIF
+   IF( tl_dom%i_perio >= 0 .AND. il_attid == 0 )THEN
+      tl_att=att_init('periodicity',tl_dom%i_perio)
+      CALL file_add_att(tl_fileout,tl_att)
+   ENDIF
+
+   ! add attribute east west overlap
+   il_attid=0
+   IF( ASSOCIATED(tl_fileout%t_att) )THEN
+      il_attid=att_get_index(tl_fileout%t_att(:),'ew_overlap')
+   ENDIF
+   IF( il_attid == 0 )THEN
+      il_ind=var_get_index(tl_fileout%t_var(:),'longitude')
+      IF( il_ind == 0 )THEN
+         il_ind=var_get_index(tl_fileout%t_var(:),'longitude_T')
+      ENDIF
+      il_ew=grid_get_ew_overlap(tl_fileout%t_var(il_ind))
+      IF( il_ew >= 0 )THEN
+         tl_att=att_init('ew_overlap',il_ew)
+         CALL file_add_att(tl_fileout,tl_att)
+      ENDIF
+   ENDIF
+
+   ! create file
+   CALL iom_create(tl_fileout)
+
+   ! write file
+   CALL iom_write_file(tl_fileout)
+
+   ! close file
+   CALL iom_close(tl_fileout)
+
+   ! clean
+   CALL att_clean(tl_att)
+   CALL var_clean(tl_var(:))
+   DEALLOCATE( tl_var) 
+
+   CALL file_clean(tl_fileout)
+   CALL var_clean_extra()
+
+   ! close log file
+   CALL logger_footer()
+   CALL logger_close() 
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION create_coord_get_offset(id_rho) &
+         & RESULT (if_offset)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function compute offset over Arakawa grid points, 
+   !> given refinement factor.
+   !> 
+   !> @author J.Paul
+   !> @date August, 2014 - Initial Version
+   !>
+   !> @param[in] id_rho array of refinement factor
+   !> @return array of offset
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_rho
+
+      ! function
+      INTEGER(i4), DIMENSION(2,2,ip_npoint) :: if_offset
+
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! case 'T'
+      if_offset(jp_I,:,jp_T)=FLOOR(REAL(id_rho(jp_I)-1,dp)*0.5)
+      if_offset(jp_J,:,jp_T)=FLOOR(REAL(id_rho(jp_J)-1,dp)*0.5)
+      ! case 'U'
+      if_offset(jp_I,1,jp_U)=0
+      if_offset(jp_I,2,jp_U)=id_rho(jp_I)-1
+      if_offset(jp_J,:,jp_U)=FLOOR(REAL(id_rho(jp_J)-1,dp)*0.5)
+      ! case 'V'
+      if_offset(jp_I,:,jp_V)=FLOOR(REAL(id_rho(jp_I)-1,dp)*0.5)
+      if_offset(jp_J,1,jp_V)=0
+      if_offset(jp_J,2,jp_V)=id_rho(jp_J)-1
+      ! case 'F'
+      if_offset(jp_I,1,jp_F)=0
+      if_offset(jp_I,2,jp_F)=id_rho(jp_I)-1
+      if_offset(jp_J,1,jp_F)=0
+      if_offset(jp_J,2,jp_F)=id_rho(jp_J)-1
+
+   END FUNCTION create_coord_get_offset
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE create_coord_interp(td_var, id_rho, id_offset, &
+         &                        id_iext, id_jext)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine interpolate variable, given refinment factor.
+   !> 
+   !> @details 
+   !>  Optionaly, you could specify number of points 
+   !>    to be extrapolated in i- and j-direction.<br/>
+   !>  variable mask is first computed (using _FillValue) and interpolated.<br/>
+   !>  variable is then extrapolated, and interpolated.<br/> 
+   !>  Finally interpolated mask is applied on refined variable.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable strcuture 
+   !> @param[in] id_rho    array of refinement factor
+   !> @param[in] id_offset offset between fine grid and coarse grid
+   !> @param[in] id_iext   number of points to be extrapolated in i-direction
+   !> @param[in] id_jext   number of points to be extrapolated in j-direction
+   !>
+   !> @todo check if mask is really needed
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
+      INTEGER(i4), DIMENSION(:)  , INTENT(IN   ) :: id_rho
+      INTEGER(i4), DIMENSION(:,:), INTENT(IN)    :: id_offset
+      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_iext
+      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_jext
+
+      ! local variable
+      TYPE(TVAR)  :: tl_mask
+
+      INTEGER(i1), DIMENSION(:,:,:,:), ALLOCATABLE :: bl_mask
+
+      INTEGER(i4) :: il_iext
+      INTEGER(i4) :: il_jext
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( ANY(SHAPE(id_offset(:,:)) /= 2) )THEN
+         CALL logger_error("CREATE COORD INTERP: invalid dimension of "//&
+         &                 "offset array")
+      ENDIF
+
+      !WARNING: two extrabands are required for cubic interpolation
+      il_iext=2
+      IF( PRESENT(id_iext) ) il_iext=id_iext
+
+      il_jext=2
+      IF( PRESENT(id_jext) ) il_jext=id_jext
+      
+      IF( il_iext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
+         CALL logger_warn("CREATE COORD INTERP: at least extrapolation "//&
+         &  "on two points are required with cubic interpolation ")
+         il_iext=2
+      ENDIF
+
+      IF( il_jext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
+         CALL logger_warn("CREATE COORD INTERP: at least extrapolation "//&
+         &  "on two points are required with cubic interpolation ")
+         il_jext=2
+      ENDIF
+
+      IF( ANY(id_rho(:)>1) )THEN
+         ! work on mask
+         ! create mask
+         ALLOCATE(bl_mask(td_var%t_dim(1)%i_len, &
+         &                td_var%t_dim(2)%i_len, &
+         &                td_var%t_dim(3)%i_len, &
+         &                td_var%t_dim(4)%i_len) )
+
+         bl_mask(:,:,:,:)=1
+         WHERE(td_var%d_value(:,:,:,:)==td_var%d_fill) bl_mask(:,:,:,:)=0      
+
+         SELECT CASE(TRIM(td_var%c_point))
+         CASE DEFAULT ! 'T'
+            tl_mask=var_init('tmask',bl_mask(:,:,:,:),td_dim=td_var%t_dim(:),&
+            &                id_ew=td_var%i_ew )
+         CASE('U')
+            tl_mask=var_init('umask',bl_mask(:,:,:,:),td_dim=td_var%t_dim(:),&
+            &                id_ew=td_var%i_ew )
+         CASE('V')
+            tl_mask=var_init('vmask',bl_mask(:,:,:,:),td_dim=td_var%t_dim(:),&
+            &                id_ew=td_var%i_ew )
+         CASE('F')
+            tl_mask=var_init('fmask',bl_mask(:,:,:,:),td_dim=td_var%t_dim(:),&
+            &                id_ew=td_var%i_ew )
+         END SELECT         
+
+         DEALLOCATE(bl_mask)
+
+         ! interpolate mask
+         CALL interp_fill_value( tl_mask, id_rho(:), &
+         &                       id_offset=id_offset(:,:) )
+
+         ! work on variable
+         ! add extraband
+         CALL extrap_add_extrabands(td_var, il_iext, il_jext)
+
+         ! extrapolate variable
+         CALL extrap_fill_value( td_var )
+
+         ! interpolate variable
+         CALL interp_fill_value( td_var, id_rho(:), &
+         &                       id_offset=id_offset(:,:))
+
+         ! remove extraband
+         CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J))
+
+         ! keep original mask 
+         WHERE( tl_mask%d_value(:,:,:,:) == 0 )
+            td_var%d_value(:,:,:,:)=td_var%d_fill
+         END WHERE
+      ENDIF
+
+      ! clean variable structure
+      CALL var_clean(tl_mask)
+
+   END SUBROUTINE create_coord_interp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END PROGRAM create_coord
Index: /utils/tools_ticket2413/SIREN/src/create_layout.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/create_layout.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/create_layout.f90	(revision 12863)
@@ -0,0 +1,351 @@
+!----------------------------------------------------------------------
+! MERCATOR OCEAN, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @file
+!> @brief 
+!> This program creates/computes the domain layout for you configuration.
+!>
+!> @details
+!> @section sec1 method
+!>
+!> Domain layout is computed, with domain dimension, overlap between subdomain,
+!> and the number of processors available or following i and j-direction.
+!> Then the number of sea/land processors is compute with mask.
+!>
+!> The optimized domain layout is assumed to be the domain layout, with the the most land 
+!> processors removed. If no land processor could be removed, it assumed to be the domain layout
+!> with the most sea processors.
+!>
+!> @section sec2 how to
+!> USAGE: create_layout create_layout.nam [-v] [-h]<br/>
+!>    - positional arguments:<br/>
+!>       - create_layout.nam<br/>
+!>          namelist of create_layout
+!>          @note
+!>             a template of the namelist could be created running (in templates directory):
+!>             @code{.sh}
+!>                python create_templates.py create_layout
+!>             @endcode
+!>
+!>    - optional arguments:<br/>
+!>       - -h, --help<br/>
+!>          show this help message (and exit)<br/>
+!>       - -v, --version<br/>
+!>          show Siren's version   (and exit)
+!>
+!> @section sec_layout create_layout.nam
+!>    create_layout.nam contains 4 namelists:<br/>
+!>       - **namlog** to set logger parameters
+!>       - **namcfg** to set configuration file parameters
+!>       - **namvar** to set variable parameters
+!>       - **namout** to set output parameters
+!>
+!>    here after, each sub-namelist parameters is detailed.
+!>    @note 
+!>       default values are specified between brackets
+!>
+!> @subsection sublog namlog
+!>    the logger sub-namelist parameters are :
+!>
+!>    - **cn_logfile** [@a create_layout.log]<br/>
+!>       logger filename
+!>
+!>    - **cn_verbosity** [@a warning]<br/>
+!>       verbosity level, choose between :
+!>          - trace
+!>          - debug
+!>          - info
+!>          - warning
+!>          - error
+!>          - fatal
+!>          - none
+!>
+!>    - **in_maxerror** [@a 5]<br/> 
+!>       maximum number of error allowed
+!>
+!> @subsection subcfg namcfg
+!>    the configuration sub-namelist parameters are :
+!>
+!>    - **cn_varcfg** [@a ./cfg/variable.cfg]<br/>
+!>       path to the variable configuration file.<br/>
+!>       the variable configuration file defines standard name, 
+!>       default interpolation method, axis,... 
+!>       to be used for some known variables.<br/> 
+!>
+!>    - **cn_dimcfg** [@a ./cfg/dimension.cfg]<br/> 
+!>       path to the dimension configuration file.<br/> 
+!>       the dimension configuration file defines dimensions allowed.<br/> 
+!>
+!>    - **cn_dumcfg** [@a ./cfg/dummy.cfg]<br/> 
+!>       path to the useless (dummy) configuration file.<br/>
+!>       the dummy configuration file defines useless 
+!>       dimension or variable. these dimension(s) or variable(s) will not be
+!>       processed.<br/>
+!>
+!> @subsection subvar namvar 
+!>    the variable sub-namelist parameters are :
+!>
+!>    - **cn_varfile** [@a ]<br/> 
+!>       list of variable, and associated file 
+!>       @warning 
+!>          variable name must be __Bathymetry__ here.
+!>
+!>    - **cn_varfile** [@a ]<br/>:
+!>       list of variable, and associated file.<br/> 
+!>       *cn_varfile* is the path and filename of the file where find
+!>       variable to be used as mask grid.<br/>
+!>
+!>       Examples: 
+!>          - 'Bathymetry:bathy_meter.nc'
+!>
+!> @subsection subout namout 
+!>    the output sub-namelist parameters are :
+!>
+!>    - **in_niproc** [@a 1]<br/>:
+!>       number of processor in i-direction
+!>    - **in_njproc** [@a 1]<br/>:
+!>       number of processor in j-direction
+!>    - **in_nproc** [@a 1]<br/>:
+!>       total number of processor to be used
+!>
+!>    @note
+!>       - if *in_niproc*, and *in_njproc* are provided : the program only look for land
+!>         processor to be removed
+!>       - if *in_nproc* is provided : the program compute each possible domain layout, 
+!>         and save the one with the most land processor to be removed 
+!>       - with no information about number of processors, the program
+!>         assume to use only one processor
+!>
+!> <hr>
+!> @author
+!> J.Paul
+!>
+!> @date January, 2019 - Initial Version
+!> @date Ocober, 2019
+!> - add help and version optional arguments
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+PROGRAM create_layout
+
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+   USE date                            ! date manager
+   USE math                            ! 
+   USE att                             ! attribute manager
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+   USE file                            ! file manager
+   USE multi                           ! multi file manager
+   USE iom                             ! I/O manager
+   USE dom                             ! domain manager
+   USE grid                            ! grid manager
+   USE mpp                             ! MPP manager
+   USE iom_mpp                         ! MPP I/O manager
+
+   IMPLICIT NONE
+
+   ! parameters
+   CHARACTER(LEN=lc), PARAMETER  :: cp_myname = "create_layout"
+
+   ! local variable
+   CHARACTER(LEN=lc)                       :: cl_arg
+   CHARACTER(LEN=lc)                       :: cl_namelist
+   CHARACTER(LEN=lc)                       :: cl_var
+   CHARACTER(LEN=lc)                       :: cl_errormsg
+
+
+   INTEGER(i4)                             :: il_narg
+   INTEGER(i4)                             :: il_status
+   INTEGER(i4)                             :: il_fileid
+
+   LOGICAL                                 :: ll_exist
+
+   TYPE(TVAR)                              :: tl_var
+
+   TYPE(TFILE)                             :: tl_file
+
+   TYPE(TMPP)                              :: tl_mpp
+   TYPE(TMPP)                              :: tl_mppout
+
+   TYPE(TMULTI)                            :: tl_multi
+   
+   ! namelist variable
+   ! namlog
+   CHARACTER(LEN=lc)                       :: cn_logfile = 'create_layout.log' 
+   CHARACTER(LEN=lc)                       :: cn_verbosity = 'warning' 
+   INTEGER(i4)                             :: in_maxerror = 5
+
+   ! namcfg
+   CHARACTER(LEN=lc)                       :: cn_varcfg = './cfg/variable.cfg' 
+   CHARACTER(LEN=lc)                       :: cn_dimcfg = './cfg/dimension.cfg'
+   CHARACTER(LEN=lc)                       :: cn_dumcfg = './cfg/dummy.cfg'
+
+   ! namvar
+   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = ''
+
+   ! namout
+   INTEGER(i4)                             :: in_niproc = 0
+   INTEGER(i4)                             :: in_njproc = 0 
+   INTEGER(i4)                             :: in_nproc  = 0
+   !-------------------------------------------------------------------
+
+   NAMELIST /namlog/ &  !< logger namelist
+   &  cn_logfile,    &  !< log file
+   &  cn_verbosity,  &  !< log verbosity
+   &  in_maxerror       !< logger maximum error
+
+   NAMELIST /namcfg/ &  !< configuration namelist
+   &  cn_varcfg,     &  !< variable configuration file
+   &  cn_dimcfg,     &  !< dimension configuration file
+   &  cn_dumcfg         !< dummy configuration file
+
+   NAMELIST /namvar/ &  !< source grid namelist
+   &  cn_varfile        !< input file and mask variable   
+
+   NAMELIST /namout/ &  !< output namelist
+   &  in_niproc,     &
+   &  in_njproc,     &
+   &  in_nproc
+   !-------------------------------------------------------------------   
+
+   !
+   ! Initialisation
+   ! --------------
+   !
+   il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec
+
+   ! Traitement des arguments fournis
+   ! --------------------------------
+   IF( il_narg /= 1 )THEN
+      WRITE(cl_errormsg,*) ' ERROR : one argument is needed '
+      CALL fct_help(cp_myname,cl_errormsg) 
+      CALL EXIT(1)
+   ELSE
+
+      CALL GET_COMMAND_ARGUMENT(1,cl_arg) !f03 intrinsec
+      SELECT CASE (cl_arg)
+         CASE ('-v', '--version')
+
+            CALL fct_version(cp_myname)
+            CALL EXIT(0)
+
+         CASE ('-h', '--help')
+
+            CALL fct_help(cp_myname)
+            CALL EXIT(0)
+
+         CASE DEFAULT
+
+            cl_namelist=cl_arg
+
+            ! read namelist
+            INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist)
+            IF( ll_exist )THEN
+
+               il_fileid=fct_getunit()
+
+               OPEN( il_fileid, FILE=TRIM(cl_namelist),  &
+               &                FORM='FORMATTED',        &
+               &                ACCESS='SEQUENTIAL',     &
+               &                STATUS='OLD',            &
+               &                ACTION='READ',           &
+               &                IOSTAT=il_status)
+               CALL fct_err(il_status)
+               IF( il_status /= 0 )THEN
+                  WRITE(cl_errormsg,*) " ERROR : error opening "//TRIM(cl_namelist)
+                  CALL fct_help(cp_myname,cl_errormsg) 
+                  CALL EXIT(1)
+               ENDIF
+
+               READ( il_fileid, NML = namlog )
+               ! define log file
+               CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror)
+               CALL logger_header()
+
+               READ( il_fileid, NML = namcfg )
+               ! get variable extra information
+               CALL var_def_extra(TRIM(cn_varcfg))
+
+               ! get dimension allowed
+               CALL dim_def_extra(TRIM(cn_dimcfg))
+
+               ! get dummy variable
+               CALL var_get_dummy(TRIM(cn_dumcfg))
+               ! get dummy dimension
+               CALL dim_get_dummy(TRIM(cn_dumcfg))
+               ! get dummy attribute
+               CALL att_get_dummy(TRIM(cn_dumcfg))
+
+               READ( il_fileid, NML = namvar  )
+
+               ! match variable with file
+               tl_multi=multi_init(cn_varfile)
+
+               READ( il_fileid, NML = namout  )
+
+               CLOSE( il_fileid, IOSTAT=il_status )
+               CALL fct_err(il_status)
+               IF( il_status /= 0 )THEN
+                  CALL logger_error("CREATE LAYOUT: closing "//TRIM(cl_namelist))
+               ENDIF
+
+            ELSE
+
+               WRITE(cl_errormsg,*) " ERROR : can't find "//TRIM(cl_namelist)
+               CALL fct_help(cp_myname,cl_errormsg) 
+               CALL EXIT(1)
+
+            ENDIF
+
+      END SELECT
+   ENDIF
+
+   IF( .NOT. ASSOCIATED(tl_multi%t_mpp) .AND. tl_multi%i_nmpp /= 1 )THEN
+      CALL logger_error("CREATE LAYOUT: no (or too much) mpp file to work on. "//&
+      &                 "check cn_varfile in namelist.")
+      CALL logger_fatal("CREATE LAYOUT: no input grid found. "//&
+      &     "check namelist")
+   ELSE
+
+      CALL multi_print(tl_multi)
+      
+      ! open file
+      tl_file=file_init(TRIM(tl_multi%t_mpp(1)%c_name))
+      tl_mpp=mpp_init( tl_file )
+      ! clean
+      CALL file_clean(tl_file)
+      !
+      CALL grid_get_info(tl_mpp)
+
+      CALL iom_mpp_open(tl_mpp)
+
+      cl_var=TRIM((tl_multi%t_mpp(1)%t_proc(1)%t_var(1)%c_name))
+      tl_var=iom_mpp_read_var(tl_mpp,cl_var)
+
+      CALL iom_mpp_close(tl_mpp)
+      ! clean structure
+      CALL mpp_clean(tl_mpp)
+
+      tl_mppout=mpp_init('layout.nc',tl_var,in_niproc, in_njproc,in_nproc)
+
+      CALL mpp_print(tl_mppout)
+
+      ! clean structure
+      CALL var_clean(tl_var)
+      CALL mpp_clean(tl_mppout)
+
+   ENDIF
+
+   ! clean
+   CALL multi_clean(tl_multi)
+
+   ! close log file
+   CALL logger_footer()
+   CALL logger_close()
+
+END PROGRAM
Index: /utils/tools_ticket2413/SIREN/src/create_meshmask.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/create_meshmask.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/create_meshmask.f90	(revision 12863)
@@ -0,0 +1,1964 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @file
+!> @brief
+!>  This program creates the NetCDF file(s) which contain(s) all the
+!>  ocean domain informations.
+!>  it also permits to create the domain_cfg.nc file (needed to run NEMO v4.0
+!>  and upper), or the mesh_mask file(s).
+!>
+!> @details
+!> @section sec1 method
+!>  bathymetry (and optionally ice shelf draft) is read on input file.<br/>
+!>  horizontal grid-point position, scale factors, and the coriolis factor 
+!>  are read in coordinates file or computed.<br/> 
+!>  vertical coordinate is defined, and the bathymetry recomputed to fit the
+!>  vertical grid.<br/>
+!>  finally the masks from the bathymetry are computed.
+!>
+!>  all the variables read and or computed, are writen in one to three file(s) depending on
+!>  output option.
+!>  @note 
+!>    the file contain depends on
+!>    the vertical coordinate used (z-coord, partial steps, s-coord)
+!>
+!> @section sec2 how to
+!> USAGE: create_meshmask create_meshmask.nam [-v] [-h]<br/>
+!>    - positional arguments:<br/>
+!>       - create_meshmask.nam<br/>
+!>          namelist of create_meshmask
+!>          @note
+!>             a template of the namelist could be created running (in templates directory):
+!>             @code{.sh}
+!>                python create_templates.py create_meshmask
+!>             @endcode
+!>
+!>    - optional arguments:<br/>
+!>       - -h, --help<br/>
+!>          show this help message (and exit)<br/>
+!>       - -v, --version<br/>
+!>          show Siren's version   (and exit)
+!>
+!> @section sec_meshmask create_meshmask.nam
+!>    create_meshmask.nam contains 13 sub-namelists:<br/>
+!>       - **namlog** to set logger parameters
+!>       - **namcfg** to set configuration file parameters
+!>       - **namsrc** to set source files parameters
+!>       - **namhgr** to set horizontal grid parameters
+!>       - **namzgr** to set vertical grid parameters
+!>       - **namdmin** to set minimum depth parameters
+!>       - **namzco** to set vertical coordinate parameters
+!>       - **namzps** to set partial step parameters
+!>       - **namsco** to set sigma or hybrid parameters
+!>       - **namlbc** to set lateral boundary condition parameters
+!>       - **namwd** to set wetting and drying parameters
+!>       - **namgrd** to set grid parameters
+!>       - **namout** to set output parameters
+!>
+!>    here after, each sub-namelist parameters is detailed.
+!>    @note 
+!>       default values are specified between brackets
+!>
+!> @subsection sublog namlog
+!>    the logger sub-namelist parameters are :
+!>
+!>    - **cn_logfile** [@a create_meshmask.log]<br/>
+!>       logger filename
+!>
+!>    - **cn_verbosity** [@a warning]<br/>
+!>       verbosity level, choose between :
+!>          - trace
+!>          - debug
+!>          - info
+!>          - warning
+!>          - error
+!>          - fatal
+!>          - none
+!>
+!>    - **in_maxerror** [@a 5]<br/> 
+!>       maximum number of error allowed
+!>
+!> @subsection subcfg namcfg
+!>    the configuration sub-namelist parameters are :
+!>
+!>    - **cn_varcfg** [@a ./cfg/variable.cfg]<br/>
+!>       path to the variable configuration file.<br/>
+!>       the variable configuration file defines standard name, 
+!>       default interpolation method, axis,... 
+!>       to be used for some known variables.<br/> 
+!>
+!>    - **cn_dimcfg** [@a ./cfg/dimension.cfg]<br/> 
+!>       path to the dimension configuration file.<br/> 
+!>       the dimension configuration file defines dimensions allowed.<br/> 
+!>
+!>    - **cn_dumcfg** [@a ./cfg/dummy.cfg]<br/> 
+!>       path to the useless (dummy) configuration file.<br/>
+!>       the dummy configuration file defines useless 
+!>       dimension or variable. these dimension(s) or variable(s) will not be
+!>       processed.<br/>
+!>
+!> @subsection subsrc namsrc 
+!>    the source grid sub-namelist parameters are :
+!>
+!>    - **cn_bathy** [@a ]<br/>
+!>       path to the bathymetry file
+!>    - **cn_varbathy** [@a ]<br/>
+!>       bathymetry variable name
+!>    - **cn_coord** [@a ]<br/>
+!>       path to the coordinate file (in_mshhgr=0)
+!>    - **cn_isfdep** [@a ]<br/>
+!>       iceshelf draft  (ln_isfcav=true, see namzgr)
+!>    - **cn_varisfdep** [@a isfdraft]<br/>
+!>       iceshelf draft variable name (ln_isfcav=true, see namzgr)
+!>    - **in_perio** [@a ]<br/>
+!>       NEMO periodicity
+!>    - **ln_closea**  [@a .TRUE.]<br/>
+!>       logical to fill closed sea or not
+!>
+!> @subsection subhgr namhgr
+!>    the grid sub-namelist parameters are :
+!>
+!>    - **in_mshhgr** [@a 0]<br/>
+!>       type of horizontal mesh
+!>       - 0: curvilinear coordinate on the sphere read in coordinate.nc
+!>       - 1: geographical mesh on the sphere with regular grid-spacing
+!>       - 2: f-plane with regular grid-spacing
+!>       - 3: beta-plane with regular grid-spacing
+!>       - 4: Mercator grid with T/U point at the equator
+!>       - 5: beta-plane with regular grid-spacing and rotated domain (GYRE configuration)
+!>    - **dn_ppglam0** [@a ]<br/>
+!>       longitude of first raw and column T-point (in_mshhgr = 1 or 4)
+!>    - **dn_ppgphi0** [@a ]<br/>
+!>       latitude  of first raw and column T-point (in_mshhgr = 1 or 4)
+!>    - **dn_ppe1_deg** [@a ]<br/>
+!>       zonal      grid-spacing (degrees)         (in_mshhgr = 1,2,3 or 4)
+!>    - **dn_ppe2_deg** [@a ]<br/>
+!>       meridional grid-spacing (degrees)         (in_mshhgr = 1,2,3 or 4)
+!>
+!>
+!> @subsection subzgr namzgr
+!>    the vertical grid sub-namelist parameters are :
+!>
+!>    - **ln_zco** [@a .FALSE.]<br/>
+!>       z-coordinate - full steps
+!>    - **ln_zps** [@a .FALSE.]<br/>
+!>       z-coordinate - partial steps
+!>    - **ln_sco** [@a .FALSE.]<br/>
+!>       s- or hybrid z-s-coordinate
+!>    - **ln_isfcav** [@a .FALSE.]<br/>
+!>       ice shelf cavities
+!>    - **ln_iscpl** [@a .FALSE.]<br/>
+!>       coupling with ice sheet
+!>    - **ln_wd** [@a .FALSE.]<br/>
+!>       Wetting/drying activation
+!>    - **in_nlevel** [@a 75]<br/>
+!>       number of vertical level
+!>
+!> @subsection subdmin namdmin
+!>    the minimum depth sub-namelist parameters are :
+!>
+!>    - **dn_hmin** [@a ]<br/>
+!>       minimum ocean depth (>0) or minimum number of ocean levels (<0)
+!>    - **dn_isfhmin** [@a ]<br/>
+!>       threshold to discriminate grounded ice to floating ice
+!>
+!> @subsection subzco namzco
+!>    the vertical coordinate sub-namelist parameters are :
+!>
+!>    - **dn_pp_to_be_computed** [@a 0]<br/>
+!>
+!>    - **dn_ppsur** [@a -3958.951371276829]<br/>
+!>       coefficient to compute vertical grid
+!>
+!>    - **dn_ppa0** [@a 103.953009600000]<br/>
+!>       coefficient to compute vertical grid
+!>
+!>    - **dn_ppa1** [@a 2.415951269000]<br/>
+!>       coefficient to compute vertical grid
+!>
+!>    - **dn_ppkth** [@a 15.351013700000]<br/>
+!>       coefficient to compute vertical grid
+!>
+!>    - **dn_ppacr** [@a 7.000000000000]<br/>
+!>       coefficient to compute vertical grid
+!>
+!>    - **dn_ppdzmin** [@a 6.]<br/>
+!>       minimum vertical spacing
+!>
+!>    - **dn_pphmax** [@a 5750.]<br/>
+!>       maximum depth
+!>
+!>    - @b ln_dbletanh [@a .TRUE.]<br/>
+!>       use double tanh to compute vartical grid
+!>
+!>    - **dn_ppa2** [@a 100.760928500000]<br/>
+!>       double tanh function parameter
+!>
+!>    - **dn_ppkth2** [@a 48.029893720000]<br/>
+!>       double tanh function parameter
+!>
+!>    - **dn_ppacr2** [@a 13.000000000000]<br/>
+!>       double tanh function parameter
+!>
+!>     @note 
+!>       If *dn_ppa1*, *dn_ppa0* and *dn_ppsur* are undefined,
+!>       NEMO will compute them from *dn_ppdzmin, dn_pphmax, dn_ppkth, dn_ppacr*
+!>
+!>    @warning
+!>       this namelist is also needed to define partial steps, sigma or hybrid coordinate.
+!>
+!> @subsection subzps namzps
+!>    the partial step sub-namelist parameters are :
+!>
+!>    - **dn_e3zps_min** [@a 25.]<br/>
+!>       minimum thickness of partial step level (meters)
+!>    - **dn_e3zps_rat** [@a 0.2]<br/>
+!>       minimum thickness ratio of partial step level
+!>
+!>
+!> @subsection subsco namsco
+!>    the sigma or hybrid sub-namelist parameters are :
+!>
+!>    - **ln_s_sh94** [@a .FALSE.]<br/>
+!>       use hybrid s-sig Song and Haidvogel 1994 stretching function fssig1
+!>    - **ln_s_sf12** [@a .FALSE.]<br/>
+!>       use hybrid s-z-sig Siddorn and Furner 2012 stretching function fgamma
+!>    - **dn_sbot_min** [@a ]<br/>
+!>       minimum depth of s-bottom surface (>0) (m)
+!>    - **dn_sbot_max** [@a ]<br/>
+!>       maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+!>    - **dn_hc** [@a ]<br/>
+!>       Critical depth for transition from sigma to stretched coordinates
+!>    <br/> <br/>
+!>    Song and Haidvogel 1994 stretching additional parameters
+!>    - **dn_rmax** [@a ]<br/>
+!>       maximum cut-off r-value allowed (0<dn_rmax<1)
+!>    - **dn_theta** [@a ]<br/>
+!>       surface control parameter (0<=dn_theta<=20)
+!>    - **dn_thetb** [@a ]<br/>
+!>       bottom control parameter  (0<=dn_thetb<= 1)
+!>    - **dn_bb** [@a ]<br/>
+!>       stretching parameter ( dn_bb=0; top only, dn_bb =1; top and bottom)
+!>    <br/> <br/>
+!>    Siddorn and Furner stretching additional parameters
+!>    - **ln_sigcrit** [@a .FALSE.]<br/>
+!>       switching to sigma (T) or Z (F) at H<Hc
+!>    - **dn_alpha** [@a ]<br/>
+!>       stretchin parameter ( >1 surface; <1 bottom)
+!>    - **dn_efold** [@a ]<br/>
+!>       e-fold length scale for transition region
+!>    - **dn_zs** [@a ]<br/>
+!>       Surface cell depth (Zs) (m)
+!>       <br/>
+!>       Bottom cell (Zb) (m) = H*rn_zb_a + rn_zb_b'
+!>       - **dn_zb_a** [@a ]<br/>
+!>          Bathymetry multiplier for Zb
+!>       - **dn_zb_b** [@a ]<br/>
+!>          Offset for Zb
+!>
+!> @subsection sublbc namlbc
+!>    the lateral boundary condition sub-namelist parameters are :
+!>
+!>    - **rn_shlat** [@a 2.]<br/>
+!>       lateral boundary conditions at the coast (modify fmask)
+!>       -     shlat = 0 : free slip
+!>       - 0 < shlat < 2 : partial slip 
+!>       -     shlat = 2 : no slip
+!>       -     shlat > 2 : strong slip
+!>
+!>    for more information see Boundary Condition at the Coast 
+!>    in [NEMO documentation](https://forge.ipsl.jussieu.fr/nemo/chrome/site/doc/NEMO/manual/pdf/NEMO_manual.pdf)
+!>
+!> @subsection subwd namwd
+!>    the wetting and drying sub-namelist parameters are :
+!>
+!>    - **dn_wdmin1** [@a ]<br/>
+!>       minimum water depth on dried cells
+!>    - **dn_wdmin2** [@a ]<br/>
+!>       tolerrance of minimum water depth on dried cells
+!>    - **dn_wdld** [@a ]<br/>
+!>       land elevation below which wetting/drying
+!>
+!> @subsection subgrd namgrd
+!>    the grid sub-namelist parameters are :
+!>
+!>    - **in_cfg** [@a 0]<br/>
+!>       inverse resolution of the configuration (1/4° => 4)
+!>    - **ln_bench** [@a .FALSE.]<br/>
+!>       GYRE (in_mshhgr = 5 ) used as Benchmark.<br/>
+!>       => forced the resolution to be about 100 km
+!>    - **ln_c1d** [@a .FALSE.]<br/>
+!>       use configuration 1D
+!>    - **ln_e3_dep** [@a .FALSE.]<br/>
+!>       vertical scale factors =T: e3.=dk[depth] =F: old definition
+!>
+!> @subsection subout namout
+!>    the output sub-namelist parameters are :
+!>
+!>    - **cn_domcfg** [@a domain_cfg.nc]<br/>
+!>       output file name
+!>    - **in_msh** [@a 0]<br/>
+!>       number of output file and contain (0-9)
+!>    - **in_nproc** [@a 1]<br/>
+!>       number of processor to be used
+!>    - **in_niproc** [@a 1]<br/>
+!>       i-direction number of processor
+!>    - **in_njproc** [@a 1]<br/>
+!>       j-direction numebr of processor
+!>
+!>       - if niproc, and njproc are provided : the program only look for land
+!>         processor to be removed
+!>       - if nproc is provided : the program compute each possible domain layout, 
+!>         and save the one with the most land processor to be removed 
+!>       - with no information about number of processors, the program
+!>         assume to use only one processor
+!>
+!>    @note
+!>        - if         in_msh = 0  : write '**domain_cfg.nc**' file.
+!>        - if MOD(in_msh, 3) = 1  : write '<b>mesh_mask.nc</b>' file.
+!>        - if MOD(in_msh, 3) = 2  : write '<b>mesh.nc</b>' and '<b>mask.nc</b>' files.
+!>        - if MOD(in_msh, 3) = 0  : write '<b>mesh_hgr.nc</b>', '<b>mesh_zgr.nc</b>' and '<b>mask.nc</b>' files.<br/>
+!>       For huge size domain, use option 2 or 3 depending on your vertical coordinate.<br/>
+!>
+!>    @note
+!>        - if 0 < in_msh <= 3: write full 3D arrays for e3[tuvw] and gdep[tuvw]
+!>        - if 3 < in_msh <= 6: write full 3D arrays for e3[tuvw] and 2D arrays 
+!>                            corresponding to the depth of the bottom t- and w-points
+!>        - if 6 < in_msh <= 9: write 2D arrays corresponding to the depth and the
+!>                            thickness (e3[tw]_ps) of the bottom points
+!>
+!> <hr>
+!> @author J.Paul
+!>
+!> @date September, 2015 - Initial Version (based on domhgr.F90, domzgr.F90, domwri.F90)
+!> @date October, 2016
+!> - update from trunk (revision 6961): add wetting and drying, ice sheet coupling..
+!> @date October, 2016
+!> - dimension to be used select from configuration file
+!> - do not use anymore special case for ORCA grid
+!> - allow to write domain_cfg file
+!> @date November, 2016
+!> - choose vertical scale factors (e3.=dk[depth] or old definition)
+!> @date January, 2019
+!> - add url path to global attributes of output file(s)
+!> @date February, 2019
+!> - rename sub namelist namin to namsrc
+!> @date Ocober, 2019
+!> - add help and version optional arguments
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+PROGRAM create_meshmask
+
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+   USE phycst                          ! physical constant
+   USE logger                          ! log file manager
+   USE date                            ! date manager
+   USE fct                             ! basic useful function
+   USE att                             ! attribute manager
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+   USE mpp                             ! MPP manager
+   USE iom_mpp                         ! I/O MPP manager
+   USE lbc                             ! lateral boundary conditions
+   USE grid
+   USE grid_hgr
+   USE grid_zgr
+
+   IMPLICIT NONE
+
+   ! parameters
+   CHARACTER(LEN=lc), PARAMETER  :: cp_myname = "create_meshmask"
+
+   ! local variable
+   CHARACTER(LEN=lc)                              :: cl_arg
+   CHARACTER(LEN=lc)                              :: cl_namelist
+   CHARACTER(LEN=lc)                              :: cl_date
+   CHARACTER(LEN=lc)                              :: cl_url
+   CHARACTER(LEN=lc)                              :: cl_errormsg
+
+   INTEGER(i1), DIMENSION(:)        , ALLOCATABLE :: bl_tmp
+
+   INTEGER(i4)                                    :: il_narg
+   INTEGER(i4)                                    :: il_status
+   INTEGER(i4)                                    :: il_fileid
+   INTEGER(i4)                                    :: il_attid
+   INTEGER(i4)                                    :: il_ew
+   INTEGER(i4)                                    :: jpi
+   INTEGER(i4)                                    :: jpj
+   INTEGER(i4)                                    :: jpk
+   INTEGER(i4), DIMENSION(:)        , ALLOCATABLE :: il_tmp
+   INTEGER(i4), DIMENSION(:,:)      , ALLOCATABLE :: il_mask
+
+   LOGICAL                                        :: ll_exist
+   LOGICAL                                        :: ll_domcfg
+
+   REAL(dp)   , DIMENSION(:,:)      , ALLOCATABLE :: dl_tmp2D
+   REAL(dp)   , DIMENSION(:,:,:)    , ALLOCATABLE :: dl_tmp3D
+
+   TYPE(TATT)                                     :: tl_att
+   TYPE(TATT) , DIMENSION(:)        , ALLOCATABLE :: tl_gatt
+
+   TYPE(TDIM)                                     :: tl_dim
+   
+   TYPE(TVAR)                                     :: tl_bathy
+   TYPE(TVAR)                                     :: tl_risfdep
+   TYPE(TVAR)                                     :: tl_misf
+   TYPE(TVAR)                                     :: tl_gdepu
+   TYPE(TVAR)                                     :: tl_gdepv
+   TYPE(TVAR)                                     :: tl_hdept
+   TYPE(TVAR)                                     :: tl_hdepw
+   TYPE(TVAR)                                     :: tl_scalar
+
+   TYPE(TNAMH)                                    :: tl_namh
+   TYPE(TNAMZ)                                    :: tl_namz
+
+   TYPE(TMPP)                                     :: tl_mpp
+   TYPE(TMPP) , TARGET                            :: tl_mppout0
+   TYPE(TMPP) , TARGET                            :: tl_mppout1
+   TYPE(TMPP) , TARGET                            :: tl_mppout2
+   TYPE(TMPP) , POINTER                           :: tl_mppmsk
+   TYPE(TMPP) , POINTER                           :: tl_mpphgr
+   TYPE(TMPP) , POINTER                           :: tl_mppzgr
+
+   ! parameter
+   INTEGER(i4) , PARAMETER :: ip_maxatt = 40
+
+   ! loop indices
+   INTEGER(i4) :: ji
+   INTEGER(i4) :: jj
+   INTEGER(i4) :: jk
+
+   INTEGER(i4) :: ik
+
+   ! namelist variable
+   ! namlog
+   CHARACTER(LEN=lc) :: cn_logfile  = 'create_meshmask.log' 
+   CHARACTER(LEN=lc) :: cn_verbosity= 'warning' 
+   INTEGER(i4)       :: in_maxerror = 5
+
+   ! namcfg
+   CHARACTER(LEN=lc) :: cn_varcfg   = './cfg/variable.cfg' 
+   CHARACTER(LEN=lc) :: cn_dimcfg   = './cfg/dimension.cfg'
+   CHARACTER(LEN=lc) :: cn_dumcfg   = './cfg/dummy.cfg'
+
+   ! namsrc
+   CHARACTER(LEN=lc) :: cn_bathy    = ''
+   CHARACTER(LEN=lc) :: cn_varbathy = ''
+   CHARACTER(LEN=lc) :: cn_coord    = ''
+   CHARACTER(LEN=lc) :: cn_isfdep   = ''
+   CHARACTER(LEN=lc) :: cn_varisfdep= 'isfdraft'
+   INTEGER(i4)       :: in_perio    = -1
+   LOGICAL           :: ln_closea   = .TRUE.
+
+   ! namzgr
+   LOGICAL           :: ln_zco      = .FALSE.
+   LOGICAL           :: ln_zps      = .FALSE.
+   LOGICAL           :: ln_sco      = .FALSE.
+   LOGICAL           :: ln_isfcav   = .FALSE.
+   LOGICAL           :: ln_iscpl    = .FALSE.
+   LOGICAL           :: ln_wd       = .FALSE.
+   INTEGER(i4)       :: in_nlevel   = 75
+
+   ! namlbc
+   REAL(sp)          :: rn_shlat    = 2.
+
+   ! namout
+   CHARACTER(LEN=lc) :: cn_domcfg   = 'domain_cfg.nc'
+   INTEGER(i4)       :: in_msh      = 0 
+   CHARACTER(LEN=lc) :: cn_type     = 'cdf'
+   INTEGER(i4)       :: in_nproc    = 0
+   INTEGER(i4)       :: in_niproc   = 0
+   INTEGER(i4)       :: in_njproc   = 0
+   !-------------------------------------------------------------------
+   NAMELIST /namlog/ &  !< logger namelist
+   &  cn_logfile,    &  !< log file
+   &  cn_verbosity,  &  !< log verbosity
+   &  in_maxerror       !< logger maximum error
+
+   NAMELIST /namcfg/ &  !< configuration namelist
+   &  cn_varcfg,     &  !< variable configuration file
+   &  cn_dimcfg,     &  !< dimension configuration file
+   &  cn_dumcfg         !< dummy configuration file
+
+   NAMELIST /namsrc/ &  !< source namelist
+   &  cn_bathy,      &  !< Bathymetry file
+   &  cn_varbathy,   &  !< Bathymetry variable name
+   &  cn_coord,      &  !< Coordinate file (in_mshhgr=0)
+   &  cn_isfdep,     &  !< Iceshelf draft  (ln_isfcav=true)
+   &  cn_varisfdep,  &  !< Iceshelf draft variable name (ln_isfcav=true)
+   &  in_perio,      &  !< NEMO periodicity
+   &  ln_closea
+
+   NAMELIST /namzgr/ &
+   &  ln_zco,        &  !< z-coordinate
+   &  ln_zps,        &  !< z-coordinate with partial steps
+   &  ln_sco,        &  !< s-coordinate
+   &  ln_isfcav,     &  !< presence of ISF
+   &  ln_iscpl,      &  !< coupling with ice sheet
+   &  ln_wd,         &  !< Wetting/drying activation
+   &  in_nlevel
+
+   NAMELIST /namlbc/  &
+   &  rn_shlat          !< lateral momentum boundary condition
+
+   NAMELIST /namout/ &  !< output namlist
+   &  cn_domcfg,     &  !< output file name
+   &  in_msh,        &  !< number of output file (1,2,3)
+   &  in_nproc,      &  !< number of processor to be used
+   &  in_niproc,     &  !< i-direction number of processor
+   &  in_njproc         !< j-direction numebr of processor
+   !-------------------------------------------------------------------   
+
+   !
+   ! Initialisation
+   ! --------------
+   !
+   il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec
+
+   ! Traitement des arguments fournis
+   ! --------------------------------
+   IF( il_narg /= 1 )THEN
+      WRITE(cl_errormsg,*) ' ERROR : one argument is needed '
+      CALL fct_help(cp_myname,cl_errormsg) 
+      CALL EXIT(1)
+   ELSE
+
+      CALL GET_COMMAND_ARGUMENT(1,cl_arg) !f03 intrinsec
+      SELECT CASE (cl_arg)
+         CASE ('-v', '--version')
+
+            CALL fct_version(cp_myname)
+            CALL EXIT(0)
+
+         CASE ('-h', '--help')
+
+            CALL fct_help(cp_myname)
+            CALL EXIT(0)
+
+         CASE DEFAULT
+
+            cl_namelist=cl_arg
+
+            ! read namelist
+            INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist)
+            IF( ll_exist )THEN
+
+               il_fileid=fct_getunit()
+
+               OPEN( il_fileid, FILE=TRIM(cl_namelist), &
+               &                FORM='FORMATTED',       &
+               &                ACCESS='SEQUENTIAL',    &
+               &                STATUS='OLD',           &
+               &                ACTION='READ',          &
+               &                IOSTAT=il_status)
+               CALL fct_err(il_status)
+               IF( il_status /= 0 )THEN
+                  WRITE(cl_errormsg,*) " ERROR : error opening "//TRIM(cl_namelist)
+                  CALL fct_help(cp_myname,cl_errormsg) 
+                  CALL EXIT(1)
+               ENDIF
+
+               READ( il_fileid, NML = namlog )
+ 
+               ! define logger file
+               CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror)
+               CALL logger_header()
+
+               READ( il_fileid, NML = namcfg )
+               ! get variable extra information
+               CALL var_def_extra(TRIM(cn_varcfg))
+
+               ! get dimension allowed
+               CALL dim_def_extra(TRIM(cn_dimcfg))
+
+               ! get dummy variable
+               CALL var_get_dummy(TRIM(cn_dumcfg))
+               ! get dummy dimension
+               CALL dim_get_dummy(TRIM(cn_dumcfg))
+               ! get dummy attribute
+               CALL att_get_dummy(TRIM(cn_dumcfg))
+
+               READ( il_fileid, NML = namsrc )
+               READ( il_fileid, NML = namzgr )
+               READ( il_fileid, NML = namlbc )
+
+               READ( il_fileid, NML = namout  )
+
+               CLOSE( il_fileid, IOSTAT=il_status )
+               CALL fct_err(il_status)
+               IF( il_status /= 0 )THEN
+                  CALL logger_error("CREATE MASK: closing "//TRIM(cl_namelist))
+               ENDIF
+
+            ELSE
+
+               WRITE(cl_errormsg,*) " ERROR : can't find "//TRIM(cl_namelist)
+               CALL fct_help(cp_myname,cl_errormsg) 
+               CALL EXIT(1)
+
+            ENDIF
+
+      END SELECT
+   ENDIF
+
+   ll_domcfg=.FALSE.
+   IF( in_msh == 0 )THEN
+      ll_domcfg=.TRUE.
+   ENDIF
+
+   ! open file
+   IF( cn_bathy /= '' )THEN
+      tl_mpp=mpp_init( file_init(TRIM(cn_bathy)), id_perio=in_perio)
+      CALL grid_get_info(tl_mpp)
+   ELSE
+      CALL logger_fatal("CREATE MESH MASK: no input bathymetry file found. "//&
+      &     "check namelist")      
+   ENDIF
+
+   ! read bathymetry
+   WRITE(*,*) 'FILE TO BE USED:',TRIM(cn_bathy)
+   CALL iom_mpp_open(tl_mpp)
+
+   ! get dimension
+   jpi=tl_mpp%t_dim(jp_I)%i_len
+   jpj=tl_mpp%t_dim(jp_J)%i_len
+   jpk=in_nlevel
+
+   WRITE(*,*) 'DIMENSION TO BE USED :',jpi,jpj,jpk
+
+   ! read variable
+   IF( TRIM(cn_varbathy) == '' )THEN
+      IF( ln_zco )THEN
+         cn_varbathy='Bathy_level'
+      ELSEIF( ln_zps .OR. ln_sco )THEN
+         IF( ln_isfcav )THEN
+            cn_varbathy='Bathymetry_isf'
+         ELSE
+            cn_varbathy='Bathymetry'
+         ENDIF
+      ENDIF
+   ENDIF
+   WRITE(*,*) 'VARIABLE READ : '//TRIM(cn_varbathy)
+   tl_bathy=iom_mpp_read_var(tl_mpp, TRIM(cn_varbathy))
+   CALL iom_mpp_close(tl_mpp)
+
+   WHERE( tl_bathy%d_value(:,:,1,1) == tl_bathy%d_fill .OR. &
+        & tl_bathy%d_value(:,:,1,1) < 0._dp )
+      tl_bathy%d_value(:,:,1,1) = 0._dp
+   END WHERE
+ 
+   IF ( ln_isfcav ) THEN
+      WRITE(*,*) 'ICESHELF DRAFT FILE TO BE USED:',TRIM(cn_isfdep)
+      WRITE(*,*) 'ICESHELF VARIABLE READ : '//TRIM(cn_varisfdep)
+      ! open Iceshelf draft
+      IF( cn_isfdep /= '' )THEN
+         tl_mpp=mpp_init( file_init(TRIM(cn_isfdep)), id_perio=in_perio)
+         CALL grid_get_info(tl_mpp)
+      ELSE
+         CALL logger_fatal("CREATE MESH MASK: no input Iceshelf draft '//&
+            &  'file found. check namelist")      
+      ENDIF
+
+      ! read Iceshelf draft
+      CALL iom_mpp_open(tl_mpp)
+      IF( ln_zps .OR. ln_sco )   THEN
+         tl_risfdep=iom_mpp_read_var(tl_mpp, cn_varisfdep)
+      ENDIF
+      CALL iom_mpp_close(tl_mpp)
+   ELSE
+      ALLOCATE(dl_tmp2D(jpi,jpj))
+      dl_tmp2D(:,:)=0._dp
+
+      tl_risfdep=var_init(cn_varisfdep, dl_tmp2D(:,:), id_type=NF90_DOUBLE)
+
+      DEALLOCATE(dl_tmp2D)
+   ENDIF
+
+   ! fill closed sea
+   IF( ln_closea )THEN
+      WRITE(*,*) "CLOSED SEA"
+      ALLOCATE( il_mask(tl_bathy%t_dim(1)%i_len, &
+      &                 tl_bathy%t_dim(2)%i_len) )
+
+      ! split domain in N sea subdomain
+      il_mask(:,:)=grid_split_domain(tl_bathy)
+
+      !  fill smallest domain
+      CALL grid_fill_small_dom( tl_bathy, il_mask(:,:) )
+
+      DEALLOCATE( il_mask )
+   ENDIF
+
+   in_perio = tl_mpp%i_perio
+   il_ew    = tl_mpp%i_ew
+
+   ! clean
+   CALL mpp_clean(tl_mpp)
+
+   ! Horizontal mesh (dom_hgr) -------------------------------------------------
+   tl_namh=grid_hgr_nam( cn_coord, in_perio, cl_namelist )
+
+   ! init Horizontal grid global variable
+   CALL grid_hgr_init(jpi,jpj,jpk,ll_domcfg)
+
+   ! compute horizontal mesh
+   WRITE(*,*) "COMPUTE HORIZONTAL MESH"
+   CALL grid_hgr_fill(tl_namh,jpi,jpj,ll_domcfg)      
+
+   ! Vertyical  mesh (dom_zgr) -------------------------------------------------
+   tl_namz=grid_zgr_nam( cn_coord, in_perio, cl_namelist )
+
+   ! init Vertical grid global variable
+   CALL grid_zgr_init(jpi,jpj,jpk,ln_sco)
+   IF( ln_zps    ) CALL grid_zgr_zps_init(jpi,jpj)
+   IF( ln_sco    ) CALL grid_zgr_sco_init(jpi,jpj) 
+
+   ! compute vertical  mesh
+   WRITE(*,*) "COMPUTE VERTICAL MESH"
+   CALL grid_zgr_fill( tl_namz,jpi,jpj,jpk, tl_bathy, tl_risfdep )
+
+   ! compute masks
+   WRITE(*,*) "COMPUTE MASK"
+   CALL create_meshmask__mask(tl_namh,jpi,jpj,jpk,ll_domcfg)
+
+   ! Maximum stiffness ratio/hydrostatic consistency
+   IF( ln_sco    ) CALL grid_zgr_sco_stiff(tl_namz,jpi,jpj,jpk)
+ 
+   ! clean
+   CALL var_clean(tl_bathy)
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! create ouptut structure 
+   IF( in_niproc == 0 .AND. &
+   &   in_njproc == 0 .AND. &
+   &   in_nproc  == 0 )THEN
+      in_niproc = 1
+      in_njproc = 1
+      in_nproc = 1
+   ENDIF
+
+   WRITE(*,*) "WRITE FILE(S)"
+   IF( ll_domcfg )THEN
+         !                                  ! ============================
+         !                                  ! create 'domain_cfg.nc' file
+         !                                  ! ============================
+         tl_mppout0=mpp_init( cn_domcfg, tg_tmask, &
+         &                    in_niproc, in_njproc, in_nproc, &
+         &                    cd_type=cn_type )
+
+         tl_mppmsk=>tl_mppout0
+         tl_mpphgr=>tl_mppout0
+         tl_mppzgr=>tl_mppout0
+
+   ELSE
+      SELECT CASE ( MOD(in_msh, 3) )
+         !                                  ! ============================
+      CASE ( 1 )                            !  create 'mesh_mask.nc' file
+         !                                  ! ============================
+         tl_mppout0=mpp_init( 'mesh_mask.nc', tg_tmask, &
+         &                    in_niproc, in_njproc, in_nproc, &
+         &                    cd_type=cn_type )
+
+         tl_mppmsk=>tl_mppout0
+         tl_mpphgr=>tl_mppout0
+         tl_mppzgr=>tl_mppout0
+         
+         !                                  ! ============================
+      CASE ( 2 )                            !  create 'mesh.nc' and 
+         !                                  !         'mask.nc' files
+         !                                  ! ============================
+         tl_mppout0=mpp_init( 'mask.nc', tg_tmask, &
+         &                    in_niproc, in_njproc, in_nproc, &
+         &                    cd_type=cn_type )
+         tl_mppout1=mpp_init( 'mesh.nc', tg_tmask, &
+         &                    in_niproc, in_njproc, in_nproc, &
+         &                    cd_type=cn_type )
+
+         tl_mppmsk=>tl_mppout0
+         tl_mpphgr=>tl_mppout1
+         tl_mppzgr=>tl_mppout1
+
+         !                                  ! ============================
+      CASE ( 0 )                            !  create 'mesh_hgr.nc'
+         !                                  !         'mesh_zgr.nc' and
+         !                                  !         'mask.nc'     files
+         !                                  ! ============================
+         tl_mppout0=mpp_init( 'mask.nc', tg_tmask, &
+         &                    in_niproc, in_njproc, in_nproc, &
+         &                    cd_type=cn_type )
+         tl_mppout1=mpp_init( 'mesh_hgr.nc', tg_tmask, &
+         &                    in_niproc, in_njproc, in_nproc, &
+         &                    cd_type=cn_type )
+         tl_mppout2=mpp_init( 'mesh_zgr.nc', tg_tmask, &
+         &                    in_niproc, in_njproc, in_nproc, &
+         &                    cd_type=cn_type )
+         !
+
+         tl_mppmsk=>tl_mppout0
+         tl_mpphgr=>tl_mppout1
+         tl_mppzgr=>tl_mppout2
+
+      END SELECT
+   ENDIF
+
+   ! add variables
+   IF( ll_domcfg )THEN
+      ALLOCATE(il_tmp(1))
+      tl_dim%l_use=.FALSE.
+
+      il_tmp(:)=jpi
+      tl_scalar=var_init('jpiglo', il_tmp(:), id_type=NF90_INT, td_dim=tl_dim)
+      CALL mpp_add_var(tl_mppmsk, tl_scalar)
+
+      il_tmp(:)=jpj
+      tl_scalar=var_init('jpjglo', il_tmp(:), id_type=NF90_INT, td_dim=tl_dim)
+      CALL mpp_add_var(tl_mppmsk, tl_scalar)
+
+      il_tmp(:)=jpk
+      tl_scalar=var_init('jpkglo', il_tmp(:), id_type=NF90_INT, td_dim=tl_dim)
+      CALL mpp_add_var(tl_mppmsk, tl_scalar)
+      
+      il_tmp(:)=tl_mppout0%i_perio
+      tl_scalar=var_init('jperio', il_tmp(:), id_type=NF90_INT, td_dim=tl_dim)
+      CALL mpp_add_var(tl_mppmsk, tl_scalar)
+
+      DEALLOCATE(il_tmp)
+      ALLOCATE(bl_tmp(1))
+
+      bl_tmp(:)=0
+      IF( ln_zco ) bl_tmp(:)=1
+      tl_scalar=var_init('ln_zco',bl_tmp(:), id_type=NF90_BYTE, td_dim=tl_dim)
+      CALL mpp_add_var(tl_mppmsk, tl_scalar)
+
+      bl_tmp(:)=0
+      IF( ln_zps ) bl_tmp(:)=1
+      tl_scalar=var_init('ln_zps',bl_tmp(:), id_type=NF90_BYTE, td_dim=tl_dim)
+      CALL mpp_add_var(tl_mppmsk, tl_scalar)
+
+      bl_tmp(:)=0
+      IF( ln_sco ) bl_tmp(:)=1
+      tl_scalar=var_init('ln_sco',bl_tmp(:), id_type=NF90_BYTE, td_dim=tl_dim)
+      CALL mpp_add_var(tl_mppmsk, tl_scalar)
+
+      bl_tmp(:)=0
+      IF( ln_isfcav ) bl_tmp(:)=1
+      tl_scalar=var_init('ln_isfcav',bl_tmp(:), id_type=NF90_BYTE, td_dim=tl_dim)
+      CALL mpp_add_var(tl_mppmsk, tl_scalar)
+
+      DEALLOCATE(bl_tmp)
+      CALL var_clean(tl_scalar)
+   ENDIF
+
+   !!! mask (msk)
+   !!!----------------------
+   IF( .NOT. ll_domcfg )THEN
+      ! tmask
+      CALL mpp_add_var(tl_mppmsk, tg_tmask)
+      CALL var_clean(tg_tmask)
+      ! umask
+      CALL mpp_add_var(tl_mppmsk, tg_umask)
+      CALL var_clean(tg_umask)
+      ! vmask
+      CALL mpp_add_var(tl_mppmsk, tg_vmask)
+      CALL var_clean(tg_vmask)
+      ! fmask
+      CALL mpp_add_var(tl_mppmsk, tg_fmask)
+      CALL var_clean(tg_fmask)
+   ENDIF
+
+   !!! horizontal mesh (hgr)
+   !!!----------------------
+
+   ! latitude
+   ! glamt
+   CALL mpp_add_var(tl_mpphgr, tg_glamt)
+   CALL var_clean(tg_glamt)
+   ! glamu
+   CALL mpp_add_var(tl_mpphgr, tg_glamu)
+   CALL var_clean(tg_glamu)
+   ! glamV
+   CALL mpp_add_var(tl_mpphgr, tg_glamv)
+   CALL var_clean(tg_glamv)
+   ! glamf
+   CALL mpp_add_var(tl_mpphgr, tg_glamf)
+   CALL var_clean(tg_glamf)
+
+   ! longitude
+   ! gphit
+   CALL mpp_add_var(tl_mpphgr, tg_gphit)
+   CALL var_clean(tg_gphit)
+   ! gphiu
+   CALL mpp_add_var(tl_mpphgr, tg_gphiu)
+   CALL var_clean(tg_gphiu)
+   ! gphiv
+   CALL mpp_add_var(tl_mpphgr, tg_gphiv)
+   CALL var_clean(tg_gphiv)
+   ! gphif
+   CALL mpp_add_var(tl_mpphgr, tg_gphif)
+   CALL var_clean(tg_gphif)
+
+   ! e1 scale factors
+   ! e1t
+   CALL mpp_add_var(tl_mpphgr, tg_e1t)
+   CALL var_clean(tg_e1t)
+   ! e1u
+   CALL mpp_add_var(tl_mpphgr, tg_e1u)
+   CALL var_clean(tg_e1u)
+   ! e1v
+   CALL mpp_add_var(tl_mpphgr, tg_e1v)
+   CALL var_clean(tg_e1v)
+   ! e1f
+   CALL mpp_add_var(tl_mpphgr, tg_e1f)
+   CALL var_clean(tg_e1f)
+
+   ! e2 scale factors
+   ! e2t
+   CALL mpp_add_var(tl_mpphgr, tg_e2t)
+   CALL var_clean(tg_e2t)
+   ! e2u
+   CALL mpp_add_var(tl_mpphgr, tg_e2u)
+   CALL var_clean(tg_e2u)
+   ! e2v
+   CALL mpp_add_var(tl_mpphgr, tg_e2v)
+   CALL var_clean(tg_e2v)
+   ! e2f
+   CALL mpp_add_var(tl_mpphgr, tg_e2f)
+   CALL var_clean(tg_e2f)
+
+   ! coriolis factor
+   ! ff_t
+   CALL mpp_add_var(tl_mpphgr, tg_ff_t)
+   CALL var_clean(tg_ff_t)
+   ! ff_f
+   CALL mpp_add_var(tl_mpphgr, tg_ff_f)
+   CALL var_clean(tg_ff_f)
+
+   ! angles
+   IF( .NOT. ll_domcfg )THEN
+      ! cost
+      CALL mpp_add_var(tl_mpphgr, tg_gcost)
+      CALL var_clean(tg_gcost)
+      ! cosu
+      CALL mpp_add_var(tl_mpphgr, tg_gcosu)
+      CALL var_clean(tg_gcosu)
+      ! cosv
+      CALL mpp_add_var(tl_mpphgr, tg_gcosv)
+      CALL var_clean(tg_gcosv)
+      ! cosf
+      CALL mpp_add_var(tl_mpphgr, tg_gcosf)
+      CALL var_clean(tg_gcosf)
+      
+      ! sint
+      CALL mpp_add_var(tl_mpphgr, tg_gsint)
+      CALL var_clean(tg_gsint)
+      ! sinu
+      CALL mpp_add_var(tl_mpphgr, tg_gsinu)
+      CALL var_clean(tg_gsinu)
+      ! sinv
+      CALL mpp_add_var(tl_mpphgr, tg_gsinv)
+      CALL var_clean(tg_gsinv)
+      ! sinf
+      CALL mpp_add_var(tl_mpphgr, tg_gsinf)
+      CALL var_clean(tg_gsinf)
+   ENDIF
+   
+   !!! vertical mesh (zgr)
+   !!!----------------------
+   ! note that mbkt is set to 1 over land ==> use surface tmask
+   ! 
+   ! mbathy
+   tg_mbathy%d_value(:,:,:,:) = tg_ssmask%d_value(:,:,:,:) * &
+   &                            tg_mbkt%d_value(:,:,:,:)
+   !
+   IF( ll_domcfg )THEN
+      tg_mbathy%c_name='bottom_level'
+   ENDIF
+   CALL mpp_add_var(tl_mppzgr, tg_mbathy)
+   CALL var_clean(tg_mbathy)
+
+   ! misf
+   ALLOCATE(dl_tmp2D(jpi,jpj))
+   dl_tmp2D(:,:)=dp_fill
+
+   tl_misf =var_init('misf     ',dl_tmp2D(:,:), id_type=NF90_INT)
+
+   DEALLOCATE(dl_tmp2D)
+   tl_misf%d_value(:,:,1,1) = tg_ssmask%d_value(:,:,1,1) * &
+   &                          tg_mikt%d_value(:,:,1,1)
+   !
+   IF( ll_domcfg ) tl_misf%c_name='top_level'
+   CALL mpp_add_var(tl_mppzgr, tl_misf)
+   CALL var_clean(tl_misf)
+
+   IF( .NOT. ll_domcfg )THEN
+      ! isfdraft
+      tl_risfdep%d_value(:,:,:,:) = tl_risfdep%d_value(:,:,:,:) * &
+      &                             tg_mikt%d_value(:,:,:,:)
+ 
+      CALL mpp_add_var(tl_mppzgr, tl_risfdep)
+      CALL var_clean(tl_risfdep)
+   ENDIF
+
+   IF( ln_sco ) THEN ! s-coordinate
+
+      IF( .NOT. ll_domcfg )THEN
+         ! hbatt
+         CALL mpp_add_var(tl_mppzgr, tg_hbatt)
+         CALL var_clean(tg_hbatt)
+         ! hbatu
+         CALL mpp_add_var(tl_mppzgr, tg_hbatu)
+         CALL var_clean(tg_hbatu)
+         ! hbatv
+         CALL mpp_add_var(tl_mppzgr, tg_hbatv)
+         CALL var_clean(tg_hbatv)
+         ! hbatf
+         CALL mpp_add_var(tl_mppzgr, tg_hbatf)
+         CALL var_clean(tg_hbatf)
+
+         ! scaling coef.
+         IF( .NOT. (tl_namz%l_s_sh94 .OR. tl_namz%l_s_sf12) )THEN
+            ! gsigt
+            CALL mpp_add_var(tl_mppzgr, tg_gsigt)
+            CALL var_clean(tg_gsigt)
+            ! gsigw
+            CALL mpp_add_var(tl_mppzgr, tg_gsigw)
+            CALL var_clean(tg_gsigw)
+            ! gsi3w
+            CALL mpp_add_var(tl_mppzgr, tg_gsi3w)
+            CALL var_clean(tg_gsi3w)
+            ! esigt
+            CALL mpp_add_var(tl_mppzgr, tg_esigt)
+            CALL var_clean(tg_esigt)
+            ! esigw
+            CALL mpp_add_var(tl_mppzgr, tg_esigw)
+            CALL var_clean(tg_esigw)
+         ENDIF
+      ENDIF
+
+      ! scale factors
+      ! e3t_0
+      CALL mpp_add_var(tl_mppzgr, tg_e3t_0)
+      CALL var_clean(tg_e3t_0)
+      ! e3u_0
+      CALL mpp_add_var(tl_mppzgr, tg_e3u_0)
+      CALL var_clean(tg_e3u_0)
+      ! e3v_0
+      CALL mpp_add_var(tl_mppzgr, tg_e3v_0)
+      CALL var_clean(tg_e3v_0)
+      ! e3f_0
+      CALL mpp_add_var(tl_mppzgr, tg_e3f_0)
+      CALL var_clean(tg_e3f_0)
+      ! e3w_0
+      CALL mpp_add_var(tl_mppzgr, tg_e3w_0)
+      CALL var_clean(tg_e3w_0)
+      ! e3uw_0
+      CALL mpp_add_var(tl_mppzgr, tg_e3uw_0)
+      CALL var_clean(tg_e3uw_0)
+      ! e3vw_0
+      CALL mpp_add_var(tl_mppzgr, tg_e3vw_0)
+      CALL var_clean(tg_e3vw_0)
+
+      ! Max. grid stiffness ratio
+      ! rx1
+      IF( ll_domcfg ) tg_rx1%c_name='stiffness'
+      CALL mpp_add_var(tl_mppzgr, tg_rx1)
+      CALL var_clean(tg_rx1)
+
+      ! stretched system
+      IF( .NOT. tl_namz%l_e3_dep )THEN
+         ! gdept_1d
+         CALL mpp_add_var(tl_mppzgr, tg_gdept_1d)
+         CALL var_clean(tg_gdept_1d)
+         ! gdepw_1d
+         CALL mpp_add_var(tl_mppzgr, tg_gdepw_1d)
+         CALL var_clean(tg_gdepw_1d)
+         
+         ! gdept_0
+         CALL mpp_add_var(tl_mppzgr, tg_gdept_0)      
+         CALL var_clean(tg_gdept_0)
+         ! gdepw_0
+         CALL mpp_add_var(tl_mppzgr, tg_gdepw_0)      
+         CALL var_clean(tg_gdepw_0)
+      ENDIF
+
+   ENDIF
+
+   IF( ln_zps ) THEN ! z-coordinate - partial steps
+
+      IF( ll_domcfg .OR. in_msh <= 6 ) THEN ! 3D vertical scale factors
+
+         ! e3t_0
+         CALL mpp_add_var(tl_mppzgr, tg_e3t_0)
+         CALL var_clean(tg_e3t_0)
+         ! e3u_0
+         CALL mpp_add_var(tl_mppzgr, tg_e3u_0)
+         CALL var_clean(tg_e3u_0)
+         ! e3v_0
+         CALL mpp_add_var(tl_mppzgr, tg_e3v_0)
+         CALL var_clean(tg_e3v_0)
+         ! e3w_0
+         CALL mpp_add_var(tl_mppzgr, tg_e3w_0)
+         CALL var_clean(tg_e3w_0)
+
+      ELSE
+
+         DO jj = 1,jpj   
+            DO ji = 1,jpi
+               ik=tg_mbkt%d_value(ji,jj,1,1)
+               tg_e3tp%d_value(ji,jj,1,1) = tg_e3t_0%d_value(ji,jj,ik,1) * &
+                  &                         tg_ssmask%d_value(ji,jj,1,1)
+               tg_e3wp%d_value(ji,jj,1,1) = tg_e3w_0%d_value(ji,jj,ik,1) * &
+                  &                         tg_ssmask%d_value(ji,jj,1,1)
+            END DO
+         END DO         
+         ! e3t_ps
+         CALL mpp_add_var(tl_mppzgr, tg_e3tp)
+         CALL var_clean(tg_e3tp)
+         ! e3w_ps
+         CALL mpp_add_var(tl_mppzgr, tg_e3wp)
+         CALL var_clean(tg_e3wp)
+
+      ENDIF ! 3D vertical scale factors
+
+      IF( ll_domcfg .OR. in_msh <= 3 ) THEN ! 3D depth
+         
+         IF( .NOT. tl_namz%l_e3_dep )THEN
+      
+            ! gdepu, gdepv
+            IF( .NOT. ll_domcfg )THEN
+               ALLOCATE(dl_tmp3D(jpi,jpj,jpk))
+               dl_tmp3D(:,:,:)=dp_fill
+
+               tl_gdepu=var_init('gdepu',dl_tmp3D(:,:,:), id_type=NF90_FLOAT)
+               tl_gdepv=var_init('gdepv',dl_tmp3D(:,:,:), id_type=NF90_FLOAT)
+
+               DEALLOCATE(dl_tmp3D)
+               DO jk = 1,jpk   
+                  DO jj = 1, jpj-1   
+                     DO ji = 1, jpi-1   ! vector opt.
+                        tl_gdepu%d_value(ji,jj,jk,1) = MIN( tg_gdept_0%d_value(ji  ,jj  ,jk,1) , &
+                           &                                tg_gdept_0%d_value(ji+1,jj  ,jk,1) )
+
+                        tl_gdepv%d_value(ji,jj,jk,1) = MIN( tg_gdept_0%d_value(ji  ,jj  ,jk,1) , &
+                           &                                tg_gdept_0%d_value(ji  ,jj+1,jk,1) )
+                     END DO   
+                  END DO   
+               END DO         
+               CALL lbc_lnk( tl_gdepu%d_value(:,:,:,1), 'U', in_perio, 1._dp )
+               CALL lbc_lnk( tl_gdepv%d_value(:,:,:,1), 'V', in_perio, 1._dp )
+
+               ! gdepu
+               CALL mpp_add_var(tl_mppzgr, tl_gdepu)
+               CALL var_clean(tl_gdepu)
+               ! gdepv
+               CALL mpp_add_var(tl_mppzgr, tl_gdepv)
+               CALL var_clean(tl_gdepv)
+            ENDIF
+
+            ! gdept_0
+            CALL mpp_add_var(tl_mppzgr, tg_gdept_0)
+            CALL var_clean(tg_gdept_0)
+
+            ! gdepw_0
+            CALL mpp_add_var(tl_mppzgr, tg_gdepw_0)
+            CALL var_clean(tg_gdepw_0)
+         ENDIF
+
+      ELSE ! 2D bottom depth
+         ALLOCATE(dl_tmp2D(jpi,jpj))
+         dl_tmp2D(:,:)=dp_fill
+
+         tl_hdept=var_init('hdept',dl_tmp2D(:,:), id_type=NF90_INT)
+         tl_hdepw=var_init('hdepw',dl_tmp2D(:,:), id_type=NF90_INT)
+
+         DEALLOCATE(dl_tmp2D)
+         DO jj = 1,jpj   
+            DO ji = 1,jpi
+               ik=tg_mbkt%d_value(ji,jj,1,1)
+               tl_hdept%d_value(ji,jj,1,1) = tg_gdept_0%d_value(ji,jj,ik  ,1) * tg_ssmask%d_value(ji,jj,1,1)
+               tl_hdepw%d_value(ji,jj,1,1) = tg_gdepw_0%d_value(ji,jj,ik+1,1) * tg_ssmask%d_value(ji,jj,1,1)
+            END DO
+         END DO
+         ! hdept
+         CALL mpp_add_var(tl_mppzgr, tl_hdept)
+         CALL var_clean(tl_hdept)
+         ! hdepw
+         CALL mpp_add_var(tl_mppzgr, tl_hdepw)
+         CALL var_clean(tl_hdepw)
+
+         ! clean
+         CALL var_clean(tg_gdept_0)
+
+      ENDIF ! 3D depth
+
+   ENDIF
+
+   ! scale factors
+   IF( ll_domcfg )THEN
+      ! e3t_1d
+      CALL mpp_add_var(tl_mppzgr, tg_e3t_1d)
+      CALL var_clean(tg_e3t_1d)
+      ! e3w_1d
+      CALL mpp_add_var(tl_mppzgr, tg_e3w_1d)
+      CALL var_clean(tg_e3w_1d)
+   ENDIF
+
+   IF( ln_zps .OR. ln_zco )THEN ! z-coordinate 
+      IF( .NOT. tl_namz%l_e3_dep )THEN
+         ! depth
+         ! gdept_1d
+         CALL mpp_add_var(tl_mppzgr, tg_gdept_1d)
+         CALL var_clean(tg_gdept_1d)
+         ! gdepw_1d
+         CALL mpp_add_var(tl_mppzgr, tg_gdepw_1d)
+         CALL var_clean(tg_gdepw_1d)
+      ENDIF
+   ENDIF
+
+   ! define global attributes
+   ALLOCATE(tl_gatt(ip_maxatt))
+
+   tl_gatt(:) = create_meshmask__gloatt(cn_bathy,cn_coord,cn_isfdep,tl_namh,tl_namz)
+
+
+   IF( in_msh == 0 ) in_msh=1
+   SELECT CASE ( MOD(in_msh, 3) )
+      CASE ( 1 )
+         ! add some attribute
+         tl_att=att_init("Created_by","SIREN create_meshmask")
+         CALL mpp_add_att(tl_mppmsk, tl_att)
+         
+         !add source url
+         cl_url=fct_split(fct_split(cp_url,2,'$'),2,'URL:')
+         tl_att=att_init("SIREN_url",cl_url)
+         CALL mpp_add_att(tl_mppmsk, tl_att)
+
+         ! add date of creation
+         cl_date=date_print(date_now())
+         tl_att=att_init("Creation_date",TRIM(cl_date))
+         CALL mpp_add_att(tl_mppmsk, tl_att)
+         
+         ! add attribute periodicity
+         il_attid=0
+         IF( ASSOCIATED(tl_mppmsk%t_proc(1)%t_att) )THEN
+            il_attid=att_get_id(tl_mppmsk%t_proc(1)%t_att(:),'periodicity')
+         ENDIF
+         IF( in_perio >= 0 .AND. il_attid == 0 )THEN
+            tl_att=att_init('periodicity',in_perio)
+            CALL mpp_add_att(tl_mppmsk,tl_att)
+         ENDIF
+         
+         il_attid=0
+         IF( ASSOCIATED(tl_mppmsk%t_proc(1)%t_att) )THEN
+            il_attid=att_get_id(tl_mppmsk%t_proc(1)%t_att(:),'ew_overlap')
+         ENDIF
+         IF( il_ew >= 0 .AND. il_attid == 0 )THEN
+            tl_att=att_init('ew_overlap',il_ew)
+            CALL mpp_add_att(tl_mppmsk,tl_att)
+         ENDIF
+         
+         ji=1
+         DO WHILE( tl_gatt(ji)%c_name /= '' )
+            CALL mpp_add_att(tl_mppmsk,tl_gatt(ji))
+            ji=ji+1
+         ENDDO
+         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+         ! create file
+         CALL iom_mpp_create(tl_mppmsk)
+         
+         ! write file
+         CALL iom_mpp_write_file(tl_mppmsk)
+         ! close file
+         CALL iom_mpp_close(tl_mppmsk)
+         
+         ! clean
+         CALL mpp_clean(tl_mppmsk)
+
+      CASE ( 2 )
+         ! add some attribute
+         tl_att=att_init("Created_by","SIREN create_meshmask")
+         CALL mpp_add_att(tl_mppmsk, tl_att)
+         CALL mpp_add_att(tl_mpphgr, tl_att)
+         
+         !add source url
+         cl_url=fct_split(fct_split(cp_url,2,'$'),2,'URL:')
+         tl_att=att_init("SIREN_url",cl_url)
+         CALL mpp_add_att(tl_mppmsk, tl_att)
+         CALL mpp_add_att(tl_mpphgr, tl_att)
+
+         ! add date of creation
+         cl_date=date_print(date_now())
+         tl_att=att_init("Creation_date",TRIM(cl_date))
+         CALL mpp_add_att(tl_mppmsk, tl_att)
+         CALL mpp_add_att(tl_mpphgr, tl_att)
+         
+         ! add attribute periodicity
+         il_attid=0
+         IF( ASSOCIATED(tl_mppmsk%t_proc(1)%t_att) )THEN
+            il_attid=att_get_id(tl_mppmsk%t_proc(1)%t_att(:),'periodicity')
+         ENDIF
+         IF( in_perio >= 0 .AND. il_attid == 0 )THEN
+            tl_att=att_init('periodicity',in_perio)
+            CALL mpp_add_att(tl_mppmsk,tl_att)
+            CALL mpp_add_att(tl_mpphgr,tl_att)
+         ENDIF
+         
+         il_attid=0
+         IF( ASSOCIATED(tl_mppmsk%t_proc(1)%t_att) )THEN
+            il_attid=att_get_id(tl_mppmsk%t_proc(1)%t_att(:),'ew_overlap')
+         ENDIF
+         IF( il_ew >= 0 .AND. il_attid == 0 )THEN
+            tl_att=att_init('ew_overlap',il_ew)
+            CALL mpp_add_att(tl_mppmsk,tl_att)
+            CALL mpp_add_att(tl_mpphgr,tl_att)
+         ENDIF
+
+         ji=1
+         DO WHILE( tl_gatt(ji)%c_name /= '' )
+            CALL mpp_add_att(tl_mppmsk,tl_gatt(ji))
+            CALL mpp_add_att(tl_mpphgr,tl_gatt(ji))
+            ji=ji+1
+         ENDDO
+         
+         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+         ! create mask file
+         !-----------------
+         CALL iom_mpp_create(tl_mppmsk)
+         
+         ! write file
+         CALL iom_mpp_write_file(tl_mppmsk)
+         ! close file
+         CALL iom_mpp_close(tl_mppmsk)
+         
+         ! clean
+         CALL mpp_clean(tl_mppmsk)
+
+         ! create mesh file
+         !-----------------
+         CALL iom_mpp_create(tl_mpphgr)
+         
+         ! write file
+         CALL iom_mpp_write_file(tl_mpphgr)
+         ! close file
+         CALL iom_mpp_close(tl_mpphgr)
+         
+         ! clean
+         CALL mpp_clean(tl_mpphgr)
+
+      CASE(0)
+         ! add some attribute
+         tl_att=att_init("Created_by","SIREN create_meshmask")
+         CALL mpp_add_att(tl_mppmsk, tl_att)
+         CALL mpp_add_att(tl_mpphgr, tl_att)
+         CALL mpp_add_att(tl_mppzgr, tl_att)
+         
+         !add source url
+         cl_url=fct_split(fct_split(cp_url,2,'$'),2,'URL:')
+         tl_att=att_init("SIREN_url",cl_url)
+         CALL mpp_add_att(tl_mppmsk, tl_att)
+         CALL mpp_add_att(tl_mpphgr, tl_att)
+         CALL mpp_add_att(tl_mppzgr, tl_att)
+
+         ! add date of creation
+         cl_date=date_print(date_now())
+         tl_att=att_init("Creation_date",TRIM(cl_date))
+         CALL mpp_add_att(tl_mppmsk, tl_att)
+         CALL mpp_add_att(tl_mpphgr, tl_att)
+         CALL mpp_add_att(tl_mppzgr, tl_att)
+         
+         ! add attribute periodicity
+         il_attid=0
+         IF( ASSOCIATED(tl_mppmsk%t_proc(1)%t_att) )THEN
+            il_attid=att_get_id(tl_mppmsk%t_proc(1)%t_att(:),'periodicity')
+         ENDIF
+         IF( in_perio >= 0 .AND. il_attid == 0 )THEN
+            tl_att=att_init('periodicity',in_perio)
+            CALL mpp_add_att(tl_mppmsk,tl_att)
+            CALL mpp_add_att(tl_mpphgr,tl_att)
+            CALL mpp_add_att(tl_mppzgr,tl_att)
+         ENDIF
+ 
+         il_attid=0
+         IF( ASSOCIATED(tl_mppmsk%t_proc(1)%t_att) )THEN
+            il_attid=att_get_id(tl_mppmsk%t_proc(1)%t_att(:),'ew_overlap')
+         ENDIF
+         IF( il_ew >= 0 .AND. il_attid == 0 )THEN
+            tl_att=att_init('ew_overlap',il_ew)
+            CALL mpp_add_att(tl_mppmsk,tl_att)
+            CALL mpp_add_att(tl_mpphgr,tl_att)
+            CALL mpp_add_att(tl_mppzgr,tl_att)
+         ENDIF
+
+         ji=1
+         DO WHILE( tl_gatt(ji)%c_name /= '' )
+            CALL mpp_add_att(tl_mppmsk,tl_gatt(ji))
+            CALL mpp_add_att(tl_mpphgr,tl_gatt(ji))
+            CALL mpp_add_att(tl_mppzgr,tl_gatt(ji))
+            ji=ji+1
+         ENDDO
+
+         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+         ! create mask file
+         !-----------------
+         CALL iom_mpp_create(tl_mppmsk)
+ 
+         ! write file
+         CALL iom_mpp_write_file(tl_mppmsk)
+         ! close file
+         CALL iom_mpp_close(tl_mppmsk)
+ 
+         ! clean
+         WRITE(*,*) "CLEAN MSK"
+         CALL mpp_clean(tl_mppmsk)
+
+         ! create mesh_hgr file
+         !-----------------
+         CALL iom_mpp_create(tl_mpphgr)
+ 
+         ! write file
+         CALL iom_mpp_write_file(tl_mpphgr)
+         ! close file
+         CALL iom_mpp_close(tl_mpphgr)
+ 
+         ! clean
+         WRITE(*,*) "CLEAN HGR"
+         CALL mpp_clean(tl_mpphgr)
+
+         ! create mesh_zgr file
+         !-----------------
+         WRITE(*,*) "CREATE ZGR"
+         CALL iom_mpp_create(tl_mppzgr)
+ 
+         ! write file
+         WRITE(*,*) "WRITE ZGR"
+         CALL iom_mpp_write_file(tl_mppzgr)
+         ! close file
+         WRITE(*,*) "CLOSE ZGR"
+         CALL iom_mpp_close(tl_mppzgr)
+ 
+         ! clean
+         WRITE(*,*) "CLEAN ZGR"
+         CALL mpp_clean(tl_mppzgr)
+
+      CASE DEFAULT
+         CALL logger_fatal("CREATE MESHMASK : something wrong with in_msh("//&
+            &  TRIM(fct_str(in_msh))//"), check your namelist.")
+    END SELECT
+
+   ! clean
+   WRITE(*,*) "CLEAN"
+   CALL att_clean(tl_att)
+   CALL att_clean(tl_gatt)
+
+   DEALLOCATE(tl_gatt)
+
+   CALL grid_hgr_clean(ll_domcfg)
+   CALL grid_zgr_clean(ln_sco)
+   IF( ln_zps    ) CALL grid_zgr_zps_clean()
+   IF( ln_sco    ) CALL grid_zgr_sco_clean()
+   CALL var_clean_extra()
+
+   ! close log file
+   CALL logger_footer()
+   CALL logger_close()
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE create_meshmask__mask(td_nam,jpi,jpj,jpk,ld_domcfg) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute land/ocean mask arrays at tracer points, 
+   !>      horizontal velocity points (u & v), vorticity points (f) and 
+   !>      barotropic stream function  points (b). 
+   !>
+   !> @details
+   !>
+   !> ** Method  :   The ocean/land mask is computed from the basin bathymetry in level (mbathy) 
+   !>      which is defined or read in dommba.
+   !>      mbathy equals 0 over continental T-point and the number of ocean level over the ocean.
+   !>
+   !>      At a given position (ji,jj,jk) the ocean/land mask is given by:
+   !>      - t-point : 
+   !>             - 0. IF mbathy( ji ,jj) =< 0
+   !>             - 1. IF mbathy( ji ,jj) >= jk
+   !>      - u-point : 
+   !>             - 0. IF mbathy( ji ,jj)  or mbathy(ji+1, jj ) =< 0
+   !>             - 1. IF mbathy( ji ,jj) and mbathy(ji+1, jj ) >= jk.
+   !>      - v-point : 
+   !>             - 0. IF mbathy( ji ,jj)  or mbathy( ji ,jj+1) =< 0
+   !>             - 1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1) >= jk.
+   !>      - f-point : 
+   !>             - 0. IF mbathy( ji ,jj)  or mbathy( ji ,jj+1) or mbathy(ji+1,jj)  or mbathy(ji+1,jj+1) =< 0
+   !>             - 1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1) and mbathy(ji+1,jj) and mbathy(ji+1,jj+1) >= jk.
+   !>      - b-point : the same definition as for f-point of the first ocean
+   !>                level (surface level) but with 0 along coastlines.
+   !>      - tmask_i : interior ocean mask at t-point, i.e. excluding duplicated
+   !>                rows/lines due to cyclic or North Fold boundaries as well
+   !>                as MPP halos.
+   !>
+   !> @warning do not set the lateral friction through the value of fmask along
+   !>      the coast and topography. 
+   !>
+   !> @note If nperio not equal to 0, the land/ocean mask arrays
+   !>      are defined with the proper value at lateral domain boundaries,
+   !>      but bmask. indeed, bmask defined the domain over which the
+   !>      barotropic stream function is computed. this domain cannot
+   !>      contain identical columns because the matrix associated with
+   !>      the barotropic stream function equation is then no more inverti-
+   !>      ble. therefore bmask is set to 0 along lateral domain boundaries
+   !>      even IF nperio is not zero.
+   !>
+   !>      In case of open boundaries (lk_bdy=T):
+   !>        - tmask is set to 1 on the points to be computed bay the open
+   !>          boundaries routines.
+   !>        - bmask is  set to 0 on the open boundaries.
+   !>
+   !> ** Action :   
+   !>       - tmask    : land/ocean mask at t-point (=0. or 1.)
+   !>       - umask    : land/ocean mask at u-point (=0. or 1.)
+   !>       - vmask    : land/ocean mask at v-point (=0. or 1.)
+   !>       - fmask    : land/ocean mask at f-point (=0. or 1.)
+   !>       - bmask    : land/ocean mask at barotropic stream
+   !>                  function point (=0. or 1.) and set to 0 along lateral boundaries
+   !>       - tmask_i  : interior ocean mask
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from dom_msk
+   !> @date October, 2016
+   !> - do not use anymore special case for ORCA grid
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !> @param[in] jpk
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TNAMH), INTENT(IN) :: td_nam
+      INTEGER(i4), INTENT(IN) :: jpi
+      INTEGER(i4), INTENT(IN) :: jpj
+      INTEGER(i4), INTENT(IN) :: jpk
+      LOGICAL    , INTENT(IN) :: ld_domcfg
+
+      ! local variable
+!      INTEGER(i4)  ::   ii0, ii1  ! local integers
+!      INTEGER(i4)  ::   ij0, ij1
+!      INTEGER(i4)  ::   isrow
+
+!      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE ::  imsk
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE ::  zwf
+
+!      REAL(dp)   , DIMENSION(:)  , ALLOCATABLE :: dl_tpol
+!      REAL(dp)   , DIMENSION(:)  , ALLOCATABLE :: dl_fpol
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+!      ALLOCATE( imsk(jpi,jpj) )
+
+!      ALLOCATE( dl_tpol(jpi) )
+!      ALLOCATE( dl_fpol(jpi) )
+
+      CALL logger_info('dommsk : ocean mask ')
+      CALL logger_info('~~~~~~')
+      IF    (      rn_shlat == 0.               )THEN ; CALL logger_info('   ocean lateral  free-slip ')
+      ELSEIF(      rn_shlat == 2.               )THEN ; CALL logger_info('   ocean lateral  no-slip ')
+      ELSEIF( 0. < rn_shlat .AND. rn_shlat < 2. )THEN ; CALL logger_info('   ocean lateral  partial-slip ')
+      ELSEIF( 2. < rn_shlat                     )THEN ; CALL logger_info('   ocean lateral  strong-slip ')
+      ELSE ; CALL logger_info(' rn_shlat is negative = '//TRIM(fct_str(rn_shlat)))
+      ENDIF
+
+      ! 1. Ocean/land mask at t-point (computed from mbathy)
+      ! -----------------------------
+      ! N.B. tmask has already the right boundary conditions since mbathy is ok
+      !
+      tg_tmask%d_value(:,:,:,1) = 0._dp
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( tg_mbathy%d_value(ji,jj,1,1) - REAL(jk,dp) + 0.1_dp >= 0._dp )THEN
+                  tg_tmask%d_value(ji,jj,jk,1) = 1._dp
+               ENDIF
+            ENDDO  
+         ENDDO  
+      ENDDO  
+      
+      ! (ISF) define barotropic mask and mask the ice shelf point
+      tg_ssmask%d_value(:,:,1,1)=tg_tmask%d_value(:,:,1,1) ! at this stage ice shelf is not masked
+      
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( tg_misfdep%d_value(ji,jj,1,1) - REAL(jk,dp) - 0.1_dp >= 0._dp )   THEN
+                  tg_tmask%d_value(ji,jj,jk,1) = 0._dp
+               END IF
+            ENDDO  
+         ENDDO  
+      ENDDO
+
+!      ! Interior domain mask (used for global sum)
+!      ! --------------------
+!      tg_tmask_i%d_value(:,:,1,1) = tg_ssmask%d_value(:,:,1,1)  ! (ISH) tmask_i = 1 even on the ice shelf
+!
+!      tg_tmask_h%d_value(:,:,1,1) = 1._dp          ! 0 on the halo and 1 elsewhere
+!
+!      tg_tmask_h%d_value( 1 , : ,1,1) = 0._dp      ! first columns
+!      tg_tmask_h%d_value(jpi, : ,1,1) = 0._dp      ! last  columns
+!      tg_tmask_h%d_value( : , 1 ,1,1) = 0._dp      ! first rows
+!      tg_tmask_h%d_value( : ,jpj,1,1) = 0._dp      ! last  rows
+!
+!      ! north fold mask
+!      ! ---------------
+!      dl_tpol(1:jpi) = 1._dp 
+!      dl_fpol(1:jpi) = 1._dp
+!      IF( td_nam%i_perio == 3 .OR. td_nam%i_perio == 4 )THEN      ! T-point pivot
+!         dl_tpol(jpi/2+1:jpi) = 0._dp
+!         dl_fpol(   1   :jpi) = 0._dp
+!         IF( mjg(nlej) == jpj ) THEN                  ! only half of the nlcj-1 row
+!            DO ji = iif+1, iil-1
+!               tg_tmask_h%d_value(ji,nlej-1,1,1) = tg_tmask_h%d_value(ji,nlej-1,1,1) * dl_tpol(mig(ji))
+!            END DO
+!         ENDIF
+!      ENDIF
+!
+!      tg_tmask_i%d_value(:,:,1,1) = tg_tmask_i%d_value(:,:,1,1) * tg_tmask_h%d_value(:,:,1,1)
+!
+!      IF( td_nam%i_perio == 5 .OR. td_nam%i_perio == 6 )THEN      ! F-point pivot
+!         dl_tpol(   1   :jpi) = 0._dp
+!         dl_fpol(jpi/2+1:jpi) = 0._dp
+!      ENDIF
+
+      ! 2. Ocean/land mask at u-,  v-, and z-points (computed from tmask)
+      ! -------------------------------------------
+      DO jk = 1, jpk
+         DO jj = 1, jpj-1
+            DO ji = 1, jpi-1  ! vector loop
+               tg_umask%d_value(ji,jj,jk,1) = tg_tmask%d_value(ji  ,jj  ,jk,1) * &
+                                            & tg_tmask%d_value(ji+1,jj  ,jk,1)
+
+               tg_vmask%d_value(ji,jj,jk,1) = tg_tmask%d_value(ji  ,jj  ,jk,1) * &
+                                            & tg_tmask%d_value(ji  ,jj+1,jk,1)
+            !END DO
+            !DO ji = 1, jpi-1  ! NO vector opt.
+               IF( .NOT. ld_domcfg )THEN
+                  tg_fmask%d_value(ji,jj,jk,1) = tg_tmask%d_value(ji  ,jj  ,jk,1) * &
+                                               & tg_tmask%d_value(ji+1,jj  ,jk,1) * &
+                                               & tg_tmask%d_value(ji  ,jj+1,jk,1) * &
+                                               & tg_tmask%d_value(ji+1,jj+1,jk,1)
+               ENDIF
+            ENDDO
+         ENDDO
+      ENDDO      
+
+!      ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at least 1 wet cell at u point
+!      DO jj = 1, jpjm1
+!         DO ji = 1, fs_jpim1   ! vector loop
+!            tg_ssumask%d_value(ji,jj,1,1)  = tg_ssmask%d_value(ji  ,jj  ,1,1) * &
+!                                           & tg_ssmask%d_value(ji+1,jj  ,1,1) * &
+!                                           & MIN( 1._wp, SUM(tg_umask%d_value(ji,jj,:,1)) )
+!            tg_ssvmask%d_value(ji,jj,1,1)  = tg_ssmask%d_value(ji  ,jj  ,1,1) * &
+!                                           & tg_ssmask%d_value(ji  ,jj+1,1,1) * &
+!                                           & MIN( 1._wp, SUM(tg_vmask%d_value(ji,jj,:,1)) )
+!         END DO
+!         DO ji = 1, jpim1      ! NO vector opt.
+!            tg_ssfmask%d_value(ji,jj,1,1) =  tg_ssmask%d_value(ji  ,jj  ,1,1) * &
+!                                          &  tg_ssmask%d_value(ji+1,jj  ,1,1) * &
+!                                          &  tg_ssmask%d_value(ji  ,jj+1,1,1) * &
+!                                          &  tg_ssmask%d_value(ji+1,jj+1,1,1) * &
+!                                          &  MIN( 1._wp, SUM(tg_fmask%d_value(ji,jj,:,1)) )
+!         END DO
+!      END DO
+      CALL lbc_lnk( tg_umask%d_value  (:,:,:,1), 'U', td_nam%i_perio, 1._dp )      ! Lateral boundary conditions
+      CALL lbc_lnk( tg_vmask%d_value  (:,:,:,1), 'V', td_nam%i_perio, 1._dp )
+      IF( .NOT. ld_domcfg )THEN
+         CALL lbc_lnk( tg_fmask%d_value  (:,:,:,1), 'F', td_nam%i_perio, 1._dp )
+      ENDIF
+!      CALL lbc_lnk( tg_ssumask%d_value(:,:,:,1), 'U', td_nam%i_perio, 1._dp )      ! Lateral boundary conditions
+!      CALL lbc_lnk( tg_ssvmask%d_value(:,:,:,1), 'V', td_nam%i_perio, 1._dp )
+!      CALL lbc_lnk( tg_ssfmask%d_value(:,:,:,1), 'F', td_nam%i_perio, 1._dp )
+
+      ! 3. Ocean/land mask at wu-, wv- and w points 
+      !----------------------------------------------
+!      tg_wmask%d_value (:,:,1,1) = tg_tmask%d_value(:,:,1,1) ! surface
+!      tg_wumask%d_value(:,:,1,1) = tg_umask%d_value(:,:,1,1)
+!      tg_wvmask%d_value(:,:,1,1) = tg_vmask%d_value(:,:,1,1)
+!
+!      DO jk=2,jpk                                            ! interior values
+!         tg_wmask%d_value (:,:,jk,1) = tg_tmask%d_value(:,:,jk  ,1) * &
+!                                     & tg_tmask%d_value(:,:,jk-1,1)
+!         tg_wumask%d_value(:,:,jk,1) = tg_umask%d_value(:,:,jk  ,1) * &
+!                                     & tg_umask%d_value(:,:,jk-1,1)   
+!         tg_wvmask%d_value(:,:,jk,1) = tg_vmask%d_value(:,:,jk  ,1) * &
+!                                     & tg_vmask%d_value(:,:,jk-1,1)
+!      ENDDO
+
+      ! Lateral boundary conditions on velocity (modify fmask)
+      ! ---------------------------------------     
+      IF( .NOT. ld_domcfg )THEN
+         ALLOCATE( zwf(jpi,jpj) )
+         DO jk = 1, jpk
+            zwf(:,:) = tg_fmask%d_value(:,:,jk,1)         
+            DO jj = 2, jpj-1
+               DO ji = 2, jpi-1   ! vector opt.
+                  IF( tg_fmask%d_value(ji,jj,jk,1) == 0._dp )THEN
+                     tg_fmask%d_value(ji,jj,jk,1) = rn_shlat * &
+                                                  & MIN(1._dp , MAX(zwf(ji+1,jj), zwf(ji,jj+1), &
+                                                  &                 zwf(ji-1,jj), zwf(ji,jj-1)) )
+                  ENDIF
+               END DO
+            END DO
+            DO jj = 2, jpj-1
+               IF( tg_fmask%d_value(1,jj,jk,1) == 0._dp )THEN
+                  tg_fmask%d_value(1  ,jj,jk,1) = rn_shlat * &
+                                                & MIN(1._dp, MAX(zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1)))
+               ENDIF
+               IF( tg_fmask%d_value(jpi,jj,jk,1) == 0._dp )THEN
+                  tg_fmask%d_value(jpi,jj,jk,1) = rn_shlat * &
+                                                & MIN(1._wp, MAX(zwf(jpi,jj+1), zwf(jpi-1,jj), zwf(jpi,jj-1)))
+               ENDIF
+            END DO         
+            DO ji = 2, jpi-1
+               IF( tg_fmask%d_value(ji,1,jk,1) == 0._dp )THEN
+                  tg_fmask%d_value(ji, 1 ,jk,1) = rn_shlat * &
+                                                & MIN(1._dp, MAX(zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1)))
+               ENDIF
+               IF( tg_fmask%d_value(ji,jpj,jk,1) == 0._dp )THEN
+                  tg_fmask%d_value(ji,jpj,jk,1) = rn_shlat * &
+                                                & MIN(1._dp, MAX(zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpj-1)))
+               ENDIF
+            END DO
+         END DO
+         DEALLOCATE( zwf )
+
+!      IF( td_nam%c_cfg == "orca" .AND. td_nam%i_cfg == 2 )THEN   ! ORCA_R2 configuration
+!         !                                                 ! Increased lateral friction near of some straits
+!         IF( td_nam%i_cla == 0 ) THEN
+!            ! Gibraltar strait  : partial slip (fmask=0.5)
+!            ij0 = 101   ;   ij1 = 101
+!            ii0 = 139   ;   ii1 = 140   
+!            tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) =  0.5_dp
+!
+!            ij0 = 102   ;   ij1 = 102
+!            ii0 = 139   ;   ii1 = 140
+!            tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) =  0.5_dp
+!            !
+!            !Bab el Mandeb : partial slip (fmask=1)
+!            ij0 =  87   ;   ij1 =  88
+!            ii0 = 160   ;   ii1 = 160
+!            tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) =  1._dp
+!
+!            ij0 =  88   ;   ij1 =  88
+!            ii0 = 159   ;   ii1 = 159
+!            tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) =  1._dp
+!            !
+!         ENDIF
+!      ENDIF
+!      !
+!      IF( td_nam%c_cfg == "orca" .AND. td_nam%i_cfg == 1 )THEN   ! ORCA R1 configuration
+!         ! Increased lateral friction near of some straits
+!         ! This dirty section will be suppressed by simplification process:
+!         ! all this will come back in input files
+!         ! Currently these hard-wired indices relate to configuration with
+!         ! extend grid (jpjglo=332)
+!         !
+!         isrow = 332 - jpj
+!         ! Gibraltar Strait
+!         ii0 = 282           ;   ii1 = 283 
+!         ij0 = 201 + isrow   ;   ij1 = 241 - isrow
+!         tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) = 2._dp  
+!
+!         ! Bhosporus Strait
+!         ii0 = 314           ;   ii1 = 315
+!         ij0 = 208 + isrow   ;   ij1 = 248 - isrow 
+!         tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp  
+!
+!         ! Makassar Strait (Top) 
+!         ii0 =  48           ;   ii1 =  48
+!         ij0 = 149 + isrow   ;   ij1 = 190 - isrow
+!         tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 3._dp  
+!
+!         ! Lombok Strait
+!         ii0 =  44           ;   ii1 =  44
+!         ij0 = 124 + isrow   ;   ij1 = 165 - isrow
+!         tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp  
+!
+!         ! Ombai Strait
+!         ii0 =  53           ;   ii1 =  53
+!         ij0 = 124 + isrow   ;   ij1 = 165 - isrow
+!         tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp  
+!
+!         ! Timor Passage
+!         ii0 =  56           ;   ii1 =  56
+!         ij0 = 124 + isrow   ;   ij1 = 165 - isrow
+!         tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp  
+!
+!         ! West Halmahera Strait
+!         ii0 =  58           ;   ii1 =  58
+!         ij0 = 141 + isrow   ;   ij1 = 182 - isrow
+!         tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 3._dp  
+!
+!         ! East Halmahera Strait
+!         ii0 =  55           ;   ii1 =  55
+!         ij0 = 141 + isrow   ;   ij1 = 182 - isrow
+!         tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 3._dp  
+!         !
+!      ENDIF
+      !
+         CALL lbc_lnk( tg_fmask%d_value(:,:,:,1), 'F', td_nam%i_perio, 1._dp )      ! Lateral boundary conditions on fmask
+      ENDIF
+
+!      DEALLOCATE( imsk )
+
+!      DEALLOCATE( dl_tpol )
+!      DEALLOCATE( dl_fpol )
+      
+   END SUBROUTINE create_meshmask__mask
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION create_meshmask__gloatt(cd_bathy,cd_coord,cd_isfdep,td_namh,td_namz) &
+         & RESULT(tf_att)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> this function create array of global attributes.
+   !>
+   !> @author J.Paul
+   !> @date October, 2016 - initial release
+   !>
+   !> @param[in] cd_bathy
+   !> @param[in] cd_coord
+   !> @param[in] cd_isfdep
+   !> @param[in] td_namh
+   !> @param[in] td_namz
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN   )  :: cd_bathy 
+      CHARACTER(LEN=*), INTENT(IN   )  :: cd_coord 
+      CHARACTER(LEN=*), INTENT(IN   )  :: cd_isfdep 
+      TYPE(TNAMH)     , INTENT(IN   )  :: td_namh 
+      TYPE(TNAMZ)     , INTENT(IN   )  :: td_namz 
+
+      ! function
+      TYPE(TATT), DIMENSION(ip_maxatt) :: tf_att
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ji=1    ; tf_att(ji)=att_init("src_bathy",TRIM(cd_bathy))
+      ! horizontal grid
+      ji=ji+1 ; tf_att(ji)=att_init("in_mshhgr",td_namh%i_mshhgr)
+      SELECT CASE(td_namh%i_mshhgr)
+         CASE(0)
+            ji=ji+1 ; tf_att(ji)=att_init("src_coord",TRIM(cd_coord))
+         CASE(1,4)
+            ji=ji+1 ; tf_att(ji)=att_init("ppglam0",td_namh%d_ppglam0)
+            ji=ji+1 ; tf_att(ji)=att_init("ppgphi0",td_namh%d_ppgphi0)
+         CASE(2,3)
+            ji=ji+1 ; tf_att(ji)=att_init("ppglam0",td_namh%d_ppglam0)
+            ji=ji+1 ; tf_att(ji)=att_init("ppgphi0",td_namh%d_ppgphi0)
+            ji=ji+1 ; tf_att(ji)=att_init("ppe1_deg",td_namh%d_ppe1_deg)
+            ji=ji+1 ; tf_att(ji)=att_init("ppe2_deg",td_namh%d_ppe2_deg)
+      END SELECT
+
+      IF( td_namz%l_isfcav )THEN
+         ji=ji+1 ; tf_att(ji)=att_init("ice_shelf_cavities","activated")
+         ji=ji+1 ; tf_att(ji)=att_init("src_isfdep",TRIM(cd_isfdep))
+      ENDIF
+      IF( td_namz%l_iscpl )THEN
+         ji=ji+1 ; tf_att(ji)=att_init("ice_sheet_coupling","activated")
+      ENDIF
+
+      ! vertical grid
+      IF( td_namz%l_zco )THEN
+         ji=ji+1 ; tf_att(ji)=att_init("z_coord","full steps")
+      ENDIF
+      IF( td_namz%l_zps )THEN
+         ji=ji+1 ; tf_att(ji)=att_init("z_coord","partial steps")
+      ENDIF
+      IF( td_namz%l_sco )THEN
+         IF( td_namz%l_s_sh94 )THEN
+            ji=ji+1 ; tf_att(ji)=att_init("z_coord","hybrid Song and Haidvogel 1994")
+         ELSEIF( td_namz%l_s_sf12 )THEN
+            ji=ji+1 ; tf_att(ji)=att_init("z_coord","hybrid Siddorn and Furner 2012")
+         ELSE
+            ji=ji+1 ; tf_att(ji)=att_init("z_coord","sigma")
+         ENDIF
+      ENDIF
+      ji=ji+1 ; tf_att(ji)=att_init("hmin",td_namz%d_hmin)
+      IF( td_namz%l_isfcav ) ji=ji+1 ; tf_att(ji)=att_init("isfhmin",td_namz%d_isfhmin)
+
+      ! zco
+      IF( td_namz%d_ppsur /= NF90_FILL_DOUBLE )THEN
+         ji=ji+1 ; tf_att(ji)=att_init("ppsur",td_namz%d_ppsur)
+      ELSE
+         ji=ji+1 ; tf_att(ji)=att_init("ppsur","to_be_computed")
+      ENDIF
+      IF( td_namz%d_ppa0 /= NF90_FILL_DOUBLE )THEN
+         ji=ji+1 ; tf_att(ji)=att_init("ppa0",td_namz%d_ppa0)
+      ELSE
+         ji=ji+1 ; tf_att(ji)=att_init("ppa0","to_be_computed")
+      ENDIF
+      IF( td_namz%d_ppa1 /= NF90_FILL_DOUBLE )THEN
+         ji=ji+1 ; tf_att(ji)=att_init("ppa1",td_namz%d_ppa1)
+      ELSE
+         ji=ji+1 ; tf_att(ji)=att_init("ppa1","to_be_computed")
+      ENDIF
+
+      ji=ji+1 ; tf_att(ji)=att_init("ppkth",td_namz%d_ppkth)
+      ji=ji+1 ; tf_att(ji)=att_init("ppacr",td_namz%d_ppacr)
+      ji=ji+1 ; tf_att(ji)=att_init("ppdzmin",td_namz%d_ppdzmin)
+      ji=ji+1 ; tf_att(ji)=att_init("pphmax",td_namz%d_pphmax)
+
+      IF( td_namz%l_dbletanh )THEN
+         ji=ji+1 ; tf_att(ji)=att_init("ppa2",td_namz%d_ppa2)
+         ji=ji+1 ; tf_att(ji)=att_init("ppkth2",td_namz%d_ppkth2)
+         ji=ji+1 ; tf_att(ji)=att_init("ppacr2",td_namz%d_ppacr2)
+      ENDIF
+
+      IF( td_namz%l_zps )THEN
+         ji=ji+1 ; tf_att(ji)=att_init("e3zps_min",td_namz%d_e3zps_min)
+         ji=ji+1 ; tf_att(ji)=att_init("e3zps_rat",td_namz%d_e3zps_rat)
+      ENDIF
+
+      IF( td_namz%l_sco )THEN
+         ji=ji+1 ; tf_att(ji)=att_init("sbot_min",td_namz%d_sbot_min)
+         ji=ji+1 ; tf_att(ji)=att_init("sbot_max",td_namz%d_sbot_max)
+         ji=ji+1 ; tf_att(ji)=att_init("hc",td_namz%d_hc)
+         IF( td_namz%l_s_sh94 )THEN
+            ji=ji+1 ; tf_att(ji)=att_init("rmax",td_namz%d_rmax)
+            ji=ji+1 ; tf_att(ji)=att_init("theta",td_namz%d_theta)
+            ji=ji+1 ; tf_att(ji)=att_init("thetb",td_namz%d_thetb)
+            ji=ji+1 ; tf_att(ji)=att_init("bb",td_namz%d_bb)
+         ELSEIF( td_namz%l_s_sf12 )THEN
+            IF( td_namz%l_sigcrit ) ji=ji+1 ; tf_att(ji)=att_init("sigma_below_critical_depth","activated")
+            ji=ji+1 ; tf_att(ji)=att_init("alpha",td_namz%d_alpha)
+            ji=ji+1 ; tf_att(ji)=att_init("efold",td_namz%d_efold)
+            ji=ji+1 ; tf_att(ji)=att_init("zs",td_namz%d_zs)
+            ji=ji+1 ; tf_att(ji)=att_init("zb_a",td_namz%d_zb_a)
+            ji=ji+1 ; tf_att(ji)=att_init("zb_b",td_namz%d_zb_b)
+         ENDIF
+      ENDIF
+
+      IF( td_namz%l_wd )THEN
+         ji=ji+1 ; tf_att(ji)=att_init("wetting_drying","activated")
+      ENDIF
+
+      IF( td_namz%l_wd )THEN
+         ji=ji+1 ; tf_att(ji)=att_init("wdmin1",td_namz%d_wdmin1)
+         ji=ji+1 ; tf_att(ji)=att_init("wdmin2",td_namz%d_wdmin2)
+         ji=ji+1 ; tf_att(ji)=att_init("wdld",td_namz%d_wdld)
+      ENDIF
+ 
+   END FUNCTION create_meshmask__gloatt
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END PROGRAM
Index: /utils/tools_ticket2413/SIREN/src/create_restart.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/create_restart.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/create_restart.f90	(revision 12863)
@@ -0,0 +1,1518 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @file
+!> @brief 
+!> this program creates restart file or initial state.
+!>
+!> @details
+!> @section sec1 method
+!> variables could be 
+!>  - extracted from fine grid file
+!>  - interpolated from coarse grid file
+!>  - interpolated from restart file
+!>  - handwritten
+!>
+!> then they are split over new layout. 
+!> @note
+!>    interpolation and/or extrapolation method could be different for each variable.
+!>
+!> @section sec2 how to
+!> USAGE: create_restart create_restart.nam [-v] [-h]<br/>
+!>    - positional arguments:<br/>
+!>       - create_restart.nam<br/>
+!>          namelist of create_restart
+!>          @note
+!>             a template of the namelist could be created running (in templates directory):
+!>             @code{.sh}
+!>                python create_templates.py create_restart
+!>             @endcode
+!>
+!>    - optional arguments:<br/>
+!>       - -h, --help<br/>
+!>          show this help message (and exit)<br/>
+!>       - -v, --version<br/>
+!>          show Siren's version   (and exit)
+!>
+!> @section sec_restart create_restart.nam
+!>    create_restart.nam contains 9 namelists:<br/>
+!>       - **namlog** to set logger parameters
+!>       - **namcfg** to set configuration file parameters
+!>       - **namsrc** to set source/coarse grid parameters
+!>       - **namtgt** to set target/fine grid parameters
+!>       - **namzgr** to set vertical grid parameters
+!>       - **namzps** to set partial step parameters
+!>       - **namvar** to set variable parameters
+!>       - **namnst** to set sub domain and nesting paramters
+!>       - **namout** to set output parameters
+!>
+!>    here after, each sub-namelist parameters is detailed.
+!>    @note 
+!>       default values are specified between brackets
+!>
+!> @subsection sublog namlog
+!>    the logger sub-namelist parameters are :
+!>
+!>    - **cn_logfile** [@a create_restart.log]<br/>
+!>       logger filename
+!>
+!>    - **cn_verbosity** [@a warning]<br/>
+!>       verbosity level, choose between :
+!>          - trace
+!>          - debug
+!>          - info
+!>          - warning
+!>          - error
+!>          - fatal
+!>          - none
+!>
+!>    - **in_maxerror** [@a 5]<br/> 
+!>       maximum number of error allowed
+!>
+!> @subsection subcfg namcfg
+!>    the configuration sub-namelist parameters are :
+!>
+!>    - **cn_varcfg** [@a ./cfg/variable.cfg]<br/>
+!>       path to the variable configuration file.<br/>
+!>       the variable configuration file defines standard name, 
+!>       default interpolation method, axis,... 
+!>       to be used for some known variables.<br/> 
+!>
+!>    - **cn_dimcfg** [@a ./cfg/dimension.cfg]<br/> 
+!>       path to the dimension configuration file.<br/> 
+!>       the dimension configuration file defines dimensions allowed.<br/> 
+!>
+!>    - **cn_dumcfg** [@a ./cfg/dummy.cfg]<br/> 
+!>       path to the useless (dummy) configuration file.<br/>
+!>       the dummy configuration file defines useless 
+!>       dimension or variable. these dimension(s) or variable(s) will not be
+!>       processed.<br/>
+!>
+!> @subsection subsrc namsrc 
+!>    the coarse grid sub-namelist parameters are :
+!>
+!>    - **cn_coord0** [@a ]<br/> 
+!>       path to the coordinate file
+!>
+!>    - **in_perio0** [@a ]<br/> 
+!>       NEMO periodicity index<br/> 
+!>       the NEMO periodicity could be choose between 0 to 6:
+!>       <dl>
+!>          <dt>in_perio=0</dt>
+!>          <dd>standard regional model</dd>
+!>          <dt>in_perio=1</dt>
+!>          <dd>east-west cyclic model</dd>
+!>          <dt>in_perio=2</dt>
+!>          <dd>model with symmetric boundary condition across the equator</dd>
+!>          <dt>in_perio=3</dt>
+!>          <dd>regional model with North fold boundary and T-point pivot</dd>
+!>          <dt>in_perio=4</dt>
+!>          <dd>global model with a T-point pivot.<br/>
+!>          example: ORCA2, ORCA025, ORCA12</dd>
+!>          <dt>in_perio=5</dt>
+!>          <dd>regional model with North fold boundary and F-point pivot</dd>
+!>          <dt>in_perio=6</dt>
+!>          <dd>global model with a F-point pivot<br/>
+!>          example: ORCA05</dd>
+!>          </dd>
+!>       </dl>
+!>       @sa For more information see @ref md_src_docsrc_6_perio
+!>       and Model Boundary Condition paragraph in the 
+!>       [NEMO documentation](https://forge.ipsl.jussieu.fr/nemo/chrome/site/doc/NEMO/manual/pdf/NEMO_manual.pdf)
+!>
+!> @subsection subtgt namtgt 
+!>    the fine grid sub-namelist parameters are :
+!>
+!>    - **cn_coord1** [@a ]<br/> 
+!>       path to coordinate file
+!>
+!>    - **cn_bathy1** [@a ]<br/> 
+!>       path to bathymetry file
+!>
+!>    - **in_perio1** [@a ]<br/>
+!>       NEMO periodicity index (see above)
+!>    @note if the fine/target coordinates file (cn_coord1) was created by SIREN, you do
+!>    not need to fill this parameter. SIREN will read it on the global attributes of
+!>    the coordinates file.
+!>
+!> @subsection subzgr namzgr
+!>    the vertical grid sub-namelist parameters are :
+!>
+!>    - **dn_pp_to_be_computed** [@a 0]<br/>
+!>
+!>    - **dn_ppsur** [@a -3958.951371276829]<br/>
+!>       coefficient to compute vertical grid
+!>
+!>    - **dn_ppa0** [@a 103.953009600000]<br/>
+!>       coefficient to compute vertical grid
+!>
+!>    - **dn_ppa1** [@a 2.415951269000]<br/>
+!>       coefficient to compute vertical grid
+!>
+!>    - **dn_ppa2** [@a 100.760928500000]<br/>
+!>       double tanh function parameter
+!>
+!>    - **dn_ppkth** [@a 15.351013700000]<br/>
+!>       coefficient to compute vertical grid
+!>
+!>    - **dn_ppkth2** [@a 48.029893720000]<br/>
+!>       double tanh function parameter
+!>
+!>    - **dn_ppacr** [@a 7.000000000000]<br/>
+!>       coefficient to compute vertical grid
+!>
+!>    - **dn_ppacr2** [@a 13.000000000000]<br/>
+!>       double tanh function parameter
+!>
+!>    - **dn_ppdzmin** [@a 6.]<br/>
+!>       minimum vertical spacing
+!>
+!>    - **dn_pphmax** [@a 5750.]<br/>
+!>       maximum depth
+!>
+!>    - **in_nlevel** [@a 75]<br/>
+!>       number of vertical level
+!>
+!>     @note 
+!>       If *dn_ppa1*, *dn_ppa0* and *dn_ppsur* are undefined,
+!>       NEMO will compute them from *dn_ppdzmin, dn_pphmax, dn_ppkth, dn_ppacr*
+!>
+!> @subsection subzps namzps
+!>    the partial step sub-namelist parameters are :
+!>
+!>    - **dn_e3zps_min** [@a 25.]<br/>
+!>       minimum thickness of partial step level (meters)
+!>    - **dn_e3zps_rat** [@a 0.2]<br/>
+!>       minimum thickness ratio of partial step level
+!>
+!> @subsection subvar namvar 
+!>    the variable sub-namelist parameters are :
+!>
+!>    - **cn_varfile** [@a ]<br/> 
+!>       list of variable, and associated file 
+!>
+!>       *cn_varfile* is the path and filename of the file where find
+!>       variable.
+!>       @note 
+!>          *cn_varfile* could be a matrix of value, if you want to handwrite
+!>          variable value.<br/>
+!>          the variable array of value is split into equal subdomain.<br/>
+!>          each subdomain is filled with the corresponding value 
+!>          of the matrix.<br/>          
+!>          separators used to defined matrix are:
+!>             - ',' for line
+!>             - '/' for row
+!>             Example:<br/>
+!>                3,2,3/1,4,5  =>  @f$ \left( \begin{array}{ccc}
+!>                                      3 & 2 & 3 \\
+!>                                      1 & 4 & 5 \end{array} \right) @f$
+!>
+!>       Examples: 
+!>          - 'votemper:gridT.nc', 'vozocrtx:gridU.nc'
+!>          - 'votemper:10\25', 'vozocrtx:gridU.nc'<br/>
+!>
+!>       @note
+!>          to get all variables from one file:
+!>
+!>       Example:
+!>          - 'all:restart.dimg'
+!>
+!>       @note 
+!>          Optionnaly, NEMO periodicity could be added following the filename.
+!>          the periodicity must be separated by ';'
+!>
+!>       Example:
+!>          - 'votemper:gridT.nc ; perio=4'
+!>
+!>    - **cn_varinfo** [@a ]<br/> 
+!>       list of variable and extra information about request(s) to be used<br/>
+!>
+!>       each elements of *cn_varinfo* is a string character (separated by ',').<br/>
+!>       it is composed of the variable name follow by ':', 
+!>       then request(s) to be used on this variable.<br/> 
+!>       request could be:
+!>          - int = interpolation method
+!>          - ext = extrapolation method
+!>          - flt = filter method
+!>          - min = minimum value
+!>          - max = maximum value
+!>          - unt = new units
+!>          - unf = unit scale factor (linked to new units)
+!>
+!>             requests must be separated by ';'.<br/>
+!>             order of requests does not matter.<br/>
+!>
+!>       informations about available method could be find in @ref interp,
+!>       @ref extrap and @ref filter modules.<br/>
+!>       Example: 
+!>          - 'votemper: int=linear; flt=hann; ext=dist_weight',
+!>            'vosaline: int=cubic'
+!>
+!>       @note 
+!>          If you do not specify a method which is required, 
+!>          default one is apply.
+!>
+!> @subsection subnst namnst 
+!>    the nesting sub-namelist parameters are :
+!>
+!>    - **in_rhoi**  [@a 1]<br/> 
+!>       refinement factor in i-direction
+!>
+!>    - **in_rhoj**  [@a 1]<br/> 
+!>       refinement factor in j-direction
+!>
+!>    @note 
+!>       coarse grid indices will be deduced from fine grid
+!>       coordinate file.
+!>
+!> @subsection subout namout 
+!>    the output sub-namelist parameter is :
+!>
+!>    - **cn_fileout** [@a restart.nc]<br/>
+!>       output bathymetry filename
+!>
+!>    - **ln_extrap** [@a .FALSE.]<br/>
+!>       logical to extrapolate land point or not
+!>
+!>    - **in_niproc** [@a 1]<br/>
+!>       number of processor in i-direction
+!>
+!>    - **in_njproc** [@a 1]<br/>
+!>       number of processor in j-direction
+!>
+!>    - **in_nproc** [@a 1]<br/>
+!>       total number of processor to be used
+!>
+!>    - **cn_type** [@a ]<br/>
+!>       output format ('dimg', 'cdf')
+!>
+!>    @note
+!>       - if *in_niproc*, and *in_njproc* are provided : the program only look for land
+!>         processor to be removed
+!>       - if *in_nproc* is provided : the program compute each possible domain layout, 
+!>         and save the one with the most land processor to be removed 
+!>       - with no information about number of processors, the program
+!>         assume to use only one processor
+!>
+!> <hr>
+!> @author J.Paul
+!>
+!> @date November, 2013 - Initial Version
+!> @date September, 2014
+!> - add header for user
+!> - offset computed considering grid point
+!> - add attributes in output variable
+!> @date June, 2015
+!> - extrapolate all land points, and add ln_extrap in namelist.
+!> - allow to change unit.
+!> @date September, 2015
+!> - manage useless (dummy) variable, attributes, and dimension
+!> @date October, 2016
+!> - dimension to be used select from configuration file
+!> @date January, 2019
+!> - add url path to global attributes of output file(s)
+!> - check name and standard name for longitude and latitude
+!> @date February, 2019
+!> - rename sub namelist namcrs to namsrc
+!> - rename sub namelist namfin to namtgt
+!> @date May, 2019
+!> - create and clean file structure to avoid memory leaks
+!> @date August, 2019
+!> - use periodicity read from namelist, and store in multi structure
+!> @date Ocober, 2019
+!> - add help and version optional arguments
+!>
+!> @todo
+!> - rewrite using meshmask instead of bathymetry and coordinates files
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+PROGRAM create_restart
+
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+   USE date                            ! date manager
+   USE att                             ! attribute manager
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+   USE file                            ! file manager
+   USE multi                           ! multi file manager
+   USE iom                             ! I/O manager
+   USE grid                            ! grid manager
+   USE vgrid                           ! vertical grid manager
+   USE extrap                          ! extrapolation manager
+   USE interp                          ! interpolation manager
+   USE filter                          ! filter manager
+   USE mpp                             ! MPP manager
+   USE dom                             ! domain manager
+   USE iom_mpp                         ! MPP I/O manager
+   USE iom_dom                         ! DOM I/O manager
+
+   IMPLICIT NONE
+
+   ! parameters
+   CHARACTER(LEN=lc), PARAMETER  :: cp_myname = "create_restart"
+
+   ! local variable
+   CHARACTER(LEN=lc)                                  :: cl_arg
+   CHARACTER(LEN=lc)                                  :: cl_namelist
+   CHARACTER(LEN=lc)                                  :: cl_date
+   CHARACTER(LEN=lc)                                  :: cl_name
+   CHARACTER(LEN=lc)                                  :: cl_data
+   CHARACTER(LEN=lc)                                  :: cl_fileout 
+   CHARACTER(LEN=lc)                                  :: cl_url
+   CHARACTER(LEN=lc)                                  :: cl_errormsg
+
+   INTEGER(i4)                                        :: il_narg
+   INTEGER(i4)                                        :: il_status
+   INTEGER(i4)                                        :: il_fileid
+   INTEGER(i4)                                        :: il_varid
+   INTEGER(i4)                                        :: il_attid
+   INTEGER(i4)                                        :: il_nvar
+   INTEGER(i4)                                        :: il_imin1
+   INTEGER(i4)                                        :: il_imax1
+   INTEGER(i4)                                        :: il_jmin1
+   INTEGER(i4)                                        :: il_jmax1
+   INTEGER(i4)                                        :: il_imin0
+   INTEGER(i4)                                        :: il_imax0
+   INTEGER(i4)                                        :: il_jmin0
+   INTEGER(i4)                                        :: il_jmax0
+   INTEGER(i4)                                        :: il_index
+   INTEGER(i4)      , DIMENSION(ip_maxdim)            :: il_rho
+   INTEGER(i4)      , DIMENSION(2,2)                  :: il_xghost
+   INTEGER(i4)      , DIMENSION(2,2)                  :: il_offset
+   INTEGER(i4)      , DIMENSION(2,2)                  :: il_ind
+
+   LOGICAL                                            :: ll_exist
+   LOGICAL                                            :: ll_sameGrid
+
+   TYPE(TDOM)                                         :: tl_dom1
+   TYPE(TDOM)                                         :: tl_dom0
+
+   TYPE(TATT)                                         :: tl_att
+   
+   TYPE(TVAR)                                         :: tl_depth
+   TYPE(TVAR)                                         :: tl_time
+   TYPE(TVAR)                                         :: tl_lon
+   TYPE(TVAR)                                         :: tl_lat
+   TYPE(TVAR)       , DIMENSION(:)      , ALLOCATABLE :: tl_var
+   TYPE(TVAR)       , DIMENSION(:)      , ALLOCATABLE :: tl_level
+   
+   TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
+
+   TYPE(TFILE)                                        :: tl_file
+
+   TYPE(TMPP)                                         :: tl_coord0
+   TYPE(TMPP)                                         :: tl_coord1
+   TYPE(TMPP)                                         :: tl_bathy1
+   TYPE(TMPP)                                         :: tl_mpp
+   TYPE(TMPP)                                         :: tl_mppout
+
+   TYPE(TMULTI)                                       :: tl_multi
+
+   ! loop indices
+   INTEGER(i4) :: ji
+   INTEGER(i4) :: jj
+   INTEGER(i4) :: jvar
+
+   ! namelist variable
+   ! namlog
+   CHARACTER(LEN=lc)                       :: cn_logfile = 'create_restart.log' 
+   CHARACTER(LEN=lc)                       :: cn_verbosity = 'warning' 
+   INTEGER(i4)                             :: in_maxerror = 5
+
+   ! namcfg
+   CHARACTER(LEN=lc)                       :: cn_varcfg = './cfg/variable.cfg' 
+   CHARACTER(LEN=lc)                       :: cn_dimcfg = './cfg/dimension.cfg'
+   CHARACTER(LEN=lc)                       :: cn_dumcfg = './cfg/dummy.cfg'
+
+   ! namsrc
+   CHARACTER(LEN=lc)                       :: cn_coord0 = '' 
+   INTEGER(i4)                             :: in_perio0 = -1
+
+   ! namtgt
+   CHARACTER(LEN=lc)                       :: cn_coord1 = ''
+   CHARACTER(LEN=lc)                       :: cn_bathy1 = ''
+   INTEGER(i4)                             :: in_perio1 = -1
+
+   !namzgr
+   REAL(dp)                                :: dn_pp_to_be_computed = 0._dp
+   REAL(dp)                                :: dn_ppsur   = -3958.951371276829_dp
+   REAL(dp)                                :: dn_ppa0    =   103.953009600000_dp
+   REAL(dp)                                :: dn_ppa1    =     2.415951269000_dp
+   REAL(dp)                                :: dn_ppa2    =   100.760928500000_dp
+   REAL(dp)                                :: dn_ppkth   =    15.351013700000_dp
+   REAL(dp)                                :: dn_ppkth2  =    48.029893720000_dp
+   REAL(dp)                                :: dn_ppacr   =     7.000000000000_dp
+   REAL(dp)                                :: dn_ppacr2  =    13.000000000000_dp
+   REAL(dp)                                :: dn_ppdzmin = 6._dp
+   REAL(dp)                                :: dn_pphmax  = 5750._dp
+   INTEGER(i4)                             :: in_nlevel  = 75
+
+   !namzps
+   REAL(dp)                                :: dn_e3zps_min = 25._dp
+   REAL(dp)                                :: dn_e3zps_rat = 0.2_dp
+
+   ! namvar
+   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varfile = ''
+   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = ''
+
+   ! namnst
+   INTEGER(i4)                             :: in_rhoi = 1
+   INTEGER(i4)                             :: in_rhoj = 1
+
+   ! namout
+   CHARACTER(LEN=lc)                       :: cn_fileout = 'restart.nc' 
+   LOGICAL                                 :: ln_extrap  = .FALSE.
+   INTEGER(i4)                             :: in_nproc   = 0
+   INTEGER(i4)                             :: in_niproc  = 0
+   INTEGER(i4)                             :: in_njproc  = 0
+   CHARACTER(LEN=lc)                       :: cn_type    = ''
+
+   !-------------------------------------------------------------------
+
+   NAMELIST /namlog/ &  !< logger namelist
+   &  cn_logfile,    &  !< log file
+   &  cn_verbosity,  &  !< log verbosity
+   &  in_maxerror       !< logger maximum error
+
+   NAMELIST /namcfg/ &  !< configuration namelist
+   &  cn_varcfg,     &  !< variable configuration file
+   &  cn_dimcfg,     &  !< dimension configuration file
+   &  cn_dumcfg         !< dummy configuration file
+
+   NAMELIST /namsrc/ &  !< source/coarse grid namelist
+   &  cn_coord0,     &  !< coordinate file
+   &  in_perio0         !< periodicity index
+
+   NAMELIST /namtgt/ &  !< target/fine grid namelist
+   &  cn_coord1,     &  !< coordinate file
+   &  cn_bathy1,     &  !< bathymetry file
+   &  in_perio1         !< periodicity index
+ 
+   NAMELIST /namzgr/ &
+   &  dn_pp_to_be_computed, &
+   &  dn_ppsur,      &
+   &  dn_ppa0,       &
+   &  dn_ppa1,       &
+   &  dn_ppa2,       &
+   &  dn_ppkth,      &
+   &  dn_ppkth2,     &
+   &  dn_ppacr,      &
+   &  dn_ppacr2,     &
+   &  dn_ppdzmin,    &
+   &  dn_pphmax,     &
+   &  in_nlevel         !< number of vertical level
+
+   NAMELIST /namzps/ &
+   &  dn_e3zps_min,  &
+   &  dn_e3zps_rat
+
+   NAMELIST /namvar/ &  !< variable namelist
+   &  cn_varfile,    &  !< list of variable file
+   &  cn_varinfo        !< list of variable and interpolation method to be used.
+
+   NAMELIST /namnst/ &  !< nesting namelist
+   &  in_rhoi,       &  !< refinement factor in i-direction
+   &  in_rhoj           !< refinement factor in j-direction
+
+   NAMELIST /namout/ &  !< output namelist
+   &  cn_fileout,    &  !< fine grid bathymetry file
+   &  ln_extrap,     &  !< extrapolate or not
+   &  in_niproc,     &  !< i-direction number of processor
+   &  in_njproc,     &  !< j-direction numebr of processor
+   &  in_nproc,      &  !< number of processor to be used
+   &  cn_type           !< output type format (dimg, cdf)
+   !-------------------------------------------------------------------
+
+   !
+   ! Initialisation
+   ! --------------
+   !
+   il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec
+
+   ! Traitement des arguments fournis
+   ! --------------------------------
+   IF( il_narg /= 1 )THEN
+      WRITE(cl_errormsg,*) ' ERROR : one argument is needed '
+      CALL fct_help(cp_myname,cl_errormsg) 
+      CALL EXIT(1)
+   ELSE
+
+      CALL GET_COMMAND_ARGUMENT(1,cl_arg) !f03 intrinsec
+      SELECT CASE (cl_arg)
+         CASE ('-v', '--version')
+
+            CALL fct_version(cp_myname)
+            CALL EXIT(0)
+
+         CASE ('-h', '--help')
+
+            CALL fct_help(cp_myname)
+            CALL EXIT(0)
+
+         CASE DEFAULT
+
+            cl_namelist=cl_arg
+
+            ! read namelist
+            INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist)
+            IF( ll_exist )THEN
+
+               il_fileid=fct_getunit()
+
+               OPEN( il_fileid, FILE=TRIM(cl_namelist),  &
+               &                FORM='FORMATTED',        &
+               &                ACCESS='SEQUENTIAL',     &
+               &                STATUS='OLD',            &
+               &                ACTION='READ',           &
+               &                IOSTAT=il_status)
+               CALL fct_err(il_status)
+               IF( il_status /= 0 )THEN
+                  WRITE(cl_errormsg,*) " ERROR : error opening "//TRIM(cl_namelist)
+                  CALL fct_help(cp_myname,cl_errormsg) 
+                  CALL EXIT(1)
+               ENDIF
+
+               READ( il_fileid, NML = namlog )
+ 
+               ! define logger file
+               CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror)
+               CALL logger_header()
+
+               READ( il_fileid, NML = namcfg )
+               ! get variable extra information
+               CALL var_def_extra(TRIM(cn_varcfg))
+
+               ! get dimension allowed
+               CALL dim_def_extra(TRIM(cn_dimcfg))
+
+               ! get dummy variable
+               CALL var_get_dummy(TRIM(cn_dumcfg))
+               ! get dummy dimension
+               CALL dim_get_dummy(TRIM(cn_dumcfg))
+               ! get dummy attribute
+               CALL att_get_dummy(TRIM(cn_dumcfg))
+
+               READ( il_fileid, NML = namsrc )
+               READ( il_fileid, NML = namtgt )
+               READ( il_fileid, NML = namzgr )
+               READ( il_fileid, NML = namvar )
+               ! add user change in extra information
+               CALL var_chg_extra(cn_varinfo)
+               ! match variable with file
+               tl_multi=multi_init(cn_varfile)
+
+               READ( il_fileid, NML = namnst )
+               READ( il_fileid, NML = namout )
+
+               CLOSE( il_fileid, IOSTAT=il_status )
+               CALL fct_err(il_status)
+               IF( il_status /= 0 )THEN
+                  CALL logger_error("CREATE RESTART: closing "//TRIM(cl_namelist))
+               ENDIF
+
+            ELSE
+
+               WRITE(cl_errormsg,*) " ERROR : can't find "//TRIM(cl_namelist)
+               CALL fct_help(cp_myname,cl_errormsg) 
+               CALL EXIT(1)
+
+            ENDIF
+
+      END SELECT
+   ENDIF
+
+   CALL multi_print(tl_multi)
+
+   IF( tl_multi%i_nvar <= 0 )THEN
+      CALL logger_fatal("CREATE RESTART: no variable to be used."//&
+      &  " check namelist.")
+   ENDIF
+
+   ! open files
+   IF( cn_coord0 /= '' )THEN
+      tl_file=file_init(TRIM(cn_coord0))
+      tl_coord0=mpp_init( tl_file, id_perio=in_perio0)
+      ! clean
+      CALL file_clean(tl_file)
+      CALL grid_get_info(tl_coord0)
+   ELSE
+      CALL logger_fatal("CREATE RESTART: no coarse grid coordinate found. "//&
+      &     "check namelist")      
+   ENDIF
+
+   IF( TRIM(cn_coord1) /= '' )THEN
+      tl_file=file_init(TRIM(cn_coord1))
+      tl_coord1=mpp_init( tl_file, id_perio=in_perio1)
+      ! clean
+      CALL file_clean(tl_file)
+      CALL grid_get_info(tl_coord1)
+   ELSE
+      CALL logger_fatal("CREATE RESTART: no fine grid coordinate found. "//&
+      &     "check namelist")
+   ENDIF
+
+   IF( TRIM(cn_bathy1) /= '' )THEN
+      tl_file=file_init(TRIM(cn_bathy1))
+      tl_bathy1=mpp_init( tl_file, id_perio=in_perio1)
+      ! clean
+      CALL file_clean(tl_file)
+      CALL grid_get_info(tl_bathy1)
+   ELSE
+      CALL logger_fatal("CREATE RESTART: no fine grid bathymetry found. "//&
+      &     "check namelist")
+   ENDIF
+
+   ! check
+   ! check output file do not already exist
+   IF( in_nproc > 0 )THEN
+      cl_fileout=file_rename(cn_fileout,1)
+   ELSE
+      cl_fileout=file_rename(cn_fileout)
+   ENDIF
+   INQUIRE(FILE=TRIM(cl_fileout), EXIST=ll_exist)
+   IF( ll_exist )THEN
+      CALL logger_fatal("CREATE RESTART: output file "//TRIM(cl_fileout)//&
+      &  " already exist.")
+   ENDIF
+
+   ! check refinement factor
+   il_rho(:)=1
+   IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN
+      CALL logger_error("CREATE RESTART: invalid refinement factor."//&
+      &  " check namelist "//TRIM(cl_namelist))
+   ELSE
+      il_rho(jp_I)=in_rhoi
+      il_rho(jp_J)=in_rhoj
+   ENDIF
+
+   ! check domain indices
+   ! compute coarse grid indices around fine grid
+   il_ind(:,:)=grid_get_coarse_index(tl_coord0, tl_coord1, &
+   &                                 id_rho=il_rho(:))
+
+   il_imin0=il_ind(1,1) ; il_imax0=il_ind(1,2)
+   il_jmin0=il_ind(2,1) ; il_jmax0=il_ind(2,2)
+
+   ! check domain validity
+   CALL grid_check_dom(tl_coord0, il_imin0, il_imax0, il_jmin0, il_jmax0)
+
+   !3-2-4 check coincidence between coarse and fine grid
+   CALL grid_check_coincidence( tl_coord0, tl_coord1, &
+   &                            il_imin0, il_imax0, &
+   &                            il_jmin0, il_jmax0, &
+   &                            il_rho(:) )
+
+   ! fine grid ghost cell
+   il_xghost(:,:)=grid_get_ghost(tl_bathy1)
+
+   ! work on variables
+   IF( .NOT. ASSOCIATED(tl_multi%t_mpp) )THEN
+      CALL logger_error("CREATE RESTART: no file to work on. "//&
+      &                 "check cn_varfile in namelist.")
+   ELSE
+      ALLOCATE( tl_var( tl_multi%i_nvar ) )
+
+      jvar=0
+      ! for each file
+      DO ji=1,tl_multi%i_nmpp
+
+         WRITE(cl_data,'(a,i2.2)') 'data-',jvar+1
+         IF( .NOT. ASSOCIATED(tl_multi%t_mpp(ji)%t_proc(1)%t_var) )THEN
+
+            CALL logger_error("CREATE RESTART: no variable to work on for "//&
+            &                 "mpp "//TRIM(tl_multi%t_mpp(ji)%c_name)//&
+            &                 ". check cn_varfile in namelist.")
+
+         ELSEIF( TRIM(tl_multi%t_mpp(ji)%c_name) == TRIM(cl_data) )THEN
+         !- use input matrix to fill variable
+
+            WRITE(*,'(a)') "work on data"
+            ! for each variable initialise from matrix
+            DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
+
+               jvar=jvar+1
+
+               WRITE(*,'(2x,a,a)') "work on variable "//&
+               &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
+
+               ! fill value with matrix data
+               tl_var(jvar) = create_restart_matrix( &
+               &  tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj), tl_coord1, &
+               &  in_nlevel, il_xghost(:,:) )
+
+               ! add ghost cell
+               CALL grid_add_ghost(tl_var(jvar), il_xghost(:,:))
+
+            ENDDO
+         !- end of use input matrix to fill variable
+         ELSE
+         !- use mpp file to fill variable
+
+            WRITE(*,'(a)') "work on file "//TRIM(tl_multi%t_mpp(ji)%c_name)
+            !
+            tl_file=file_init(TRIM(tl_multi%t_mpp(ji)%t_proc(1)%c_name), &
+               &              id_perio=tl_multi%t_mpp(ji)%i_perio)
+            tl_mpp=mpp_init( tl_file )
+            ! clean
+            CALL file_clean(tl_file)
+            CALL grid_get_info(tl_mpp)
+
+            ! check vertical dimension
+            IF( tl_mpp%t_dim(jp_K)%l_use .AND. &
+            &   tl_mpp%t_dim(jp_K)%i_len /= in_nlevel  )THEN
+               CALL logger_error("CREATE RESTART: dimension in file "//&
+               &  TRIM(tl_mpp%c_name)//" not agree with namelist in_nlevel ")
+            ENDIF
+
+            ! open mpp file
+            CALL iom_mpp_open(tl_mpp)
+
+            ! get or check depth value
+            CALL create_restart_check_depth( tl_mpp, tl_depth )
+
+            ! get or check time value
+            CALL create_restart_check_time( tl_mpp, tl_time )
+
+            ! close mpp file
+            CALL iom_mpp_close(tl_mpp)
+
+            IF( ANY(tl_mpp%t_dim(1:2)%i_len /= tl_coord0%t_dim(1:2)%i_len) .OR.&
+            &   ALL(il_rho(:)==1) )THEN
+            !!! extract value from fine grid 
+
+               IF( ANY( tl_mpp%t_dim(1:2)%i_len < &
+               &        tl_coord1%t_dim(1:2)%i_len) )THEN
+                  CALL logger_fatal("CREATE RESTART: dimensions in file "//&
+                  &  TRIM(tl_mpp%c_name)//" smaller than those in fine"//&
+                  &  " grid coordinates.")
+               ENDIF
+
+               ! use coord0 instead of mpp for restart file case 
+               !  (without lon,lat)
+               ll_sameGrid=.FALSE.
+               IF( ALL(tl_mpp%t_dim(1:2)%i_len /= tl_coord0%t_dim(1:2)%i_len) &
+               &   )THEN
+                  ll_sameGrid=.TRUE. 
+               ENDIF
+
+               ! compute domain on fine grid
+               IF( ll_sameGrid )THEN
+                  il_ind(:,:)=grid_get_coarse_index(tl_mpp, tl_coord1 )
+               ELSE
+                  il_ind(:,:)=grid_get_coarse_index(tl_coord0, tl_coord1 )
+               ENDIF
+
+               il_imin1=il_ind(1,1) ; il_imax1=il_ind(1,2)
+               il_jmin1=il_ind(2,1) ; il_jmax1=il_ind(2,2)
+
+               !- check grid coincidence
+               IF( ll_sameGrid )THEN
+                  il_rho(:)=1
+                  CALL grid_check_coincidence( tl_mpp, tl_coord1, &
+                  &                            il_imin1, il_imax1, &
+                  &                            il_jmin1, il_jmax1, &
+                  &                            il_rho(:) )
+               ELSE
+                  CALL grid_check_coincidence( tl_coord0, tl_coord1, &
+                  &                            il_imin1, il_imax1, &
+                  &                            il_jmin1, il_jmax1, &
+                  &                            il_rho(:) )
+               ENDIF
+
+               ! compute domain
+               tl_dom1=dom_init(tl_mpp,         &
+               &                il_imin1, il_imax1, &
+               &                il_jmin1, il_jmax1)
+               
+               ! open mpp files
+               CALL iom_dom_open(tl_mpp, tl_dom1)
+
+               ! for each variable of this file
+               DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
+
+                  WRITE(*,'(2x,a,a)') "work on (extract) variable "//&
+                  &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
+
+                  jvar=jvar+1
+                  cl_name=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name
+                  ! read variable over domain
+                  tl_var(jvar)=iom_dom_read_var(tl_mpp, TRIM(cl_name), tl_dom1)
+
+                  ! add attribute to variable
+                  tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name)))
+                  CALL var_move_att(tl_var(jvar), tl_att)
+
+                  tl_att=att_init('src_i_indices',(/il_imin0, il_imax0/))
+                  CALL var_move_att(tl_var(jvar), tl_att)
+
+                  tl_att=att_init('src_j_indices',(/il_jmin0, il_jmax0/))
+                  CALL var_move_att(tl_var(jvar), tl_att)
+
+                  ! clean structure
+                  CALL att_clean(tl_att)
+
+                  ! add ghost cell
+                  CALL grid_add_ghost(tl_var(jvar), tl_dom1%i_ghost(:,:))
+
+               ENDDO
+
+               ! close mpp file
+               CALL iom_dom_close(tl_mpp)
+
+               ! clean structure
+               CALL mpp_clean(tl_mpp)
+               CALL dom_clean(tl_dom1)
+
+            ELSE
+            !!! get value from coarse grid 
+
+               ! compute domain on coarse grid
+               tl_dom0=dom_init(tl_mpp,             &
+               &                il_imin0, il_imax0, &
+               &                il_jmin0, il_jmax0 )
+
+               ! add extra band (if possible) to compute interpolation
+               CALL dom_add_extra(tl_dom0)
+
+               ! open mpp files
+               CALL iom_dom_open(tl_mpp, tl_dom0)
+               ! for each variable of this file
+               DO jj=1,tl_multi%t_mpp(ji)%t_proc(1)%i_nvar
+
+                  WRITE(*,'(2x,a,a)') "work on (interp) variable "//&
+                  &  TRIM(tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
+
+                  jvar=jvar+1
+                  cl_name=tl_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name
+
+                  ! read variable over domain
+                  tl_var(jvar)=iom_dom_read_var(tl_mpp, TRIM(cl_name), tl_dom0)
+
+                  il_offset(:,:)=grid_get_fine_offset(tl_coord0, &
+                     &                                il_imin0, il_jmin0, &
+                     &                                il_imax0, il_jmax0, &
+                     &                                tl_coord1, &
+                     &                                id_rho=il_rho(:), &
+                     &                                cd_point=TRIM(tl_var(jvar)%c_point))
+
+                  ! interpolate variable
+                  CALL create_restart_interp(tl_var(jvar), & 
+                     &                       il_rho(:), &
+                     &                       id_offset=il_offset(:,:))
+
+                  ! remove extraband added to domain
+                  CALL dom_del_extra( tl_var(jvar), tl_dom0, il_rho(:) )
+
+                  ! add attribute to variable
+                  tl_att=att_init('src_file',TRIM(fct_basename(tl_mpp%c_name)))
+                  CALL var_move_att(tl_var(jvar), tl_att)
+
+                  tl_att=att_init('src_i-indices',(/il_imin0, il_imax0/))
+                  CALL var_move_att(tl_var(jvar), tl_att)
+
+                  tl_att=att_init('src_j-indices',(/il_jmin0, il_jmax0/))
+                  CALL var_move_att(tl_var(jvar), tl_att)
+
+                  IF( ANY(il_rho(:)/=1) )THEN
+                     tl_att=att_init("refinment_factor", &
+                     &               (/il_rho(jp_I),il_rho(jp_J)/))
+                     CALL var_move_att(tl_var(jvar), tl_att)
+                  ENDIF
+
+                  ! clean structure
+                  CALL att_clean(tl_att)
+
+                  ! add ghost cell
+                  CALL grid_add_ghost(tl_var(jvar), il_xghost(:,:))
+               ENDDO
+
+               ! close mpp file
+               CALL iom_dom_close(tl_mpp)
+
+               ! clean structure
+               CALL mpp_clean(tl_mpp)
+               CALL dom_clean(tl_dom0)
+
+            ENDIF
+
+            ! clean structure
+            CALL mpp_clean(tl_mpp)
+         ENDIF
+      ENDDO
+   ENDIF
+
+   il_nvar=tl_multi%i_nvar
+
+   ! clean
+   CALL multi_clean(tl_multi)
+   CALL mpp_clean(tl_coord0)
+
+   IF( .NOT. ln_extrap )THEN
+      ! compute level
+      ALLOCATE(tl_level(ip_npoint))
+      tl_level(:)=vgrid_get_level(tl_bathy1, cl_namelist )
+   ENDIF
+
+   ! clean
+   CALL mpp_clean(tl_bathy1)
+
+   ! use additional request
+   DO jvar=1,il_nvar
+
+      ! change unit and apply factor
+      CALL var_chg_unit(tl_var(jvar))
+
+      ! forced min and max value
+      CALL var_limit_value(tl_var(jvar))
+
+      ! filter
+      CALL filter_fill_value(tl_var(jvar))
+
+      IF( .NOT. ln_extrap )THEN
+         ! use mask
+         CALL create_restart_mask(tl_var(jvar), tl_level(:))
+      ENDIF
+
+   ENDDO
+
+   ! create file
+   IF( in_niproc == 0 .AND. &
+   &   in_njproc == 0 .AND. &
+   &   in_nproc == 0 )THEN
+      in_niproc = 1
+      in_njproc = 1
+      in_nproc = 1
+   ENDIF
+
+   ! add dimension
+   tl_dim(:)=var_max_dim(tl_var(:))
+
+   DO ji=1,il_nvar
+
+      IF( ALL(tl_var(ji)%t_dim(:)%i_len == tl_dim(:)%i_len) )THEN
+         tl_mppout=mpp_init( TRIM(cn_fileout), tl_var(ji), &
+         &                   in_niproc, in_njproc, in_nproc, &
+         &                   cd_type=cn_type)
+         EXIT
+      ENDIF
+
+   ENDDO
+
+   DO ji=1,ip_maxdim
+
+      IF( tl_dim(ji)%l_use )THEN
+         CALL mpp_move_dim(tl_mppout, tl_dim(ji))
+         SELECT CASE(TRIM(tl_dim(ji)%c_sname))
+         CASE('z','t')
+            DO jj=1,tl_mppout%i_nproc
+               CALL file_add_dim(tl_mppout%t_proc(jj), tl_dim(ji))
+            ENDDO
+         END SELECT 
+      ENDIF
+
+   ENDDO
+
+   ! add variables
+   IF( ALL( tl_dim(1:2)%l_use ) )THEN
+
+      ! open mpp files
+      CALL iom_mpp_open(tl_coord1)
+
+      ! add longitude
+      il_varid=var_get_id(tl_coord1%t_proc(1)%t_var(:),'longitude')
+      IF( il_varid == 0 )THEN
+         il_varid=var_get_id(tl_coord1%t_proc(1)%t_var(:),'longitude_T')
+      ENDIF
+      tl_lon=iom_mpp_read_var(tl_coord1, il_varid)
+      CALL mpp_add_var(tl_mppout, tl_lon)
+      CALL var_clean(tl_lon)
+
+      ! add latitude
+      il_varid=var_get_id(tl_coord1%t_proc(1)%t_var(:),'latitude')
+      IF( il_varid == 0 )THEN
+         il_varid=var_get_id(tl_coord1%t_proc(1)%t_var(:),'latitude_T')
+      ENDIF
+      tl_lat=iom_mpp_read_var(tl_coord1, il_varid)
+      CALL mpp_add_var(tl_mppout, tl_lat)
+      CALL var_clean(tl_lat)
+
+      ! close mpp files
+      CALL iom_mpp_close(tl_coord1)
+
+   ENDIF
+
+   IF( tl_dim(3)%l_use )THEN
+      IF( ASSOCIATED(tl_depth%d_value) )THEN
+         ! add depth
+         CALL mpp_add_var(tl_mppout, tl_depth)
+      ELSE
+         CALL logger_warn("CREATE RESTART: no value for depth variable.")
+      ENDIF
+   ENDIF
+   IF( ASSOCIATED(tl_depth%d_value) ) CALL var_clean(tl_depth)
+
+   IF( tl_dim(4)%l_use )THEN
+      IF( ASSOCIATED(tl_time%d_value) )THEN
+         ! add time
+         CALL mpp_add_var(tl_mppout, tl_time)
+      ELSE
+         CALL logger_warn("CREATE RESTART: no value for time variable.")
+      ENDIF
+   ENDIF
+   IF( ASSOCIATED(tl_time%d_value) ) CALL var_clean(tl_time)
+
+   ! add other variable
+   DO jvar=il_nvar,1,-1
+      ! check if variable already add
+      il_index=var_get_index(tl_mppout%t_proc(1)%t_var(:), tl_var(jvar)%c_name)
+      IF( il_index == 0 )THEN
+         CALL mpp_add_var(tl_mppout, tl_var(jvar))
+         CALL var_clean(tl_var(jvar))
+      ENDIF
+   ENDDO
+
+   ! add some attribute
+   tl_att=att_init("Created_by","SIREN create_restart")
+   CALL mpp_add_att(tl_mppout, tl_att)
+
+   !add source url
+   cl_url=fct_split(fct_split(cp_url,2,'$'),2,'URL:')
+   tl_att=att_init("SIREN_url",cl_url)
+   CALL mpp_add_att(tl_mppout, tl_att)
+
+   ! add date of creation
+   cl_date=date_print(date_now())
+   tl_att=att_init("Creation_date",TRIM(cl_date))
+   CALL mpp_add_att(tl_mppout, tl_att)
+
+   ! add attribute periodicity
+   il_attid=0
+   IF( ASSOCIATED(tl_mppout%t_proc(1)%t_att) )THEN
+      il_attid=att_get_id(tl_mppout%t_proc(1)%t_att(:),'periodicity')
+   ENDIF
+   IF( tl_coord1%i_perio >= 0 .AND. il_attid == 0 )THEN
+      tl_att=att_init('periodicity',tl_coord1%i_perio)
+      CALL mpp_add_att(tl_mppout,tl_att)
+   ENDIF
+
+   il_attid=0
+   IF( ASSOCIATED(tl_mppout%t_proc(1)%t_att) )THEN
+      il_attid=att_get_id(tl_mppout%t_proc(1)%t_att(:),'ew_overlap')
+   ENDIF
+   IF( tl_coord1%i_ew >= 0 .AND. il_attid == 0 )THEN
+      tl_att=att_init('ew_overlap',tl_coord1%i_ew)
+      CALL mpp_add_att(tl_mppout,tl_att)
+   ENDIF
+
+   ! print
+   CALL mpp_print(tl_mppout)
+
+   ! create file
+   CALL iom_mpp_create(tl_mppout)
+
+   ! write file
+   CALL iom_mpp_write_file(tl_mppout)
+   ! close file
+   CALL iom_mpp_close(tl_mppout)
+
+   ! clean
+   CALL att_clean(tl_att)
+   CALL var_clean(tl_var(:))
+   DEALLOCATE(tl_var)
+   IF( .NOT. ln_extrap )THEN
+      CALL var_clean(tl_level(:))
+      DEALLOCATE(tl_level)
+   ENDIF
+
+   CALL mpp_clean(tl_mppout)
+   CALL mpp_clean(tl_coord1)
+   CALL var_clean_extra()
+
+   ! close log file
+   CALL logger_footer()
+   CALL logger_close()
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION create_restart_matrix(td_var, td_coord, id_nlevel, id_xghost) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function create variable, filled with matrix value
+   !> 
+   !> @details 
+   !> A variable is create with the same name that the input variable, 
+   !> and with dimension of the coordinate file.<br/> 
+   !> Then the variable array of value is split into equal subdomain.
+   !> Each subdomain is filled with the associated value of the matrix.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - do not use level anymore 
+   !>
+   !> @param[in] td_var    variable structure 
+   !> @param[in] td_coord  coordinate file structure 
+   !> @param[in] id_nlevel number of vertical level  
+   !> @param[in] id_xghost ghost cell array
+   !> @return variable structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR)                 , INTENT(IN) :: td_var
+      TYPE(TMPP)                 , INTENT(IN) :: td_coord
+      INTEGER(i4)                , INTENT(IN) :: id_nlevel
+      INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_xghost
+
+      ! function
+      TYPE(TVAR)                              :: tf_var
+
+      ! local variable
+      INTEGER(i4)      , DIMENSION(3)                    :: il_dim
+      INTEGER(i4)      , DIMENSION(3)                    :: il_size
+      INTEGER(i4)      , DIMENSION(3)                    :: il_rest
+
+      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_ishape
+      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_jshape
+      INTEGER(i4)      , DIMENSION(:)      , ALLOCATABLE :: il_kshape
+
+      REAL(dp)         , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      ! write value on grid
+      ! get matrix dimension
+      il_dim(:)=td_var%t_dim(1:3)%i_len
+
+      ! output dimension
+      tl_dim(jp_I:jp_J)=dim_copy(td_coord%t_dim(jp_I:jp_J))
+      IF( id_nlevel >= 1 )THEN
+         tl_dim(jp_K)=dim_init('Z',id_nlevel)
+      ENDIF
+
+      ! remove ghost cell
+      tl_dim(jp_I)%i_len=tl_dim(jp_I)%i_len - SUM(id_xghost(jp_I,:))*ip_ghost
+      tl_dim(jp_J)%i_len=tl_dim(jp_J)%i_len - SUM(id_xghost(jp_J,:))*ip_ghost
+
+      ! split output domain in N subdomain depending of matrix dimension 
+      il_size(:) = tl_dim(1:3)%i_len / il_dim(:)
+      il_rest(:) = MOD(tl_dim(1:3)%i_len, il_dim(:))
+
+      ALLOCATE( il_ishape(il_dim(1)+1) )
+      il_ishape(:)=0
+      DO ji=2,il_dim(1)+1
+         il_ishape(ji)=il_ishape(ji-1)+il_size(1)
+      ENDDO
+      ! add rest to last cell
+      il_ishape(il_dim(1)+1)=il_ishape(il_dim(1)+1)+il_rest(1)
+
+      ALLOCATE( il_jshape(il_dim(2)+1) )
+      il_jshape(:)=0
+      DO jj=2,il_dim(2)+1
+         il_jshape(jj)=il_jshape(jj-1)+il_size(2)
+      ENDDO
+      ! add rest to last cell
+      il_jshape(il_dim(2)+1)=il_jshape(il_dim(2)+1)+il_rest(2)
+
+      ALLOCATE( il_kshape(il_dim(3)+1) )
+      il_kshape(:)=0
+      DO jk=2,il_dim(3)+1
+         il_kshape(jk)=il_kshape(jk-1)+il_size(3)
+      ENDDO
+      ! add rest to last cell
+      il_kshape(il_dim(3)+1)=il_kshape(il_dim(3)+1)+il_rest(3)
+
+      ! write ouput array of value 
+      ALLOCATE(dl_value( tl_dim(1)%i_len, &
+      &                  tl_dim(2)%i_len, &
+      &                  tl_dim(3)%i_len, &
+      &                  tl_dim(4)%i_len) )
+
+      dl_value(:,:,:,:)=0
+
+      DO jk=2,il_dim(3)+1
+         DO jj=2,il_dim(2)+1
+            DO ji=2,il_dim(1)+1
+               
+               dl_value( 1+il_ishape(ji-1):il_ishape(ji), &
+               &         1+il_jshape(jj-1):il_jshape(jj), &
+               &         1+il_kshape(jk-1):il_kshape(jk), &
+               &         1 ) = td_var%d_value(ji-1,jj-1,jk-1,1)
+
+            ENDDO
+         ENDDO
+      ENDDO
+
+      ! keep attribute and type
+      tf_var=var_copy(td_var)
+      DEALLOCATE( tf_var%d_value )
+      ! save new dimension
+      tf_var%t_dim(:)=dim_copy(tl_dim(:))
+      ! add variable value
+      CALL var_add_value( tf_var, dl_value(:,:,:,:), &
+      &                   id_type=td_var%i_type)
+
+      DEALLOCATE(dl_value)
+
+      ! clean 
+      DEALLOCATE(il_ishape)
+      DEALLOCATE(il_jshape)
+      DEALLOCATE(il_kshape)
+
+   END FUNCTION create_restart_matrix
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE create_restart_mask(td_var, td_mask)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine use mask to filled land point with _FillValue
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_mask   mask variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR)              , INTENT(INOUT) :: td_var
+      TYPE(TVAR), DIMENSION(:), INTENT(IN   ) :: td_mask
+
+      ! local variable
+      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_mask
+
+      ! loop indices
+      INTEGER(i4) :: jl
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      IF( ALL(td_var%t_dim(1:2)%l_use) )THEN
+         IF( ANY(td_var%t_dim(1:2)%i_len /= td_mask(1)%t_dim(1:2)%i_len) )THEN
+            CALL logger_error("CREATE RESTART MASK: dimension differ between"//&
+            &                 " variable "//TRIM(td_var%c_name)//" ("//&
+            &                 TRIM(fct_str(td_var%t_dim(1)%i_len))//","//&
+            &                 TRIM(fct_str(td_var%t_dim(2)%i_len))//&
+            &                 ") and level ("//&
+            &                 TRIM(fct_str(td_mask(1)%t_dim(1)%i_len))//","//&
+            &                 TRIM(fct_str(td_mask(1)%t_dim(2)%i_len))//")")
+         ELSE
+            ALLOCATE( il_mask(td_var%t_dim(1)%i_len, &
+            &                 td_var%t_dim(2)%i_len) )
+
+            SELECT CASE(TRIM(td_var%c_point))
+            CASE('T')
+               il_mask(:,:)=INT(td_mask(jp_T)%d_value(:,:,1,1))
+            CASE('U')
+               il_mask(:,:)=INT(td_mask(jp_U)%d_value(:,:,1,1))
+            CASE('V')
+               il_mask(:,:)=INT(td_mask(jp_V)%d_value(:,:,1,1))
+            CASE('F')
+               il_mask(:,:)=INT(td_mask(jp_F)%d_value(:,:,1,1))
+            END SELECT
+
+            DO jl=1,td_var%t_dim(4)%i_len
+               DO jk=1,td_var%t_dim(3)%i_len
+                  WHERE( il_mask(:,:) < jk )
+                     td_var%d_value(:,:,jk,jl)=td_var%d_fill
+                  END WHERE
+               ENDDO
+            ENDDO
+
+            DEALLOCATE( il_mask )
+         ENDIF
+      ENDIF
+   END SUBROUTINE create_restart_mask
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE create_restart_interp(td_var, id_rho, id_offset, &
+         &                          id_iext, id_jext)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine interpolate variable
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - do not use level anymore (for extrapolation)
+   !>
+   !> @param[inout] td_var    variable structure 
+   !> @param[in] id_rho       array of refinment factor
+   !> @param[in] id_offset    array of offset between fine and coarse grid
+   !> @param[in] id_iext      i-direction size of extra bands (default=im_minext)
+   !> @param[in] id_jext      j-direction size of extra bands (default=im_minext)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
+      INTEGER(i4), DIMENSION(:)  , INTENT(IN   ) :: id_rho
+      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ) :: id_offset
+      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_iext
+      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_jext
+
+      ! local variable
+      INTEGER(i4) :: il_iext
+      INTEGER(i4) :: il_jext
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      il_iext=3
+      IF( PRESENT(id_iext) ) il_iext=id_iext
+
+      il_jext=3
+      IF( PRESENT(id_jext) ) il_jext=id_jext
+
+      IF( il_iext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
+         CALL logger_warn("CREATE RESTART INTERP: at least extrapolation "//&
+         &  "on two points are required with cubic interpolation ")
+         il_iext=2
+      ENDIF
+
+      IF( il_jext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
+         CALL logger_warn("CREATE RESTART INTERP: at least extrapolation "//&
+         &  "on two points are required with cubic interpolation ")
+         il_jext=2
+      ENDIF
+      ! work on variable
+      ! add extraband
+      CALL extrap_add_extrabands(td_var, il_iext, il_jext)
+
+      ! extrapolate variable
+      CALL extrap_fill_value( td_var )
+
+      ! interpolate variable
+      CALL interp_fill_value( td_var, id_rho(:), &
+      &                       id_offset=id_offset(:,:) )
+
+      ! remove extraband
+      CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J))
+
+   END SUBROUTINE create_restart_interp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE create_restart_check_depth(td_mpp, td_depth)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine get depth variable value in an open mpp structure
+   !> and check if agree with already input depth variable.
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date November, 2014 - Initial Version
+   !>
+   !> @param[in] td_mpp       mpp structure
+   !> @param[inout] td_depth  depth variable structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP), INTENT(IN   ) :: td_mpp
+      TYPE(TVAR), INTENT(INOUT) :: td_depth
+
+      ! local variable
+      INTEGER(i4) :: il_varid
+      TYPE(TVAR)  :: tl_depth
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! get or check depth value
+      IF( td_mpp%t_proc(1)%i_depthid /= 0 )THEN
+
+         il_varid=td_mpp%t_proc(1)%i_depthid
+         IF( ASSOCIATED(td_depth%d_value) )THEN
+
+            tl_depth=iom_mpp_read_var(td_mpp, il_varid)
+            IF( ANY( td_depth%d_value(:,:,:,:) /= &
+            &        tl_depth%d_value(:,:,:,:) ) )THEN
+
+               CALL logger_warn("CREATE RESTART: depth value from "//&
+               &  TRIM(td_mpp%c_name)//" not conform "//&
+               &  " to those from former file(s).")
+
+            ENDIF
+            CALL var_clean(tl_depth)
+
+         ELSE
+            td_depth=iom_mpp_read_var(td_mpp,il_varid)
+         ENDIF
+
+      ENDIF
+      
+   END SUBROUTINE create_restart_check_depth
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE create_restart_check_time(td_mpp, td_time)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine get date and time in an open mpp structure
+   !> and check if agree with date and time already read.
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date November, 2014 - Initial Version
+   !>
+   !> @param[in] td_mpp      mpp structure
+   !> @param[inout] td_time  time variable structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP), INTENT(IN   ) :: td_mpp
+      TYPE(TVAR), INTENT(INOUT) :: td_time
+
+      ! local variable
+      INTEGER(i4) :: il_varid
+      TYPE(TVAR)  :: tl_time
+
+      TYPE(TDATE) :: tl_date1
+      TYPE(TDATE) :: tl_date2
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! get or check depth value
+
+      IF( td_mpp%t_proc(1)%i_timeid /= 0 )THEN
+
+         il_varid=td_mpp%t_proc(1)%i_timeid
+         IF( ASSOCIATED(td_time%d_value) )THEN
+
+            tl_time=iom_mpp_read_var(td_mpp, il_varid)
+
+            tl_date1=var_to_date(td_time)
+            tl_date2=var_to_date(tl_time)
+            IF( tl_date1 - tl_date2 /= 0 )THEN
+
+               CALL logger_warn("CREATE BOUNDARY: date from "//&
+               &  TRIM(td_mpp%c_name)//" not conform "//&
+               &  " to those from former file(s).")
+
+            ENDIF
+            CALL var_clean(tl_time)
+
+         ELSE
+            td_time=iom_mpp_read_var(td_mpp,il_varid)
+         ENDIF
+
+      ENDIF
+      
+   END SUBROUTINE create_restart_check_time
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END PROGRAM create_restart
Index: /utils/tools_ticket2413/SIREN/src/date.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/date.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/date.f90	(revision 12863)
@@ -0,0 +1,1148 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief This module provide the calculation of Julian dates, and
+!> do many manipulations with dates.
+!>
+!> @details
+!> Actually we use Modified Julian Dates, with  
+!> 17 Nov 1858 at 00:00:00 as origin.<br/>
+!>
+!>   define type TDATE:<br/>
+!> @code
+!>   TYPE(TDATE) :: tl_date1
+!> @endcode
+!>   default date is 17 Nov 1858 at 00:00:00<br/>
+!>
+!>   to intialise date : <br/>
+!>   - from date of the day at 12:00:00 : 
+!> @code
+!> tl_date1=date_today()
+!> @endcode
+!>   - from date and time of the day    : 
+!> @code
+!> tl_date1=date_now()
+!> @endcode
+!>   - from julian day                  : 
+!> @code
+!> tl_date1=date_init(dd_jd)
+!> @endcode
+!>      - dd_jd julian day (double precision) 
+!>   - from number of second since julian day origin   : 
+!> @code
+!> tl_date1=date_init(kd_nsec)
+!> @endcode
+!>      - kd_nsec number of second (integer 8) 
+!>   - from year month day              : 
+!> @code
+!> tl_date1=date_init(2012,12,10)
+!> @endcode
+!>   - from string character formatted date  : 
+!> @code
+!> tl_date1=date_init(cd_fmtdate)
+!> @endcode
+!>      - cd_fmtdate date in format YYYY-MM-DD hh:mm:ss
+!>
+!>   to print date in format YYYY-MM-DD hh:mm:ss<br/>
+!>   CHARACTER(LEN=lc) :: cl_date<br/>
+!> @code
+!>   cl_date=date_print(tl_date1)
+!>   PRINT *, TRIM(cl_date)
+!> @endcode
+!>    
+!>   to print date in another format (only year, month, day):
+!> @code
+!>   cl_date=date_print(tl_date1, cd_fmt)
+!>   PRINT *, TRIM(cl_date)
+!> @endcode
+!>       - cd_fmt ouput format (ex: cd_fmt="('y',i0.4,'m',i0.2,'d',i0.2)" ) 
+!>
+!>   to print day of the week:<br/>
+!> @code
+!>   PRINT *,"dow ", tl_date1\%i_dow
+!> @endcode
+!>   to print last day of the month:<br/>
+!> @code
+!>   PRINT *,"last day ", tl_date1\%i_lday
+!> @endcode
+!>
+!>   to know if year is a leap year:<br/>
+!> @code
+!>   ll_isleap=date_leapyear(tl_date1)
+!> @endcode
+!>    - ll_isleap is logical
+!>
+!>   to compute number of days between two dates:<br/>
+!> @code
+!>   tl_date2=date_init(2010,12,10)
+!>   dl_diff=tl_date1-tl_date2
+!> @endcode
+!>    - dl_diff is the number of days between date1 and date2 (double precision)
+!>
+!>   to add or substract nday to a date:<br/>
+!> @code
+!>   tl_date2=tl_date1+2.
+!>   tl_date2=tl_date1-2.6
+!> @endcode
+!>    - number of day (double precision)
+!>
+!>   to print julian day:<br/>
+!> @code
+!>   PRINT *," julian day",tl_date1\%r_jd
+!> @endcode
+!>
+!>   to print CNES julian day (origin 1950-01-01 00:00:00)<br/>
+!> @code
+!>   PRINT *," CNES julian day",tl_date1\%r_jc
+!> @endcode
+!>
+!>   to create pseudo julian day with origin date_now:<br/>
+!> @code
+!>   tl_date1=date_init(2012,12,10,td_dateo=date_now())
+!> @endcode
+!>   @note you erase CNES julian day when doing so<br/> 
+!>
+!>   to print julian day in seconds:<br/>
+!> @code
+!>   PRINT *, tl_date1\%k_jdsec
+!> @endcode
+!>   to print CNES or new julian day in seconds:<br/>
+!> @code
+!>   PRINT *, tl_date1\%k_jcsec
+!> @endcode
+!>
+!> @author J.Paul
+!>
+!> @date November, 2013 - Initial Version
+!
+!> @note This module is based on Perderabo's date calculator (ksh)
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!>
+!> @todo
+!> - see calendar.f90 and select Gregorian, NoLeap, or D360 calendar
+!----------------------------------------------------------------------
+MODULE date
+
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+   USE fct                             ! basic useful function
+   USE logger                          ! log file manager
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   PUBLIC :: TDATE              !< date structure
+
+   PRIVATE :: cm_fmtdate        !< date and time format
+   PRIVATE :: im_secbyday       !< number of second by day
+
+   ! function and subroutine
+   PUBLIC :: date_today         !< return the date of the day at 12:00:00
+   PUBLIC :: date_now           !< return the date and time
+   PUBLIC :: date_time          !< return the date and time in milliseconds
+   PUBLIC :: date_init          !< initialized date structure form julian day or year month day
+   PUBLIC :: date_print         !< print the date with format YYYY-MM-DD hh:mm:ss
+   PUBLIC :: date_leapyear      !< check if year is a leap year
+   PUBLIC :: OPERATOR(-)        !< substract two dates or n days to a date
+   PUBLIC :: OPERATOR(+)        !< add n days to a date
+
+   PRIVATE :: date__init_fmtdate ! initialized date structure from character YYYY-MM-DD hh:mm:ss
+   PRIVATE :: date__init_jd      ! initialized date structure from julian day
+   PRIVATE :: date__init_nsec    ! initialized date structure from number of second since origin of julian day
+   PRIVATE :: date__init_ymd     ! initialized date structure from year month day
+   PRIVATE :: date__addnday      ! add nday to a date
+   PRIVATE :: date__subnday      ! substract nday to a date
+   PRIVATE :: date__diffdate     ! compute number of days between two dates 
+   PRIVATE :: date__lastday      ! compute last day of the month
+   PRIVATE :: date__ymd2jd       ! compute julian day from year month day
+   PRIVATE :: date__jd2ymd       ! compute year month day from julian day 
+   PRIVATE :: date__jc2jd        ! compute julian day from pseudo julian day
+   PRIVATE :: date__jd2jc        ! compute pseudo julian day with new date origin
+   PRIVATE :: date__jd2dow       ! compute the day of week from julian day
+   PRIVATE :: date__hms2jd       ! compute fraction of a day from hour, minute, second
+   PRIVATE :: date__jd2hms       ! compute hour, minute, second from julian fraction
+   PRIVATE :: date__check        ! check date in date structure
+   PRIVATE :: date__adjust       ! adjust date
+   PRIVATE :: date__jd2sec       ! convert julian day in seconds since julian day origin 
+   PRIVATE :: date__sec2jd       ! convert seconds since julian day origin in julian day
+
+   TYPE TDATE !< date structure
+      INTEGER(i4) :: i_year  = 1858   !< year
+      INTEGER(i4) :: i_month = 11     !< month
+      INTEGER(i4) :: i_day   = 17     !< day
+      INTEGER(i4) :: i_hour  = 0      !< hour
+      INTEGER(i4) :: i_min   = 0      !< min
+      INTEGER(i4) :: i_sec   = 0      !< sec
+      INTEGER(i4) :: i_dow   = 0      !< day of week
+      INTEGER(i4) :: i_lday  = 0      !< last day of the month
+      REAL(dp)    :: d_jd = 0         !< julian day (origin : 1858/11/17 00:00:00)
+      REAL(dp)    :: d_jc = 0         !< CNES julian day or pseudo julian day with new date origin    
+      INTEGER(i8) :: k_jdsec  = 0     !< number of seconds since julian day origin
+      INTEGER(i8) :: k_jcsec  = 0     !< number of seconds since CNES or pseudo julian day origin
+   END TYPE TDATE   
+
+   !  module variable   
+   CHARACTER(LEN=lc), PARAMETER :: cm_fmtdate = &  !< date and time format
+   &  "(i0.4,'-',i0.2,'-',i0.2,1x,i0.2,':',i0.2,':',i0.2)"
+
+   INTEGER(i4), PARAMETER :: im_secbyday = 86400    !< number of second by day   
+
+   INTERFACE date_init
+      MODULE PROCEDURE date__init_jd    ! initialized date structure from julian day
+      MODULE PROCEDURE date__init_nsec  ! initialized date structure from number of second since origin of julian day
+      MODULE PROCEDURE date__init_ymd   ! initialized date structure from year month day
+      MODULE PROCEDURE date__init_fmtdate   ! initialized date structure from character YYYY-MM-DD hh:mm:ss
+   END INTERFACE date_init
+
+   INTERFACE OPERATOR(+)
+      MODULE PROCEDURE date__addnday   ! add nday to a date
+   END INTERFACE
+
+   INTERFACE OPERATOR(-)
+      MODULE PROCEDURE date__subnday   ! substract nday to a date
+      MODULE PROCEDURE date__diffdate  ! compute number of day between two dates
+   END INTERFACE
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION date_print(td_date, cd_fmt) &
+         & RESULT (cf_date)
+   !-------------------------------------------------------------------
+   !> @brief This function print the date and time with 
+   !> format YYYY/MM/DD hh:mm:ss.
+   !> @details
+   !> Optionally, you could specify output format. However it will be 
+   !> only apply to year, month, day.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_date   date strutcutre
+   !> @param[in] cd_fmt    ouput format (only for year,month,day)
+   !> @return date in format YYYY-MM-DD hh:mm:ss
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument   
+      TYPE(TDATE)     , INTENT(IN) :: td_date
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_fmt
+
+      ! function
+      CHARACTER(LEN=lc)            :: cf_date 
+      !----------------------------------------------------------------
+
+      IF( PRESENT(cd_fmt) )THEN
+         WRITE(cf_date,TRIM(cd_fmt)) &
+            &    td_date%i_year,td_date%i_month,td_date%i_day
+      ELSE
+         WRITE(cf_date,cm_fmtdate) &
+            &    td_date%i_year,td_date%i_month,td_date%i_day, &
+            &    td_date%i_hour,td_date%i_min,td_date%i_sec
+      ENDIF
+
+   END FUNCTION date_print
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION date_leapyear(td_date) &
+         & RESULT (lf_leap)
+   !-------------------------------------------------------------------
+   !> @brief This function check if year is a leap year.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_date   date strutcutre
+   !> @return true if year is leap year
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument   
+      TYPE(TDATE), INTENT(IN) :: td_date
+
+      ! function
+      LOGICAL                 :: lf_leap
+      !----------------------------------------------------------------
+
+      lf_leap=.false.
+      IF( (MOD(td_date%i_year,100_i4)==0) )THEN
+         IF( (MOD(td_date%i_year,400_i4)==0) )THEN
+            lf_leap=.true.
+         ENDIF
+      ELSE
+         IF( (MOD(td_date%i_year,4_i4)==0) )THEN
+            lf_leap=.true.
+         ENDIF
+      ENDIF
+
+   END FUNCTION date_leapyear
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION date_now() &
+         & RESULT (tf_date)
+   !-------------------------------------------------------------------
+   !> @brief This function return the current date and time.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @return current date and time in a date structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! function
+      TYPE(TDATE) :: tf_date
+
+      ! local variable
+      INTEGER(sp), DIMENSION(8) :: il_values
+      !----------------------------------------------------------------
+
+      CALL DATE_AND_TIME( values= il_values)
+
+      tf_date=date_init( il_values(1), il_values(2), il_values(3), &
+         &               il_values(5), il_values(6), il_values(7) )
+
+   END FUNCTION date_now
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE date_time()
+   !-------------------------------------------------------------------
+   !> @brief This subroutine print the current date and time in milliseconds.
+   !>
+   !> @author J.Paul
+   !> @date August, 2017 - Initial Version
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! local variable
+      INTEGER(sp), DIMENSION(8) :: il_values
+      CHARACTER(LEN=lc)         :: cl_fmtdate = &  !< date and time format
+      &  "(i0.4,'-',i0.2,'-',i0.2,1x,i0.2,':',i0.2,':',i0.2'.',i0.3)"      
+      !----------------------------------------------------------------
+
+      CALL DATE_AND_TIME( values= il_values)
+
+      WRITE(*,cl_fmtdate) il_values(1),il_values(2),il_values(3),il_values(5),il_values(6),il_values(7),il_values(8)
+
+   END SUBROUTINE date_time
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION date_today() &
+         & RESULT (tf_date)
+   !-------------------------------------------------------------------
+   !> @brief This function return the date of the day at 12:00:00.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @return date of the day at 12:00:00 in a date structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+      
+      ! function
+      TYPE(TDATE) :: tf_date
+
+      ! local variable
+      INTEGER(sp), DIMENSION(8) :: il_values
+      !----------------------------------------------------------------
+
+      CALL DATE_AND_TIME( values= il_values)
+
+      tf_date=date_init( il_values(1), il_values(2), il_values(3), 12_i4 )
+
+   END FUNCTION date_today
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION date__init_fmtdate(cd_datetime, td_dateo) &
+         & RESULT (tf_date)
+   !-------------------------------------------------------------------
+   !> @brief This function initialized date structure from a character 
+   !> date with format YYYY-MM-DD hh:mm:ss.<br/>
+   !> @details
+   !> Optionaly create pseudo julian day with new origin.<br/>
+   !> julian day origin is 17 Nov 1858 at 00:00:00
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date April, 2019
+   !> - check time units CF convention, raise error if not
+   !>
+   !> @param[in] cd_date   date in format YYYY-MM-DD hh:mm:ss
+   !> @param[in] td_dateo  new date origin for pseudo julian day
+   !> @return date structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument   
+      CHARACTER(LEN=*), INTENT(IN)  :: cd_datetime
+      TYPE(TDATE),      INTENT(IN), OPTIONAL :: td_dateo
+
+      ! function
+      TYPE(TDATE)                   :: tf_date
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_datetime
+      CHARACTER(LEN=lc) :: cl_date
+      CHARACTER(LEN=lc) :: cl_time
+      CHARACTER(LEN=lc) :: cl_year
+      CHARACTER(LEN=lc) :: cl_month
+      CHARACTER(LEN=lc) :: cl_day
+      CHARACTER(LEN=lc) :: cl_hour
+      CHARACTER(LEN=lc) :: cl_min
+      CHARACTER(LEN=lc) :: cl_sec
+      CHARACTER(LEN=lc) :: cl_msg
+
+      INTEGER(i4)       :: il_year
+      INTEGER(i4)       :: il_month
+      INTEGER(i4)       :: il_day
+      INTEGER(i4)       :: il_hour
+      INTEGER(i4)       :: il_min
+      INTEGER(i4)       :: il_sec
+      !----------------------------------------------------------------
+
+      cl_datetime=TRIM(ADJUSTL(cd_datetime))
+
+      cl_date=fct_split(cl_datetime,1,' ')
+      cl_time=fct_split(cl_datetime,2,' ')
+
+      cl_year = fct_split(cl_date,1,'-')
+      READ(cl_year,*) il_year
+      cl_month= fct_split(cl_date,2,'-')
+      READ(cl_month, *) il_month
+      cl_day  = fct_split(cl_date,3,'-')
+      READ(cl_day, *) il_day
+      cl_hour = fct_split(cl_time,1,':')
+      IF( TRIM(cl_hour) /= '' )THEN
+         READ(cl_hour, *) il_hour
+      ELSE
+         WRITE(cl_msg,*) "time units not conform to CF conventions"
+         CALL logger_error(cl_msg)
+         il_hour=0
+      ENDIf
+      cl_min  = fct_split(cl_time,2,':')
+      IF( TRIM(cl_min) /= '' )THEN
+         READ(cl_min, *) il_min
+      ELSE
+         WRITE(cl_msg,*) "time units not conform to CF conventions"
+         CALL logger_error(cl_msg)
+         il_min=0
+      ENDIf
+      cl_sec  = fct_split(cl_time,3,':')
+      IF( TRIM(cl_sec) /= '' )THEN
+         READ(cl_sec, *) il_sec
+      ELSE
+         WRITE(cl_msg,*) "time units not conform to CF conventions"
+         CALL logger_error(cl_msg)
+         il_sec=0
+      ENDIf
+
+      tf_date = date_init( il_year, il_month, il_day, il_hour, &
+         &                 il_min, il_sec, td_dateo=td_dateo )
+
+   END FUNCTION date__init_fmtdate
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION date__init_jd(dd_jd, td_dateo) &
+         & RESULT (tf_date)
+   !-------------------------------------------------------------------
+   !> @brief This function initialized date structure from julian day.<br/>
+   !> @details
+   !> Optionaly create pseudo julian day with new origin.<br/>
+   !> julian day origin is 17 Nov 1858 at 00:00:00
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] dd_jd     julian day
+   !> @param[in] td_dateo  new date origin for pseudo julian day
+   !>
+   !> @return date structure of julian day
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      !Argument
+      REAL(dp),    INTENT(IN)  :: dd_jd
+      TYPE(TDATE), INTENT(IN), OPTIONAL :: td_dateo
+
+      ! function
+      TYPE(TDATE)              :: tf_date
+      !----------------------------------------------------------------
+      IF( PRESENT(td_dateo) )THEN
+         CALL date__check(td_dateo)
+
+         ! pseudo julian day with origin dateo
+         tf_date%d_jc=dd_jd
+         tf_date%k_jcsec=date__jd2sec(dd_jd)
+
+         ! convert to truly julian day
+         CALL date__jc2jd(tf_date, td_dateo)
+      ELSE
+         tf_date%d_jd=dd_jd
+         tf_date%k_jdsec=date__jd2sec(dd_jd)
+
+         ! compute CNES julian day
+         CALL date__jd2jc(tf_date)
+      ENDIF
+
+      ! check input data
+      CALL date__check(tf_date)
+
+      ! compute year month day hour min sec 
+      CALL date__jd2ymd(tf_date)
+
+      ! compute day of the wekk
+      CALL date__jd2dow(tf_date)
+
+      !compute last day of the month
+      tf_date%i_lday=date__lastday(tf_date)
+
+   END FUNCTION date__init_jd
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION date__init_nsec(kd_nsec, td_dateo) &
+         & RESULT (tf_date)
+   !-------------------------------------------------------------------
+   !> @brief This function initialized date structure from number of 
+   !> second since julian day origin.<br/>
+   !> @details
+   !> Optionaly create pseudo julian day with new origin.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] kd_nsec   number of second since julian day origin
+   !> @param[in] td_dateo  new date origin for pseudo julian day
+   !>
+   !> @return date structure of julian day
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      !Argument
+      INTEGER(i8), INTENT(IN)  :: kd_nsec
+      TYPE(TDATE), INTENT(IN), OPTIONAL :: td_dateo
+
+      ! function
+      TYPE(TDATE)              :: tf_date
+      !----------------------------------------------------------------
+      IF( PRESENT(td_dateo) )THEN
+         tf_date=date_init( date__sec2jd(kd_nsec), td_dateo )
+      ELSE
+         tf_date=date_init( date__sec2jd(kd_nsec) )
+      ENDIF
+
+   END FUNCTION date__init_nsec
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION date__init_ymd(id_year, id_month, id_day, &
+         &                 id_hour, id_min, id_sec,   &
+         &                 td_dateo) &
+         & RESULT (tf_date)
+   !-------------------------------------------------------------------
+   !> @brief This function initialized date structure form year month day
+   !> and optionnaly hour min sec.<br/>
+   !> @details
+   !> Optionaly create pseudo julian day with new origin.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] id_year
+   !> @param[in] id_month
+   !> @param[in] id_day
+   !> @param[in] id_hour
+   !> @param[in] id_min
+   !> @param[in] id_sec
+   !> @param[in] td_dateo  new date origin for pseudo julian day
+   !>
+   !> @return date structure of year month day
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      !Argument
+      INTEGER(i4), INTENT(IN) :: id_year
+      INTEGER(i4), INTENT(IN) :: id_month
+      INTEGER(i4), INTENT(IN) :: id_day
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_hour
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_min
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_sec
+      TYPE(TDATE), INTENT(IN), OPTIONAL :: td_dateo
+
+      ! function
+      TYPE(TDATE)              :: tf_date
+      !----------------------------------------------------------------
+      tf_date%i_year=id_year
+      tf_date%i_month=id_month
+      tf_date%i_day=id_day
+      IF( PRESENT(id_hour) )THEN
+         tf_date%i_hour=id_hour
+      ENDIF
+      IF( PRESENT(id_min) )THEN
+         tf_date%i_min=id_min
+      ENDIF   
+      IF( PRESENT(id_sec) )THEN   
+         tf_date%i_sec=id_sec
+      ENDIF   
+      ! check input data
+      CALL date__check(tf_date)
+
+      ! compute julian day
+      CALL date__ymd2jd(tf_date)
+
+      IF( PRESENT(td_dateo) )THEN
+         CALL date__check(td_dateo)
+         ! compute julian day with origin dateo
+         CALL date__jd2jc(tf_date, td_dateo)         
+      ELSE
+         ! compute CNES julian day
+         CALL date__jd2jc(tf_date)
+      ENDIF      
+
+      ! compute day of the week
+      CALL date__jd2dow(tf_date)
+
+      !compute last day of the month
+      tf_date%i_lday=date__lastday(tf_date)
+
+   END FUNCTION date__init_ymd
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION date__diffdate(td_date1, td_date2) &
+         & RESULT (df_diff)
+   !-------------------------------------------------------------------
+   !> @brief This function compute number of day between two dates: 
+   !> nday= date1 - date2
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_date1  first date strutcutre
+   !> @param[in] td_date2  second date strutcutre
+   !> @return nday
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+       
+      !Argument
+      TYPE(TDATE), INTENT(IN) :: td_date1
+      TYPE(TDATE), INTENT(IN) :: td_date2
+
+      ! function
+      REAL(dp)                :: df_diff
+      !----------------------------------------------------------------
+
+      ! check year month day hour min sec
+      CALL date__check(td_date1)   
+      CALL date__check(td_date2)   
+
+      df_diff = td_date1%d_jd - td_date2%d_jd
+
+   END FUNCTION date__diffdate
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION date__subnday(td_date, dd_nday) &
+         & RESULT (tf_date)
+   !-------------------------------------------------------------------
+   !> @brief This function substract nday to a date:
+   !> date2 = date1 - nday
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_date   date strutcutre
+   !> @param[in] dd_nday   number of day
+   !> @return date strutcutre of date - nday
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TDATE), INTENT(IN) :: td_date
+      REAL(dp),    INTENT(IN) :: dd_nday
+
+      ! function
+      TYPE(TDATE)             :: tf_date
+      !----------------------------------------------------------------
+
+      ! check year month day hour min sec
+      CALL date__check(td_date)   
+
+      tf_date=date__init_jd(td_date%d_jd-dd_nday)
+
+   END FUNCTION date__subnday
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION date__addnday(td_date, dd_nday) &
+         & RESULT (tf_date)
+   !-------------------------------------------------------------------
+   !> @brief This function add nday to a date:
+   !> date2 = date1 + nday
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_date   date strutcutre
+   !> @param[in] dd_nday   number of day
+   !> @return date strutcutre of date + nday
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TDATE), INTENT(IN) :: td_date
+      REAL(dp),    INTENT(IN) :: dd_nday
+
+      ! function
+      TYPE(TDATE)             :: tf_date
+      !----------------------------------------------------------------
+
+      ! check year month day hour min sec
+      CALL date__check(td_date)   
+
+      tf_date=date__init_jd(td_date%d_jd+dd_nday)
+
+   END FUNCTION date__addnday
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION date__lastday(td_date) &
+         & RESULT (if_lday)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute last day of the month
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_date   date strutcutre
+   !> @return last day of the month
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument   
+      TYPE(TDATE), INTENT(IN) :: td_date
+
+      ! function
+      INTEGER(i4) :: if_lday
+
+      ! local variable
+      INTEGER, DIMENSION(12), PARAMETER :: il_lastdaytab = &
+      &        (/31,28,31,30,31,30,31,31,30,31,30,31/)
+      !----------------------------------------------------------------
+
+      ! general case
+      IF( td_date%i_month /= 2 )THEN
+         if_lday=il_lastdaytab(td_date%i_month)
+      ELSE
+         IF( date_leapyear(td_date) )THEN
+            if_lday=29
+         ELSE
+            if_lday=il_lastdaytab(td_date%i_month)
+         ENDIF
+      ENDIF
+
+   END FUNCTION date__lastday
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE date__ymd2jd(td_date)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute julian day from year month day , and fill
+   !> input date strutcutre.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_date   date strutcutre
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument   
+      TYPE(TDATE), INTENT(INOUT) :: td_date
+
+      ! local variable
+      REAL(dp) :: dl_standard_jd
+      REAL(dp) :: dl_frac
+      !----------------------------------------------------------------
+
+      dl_standard_jd= td_date%i_day - 32075                               & 
+          & + 1461 * (td_date%i_year + 4800 - (14 - td_date%i_month)/12)/4  &
+          & + 367 * (td_date%i_month - 2 + (14 - td_date%i_month)/12*12)/12 &
+          & - 3 * ((td_date%i_year + 4900 - (14 - td_date%i_month)/12)/100)/4
+      
+      td_date%d_jd = dl_standard_jd-2400001 ! origin : 17 nov 1858 h00m00s00
+
+      ! compute fraction of day
+      dl_frac=date__hms2jd(td_date)
+
+      td_date%d_jd = td_date%d_jd + dl_frac
+
+      td_date%k_jdsec = date__jd2sec( td_date%d_jd ) 
+
+   END SUBROUTINE date__ymd2jd
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE date__jd2ymd(td_date)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute year month day from julian day, and fill
+   !> input date strutcutre.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_date   date strutcutre
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument   
+      TYPE(TDATE), INTENT(INOUT) :: td_date
+
+      ! local variable
+      INTEGER(i4) :: il_standard_jd
+      INTEGER(i4) :: il_temp1
+      INTEGER(i4) :: il_temp2
+      !----------------------------------------------------------------
+
+      ! check year month day hour min sec
+      CALL date__check(td_date)   
+
+      il_standard_jd=INT( td_date%d_jd+2400001, i4 )
+
+      il_temp1=il_standard_jd + 68569
+      il_temp2=4*il_temp1/146097
+      il_temp1=il_temp1 - (146097 * il_temp2 + 3) / 4
+      td_date%i_year  = 4000 * (il_temp1 + 1) / 1461001
+      il_temp1 = il_temp1 - 1461 * td_date%i_year/4 + 31
+      td_date%i_month = 80 * il_temp1 / 2447
+      td_date%i_day   = il_temp1 - 2447 * td_date%i_month / 80
+      il_temp1 = td_date%i_month / 11
+      td_date%i_month = td_date%i_month + 2 - 12 * il_temp1
+      td_date%i_year  = 100 * (il_temp2 - 49) + td_date%i_year + il_temp1
+
+      ! compute hour, minute, second from julian fraction
+      CALL date__jd2hms(td_date)
+
+      ! adjust date
+      CALL date__adjust(td_date)
+
+   END SUBROUTINE date__jd2ymd
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE date__jc2jd(td_date, td_dateo)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute julian day from pseudo julian day 
+   !> with new date origin, and fill input date strutcutre.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_date   date
+   !> @param[in]    td_dateo  new date origin for pseudo julian day
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument   
+      TYPE(TDATE), INTENT(INOUT) :: td_date
+      TYPE(TDATE), INTENT(IN) :: td_dateo
+
+      ! local variable
+      TYPE(TDATE) :: tl_date
+      REAL(dp)    :: dl_nday
+      !----------------------------------------------------------------
+      ! origin julian day
+      tl_date=date_init(1858,11,17)
+
+      dl_nday=td_dateo-tl_date
+
+      ! compute julian day
+      td_date%d_jd = td_date%d_jc + dl_nday
+      ! compute number of second since julian day origin
+      td_date%k_jdsec = date__jd2sec(td_date%d_jd)
+
+   END SUBROUTINE date__jc2jd
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE date__jd2jc(td_date, td_dateo)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute pseudo julian day with new date origin, and
+   !> fill input date structure.<br/>
+   !>  default new origin is CNES julian day origin: 1950-01-01 00:00:00
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_date   date
+   !> @param[in] td_dateo     new origin date
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument   
+      TYPE(TDATE), INTENT(INOUT) :: td_date
+      TYPE(TDATE), INTENT(IN),   OPTIONAL :: td_dateo
+
+      ! local variable
+      TYPE(TDATE) :: tl_dateo
+      !----------------------------------------------------------------
+      IF( PRESENT(td_dateo) )THEN
+         td_date%d_jc=td_date%d_jd-td_dateo%d_jd
+      ELSE
+         ! CNES julian day origin
+         tl_dateo%i_year = 1950
+         tl_dateo%i_month = 1
+         tl_dateo%i_day = 1
+
+         CALL date__ymd2jd(tl_dateo)
+
+         td_date%d_jc = td_date%d_jd-tl_dateo%d_jd
+      ENDIF
+
+      td_date%k_jcsec = date__jd2sec(td_date%d_jc)
+
+   END SUBROUTINE date__jd2jc
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE date__jd2dow(td_date)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute the day of week from julian day, and fill
+   !> input date structure.<br/>
+   !>  days   : Sunday Monday Tuesday Wednesday Thursday Friday Saturday<br/>
+   !>  numday : 0      1      2       3         4        5      6<br/>
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_date   date strutcutre
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument   
+      TYPE(TDATE), INTENT(INOUT) :: td_date
+      !----------------------------------------------------------------
+
+      td_date%i_dow=MOD((INT(AINT(td_date%d_jd))+3),7)
+
+   END SUBROUTINE date__jd2dow
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION date__hms2jd(td_date) &
+         & RESULT (df_frac)
+   !-------------------------------------------------------------------
+   !> @brief This function compute fraction of a day from 
+   !> hour, minute, second. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_date   date strutcutre
+   !> @return fraction of the day
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument   
+      TYPE(TDATE), INTENT(IN) :: td_date
+
+      ! function
+      REAL(dp)                :: df_frac
+      !----------------------------------------------------------------
+
+      !  compute real seconds
+      df_frac = REAL( td_date%i_sec, dp )
+      !  compute real minutes
+      df_frac = REAL( td_date%i_min, dp ) + df_frac/60.0
+      !  compute real hours
+      df_frac = REAL( td_date%i_hour, dp ) + df_frac/60.0
+      !  julian fraction of a day
+      df_frac = df_frac/24.0
+
+   END FUNCTION date__hms2jd
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE date__jd2hms(td_date)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute hour, minute, second from julian 
+   !> fraction, and fill date structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_date   date strutcutre
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument   
+      TYPE(TDATE), INTENT(INOUT) :: td_date
+
+      !local variable
+      REAL(dp) :: dl_fract
+      !----------------------------------------------------------------
+
+      dl_fract=(td_date%d_jd)-AINT(td_date%d_jd)
+      !  compute hour
+      td_date%i_hour = INT( dl_fract * 24.0, i4 )
+      dl_fract = ( dl_fract - REAL( td_date%i_hour, dp ) / 24.0) * 24.0
+      !  compute minute
+      td_date%i_min = INT( dl_fract * 60.0, i4 )
+      dl_fract = ( dl_fract - REAL( td_date%i_min, dp ) / 60.0) * 60.0
+      !  compute second
+      td_date%i_sec = NINT( dl_fract * 60.0, i4 )
+
+   END SUBROUTINE date__jd2hms
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE date__check(td_date)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine check date express in date structure
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_date   date strutcutre
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+
+      ! Argument   
+      TYPE(TDATE), INTENT(IN) :: td_date
+
+      ! local variable
+      INTEGER(i4)       :: il_lastday
+      INTEGER(i4)       :: il_status
+      CHARACTER(LEN=lc) :: cl_msg
+      !----------------------------------------------------------------
+
+      ! init
+      il_status=0
+
+      ! check year
+      IF( td_date%i_year < 1858_i4 .OR. td_date%i_year > 39999_i4 )THEN
+         il_status=il_status+1
+         WRITE(cl_msg,*) "year ",td_date%i_year," out of range"
+         CALL logger_error(cl_msg)
+      ENDIF
+      ! check month
+      IF( td_date%i_month < 1_i4 .OR. td_date%i_month > 12_i4 )THEN
+         il_status=il_status+1
+         WRITE(cl_msg,*) "month ",td_date%i_month," out of range"
+         CALL logger_error(cl_msg)
+      ENDIF
+      ! check day
+      il_lastday=date__lastday(td_date)
+      IF( td_date%i_day < 1_i4 .OR. td_date%i_day > il_lastday )THEN
+         il_status=il_status+1
+         WRITE(cl_msg,*) "day ",td_date%i_day," out of range"
+         CALL logger_error(cl_msg)
+      ENDIF
+      ! check hour
+      IF( td_date%i_hour < 0_i4 .OR. td_date%i_hour > 23_i4 )THEN
+         il_status=il_status+1
+         WRITE(cl_msg,*) "hour ",td_date%i_hour," out of range"
+         CALL logger_error(cl_msg)
+      ENDIF
+      ! check minutes
+      IF( td_date%i_min < 0_i4 .OR. td_date%i_min > 59_i4 )THEN
+         il_status=il_status+1
+         WRITE(cl_msg,*) "minutes ",td_date%i_min," out of range"
+         CALL logger_error(cl_msg)
+      ENDIF   
+      ! check seconds
+      IF( td_date%i_sec < 0_i4 .OR. td_date%i_sec > 59_i4 )THEN
+         il_status=il_status+1
+         WRITE(cl_msg,*) "seconds ",td_date%i_sec," out of range"
+         CALL logger_error(cl_msg)
+      ENDIF
+
+      ! check julian day
+      IF( td_date%d_jd < 0_sp .OR. td_date%d_jd > 782028_sp )THEN
+         il_status=il_status+1
+         WRITE(cl_msg,*) "julian day ",td_date%d_jd," out of range"
+         CALL logger_error(cl_msg)
+      ENDIF
+
+      IF( il_status/= 0 )THEN
+         WRITE(cl_msg,*) " date error"
+         CALL logger_fatal(cl_msg)
+      ENDIF
+
+   END SUBROUTINE date__check
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE date__adjust(td_date)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine adjust date (correct hour, minutes, and seconds
+   !> value if need be)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_date   date strutcutre
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument   
+      TYPE(TDATE), INTENT(INOUT) :: td_date
+      !----------------------------------------------------------------
+
+      IF( td_date%i_sec == 60 )THEN
+         td_date%i_sec=0
+         td_date%i_min=td_date%i_min+1
+      ENDIF
+      
+      IF( td_date%i_min == 60 )THEN
+         td_date%i_min=0
+         td_date%i_hour=td_date%i_hour+1
+      ENDIF
+
+      IF( td_date%i_hour == 24 )THEN
+         td_date%i_hour=0
+         td_date=date__addnday(td_date,1._dp)
+      ENDIF
+
+   END SUBROUTINE date__adjust
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION date__jd2sec(dd_jul) &
+         & RESULT (if_sec)
+   !-------------------------------------------------------------------
+   !> @brief This function convert julian day in seconds
+   !> since julian day origin.
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_date   date strutcutre
+   !> @return number of seconds since julian day origin
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument   
+      REAL(dp), INTENT(IN) :: dd_jul
+
+      ! function
+      INTEGER(i8)          :: if_sec
+      !----------------------------------------------------------------
+
+      if_sec = NINT( dd_jul * im_secbyday, i8 )
+
+   END FUNCTION date__jd2sec
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION date__sec2jd(kd_nsec) &
+         & RESULT (df_sec)
+   !-------------------------------------------------------------------
+   !> @brief This function convert seconds since julian day origin in 
+   !> julian day.
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] kd_nsec   number of second since julian day origin
+   !> @return julian day
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument   
+      INTEGER(i8), INTENT(IN) :: kd_nsec
+
+      ! function
+      REAL(dp)                :: df_sec
+      !----------------------------------------------------------------
+
+      df_sec = REAL( REAL( kd_nsec , dp ) / im_secbyday, dp )
+
+   END FUNCTION date__sec2jd
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE date
+
Index: /utils/tools_ticket2413/SIREN/src/dimension.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/dimension.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/dimension.f90	(revision 12863)
@@ -0,0 +1,1772 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief 
+!> This module manage dimension and how to change order of those dimension.
+!>
+!> @details
+!>    define type TDIM:<br/>
+!> @code
+!>    TYPE(TDIM) :: tl_dim
+!> @endcode
+!>
+!>    to initialize a dimension structure:<br/>
+!> @code
+!>    tl_dim=dim_init( cd_name, [id_len,] [ld_uld,] [cd_sname])
+!> @endcode
+!>       - cd_name is the dimension name
+!>       - id_len is the dimension size [optional]
+!>       - ld_uld is true if this dimension is the unlimited one [optional]
+!>       - cd_sname is the dimension short name ('x','y','z','t') [optional]
+!>
+!>    to clean dimension structure:<br/>
+!> @code
+!>    CALL dim_clean(tl_dim)
+!> @endcode
+!>       - tl_dim : dimension strucutre or array of dimension structure
+!>
+!>    to print information about dimension structure:<br/>
+!> @code
+!>    CALL dim_print(tl_dim)
+!> @endcode
+!>
+!>    to copy dimension structure in another one (using different memory cell):<br/>
+!> @code
+!>    tl_dim2=dim_copy(tl_dim1) 
+!> @endcode
+!>
+!>    to get dimension name:<br/>
+!>    - tl_dim\%c_name
+!>
+!>    to get dimension short name:<br/>
+!>    - tl_dim\%c_sname
+!>
+!>    to get dimension length:<br/>
+!>    - tl_dim\%i_len
+!>
+!>    to know if dimension is the unlimited one:<br/>
+!>    - tl_dim\%l_uld
+!>
+!>    to get dimension id (for variable or file dimension):<br/>
+!>    - tl_dim\%i_id 
+!>
+!>    to know if dimension is used (for variable or file dimension):<br/>
+!>    - tl_dim\%l_use
+!>
+!>    Former function or information concern only one dimension. However
+!>    variables as well as files use usually 4 dimensions.<br/>
+!>    To easily work with variable we want they will be all 4D and ordered as
+!>    following: ('x','y','z','t').<br/>
+!>    Functions and subroutines below, allow to reorder dimension of 
+!>    variable.<br/>
+!>    
+!>    Suppose we defined the array of dimension structure below:<br/>
+!> @code
+!>    TYPE(TDIM), DIMENSION(4) :: tl_dim 
+!>    tl_dim(1)=dim_init( 'X', id_len=10)
+!>    tl_dim(2)=dim_init( 'T', id_len=3, ld_uld=.TRUE.)
+!> @endcode
+!>
+!>    to reorder dimension (default order: ('x','y','z','t')):<br/>
+!> @code
+!>    CALL dim_reorder(tl_dim(:))
+!> @endcode
+!>
+!>    This subroutine filled dimension structure with unused dimension, 
+!>    then switch from "disordered" dimension to "ordered" dimension.<br/>
+!>    The dimension structure return will be:<br/>
+!>    tl_dim(1) => 'X', i_len=10, l_use=T, l_uld=F<br/>
+!>    tl_dim(2) => 'Y', i_len=1,  l_use=F, l_uld=F<br/> 
+!>    tl_dim(3) => 'Z', i_len=1,  l_use=F, l_uld=F<br/>
+!>    tl_dim(4) => 'T', i_len=3,  l_use=T, l_uld=T<br/>
+!>
+!>    After using subroutine dim_reorder you could use functions and subroutine
+!>    below.<br/>
+!>
+!>    to use another dimension order.<br/>
+!> @code
+!>    CALL dim_reorder(tl(dim(:), cl_neworder)
+!> @endcode
+!>    - cl_neworder : character(len=4) (example: 'yxzt')
+!>
+!>    to switch dimension array from ordered dimension to disordered
+!> dimension:<br/>
+!> @code
+!>    CALL dim_disorder(tl_dim(:))
+!> @endcode
+!>
+!>    to fill unused dimension of an array of dimension structure.<br/>
+!> @code
+!>    tl_dimout(:)=dim_fill_unused(tl_dimin(:))
+!> @endcode
+!>    - tl_dimout(:) : 1D array (4elts) of dimension strcuture
+!>    - tl_dimin(:)  : 1D array (<=4elts) of dimension structure
+!>
+!>    to reshape array of value in "ordered" dimension:<br/>
+!> @code
+!>    CALL dim_reshape_2xyzt(tl_dim(:), value(:,:,:,:))
+!> @endcode
+!>       - value must be a 4D array of real(8) value "disordered"
+!>
+!>    to reshape array of value in "disordered" dimension:<br/>
+!> @code
+!>    CALL dim_reshape_xyzt2(tl_dim(:), value(:,:,:,:))
+!> @endcode
+!>       - value must be a 4D array of real(8) value "ordered"
+!>
+!>    to reorder a 1D array of 4 elements in "ordered" dimension:<br/>
+!> @code
+!>    CALL dim_reorder_2xyzt(tl_dim(:), tab(:))
+!> @endcode
+!>       - tab must be a 1D array with 4 elements "disordered".
+!>       It could be composed of character, integer(4), or logical
+!> 
+!>    to reorder a 1D array of 4 elements in "disordered" dimension:<br/>
+!> @code
+!>    CALL dim_reorder_xyzt2(tl_dim(:), tab(:))
+!> @endcode
+!>       - tab must be a 1D array with 4 elements "ordered".
+!>       It could be composed of character, integer(4), or logical
+!>
+!>    to get dimension index from a array of dimension structure, 
+!>    given dimension name or short name :<br/>
+!> @code
+!>    index=dim_get_index( tl_dim(:), [cl_name, cl_sname] )
+!> @endcode
+!>       - tl_dim(:) : array of dimension structure
+!>       - cl_name : dimension name [optional]
+!>       - cl_sname: dimension short name [optional]
+!>
+!>    to get dimension id used in an array of dimension structure, 
+!>    given dimension name or short name :<br/>
+!> @code
+!>    id=dim_get_id( tl_dim(:), [cl_name, cl_sname] )
+!> @endcode
+!>       - tl_dim(:) : array of dimension structure
+!>       - cl_name : dimension name [optional]
+!>       - cl_sname: dimension short name [optional]
+!>
+!> @author J.Paul
+!>
+!> @date November, 2013 - Initial Version
+!> @date September, 2015
+!> - manage useless (dummy) dimension
+!> @date October, 2016
+!> - dimension allowed read in configuration file
+!> @date May, 2019
+!> - read number of element for each dimension allowed in configuration file 
+!> - read number of element for each dummy array in configuration file
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE dim
+
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   PUBLIC :: TDIM              !< dimension structure
+
+   PRIVATE :: im_ndumdim       !< number of elt in dummy dimension array
+   PRIVATE :: cm_dumdim        !< dummy dimension array
+   PRIVATE :: im_dimX          !< number of elt in x dimension array
+   PRIVATE :: im_dimY          !< number of elt in y dimension array
+   PRIVATE :: im_dimZ          !< number of elt in z dimension array
+   PRIVATE :: im_dimT          !< number of elt in t dimension array
+   PRIVATE :: cm_dimX          !< x dimension array
+   PRIVATE :: cm_dimY          !< y dimension array
+   PRIVATE :: cm_dimZ          !< z dimension array
+   PRIVATE :: cm_dimT          !< t dimension array
+
+   ! function and subroutine
+   PUBLIC :: dim_init          !< initialize dimension structure
+   PUBLIC :: dim_clean         !< clean dimension structuree
+   PUBLIC :: dim_print         !< print dimension information
+   PUBLIC :: dim_copy          !< copy dimension structure
+   PUBLIC :: dim_reorder       !< filled dimension structure to switch from disordered to ordered dimension
+   PUBLIC :: dim_disorder      !< switch dimension array from ordered to disordered dimension
+   PUBLIC :: dim_fill_unused   !< filled dimension structure with unused dimension 
+   PUBLIC :: dim_reshape_2xyzt !< reshape array dimension to ('x','y','z','t')
+   PUBLIC :: dim_reshape_xyzt2 !< reshape array dimension from ('x','y','z','t')
+   PUBLIC :: dim_reorder_2xyzt !< reorder 1D array to ('x','y','z','t')
+   PUBLIC :: dim_reorder_xyzt2 !< reorder 1D array from ('x','y','z','t')
+   PUBLIC :: dim_get_index     !< get dimension index in array of dimension structure
+   PUBLIC :: dim_get_id        !< get dimension id in array of dimension structure
+   PUBLIC :: dim_get_dummy     !< fill dummy dimension array
+   PUBLIC :: dim_is_dummy      !< check if dimension is defined as dummy dimension
+   PUBLIC :: dim_def_extra     !< read dimension configuration file, and save dimension allowed.
+
+   PRIVATE :: dim__reshape_2xyzt_dp ! reshape real(8) 4D array to ('x','y','z','t')
+   PRIVATE :: dim__reshape_xyzt2_dp ! reshape real(8) 4D array from ('x','y','z','t')
+   PRIVATE :: dim__reorder_2xyzt_i4 ! reorder integer(4) 1D array to ('x','y','z','t')
+   PRIVATE :: dim__reorder_xyzt2_i4 ! reorder integer(4) 1D array from ('x','y','z','t')
+   PRIVATE :: dim__reorder_2xyzt_l  ! reorder logical 1D array to ('x','y','z','t')
+   PRIVATE :: dim__reorder_xyzt2_l  ! reorder logical 1D array from ('x','y','z','t')
+   PRIVATE :: dim__reorder_2xyzt_c  ! reorder string 1D array to ('x','y','z','t')
+   PRIVATE :: dim__reorder_xyzt2_c  ! reorder string 1D array from ('x','y','z','t')
+   PRIVATE :: dim__clean_unit       ! clean one dimension structure
+   PRIVATE :: dim__clean_arr        ! clean a array of dimension structure
+   PRIVATE :: dim__print_unit       ! print information on one dimension structure
+   PRIVATE :: dim__print_arr        ! print information on a array of dimension structure
+   PRIVATE :: dim__copy_unit        ! copy dimension structure
+   PRIVATE :: dim__copy_arr         ! copy array of dimension structure
+   PRIVATE :: dim__is_allowed
+
+   TYPE TDIM !< dimension structure
+      CHARACTER(LEN=lc) :: c_name = ''       !< dimension name
+      CHARACTER(LEN=lc) :: c_sname = 'u'     !< dimension short name
+      INTEGER(i4)       :: i_id  = 0         !< dimension id
+      INTEGER(i4)       :: i_len = 1         !< dimension length
+      LOGICAL           :: l_uld = .FALSE.   !< dimension unlimited or not
+      LOGICAL           :: l_use = .FALSE.   !< dimension used or not
+      INTEGER(i4)       :: i_2xyzt = 0       !< indices to reshape array to ('x','y','z','t')
+      INTEGER(i4)       :: i_xyzt2 = 0       !< indices to reshape array from ('x','y','z','t')
+   END TYPE
+
+   INTEGER(i4)                               , SAVE :: im_ndumdim !< number of elt in dummy dimension array
+   CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg), SAVE :: cm_dumdim  !< dummy dimension
+   INTEGER(i4)                               , SAVE :: im_dimX    !< number of elt in x dimension array
+   INTEGER(i4)                               , SAVE :: im_dimY    !< number of elt in y dimension array
+   INTEGER(i4)                               , SAVE :: im_dimZ    !< number of elt in z dimension array
+   INTEGER(i4)                               , SAVE :: im_dimT    !< number of elt in t dimension array
+   CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimX    !< x dimension
+   CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimY    !< y dimension
+   CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimZ    !< z dimension
+   CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimT    !< t dimension
+
+   INTERFACE dim_print
+      MODULE PROCEDURE dim__print_unit ! print information on one dimension
+      MODULE PROCEDURE dim__print_arr  ! print information on a array of dimension
+   END INTERFACE dim_print
+
+   INTERFACE dim_clean
+      MODULE PROCEDURE dim__clean_unit ! clean one dimension
+      MODULE PROCEDURE dim__clean_arr  ! clean a array of dimension
+   END INTERFACE dim_clean
+
+   INTERFACE dim_copy
+      MODULE PROCEDURE dim__copy_unit  ! copy dimension structure
+      MODULE PROCEDURE dim__copy_arr   ! copy array of dimension structure
+   END INTERFACE
+
+   INTERFACE dim_reshape_2xyzt
+      MODULE PROCEDURE dim__reshape_2xyzt_dp   ! reshape real(8) 4D array to ('x','y','z','t')
+   END INTERFACE dim_reshape_2xyzt
+
+   INTERFACE dim_reshape_xyzt2
+      MODULE PROCEDURE dim__reshape_xyzt2_dp   ! reshape real(8) 4D array from ('x','y','z','t')
+   END INTERFACE dim_reshape_xyzt2
+
+   INTERFACE dim_reorder_2xyzt
+      MODULE PROCEDURE dim__reorder_2xyzt_i4   ! reorder integer(4) 1D array to ('x','y','z','t')
+      MODULE PROCEDURE dim__reorder_2xyzt_c    ! reorder string 1D array to ('x','y','z','t')
+      MODULE PROCEDURE dim__reorder_2xyzt_l    ! reorder logical 1D array to ('x','y','z','t')
+   END INTERFACE dim_reorder_2xyzt
+
+   INTERFACE dim_reorder_xyzt2
+      MODULE PROCEDURE dim__reorder_xyzt2_i4   ! reorder integer(4) 1D array from ('x','y','z','t')
+      MODULE PROCEDURE dim__reorder_xyzt2_c    ! reorder string 1D array from ('x','y','z','t')
+      MODULE PROCEDURE dim__reorder_xyzt2_l    ! reorder logical 1D array from ('x','y','z','t')  
+   END INTERFACE dim_reorder_xyzt2
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION dim__copy_arr(td_dim) &
+         & RESULT (tf_dim)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy a array of dimension structure in another one
+   !> @details 
+   !> see dim__copy_unit
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> structure (ex: tl_dim=dim_copy(dim_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date November, 2014 - Initial Version
+   !
+   !> @param[in] td_dim   array of dimension structure
+   !> @return copy of input array of dimension structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TDIM), DIMENSION(:), INTENT(IN)   :: td_dim
+
+      ! function
+      TYPE(TDIM), DIMENSION(SIZE(td_dim(:))) :: tf_dim
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=1,SIZE(td_dim(:))
+         tf_dim(ji)=dim_copy(td_dim(ji))
+      ENDDO
+
+   END FUNCTION dim__copy_arr
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION dim__copy_unit(td_dim) &
+         & RESULT (tf_dim)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy an dimension structure in another one
+   !> @details 
+   !> dummy function to get the same use for all structure
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> structure (ex: tl_dim=dim_copy(dim_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date November, 2014 - Initial Version
+   !>
+   !> @param[in] td_dim   dimension structure
+   !> @return copy of input dimension structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TDIM), INTENT(IN)  :: td_dim
+
+      ! function
+      TYPE(TDIM)              :: tf_dim
+
+      ! local variable
+      !----------------------------------------------------------------
+
+      tf_dim=td_dim
+
+   END FUNCTION dim__copy_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION dim_get_index(td_dim, cd_name, cd_sname) &
+         & RESULT (if_idx)
+   !-------------------------------------------------------------------
+   !> @brief This function returns dimension index,
+   !> given dimension name or short name.
+   !>
+   !> @details
+   !> the function check dimension name, in the array of dimension structure.
+   !> dimension could be used or not.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014 
+   !> - do not check if dimension used
+   !>
+   !> @param[in] td_dim    array of dimension structure
+   !> @param[in] cd_name   dimension name
+   !> @param[in] cd_sname  dimension short name
+   !> @return dimension index
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TDIM)      , DIMENSION(:), INTENT(IN) :: td_dim
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+      CHARACTER(LEN=*),               INTENT(IN), OPTIONAL :: cd_sname
+
+      ! function
+      INTEGER(i4)                                :: if_idx
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_name
+      CHARACTER(LEN=lc) :: cl_dim_name
+      CHARACTER(LEN=lc) :: cl_sname
+      CHARACTER(LEN=lc) :: cl_dim_sname
+
+      INTEGER(i4) :: il_ndim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! init
+      if_idx=0
+
+      il_ndim=SIZE(td_dim(:))
+
+      ! look for dimension name
+      cl_name=fct_lower(cd_name)
+      ! check if dimension is in array of dimension structure
+      DO ji=1,il_ndim
+         cl_dim_name=fct_lower(td_dim(ji)%c_name)
+         IF( TRIM(cl_dim_name) == TRIM(cl_name) )THEN
+            if_idx=ji
+            EXIT
+         ENDIF
+      ENDDO
+
+      ! look for dimension short name
+      IF(  if_idx == 0 )THEN
+
+         cl_sname=fct_lower(cd_name)
+         ! check if dimension is in array of dimension structure
+         DO ji=1,il_ndim
+            cl_dim_sname=fct_lower(td_dim(ji)%c_sname)
+            IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ) )THEN
+               CALL logger_debug("DIM GET INDEX: variable short name "//&
+                  &              TRIM(ADJUSTL(cd_name))//" already in file")
+               if_idx=ji
+               EXIT
+            ENDIF
+         ENDDO
+
+      ENDIF
+
+      ! look for dimension short name
+      IF( PRESENT(cd_sname) )THEN
+         IF( if_idx == 0 )THEN
+
+            cl_sname=fct_lower(cd_sname)
+            ! check if dimension is in array of dimension structure
+            DO ji=1,il_ndim
+               cl_dim_sname=fct_lower(td_dim(ji)%c_sname)
+               IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ) )THEN
+                  CALL logger_debug("DIM GET INDEX: variable short name "//&
+                     &              TRIM(ADJUSTL(cd_sname))//" already in file")
+                  if_idx=ji
+                  EXIT
+               ENDIF
+            ENDDO
+
+         ENDIF
+      ENDIF
+
+   END FUNCTION dim_get_index
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION dim_get_id(td_dim, cd_name, cd_sname) &
+         & RESULT (if_id)
+   !-------------------------------------------------------------------
+   !> @brief This function returns dimension id, in a array of dimension structure,
+   !> given dimension name, or short name. 
+   !> @note only dimension used are checked.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_dim    dimension structure
+   !> @param[in] cd_name   dimension name or short name
+   !> @param[in] cd_sname  dimension short name
+   !> @return dimension id
+   !-------------------------------------------------------------------
+   
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TDIM),       DIMENSION(:), INTENT(IN) :: td_dim
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+      CHARACTER(LEN=*),               INTENT(IN), OPTIONAL :: cd_sname
+
+      ! function
+      INTEGER(i4)                                :: if_id
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_name
+      CHARACTER(LEN=lc) :: cl_dim_name
+      CHARACTER(LEN=lc) :: cl_sname
+      CHARACTER(LEN=lc) :: cl_dim_sname
+
+      INTEGER(i4) :: il_ndim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+      ! init
+      if_id=0
+
+      il_ndim=SIZE(td_dim(:))
+
+      ! look for dimension name
+      cl_name=fct_lower(cd_name)
+      ! check if dimension is in array of dimension structure and used
+      jj=0
+      DO ji=1,il_ndim
+         cl_dim_name=fct_lower(td_dim(ji)%c_name)
+         IF( TRIM(cl_dim_name) == TRIM(cl_name) .AND. &
+         &   td_dim(ji)%l_use )THEN
+            IF( td_dim(ji)%i_id /= 0 )THEN
+               if_id=td_dim(ji)%i_id
+               EXIT
+            ENDIF
+         ENDIF
+      ENDDO
+
+      ! look for dimension short name
+      IF(  if_id == 0 )THEN
+
+         cl_sname=fct_lower(cd_name)
+         ! check if dimension is in array of dimension structure and used
+         jj=0
+         DO ji=1,il_ndim
+            cl_dim_sname=fct_lower(td_dim(ji)%c_sname)
+            IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ).AND.&
+            &   td_dim(ji)%l_use )THEN
+               IF( td_dim(ji)%i_id /= 0 )THEN
+                  if_id=td_dim(ji)%i_id
+                  EXIT
+               ENDIF
+            ENDIF
+         ENDDO
+
+      ENDIF
+
+      ! look for dimension short name
+      IF( PRESENT(cd_sname) )THEN
+         IF(  if_id == 0 )THEN
+
+            cl_sname=fct_lower(cd_sname)
+            ! check if dimension is in array of dimension structure and used
+            jj=0
+            DO ji=1,il_ndim
+               cl_dim_sname=fct_lower(td_dim(ji)%c_sname)
+               IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ).AND.&
+                  & td_dim(ji)%l_use )THEN
+                  IF( td_dim(ji)%i_id /= 0 )THEN
+                     if_id=td_dim(ji)%i_id
+                     EXIT
+                  ENDIF
+               ENDIF
+            ENDDO
+
+         ENDIF
+      ENDIF
+
+   END FUNCTION dim_get_id
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION dim_init(cd_name, id_len, ld_uld, cd_sname, ld_use) &
+         & RESULT (tf_dim)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a dimension structure with given
+   !> name.<br/>
+   !> @details
+   !> Optionally length could be inform, as well as short name and if dimension
+   !> is unlimited or not.<br/>
+   !> By default, define dimension is supposed to be used.
+   !> Optionally you could force a defined dimension to be unused. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 
+   !> - add optional argument to define dimension unused
+   !> @date July, 2015
+   !> - Bug fix: inform order to disorder table instead of disorder to order
+   !> table
+   !> @date May, 2019
+   !> - use number of element for each dimention allowed, instead of while loop
+   !>
+   !> @param[in] cd_name   dimension name
+   !> @param[in] id_len    dimension length
+   !> @param[in] ld_uld    dimension unlimited
+   !> @param[in] cd_sname  dimension short name
+   !> @param[in] ld_use    dimension use or not
+   !> @return dimension structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument 
+      CHARACTER(LEN=*), INTENT(IN)  :: cd_name
+      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_len
+      LOGICAL,          INTENT(IN), OPTIONAL :: ld_uld
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_sname
+      LOGICAL,          INTENT(IN), OPTIONAL :: ld_use
+
+      ! function
+      TYPE(TDIM)                    :: tf_dim
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_name
+      CHARACTER(LEN=lc) :: cl_sname
+      !----------------------------------------------------------------
+
+      ! clean dimension
+      CALL dim_clean(tf_dim)
+
+      cl_name=fct_upper(cd_name)
+
+      CALL logger_debug( &
+      &  " DIM INIT: dimension name: "//TRIM(cl_name) )
+      tf_dim%c_name=TRIM(ADJUSTL(cd_name))
+
+      IF( PRESENT(id_len) )THEN
+         CALL logger_debug( &
+         &  " DIM INIT: dimension length: "//fct_str(id_len) )
+         tf_dim%i_len=id_len
+      ENDIF
+
+      ! define dimension is supposed to be used
+      IF( PRESENT(ld_use) )THEN
+         tf_dim%l_use=ld_use
+      ELSE
+         tf_dim%l_use=.TRUE.
+      ENDIF
+
+      IF( PRESENT(cd_sname) )THEN
+
+         cl_sname=fct_lower(cd_sname)
+
+         IF( TRIM(cl_sname) == 'x' .OR. &
+         &   TRIM(cl_sname) == 'y' .OR. & 
+         &   TRIM(cl_sname) == 'z' .OR. & 
+         &   TRIM(cl_sname) == 't' )THEN
+            CALL logger_debug( &
+            &  " DIM INIT: dimension short name: "//TRIM(cd_sname) )
+            tf_dim%c_sname=TRIM(cd_sname)
+         ELSE
+            CALL logger_warn("DIM INIT: invalid short name."//&
+            " choose between ('x','y','z','t')")
+         ENDIF
+      ENDIF
+
+      IF( TRIM(fct_lower(tf_dim%c_sname)) == 'u' )THEN
+
+         cl_name=fct_lower(cd_name)
+
+         IF(     dim__is_allowed(TRIM(cl_name), cm_dimX(:), im_dimX) )THEN
+            tf_dim%c_sname='x'
+         ELSEIF( dim__is_allowed(TRIM(cl_name), cm_dimY(:), im_dimY) )THEN
+            tf_dim%c_sname='y'
+         ELSEIF( dim__is_allowed(TRIM(cl_name), cm_dimZ(:), im_dimZ) )THEN
+            tf_dim%c_sname='z'
+         ELSEIF( dim__is_allowed(TRIM(cl_name), cm_dimT(:), im_dimT) )THEN
+            tf_dim%c_sname='t'
+         ELSE
+            CALL logger_warn("DIM INIT: "//TRIM(cd_name)//&
+            " not allowed.")
+         ENDIF
+
+      ENDIF
+
+      IF( PRESENT(ld_uld) )THEN
+         CALL logger_debug( &
+         &  " DIM INIT: unlimited dimension: "//fct_str(ld_uld) )
+         tf_dim%l_uld=ld_uld
+      ELSE
+         IF( TRIM(fct_lower(tf_dim%c_sname)) =='t'  )THEN
+            tf_dim%l_uld=.TRUE.
+         ENDIF
+      ENDIF
+      
+      ! get dimension order indices
+      tf_dim%i_xyzt2=SCAN(TRIM(cp_dimorder),TRIM(tf_dim%c_sname))
+
+   END FUNCTION dim_init
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dim__print_arr(td_dim)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine print informations of an array of dimension. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_dim array of dimension structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TDIM), DIMENSION(:), INTENT(IN) :: td_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=1,SIZE(td_dim(:))
+         CALL dim_print(td_dim(ji))
+      ENDDO
+
+   END SUBROUTINE dim__print_arr
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dim__print_unit(td_dim)
+   !-------------------------------------------------------------------
+   !> @brief This subrtoutine print dimension information. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_dim dimension structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TDIM), INTENT(IN) :: td_dim
+      !----------------------------------------------------------------
+
+      WRITE(*,'((3x,a,a),(/6x,a,a),(a,i1),(a,i5),2(a,a),2(a,i1))')   &
+      &        " dimension : ",TRIM(td_dim%c_name),               &
+      &        " short name : ",TRIM(td_dim%c_sname),        &
+      &        " id : ",td_dim%i_id,                         &
+      &        " len : ",td_dim%i_len,                       &
+      &        " use : ",TRIM(fct_str(td_dim%l_use)),        &
+      &        " uld : ",TRIM(fct_str(td_dim%l_uld)),        &
+      &        " xyzt2 : ",td_dim%i_xyzt2,                   &
+      &        " 2xyzt : ",td_dim%i_2xyzt
+
+   END SUBROUTINE dim__print_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION dim_fill_unused(td_dim) &
+         & RESULT (tf_dim)
+   !-------------------------------------------------------------------
+   !> @brief This function fill unused dimension of an array of dimension
+   !> and return a 4 elts array of dimension structure. 
+   !> @details
+   !> output dimensions 'x','y','z' and 't' are all informed.
+   !>
+   !> @note without input array of dimension, return 
+   !> a 4 elts array of dimension structure all unused
+   !> (case variable 0d)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - Bug fix: use order to disorder table (see dim_init)
+   !>
+   !> @param[in] td_dim array of dimension structure
+   !> @return  4elts array of dimension structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TDIM), DIMENSION(:), INTENT(IN), OPTIONAL :: td_dim
+
+      ! function
+      TYPE(TDIM), DIMENSION(ip_maxdim)               :: tf_dim
+
+      ! local variable
+      CHARACTER(LEN=lc)                       :: cl_dimin
+      INTEGER(i4)      , DIMENSION(1)         :: il_ind  ! index
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( PRESENT(td_dim) )THEN
+         tf_dim(1:SIZE(td_dim(:)))=td_dim(:)
+      ENDIF
+      ! concatenate short nem dimension in a character string
+      cl_dimin=fct_lower(fct_concat(tf_dim(:)%c_sname))
+      DO ji = 1, ip_maxdim
+
+         ! search missing dimension
+         IF( INDEX(cl_dimin,TRIM(fct_lower(cp_dimorder(ji:ji)))) == 0 )THEN
+            ! search first empty dimension (see dim_init)
+            il_ind(:)=MINLOC( tf_dim(:)%i_xyzt2, tf_dim(:)%i_xyzt2 == 0 )
+
+            ! put missing dimension instead of empty one
+            tf_dim(il_ind(1))%c_sname=fct_lower(cp_dimorder(ji:ji))
+            ! update output structure
+            tf_dim(il_ind(1))%c_name=fct_lower(cp_dimorder(ji:ji))
+            tf_dim(il_ind(1))%i_xyzt2=ji
+            tf_dim(il_ind(1))%i_len=1
+            tf_dim(il_ind(1))%l_use=.FALSE.
+         ENDIF
+
+      ENDDO
+         
+   END FUNCTION dim_fill_unused
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dim_reorder(td_dim, cd_dimorder)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This subroutine switch element of an array (4 elts) of dimension 
+   !> structure 
+   !> from disordered dimension to ordered dimension <br/>
+   !>
+   !> @details
+   !> Optionally you could specify dimension order to output
+   !> (default 'xyzt')
+   !> Example: (/'z','x','t','y'/) => (/'x','y','z','t'/)
+   !>
+   !> @warning this subroutine change dimension order 
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014 
+   !> - allow to choose ordered dimension to be output
+   !>
+   !> @param[inout] td_dim    array of dimension structure
+   !> @param[in] cd_dimorder  dimension order to be output 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TDIM)              , DIMENSION(:), INTENT(INOUT) :: td_dim
+      CHARACTER(LEN=ip_maxdim)              , INTENT(IN   ), OPTIONAL :: cd_dimorder
+
+      ! local variable
+      INTEGER(i4)                             :: il_ind
+
+      CHARACTER(LEN=lc)                       :: cl_dimin
+      CHARACTER(LEN=lc)                       :: cl_dimorder
+
+      TYPE(TDIM)       , DIMENSION(ip_maxdim) :: tl_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
+         CALL logger_error("DIM REORDER: invalid dimension of array dimension.")
+      ELSE
+
+         cl_dimorder=TRIM(cp_dimorder)
+         IF( PRESENT(cd_dimorder) ) cl_dimorder=TRIM(ADJUSTL(cd_dimorder))
+
+         ! add id if dimension used and no id
+         DO ji=1, ip_maxdim
+
+            IF( td_dim(ji)%l_use )THEN
+               IF( td_dim(ji)%i_id == 0 )THEN
+                  td_dim(ji)%i_id=MAXVAL(td_dim(:)%i_id)+1
+               ENDIF
+            ELSE
+               td_dim(ji)%i_id=0
+               td_dim(ji)%i_xyzt2=0
+               td_dim(ji)%i_2xyzt=0
+               td_dim(ji)%c_sname='u'
+               td_dim(ji)%c_name=''
+               td_dim(ji)%l_uld=.FALSE.
+            ENDIF
+
+         ENDDO
+
+         ! fill unused dimension
+         tl_dim(:)=dim_fill_unused(td_dim(:))
+         cl_dimin=fct_lower(fct_concat(tl_dim(:)%c_sname))
+
+         ! compute input id from output id (xyzt) 
+         DO ji = 1, ip_maxdim
+             
+            il_ind=SCAN(TRIM(cl_dimorder),TRIM(cl_dimin(ji:ji)))
+            IF( il_ind /= 0 )THEN
+               tl_dim(ji)%i_xyzt2=il_ind
+            ENDIF
+            
+         ENDDO
+
+         ! compute output id (xyzt) from input id 
+         DO ji = 1, ip_maxdim
+             
+            il_ind=SCAN(TRIM(cl_dimin),TRIM(cl_dimorder(ji:ji)))
+            IF( il_ind /= 0 )THEN
+               tl_dim(ji)%i_2xyzt=il_ind
+            ENDIF
+            
+         ENDDO
+
+         ! change dimension order to ('x','y','z','t')
+         td_dim(:)%c_name  = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%c_name)
+         td_dim(:)%c_sname = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%c_sname)
+         td_dim(:)%i_id    = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%i_id  )
+         td_dim(:)%i_len   = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%i_len )
+         td_dim(:)%l_uld   = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%l_uld )
+         td_dim(:)%l_use   = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%l_use )
+         td_dim(:)%i_2xyzt = tl_dim(:)%i_2xyzt
+         td_dim(:)%i_xyzt2 = tl_dim(:)%i_xyzt2
+
+         ! clean
+         CALL dim_clean(tl_dim(:))
+      ENDIF
+
+   END SUBROUTINE dim_reorder
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dim_disorder(td_dim)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine switch dimension array from ordered dimension ('x','y','z','t')
+   !> to disordered dimension. <br/>
+   !> @details
+   !> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/)<br/>
+   !  This is useful to add dimension in a variable or file.
+   !> @warning this subroutine change dimension order 
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_dim array of dimension structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TDIM), DIMENSION(:), INTENT(INOUT) :: td_dim
+
+      ! local variable
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
+         CALL logger_error("DIM DISORDER: invalid dimension of array dimension.")
+      ELSE      
+         ! add dummy xyzt2 id to unused dimension
+         jj=1
+         DO ji = 1, ip_maxdim
+            IF( .NOT. td_dim(ji)%l_use .AND. td_dim(ji)%i_xyzt2 == 0 )THEN
+               DO WHILE( ANY( td_dim(:)%i_xyzt2 == jj ))
+                  jj=jj+1
+               ENDDO
+               td_dim(ji)%i_xyzt2=jj
+            ENDIF
+         ENDDO
+
+         ! change dimension order from ('x','y','z','t')
+         td_dim(:)%c_name  = dim_reorder_xyzt2(td_dim,td_dim(:)%c_name)
+         td_dim(:)%c_sname = dim_reorder_xyzt2(td_dim,td_dim(:)%c_sname)
+         td_dim(:)%i_id    = dim_reorder_xyzt2(td_dim,td_dim(:)%i_id  )
+         td_dim(:)%i_len   = dim_reorder_xyzt2(td_dim,td_dim(:)%i_len )
+         td_dim(:)%l_uld   = dim_reorder_xyzt2(td_dim,td_dim(:)%l_uld )
+         td_dim(:)%l_use   = dim_reorder_xyzt2(td_dim,td_dim(:)%l_use )
+
+         ! remove dummy xyzt2 id from unused dimension
+         DO ji = 1, ip_maxdim
+            IF( .NOT. td_dim(ji)%l_use )THEN
+               td_dim(ji)%i_id=0
+               td_dim(ji)%i_xyzt2=0
+               td_dim(ji)%c_sname='u'
+               td_dim(ji)%c_name=''
+               td_dim(ji)%l_uld=.FALSE.
+            ENDIF
+         ENDDO
+      ENDIF
+
+   END SUBROUTINE dim_disorder
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION dim__reshape_2xyzt_dp(td_dim, dd_value) &
+         & RESULT (df_value)
+   !-------------------------------------------------------------------
+   !> @brief This function reshape real(8) 4D array   
+   !> to an ordered array, as defined by dim_reorder.<br/>
+   !> @details
+   !> Example: (/'z','x','t','y'/) => (/'x','y','z','t'/)
+   !
+   !> @note you must have run dim_reorder before use this subroutine
+   !
+   !> @warning output array dimension differ from input array dimension
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2019
+   !> - do not reshape array already order
+   !>
+   !> @param[in] td_dim    array of dimension structure
+   !> @param[in] dd_value  array of value to reshape
+   !> @return array of value reshaped 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TDIM), DIMENSION(:)      , INTENT(IN) :: td_dim
+      REAL(dp)  , DIMENSION(:,:,:,:), INTENT(IN) :: dd_value
+      
+      ! function
+      REAL(dp), DIMENSION(td_dim(1)%i_len, &
+         &                td_dim(2)%i_len, &
+         &                td_dim(3)%i_len, &
+         &                td_dim(4)%i_len)       :: df_value
+
+      ! local variable
+      INTEGER(i4)      , DIMENSION(ip_maxdim) :: il_shape
+      CHARACTER(LEN=lc)                       :: cl_dim
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
+         CALL logger_error("DIM RESHAPE 2 XYZT: invalid dimension of "//&
+            &  "array dimension.")
+      ELSE      
+
+         IF( ANY(td_dim(:)%i_2xyzt==0) .OR. ANY(td_dim(:)%i_xyzt2==0) )THEN
+
+            CALL logger_fatal( &
+            &  "  DIM RESHAPE 2 XYZT: you should have run dim_reorder"// &
+            &  "   before running RESHAPE" )
+
+         ENDIF
+
+         il_shape=SHAPE(dd_value)
+         ! check input dimension
+         IF( ANY(il_shape(:) /= (/ td_dim(td_dim(1)%i_xyzt2)%i_len, &
+                               &   td_dim(td_dim(2)%i_xyzt2)%i_len, &
+                               &   td_dim(td_dim(3)%i_xyzt2)%i_len, &
+                               &   td_dim(td_dim(4)%i_xyzt2)%i_len /)) )THEN
+
+            DO ji=1,ip_maxdim
+               CALL logger_debug(" DIM RESHAPE 2 XYZT: dim "//&
+                  &     TRIM(td_dim(td_dim(ji)%i_xyzt2)%c_name)//" "//&
+                  &     TRIM(fct_str(td_dim(td_dim(ji)%i_xyzt2)%i_len))//" vs "//&
+                  &     TRIM(fct_str(il_shape(ji))) )
+            ENDDO
+            CALL logger_fatal(" DIM RESHAPE 2 XYZT: wrong input dimensions " )
+
+         ELSE
+
+            ! write some informations
+            cl_dim="(/"
+            DO ji=1,ip_maxdim-1
+               cl_dim=TRIM(cl_dim)//TRIM(fct_str(il_shape(ji)))//','
+            ENDDO
+            cl_dim=TRIM(cl_dim)//TRIM(fct_str(il_shape(ip_maxdim)))//"/)"
+
+            CALL logger_debug(" DIM RESHAPE 2 XYZT: input dimensions are "//&
+            &  TRIM(cl_dim) )
+
+            cl_dim="(/"
+            DO ji=1,ip_maxdim-1
+               cl_dim=TRIM(cl_dim)//TRIM(fct_str(td_dim(ji)%i_len))//','
+            ENDDO
+            cl_dim=TRIM(cl_dim)//TRIM(fct_str(td_dim(ip_maxdim)%i_len))//"/)"
+
+            CALL logger_debug(" DIM RESHAPE 2 XYZT: ouput dimensions should be "//&
+            &  TRIM(cl_dim) )
+
+            IF( td_dim(1)%i_xyzt2 == 1 .AND. &
+              & td_dim(2)%i_xyzt2 == 2 .AND. &   
+              & td_dim(3)%i_xyzt2 == 3 .AND. &   
+              & td_dim(4)%i_xyzt2 == 4 )THEN     
+   
+               DO jl=1,td_dim(4)%i_len
+                  DO jk=1,td_dim(3)%i_len
+                     DO jj=1,td_dim(2)%i_len
+                        DO ji=1,td_dim(1)%i_len
+                           df_value(ji,jj,jk,jl)=dd_value(ji,jj,jk,jl)
+                        ENDDO
+                     ENDDO   
+                  ENDDO
+               ENDDO
+
+            ELSE
+
+               ! reorder dimension to x,y,z,t
+               df_value(:,:,:,:)=RESHAPE(SOURCE=dd_value(:,:,:,:),&
+                  &                 SHAPE = (/ td_dim(1)%i_len,   &
+                  &                            td_dim(2)%i_len,   &
+                  &                            td_dim(3)%i_len,   &
+                  &                            td_dim(4)%i_len /),&
+                  &                 ORDER = (/ td_dim(1)%i_2xyzt, &
+                  &                            td_dim(2)%i_2xyzt, &
+                  &                            td_dim(3)%i_2xyzt, &
+                  &                            td_dim(4)%i_2xyzt /))      
+            ENDIF
+         ENDIF
+      ENDIF
+
+   END FUNCTION dim__reshape_2xyzt_dp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION dim__reshape_xyzt2_dp(td_dim, dd_value) &
+         & RESULT (df_value)
+   !-------------------------------------------------------------------
+   !> @brief This function reshape ordered real(8) 4D array with dimension 
+   !> (/'x','y','z','t'/) to an "disordered" array.<br/>
+   !> @details
+   !> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/)
+   !
+   !> @note you must have run dim_reorder before use this subroutine
+   !
+   !> @warning output array dimension differ from input array dimension
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_dim    array of dimension structure
+   !> @param[in] dd_value  array of value to reshape
+   !> @return array of value reshaped 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+      
+      ! Argument      
+      TYPE(TDIM), DIMENSION(:)      , INTENT(IN) :: td_dim
+      REAL(dp),   DIMENSION(:,:,:,:), INTENT(IN) :: dd_value
+      
+      ! function
+      REAL(dp), DIMENSION(td_dim(td_dim(1)%i_xyzt2)%i_len, &
+         &                td_dim(td_dim(2)%i_xyzt2)%i_len, &
+         &                td_dim(td_dim(3)%i_xyzt2)%i_len, &
+         &                td_dim(td_dim(4)%i_xyzt2)%i_len) :: df_value
+
+      ! local variable
+      INTEGER(i4),      DIMENSION(ip_maxdim) :: il_shape
+      CHARACTER(LEN=lc)                      :: cl_dim
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
+         CALL logger_error("DIM RESHAPE XYZT 2: invalid dimension of "//&
+            &  "array dimension.")
+      ELSE
+
+         IF( ANY(td_dim(:)%i_xyzt2==0) .OR. ANY(td_dim(:)%i_2xyzt==0) )THEN
+
+            CALL logger_fatal( &
+            &  "  DIM RESHAPE XYZT 2: you should have run dim_reorder"// &
+            &  "   before running RESHAPE" )
+
+         ENDIF        
+
+         ! check input dimension
+         il_shape=SHAPE(dd_value)
+         IF( ANY(il_shape(:)/=td_dim(:)%i_len))THEN
+
+            DO ji=1,ip_maxdim
+               CALL logger_trace(" DIM RESHAPE XYZT 2: dim "//&
+               &              TRIM(td_dim(ji)%c_name)//" "//&
+               &              TRIM(fct_str(td_dim(ji)%i_len))//" vs "//&
+               &              TRIM(fct_str(il_shape(ji))) )
+            ENDDO
+            CALL logger_fatal( "DIM RESHAPE XYZT 2: wrong input dimensions ")
+
+         ELSE      
+
+            ! write some informations
+            cl_dim="(/"
+            DO ji=1,ip_maxdim-1
+               cl_dim=TRIM(cl_dim)//TRIM(fct_str(il_shape(ji)))//','
+            ENDDO
+            cl_dim=TRIM(cl_dim)//TRIM(fct_str(il_shape(ip_maxdim)))//"/)"
+
+            CALL logger_debug(" DIM RESHAPE XYZT 2: input dimensions are "//&
+            &  TRIM(cl_dim) )
+
+            cl_dim="(/"
+            DO ji=1,ip_maxdim-1
+               cl_dim=TRIM(cl_dim)//&
+               &      TRIM(fct_str(td_dim(td_dim(ji)%i_xyzt2)%i_len))//','
+            ENDDO
+            cl_dim=TRIM(cl_dim)//&
+            &      TRIM(fct_str(td_dim(td_dim(ip_maxdim)%i_xyzt2)%i_len))//"/)"
+
+            CALL logger_debug(" DIM RESHAPE XYZT 2: ouput dimensions should be "//&
+            &  TRIM(cl_dim) )
+
+            ! reshape array
+            df_value(:,:,:,:)=RESHAPE(SOURCE=dd_value,  &
+               &           SHAPE = (/ td_dim(td_dim(1)%i_xyzt2)%i_len,   &
+               &                      td_dim(td_dim(2)%i_xyzt2)%i_len,   &
+               &                      td_dim(td_dim(3)%i_xyzt2)%i_len,   &
+               &                      td_dim(td_dim(4)%i_xyzt2)%i_len /),&
+               &           ORDER = (/        td_dim(1)%i_xyzt2,          &
+               &                             td_dim(2)%i_xyzt2,          &
+               &                             td_dim(3)%i_xyzt2,          &
+               &                             td_dim(4)%i_xyzt2        /))
+
+         ENDIF      
+      ENDIF      
+
+   END FUNCTION dim__reshape_xyzt2_dp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION dim__reorder_2xyzt_i4(td_dim, id_arr) &
+         & RESULT (if_value)
+   !-------------------------------------------------------------------
+   !> @brief  This function reordered integer(4) 1D array to be suitable 
+   !> with dimension ordered as defined in dim_reorder.
+   !> @note you must have run dim_reorder before use this subroutine
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_dim array of dimension structure
+   !> @param[in] id_arr array of value to reshape
+   !> @return array of value reshaped 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
+      INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_arr
+      
+      ! function
+      INTEGER(i4), DIMENSION(ip_maxdim)     :: if_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
+      &   SIZE(id_arr(:)) /= ip_maxdim )THEN
+         CALL logger_error("DIM REORDER 2 XYZT: invalid dimension of array dimension"//&
+         &              " or of array of value.")
+      ELSE      
+         IF( ANY(td_dim(:)%i_2xyzt==0) )THEN
+
+            CALL logger_error( &
+            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder"//&
+            &  "   before running REORDER" )
+
+         ENDIF        
+
+         DO ji=1,ip_maxdim
+            if_value(ji)=id_arr(td_dim(ji)%i_2xyzt)
+         ENDDO
+      ENDIF
+
+   END FUNCTION dim__reorder_2xyzt_i4
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION dim__reorder_xyzt2_i4(td_dim, id_arr) &
+         & RESULT (if_value)
+   !-------------------------------------------------------------------
+   !> @brief This function disordered integer(4) 1D array to be suitable with
+   !> initial dimension order (ex: dimension read in file).
+   !> @note you must have run dim_reorder before use this subroutine
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_dim array of dimension structure
+   !> @param[in] id_arr array of value to reshape
+   !> @return array of value reshaped 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
+      INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_arr
+ 
+      ! function
+      INTEGER(i4), DIMENSION(ip_maxdim)     :: if_value
+ 
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
+      &   SIZE(id_arr(:)) /= ip_maxdim )THEN
+         CALL logger_error("DIM REORDER XYZT 2: invalid dimension of "//&
+            &  "array dimension or of array of value.")
+      ELSE      
+         IF( ANY(td_dim(:)%i_xyzt2==0) )THEN
+
+            CALL logger_error( &
+            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"// &
+            &  "   before running REORDER" )
+
+         ENDIF        
+
+         DO ji=1,ip_maxdim
+            if_value(ji)=id_arr(td_dim(ji)%i_xyzt2)
+         ENDDO
+      ENDIF
+
+   END FUNCTION dim__reorder_xyzt2_i4
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION dim__reorder_2xyzt_l(td_dim, ld_arr) &
+         & RESULT (lf_arr)
+   !-------------------------------------------------------------------
+   !> @brief  This function reordered logical 1D array to be suitable 
+   !> with dimension ordered as defined in dim_reorder.
+   !> @note you must have run dim_reorder before use this subroutine
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_dim array of dimension structure
+   !> @param[in] ld_arr array of value to reordered
+   !> @return array of value reordered 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
+      LOGICAL    , DIMENSION(:), INTENT(IN) :: ld_arr
+      
+      ! function
+      LOGICAL, DIMENSION(ip_maxdim)         :: lf_arr
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
+      &   SIZE(ld_arr(:)) /= ip_maxdim )THEN
+         CALL logger_error("DIM REORDER 2 XYZT: invalid dimension of array dimension"//&
+         &              " or of array of value.")
+      ELSE      
+         IF( ANY(td_dim(:)%i_2xyzt==0) )THEN
+
+            CALL logger_error( &
+            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder"// &
+            &  "   before running REORDER" )
+
+         ENDIF        
+
+         DO ji=1,ip_maxdim
+            lf_arr(ji)=ld_arr(td_dim(ji)%i_2xyzt)
+         ENDDO
+      ENDIF
+
+   END FUNCTION dim__reorder_2xyzt_l
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION dim__reorder_xyzt2_l(td_dim, ld_arr) &
+         & RESULT (lf_arr)
+   !-------------------------------------------------------------------
+   !> @brief This function disordered logical 1D array to be suitable with
+   !> initial dimension order (ex: dimension read in file).
+   !> @note you must have run dim_reorder before use this subroutine
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_dim array of dimension structure
+   !> @param[in] ld_arr array of value to reordered
+   !> @return array of value reordered 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
+      LOGICAL    , DIMENSION(:), INTENT(IN) :: ld_arr
+ 
+      ! function
+      LOGICAL, DIMENSION(ip_maxdim)         :: lf_arr
+ 
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
+      &   SIZE(ld_arr(:)) /= ip_maxdim )THEN
+         CALL logger_error("DIM REORDER XYZT 2: invalid dimension of array dimension"//&
+         &              " or of array of value.")
+      ELSE
+         IF( ANY(td_dim(:)%i_xyzt2==0) )THEN
+
+            CALL logger_error( &
+            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"//&
+            &  "  before running REORDER" )
+
+         ENDIF        
+
+         DO ji=1,ip_maxdim
+            lf_arr(ji)=ld_arr(td_dim(ji)%i_xyzt2)
+         ENDDO
+      ENDIF
+
+   END FUNCTION dim__reorder_xyzt2_l
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION dim__reorder_2xyzt_c(td_dim, cd_arr) &
+         & RESULT (cf_arr)
+   !-------------------------------------------------------------------
+   !> @brief  This function reordered string 1D array to be suitable 
+   !> with dimension ordered as defined in dim_reorder.
+   !> @note you must have run dim_reorder before use this subroutine
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_dim array of dimension structure
+   !> @param[in] cd_arr array of value to reordered
+   !> @return array of value reordered 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TDIM),       DIMENSION(:), INTENT(IN) :: td_dim
+      CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_arr
+ 
+      ! function
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdim)    :: cf_arr
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
+      &   SIZE(cd_arr(:)) /= ip_maxdim )THEN
+         CALL logger_error("DIM REORDER 2 XYZT: invalid dimension of array dimension"//&
+         &              " or of array of value.")
+      ELSE      
+         IF( ANY(td_dim(:)%i_2xyzt==0) )THEN
+
+            CALL logger_error( &
+            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder"//&
+            &  " before running REORDER" )
+
+         ENDIF        
+
+         DO ji=1,ip_maxdim
+            cf_arr(ji)=TRIM(cd_arr(td_dim(ji)%i_2xyzt))
+         ENDDO
+      ENDIF
+
+   END FUNCTION dim__reorder_2xyzt_c
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION dim__reorder_xyzt2_c(td_dim, cd_arr) &
+         & RESULT (cf_arr)
+   !-------------------------------------------------------------------
+   !> @brief This function disordered string 1D array to be suitable with
+   !> initial dimension order (ex: dimension read in file).
+   !> @note you must have run dim_reorder before use this subroutine
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_dim array of dimension structure
+   !> @param[in] cd_arr array of value to reordered
+   !> @return array of value reordered 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TDIM),       DIMENSION(:), INTENT(IN) :: td_dim
+      CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_arr
+ 
+      ! function
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdim) :: cf_arr
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
+      &   SIZE(cd_arr(:)) /= ip_maxdim )THEN
+         CALL logger_error("DIM REORDER XYZT 2: invalid dimension of array dimension"//&
+         &              " or of array of value.")
+      ELSE
+         IF( ANY(td_dim(:)%i_xyzt2==0) )THEN
+            CALL logger_error( &
+            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"// &
+            &  "   before running REORDER" )
+
+         ENDIF        
+
+         DO ji=1,ip_maxdim
+            cf_arr(ji)=TRIM(cd_arr(td_dim(ji)%i_xyzt2))
+         ENDDO
+      ENDIF
+
+   END FUNCTION dim__reorder_xyzt2_c
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dim__clean_unit(td_dim)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine clean dimension structure.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_dim dimension strucutre
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TDIM), INTENT(INOUT) :: td_dim
+
+      ! local variable
+      TYPE(TDIM) :: tl_dim ! empty dimension strucutre
+      !----------------------------------------------------------------
+
+      CALL logger_trace( &
+      &  " DIM CLEAN: reset dimension "//TRIM(td_dim%c_name) )
+
+      ! replace by empty structure
+      td_dim=tl_dim
+
+   END SUBROUTINE dim__clean_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dim__clean_arr(td_dim)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine clean array of dimension structure
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_dim array of dimension strucutre
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TDIM), DIMENSION(:), INTENT(INOUT) :: td_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=1,SIZE(td_dim(:))
+         CALL dim_clean(td_dim(ji))
+      ENDDO
+
+   END SUBROUTINE dim__clean_arr
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dim_get_dummy(cd_dummy)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill dummy dimension array
+   !
+   !> @author J.Paul
+   !> @date September, 2015 - Initial Version
+   !> @date May, 2019
+   !> - read number of dummy element
+   !>
+   !> @param[in] cd_dummy dummy configuration file
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_dummy
+
+      ! local variable
+      INTEGER(i4)   :: il_fileid
+      INTEGER(i4)   :: il_status
+
+      LOGICAL       :: ll_exist
+
+      ! loop indices
+      ! namelist
+      INTEGER(i4)                                :: in_ndumvar
+      INTEGER(i4)                                :: in_ndumdim
+      INTEGER(i4)                                :: in_ndumatt
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumvar
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumdim
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumatt
+
+      !----------------------------------------------------------------
+      NAMELIST /namdum/ &   !< dummy namelist
+      &  in_ndumvar,&       !< number of variable  name
+      &  in_ndumdim,&       !< number of dimension name
+      &  in_ndumatt,&       !< number of attribute name
+      &  cn_dumvar, &       !< variable  name
+      &  cn_dumdim, &       !< dimension name
+      &  cn_dumatt          !< attribute name
+      !----------------------------------------------------------------
+
+      ! init
+      cm_dumdim(:)=''
+
+      ! read namelist
+      INQUIRE(FILE=TRIM(cd_dummy), EXIST=ll_exist)
+      IF( ll_exist )THEN
+
+         il_fileid=fct_getunit()
+
+         OPEN( il_fileid, FILE=TRIM(cd_dummy), &
+         &                FORM='FORMATTED',       &
+         &                ACCESS='SEQUENTIAL',    &
+         &                STATUS='OLD',           &
+         &                ACTION='READ',          &
+         &                IOSTAT=il_status)
+         CALL fct_err(il_status)
+         IF( il_status /= 0 )THEN
+            CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_dummy))
+         ENDIF
+
+         READ( il_fileid, NML = namdum )
+         im_ndumdim  = in_ndumdim
+         cm_dumdim(:)= cn_dumdim(:)
+
+         CLOSE( il_fileid )
+
+         IF( im_ndumdim > ip_maxdumcfg )THEN
+            CALL logger_fatal("DIM GET dUMMY : too much dummy dimension &
+            &     ( >"//fct_str(ip_maxdumcfg)//" ). &
+            &     set ip_maxdumcfg to higher value.")
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE dim_get_dummy
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION dim_is_dummy(td_dim) &
+         & RESULT (lf_dummy)
+   !-------------------------------------------------------------------
+   !> @brief This function check if dimension is defined as dummy dimension
+   !> in configuraton file
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial Version
+   !> @date, May, 2019
+   !> - use number of dummy elt in do-loop
+   !>
+   !> @param[in] td_dim dimension structure
+   !> @return true if dimension is dummy dimension 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TDIM), INTENT(IN) :: td_dim
+      
+      ! function
+      LOGICAL                :: lf_dummy
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      lf_dummy=.FALSE.
+      DO ji=1,im_ndumdim
+         IF( fct_lower(td_dim%c_name) == fct_lower(cm_dumdim(ji)) )THEN
+            lf_dummy=.TRUE.
+            EXIT
+         ENDIF
+      ENDDO
+
+   END FUNCTION dim_is_dummy
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dim_def_extra(cd_file)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read dimension configuration file, 
+   !> and fill array of dimension allowed.
+   !>
+   !> @author J.Paul
+   !> @date Ocotber, 2016 - Initial Version
+   !> @date May, 2019
+   !> - read number of element for each dimention 
+   !
+   !> @param[in] cd_file input file (dimension configuration file)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_file
+
+      ! local variable
+      INTEGER(i4)   :: il_fileid
+      INTEGER(i4)   :: il_status
+
+      LOGICAL       :: ll_exist
+      
+      ! loop indices
+      ! namelist
+      INTEGER(i4)                                :: in_dimX = 0
+      INTEGER(i4)                                :: in_dimY = 0
+      INTEGER(i4)                                :: in_dimZ = 0
+      INTEGER(i4)                                :: in_dimT = 0
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg) :: cn_dimX = '' 
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg) :: cn_dimY = ''
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg) :: cn_dimZ = ''
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg) :: cn_dimT = ''
+
+      !----------------------------------------------------------------
+      NAMELIST /namdim/ &   !< dimension namelist
+      &  in_dimX, &       !< number of x dimension name allowed
+      &  in_dimY, &       !< number of y dimension name allowed
+      &  in_dimZ, &       !< number of z dimension name allowed
+      &  in_dimT, &       !< number of t dimension name allowed
+      &  cn_dimX, &       !< x dimension name allowed
+      &  cn_dimY, &       !< y dimension name allowed
+      &  cn_dimZ, &       !< z dimension name allowed
+      &  cn_dimT          !< t dimension name allowed
+
+      !----------------------------------------------------------------
+
+      ! init
+      cm_dimX(:)=''
+      cm_dimY(:)=''
+      cm_dimZ(:)=''
+      cm_dimT(:)=''
+
+      ! read config variable file
+      INQUIRE(FILE=TRIM(cd_file), EXIST=ll_exist)
+      IF( ll_exist )THEN
+
+         il_fileid=fct_getunit()
+   
+         OPEN( il_fileid, FILE=TRIM(cd_file), &
+         &                FORM='FORMATTED',       &
+         &                ACCESS='SEQUENTIAL',    &
+         &                STATUS='OLD',           &
+         &                ACTION='READ',          &
+         &                IOSTAT=il_status)
+         CALL fct_err(il_status)
+         IF( il_status /= 0 )THEN
+            CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_file))
+         ENDIF
+   
+         READ( il_fileid, NML = namdim )
+         im_dimX   =in_dimX
+         im_dimY   =in_dimY
+         im_dimZ   =in_dimZ
+         im_dimT   =in_dimT
+         cm_dimX(:)=cn_dimX(:)
+         cm_dimY(:)=cn_dimY(:)
+         cm_dimZ(:)=cn_dimZ(:)
+         cm_dimT(:)=cn_dimT(:)
+
+         CLOSE( il_fileid )
+
+      ELSE
+
+         CALL logger_fatal("DIM DEF EXTRA: can't find configuration"//&
+            &              " file "//TRIM(cd_file))
+
+      ENDIF         
+
+   END SUBROUTINE dim_def_extra
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION dim__is_allowed(cd_name, cd_dim, id_ndim) &
+         & RESULT (lf_allowed)
+   !-------------------------------------------------------------------
+   !> @brief This function check if dimension is allowed, i.e defined 
+   !> in dimension configuraton file
+   !>
+   !> @author J.Paul
+   !> @date October, 2016 - Initial Version
+   !> @date May, 2019
+   !> - use number of element for each dimention allowed, instead of while loop 
+   !
+   !> @param[in] cd_name dimension name
+   !> @param[in] cd_dim  array dimension name allowed
+   !> @param[in] id_ndim number of elt in array dimension name allowed
+   !> @return true if dimension is allowed 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+      CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_dim
+      INTEGER(i4)     ,               INTENT(IN) :: id_ndim
+      
+      ! function
+      LOGICAL                                    :: lf_allowed
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      lf_allowed=.FALSE.
+      DO ji=1,id_ndim
+         IF( TRIM(fct_lower(cd_name)) == TRIM(fct_lower(cd_dim(ji))) )THEN
+            lf_allowed=.TRUE.
+            EXIT
+         ENDIF
+      ENDDO
+
+   END FUNCTION dim__is_allowed
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE dim
+
Index: /utils/tools_ticket2413/SIREN/src/docsrc/1_install.md
===================================================================
--- /utils/tools_ticket2413/SIREN/src/docsrc/1_install.md	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/docsrc/1_install.md	(revision 12863)
@@ -0,0 +1,27 @@
+# Download
+
+# Download NEMO #
+to install SIREN, you should first download NEMO.
+see [NEMO quick start guide](https://forge.ipsl.jussieu.fr/nemo/wiki/Users/ModelInstall#DownloadNEMOreferencecodeandconfigurations)
+
+# Compile SIREN #
+when NEMO is installed, you just have to compile SIREN codes:
+   1. go to ./NEMOGCM/TOOLS
+   2. run maketools (ex: ./maketools -n SIREN -m ifort_mpi_beaufix)
+
+      @note to get help on maketools: ./maketools -h
+
+# Fortran Compiler #
+SIREN codes were succesfully tested with :
+  - ifort (version 18.0.1 20171018)
+  - gfortran (version 4.8.5 20150623) 
+
+<HR>
+  <b>
+  - @ref index
+  - @ref md_src_docsrc_2_quickstart
+  - @ref md_src_docsrc_3_support_bug
+  - @ref md_src_docsrc_4_codingRules
+  - @ref md_src_docsrc_5_changeLog
+  - @ref todo
+  </b>
Index: /utils/tools_ticket2413/SIREN/src/docsrc/2_quickstart.md
===================================================================
--- /utils/tools_ticket2413/SIREN/src/docsrc/2_quickstart.md	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/docsrc/2_quickstart.md	(revision 12863)
@@ -0,0 +1,848 @@
+# How To Use (Quick Start)
+
+@tableofcontents
+
+SIREN is a software to set up regional configuration with
+ [NEMO](http://www.nemo-ocean.eu).<br/> 
+Actually SIREN creates all the input files you need to run a NEMO regional configuration.<br/>
+ 
+SIREN is composed of a set of Fortran programs :
+<ul>
+ <li>create_coord.f90 to create regional grid coordinates.</li>
+ <li>create_bathy.f90 to create regional grid bathymetry.</li>
+ <li>merge_bathy.f90 to merge regional grid bathymetry with wider grid bathymetry
+ at boundaries. 
+ @note the goal of this step is to avoid break in Bathymetry.
+ This break may cause inconsistency between forcing fields  at boundary and regional fields.
+ </li>
+ <li>create_meshmask.f90 to create meshmask or domain_cfg file(s) which contain(s) all the ocean domain informations.</li>
+ <li>create_layout.f90 to create/compute the domain layout of your configuration.</li>
+ <li>create_restart.f90 to create initial state file from coarse grid restart
+ or standard outputs.
+ @note this program could also be used to refined other input fields from a wider
+ configuations (as runoff, chlorophyll etc...)
+ </li>
+ <li>create_boundary.F90 to create boundaries conditions from wider configurations
+ output fields.
+ </li>
+</ul>
+
+@warning SIREN can not:
+<ul>
+<li>create global configuration.</li>
+<li>create configuarion around or close to North pole.</li>
+<li>change number of vertical level.</li>
+</ul>
+
+Here after we briefly describe how to use each programs,
+and so how to create your own regional configuration.
+@note As demonstrator for a first start a set of GLORYS files (global reanalysis on *ORCA025* grid), as well as examples of namelists are available [here](https://cloud.mercator-ocean.fr/public.php?service=files&t=acf44730538cdda0da548ffc5f99fb55).
+
+<!-- ######################################################################  -->
+# Create coordinates file # {#coord}
+
+To create your own configuration, you first have to create a coordinates file on your domain of study.<br/>
+SIREN allows you to create this coordinates file from a wider coordinates file.<br/>
+The coordinates file created could simply be an extraction, or a refinment of
+the wide grid.<br/>
+
+To create this new cooridnates file, you have to run :
+~~~~~~~~~~~~~~~~~~
+./SIREN/create_coord.exe create_coord.nam
+~~~~~~~~~~~~~~~~~~
+
+Here after is an example of namelist for *create_coord.exe*.<br/>
+In this example, you create a coordinates file named *coord_fine.nc*.<br/>
+This new coordinates file is refined from an extraction of *coordinates_ORCA025.nc*. 
+~~~~~~~~~~~
+&namlog
+/
+
+&namcfg
+   cn_varcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg"
+   cn_dimcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/dimension.cfg"
+   cn_dumcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/dummy.cfg"
+/
+
+&namsrc
+   cn_coord0 = "PATH/coordinates_ORCA025.nc"
+   in_perio0 = 4
+/
+
+&namvar
+/
+
+&namnst
+   in_imin0 = 1070
+   in_imax0 = 1072
+   in_jmin0 = 607
+   in_jmax0 = 609
+
+   in_rhoi = 2
+   in_rhoj = 3
+/
+
+&namout
+   cn_fileout = "PATH/coord_fine.nc"
+/
+~~~~~~~~~~~
+
+@note you could define sub domain with coarse grid indices or with coordinates.
+
+Let's get describe this namelist.<br/>
+First we have the **namlog** sub-namelist. This sub-namelist set parameters of the log
+file.<br/>
+All the parameters of this sub-namelist have default value, so you could let it
+empty, as done here.<br/> This will create a log file named *create_coord.log*
+
+## namcfg
+The **namcfg** sub-namelist defines where found SIREN configuration files.<br/>
+- The variable configuration file defines standard name, default interpolation method,
+axis,... to be used for some known variables.<br/>
+Obviously, you could add other variables to those already list, in this file.
+- The dimension configuration file defines dimensions allowed.
+- The dummy configuration file defines useless dimension or variable. these dimension(s) or variable(s) will not be processed.
+
+@note You could find the generic version of those configuration files in the directory *SIREN/cfg*.
+
+## namsrc
+The **namsrc** sub-namelist set parameters of the coarse/source
+coordinates file name, path to find it, and the NEMO periodicity of the grid.<br/>
+
+@note the NEMO periodicity could be choose between 0 to 6:
+<dl>
+<dt>in_perio=0</dt>
+<dd>standard regional model</dd>
+<dt>in_perio=1</dt>
+<dd>east-west cyclic model</dd>
+<dt>in_perio=2</dt>
+<dd>model with symmetric boundary condition across the equator</dd>
+<dt>in_perio=3</dt>
+<dd>regional model with North fold boundary and T-point pivot</dd>
+<dt>in_perio=4</dt>
+<dd>global model with a T-point pivot.<br/>
+example: ORCA2, ORCA025, ORCA12</dd>
+<dt>in_perio=5</dt>
+<dd>regional model with North fold boundary and F-point pivot</dd>
+<dt>in_perio=6</dt>
+<dd>global model with a F-point pivot<br/>
+example: ORCA05</dd>
+</dd>
+</dl>
+@sa For more information see @ref md_src_docsrc_6_perio
+
+## namvar
+The **namvar** sub-namelist lists variables to be used.<br/>
+By default all the variables of the coarse/source coordinates file are used to create
+the new coordinates file.<br/> 
+The interpolation methods to be used are defined in the configuration variables file (see
+above). So you do not need to fill this sub-namelist too.
+
+## namnst
+The **namnst** sub-namelist defines the subdomain to be used as well as refinment factor.<br/>
+
+<ul>
+<li> you could define sub domain with coarse grid indices</li> 
+
+~~~~~~~~~~~
+&namnst
+   in_imin0 = 1070
+   in_imax0 = 1072
+   in_jmin0 = 607
+   in_jmax0 = 609
+/
+~~~~~~~~~~~
+
+<li>or with coordinates</li>
+
+~~~~~~~~~~~
+&namnst
+   rn_lonmin0 = -97.9 
+   rn_lonmax0 = -62.3 
+   rn_latmin0 =   7.7
+   rn_latmax0 =  30.8
+/
+~~~~~~~~~~~
+
+<li>you can select area quite every where (excepted too close from the North
+pole), and use the refinment factor you want.</li>
+
+~~~~~~~~~~~
+&namnst
+   in_imin0 = 1070
+   in_imax0 = 1072
+   in_jmin0 = 607
+   in_jmax0 = 609
+
+   in_rhoi = 2
+   in_rhoj = 3
+/
+~~~~~~~~~~~
+@image html grid_zoom_60.png
+<center>@image latex grid_zoom_40.png
+</center>
+<!-- @note ghost cells all around the grid are not shown here. -->
+
+<li>you can select area crossing the east-west overlap of the global ORCA grid.</li>
+
+~~~~~~~~~~~
+&namnst          
+   in_imin0 = 1402 
+   in_imax0 = 62
+   in_jmin0 = 490 
+   in_jmax0 = 570 
+
+   in_rhoi = 5
+   in_rhoj = 5 
+/                
+~~~~~~~~~~~
+@image html grid_glob_over_30.png
+<center>@image latex grid_glob_over_20.png
+</center>
+<!-- @note in blue, the east-west overlap band of ORCA grid. -->
+
+<li>you can select east-west cyclic area.</li>
+
+~~~~~~~~~~~
+&namnst
+   in_imin0 = 0
+   in_imax0 = 0
+   in_jmin0 = 390
+   in_jmax0 = 450
+
+   in_rhoi = 1
+   in_rhoj = 1
+/
+~~~~~~~~~~~
+@image html grid_glob_band_30.png
+<center>@image latex grid_glob_band_20.png
+</center>
+
+</ul>
+
+Finally the **namout** sub-namelist defines the output file.<br/>
+
+@note All the output files created by SIREN include information about NEMO
+periodicity, as well as source file, indices and refinment used.
+
+@sa For more information and options to create coordinates, see create_coord.f90
+
+<!-- ######################################################################  -->
+# Create bathymetry file # {#bathy}
+
+Then you need a Bathymetry file.<br/>
+SIREN allows you to create a Bathymetry extracted or refined from a wider
+Bathymetry grid.<br/>
+
+To create this new bathymetry, you have to run :
+~~~~~~~~~~~~~~~~~~
+./SIREN/create_bathy.exe create_bathy.nam
+~~~~~~~~~~~~~~~~~~
+
+Here after is an example of namelist for *create_bathy.exe*.<br/>
+In this example, you create a bathymetry file named *bathy_fine.nc*.<br/>
+This new bathymetry file is refined from an extraction of *bathy_meter_ORCA025.nc*.<br/>
+Moreover a minimum value of 5m is imposed to the output Bathymetry.
+~~~~~~~~~~~~~~~~~~
+&namlog
+/
+
+&namcfg
+   cn_varcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg"
+   cn_dimcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/dimension.cfg"
+/
+
+&namsrc
+   cn_coord0 = "PATH/coordinates_ORCA025.nc"
+   in_perio0 = 4
+/
+
+&namtgt
+   cn_coord1 = "PATH/coord_fine.nc"
+/
+
+&namvar
+   cn_varfile = "Bathymetry:PATH/bathy_meter_ORCA025.nc"
+   cn_varinfo = "Bathymetry: min=5"
+/
+
+&namnst
+   in_rhoi = 2
+   in_rhoj = 3
+/
+
+&namout
+   cn_fileout = "PATH/bathy_fine.nc"      
+/
+~~~~~~~~~~~~~~~~~~
+
+Let's get describe this namelist.<br/>
+
+## namlog, namcfg
+First as previously, we have the **namlog** and **namcfg** sub-namelist (see above for more
+explanation).<br/>
+
+## namsrc
+Then the **namsrc** sub-namelist set parameters of the source/wide
+coordinates file.<br/>
+@note in all SIREN namelist: <br/>
+**0** referred to the coarse/wide grid.<br/>
+**1** referred to the fine grid.
+
+## namtgt
+In the same way, the **namtgt** sub-namelist  set parameters of the target/fine
+coordinates file.<br/>
+@note in this namelist example, there is no need to set the variable *in_perio1* to define the NEMO
+periodicity of the fine grid. Indeed, if this variable is not inform, SIREN tries to read it 
+in the global attributes of the file. So if you created the fine coordinates with SIREN, you do not have to
+fill it. In other case, you should add it to the namelist.
+
+## namvar
+The **namvar** sub-namelist lists variables to be used:
+<dl>
+   <dt>cn_varfile</dt>
+      <dd> defines the variable name ("Bathymetry" here) and the input file associated with.
+            @warning The domain of the input Bathymetry have to be larger than the output domain.
+         @note 
+         <ul>
+            <li>if the input file is at coarse grid resolution (same than *cn_coord0*), the ouptut Bathymetry will be refined on fine grid.</li>
+            <li>if the input file is a wider bathymetry (already at fine grid resolution), the output Bathymetry will be extracted from this one.</li>
+         </ul>
+      </dd>
+   <dt>cn_varinfo</dt>
+      <dd> defines user's requests for a variable.
+         @note Default interpolation method for the Bathymetry, is *cubic* interpolation.<br/>
+         So you may want to specify a minimum value to avoid negative value, or to change interpolation method.<br/>
+         example: <ul><li>cn_varinfo="Bathymetry: min=1"'</li>
+                      <li>cn_varinfo="Bathymetry: int=linear"</li></ul>
+      </dd>
+</dl>
+
+## namnst
+The **namnst** sub-namelist defines the subdomain refinment factor.<br/>
+Of course those refinment factors have to be convenient with refinment
+from coarse grid *cn_coord0* to fine grid *cn_coord1*.
+@note subdomain indices are automatically deduced from fine and coarse grid
+coordinates.
+
+## namout
+Finally, this **namout** sub-namelist defines the output file.<br/>
+
+@note All the output files create by SIREN include information about 
+source file, indices, refinment and interpolation method used.
+
+@sa For more information and options to create bathymetry, see
+create_bathy.f90
+
+<!-- ######################################################################  -->
+# Merge bathymetry file # {#merge}
+
+The Bathymetry you build, may differ from the wider one.<br/>
+To avoid issue with boundaries forcing fields, you should merge fine and coarse Bathymetry on boundaries.<br/>
+SIREN allows you to do this.<br/>
+
+To create this merged bathymetry, you have to run :
+~~~~~~~~~~~~~~~~~~
+./SIREN/merge_bathy.exe merge_bathy.nam
+~~~~~~~~~~~~~~~~~~
+
+Here after is an example of namelist for *merge_bathy.exe*.<br/>
+~~~~~~~~~~~~~~~~~~
+&namlog
+/
+
+&namcfg
+   cn_varcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg"
+   cn_dimcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/dimension.cfg"
+/
+
+&namsrc
+   cn_bathy0 = "PATH/bathy_meter_ORCA025.nc"
+   in_perio0 = 4
+/
+
+&namtgt
+   cn_bathy1 = "PATH/bathy_fine.nc"
+/
+
+&namnst
+   in_rhoi = 3
+   in_rhoj = 3
+/
+
+&nambdy
+/
+
+&namout
+   cn_fileout = "PATH/bathy_merged.nc"      
+/
+~~~~~~~~~~~~~~~~~~
+
+## namlog, namcfg
+In this namelist, you find again the **namlog**, **namcfg** describe above.
+
+## namsrc
+Then the **namsrc** sub-namelist sets parameters of the source/wide grid.
+However this time, this is the source/wide grid Bathymetry wich have to be informed.
+
+## namtgt
+The **namtgt** sub-namelist defines parameters of the target/fine grid Bathymetry.
+@note here again you could add the *in_perio1* parameter if need be i.e. if your
+fine grid Bathymetry was not created by SIREN.
+
+## namnst
+The **namnst** sub-namelist defines the subdomain refinment factor.
+
+## nambdy
+The **nambdy** sub-namelist defines the subdomain boundaries.<br/>
+By default SIREN tries to create boundaries for each side. Boundary exist if there is at least one sea point on the second row of each side. So you could let this namelist empty.
+@sa For more information about boundaries, see @ref boundary
+
+## namout
+Finally, this **namout** sub-namelist defines the output file.<br/>
+
+@sa For more information and options to merge bathymetry, see
+merge_bathy.f90
+
+<!-- ######################################################################  -->
+# Create meshmask (ocean domain informations) # {#meshmask}
+
+
+Depending on the vertical grid you choose to use, NEMO may not see the bathymetry exactly as you defined it just before. To get the ocean domain informations as seen by NEMO, SIREN allows you to create the meshmask file(s) which contain(s) all those informations.<br/>
+Morevoer SIREN allows you to create the *domain_cfg* file which is the new input file for NEMO (release 3.7 and upper).<br/>
+
+To create the meshmask file(s), you have to run :
+~~~~~~~~~~~~~~~~~~
+./SIREN/create_meshmask.exe create_meshmask.nam
+~~~~~~~~~~~~~~~~~~
+
+Here after is an example of namelist for *create_meshmask.exe*.<br/>
+In this example, you create one meshmask file named *mesh_mask.nc*.<br/>
+It uses coordinates file *coord_fine.nc* to define horizontal grid.
+and defines z-coordinate with partial steps.
+The minimum depth of the final Bathymetry is 10m. 
+~~~~~~~~~~~
+&namlog
+/
+
+&namcfg
+   cn_varcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg"
+   cn_dimcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/dimension.cfg"
+/
+
+&namsrc
+   cn_bathy = "PATH/bathy_merged.nc"
+   cn_coord = "PATH/coord_fine.nc"
+   in_perio = 4
+/
+
+&namhgr
+   in_mshhgr = 0
+/
+
+&namzgr
+   ln_zps   = .TRUE.
+   in_nlevel= 75
+/
+
+&namdmin
+   dn_hmin=10.
+/
+
+&namzco
+   dn_ppsur   = -3958.951371276829
+   dn_ppa0    =   103.953009600000
+   dn_ppa1    =     2.415951269000
+   dn_ppkth   =    15.351013700000
+   dn_ppacr   =     7.000000000000
+   dn_ppdzmin = 6.
+   dn_pphmax  = 5750.
+   ln_dbletanh= .TRUE.
+   dn_ppa2    =   100.760928500000
+   dn_ppkth2  =    48.029893720000
+   dn_ppacr2  =    13.000000000000
+/
+
+&namzps
+   dn_e3zps_min = 25.
+   dn_e3zps_rat = 0.2
+/
+
+&namsco
+/
+
+&namlbc
+/
+
+&namwd
+/
+
+&namgrd
+/
+
+&namout
+   in_msh = 1
+/
+~~~~~~~~~~~
+
+Let's get describe this namelist more accurately.<br/>
+
+## namlog, namcfg
+As previously, we have the **namlog** and **namcfg** describe above.<br/>
+
+## namsrc
+The **namsrc** sub-namelist defines the Bathymetry to be used.
+Mainly SIREN need Bathymetry to create meshmask.
+Here we also read coordinates directly on a file. 
+@note 
+ 1. here again you could add the *in_perio* parameter if need be i.e. if your
+Bathymetry was not created by SIREN.
+ 2. by default SIREN suppress closed sea/lake from the ORCA domain.
+
+## namhgr
+The **namhgr** sub-namelist defines the horizontal grid.
+the type of horizontal mesh is choose between :<ul>
+<li> in_mshhgr=0 : curvilinear coordinate on the sphere read in coordinate.nc</li>
+<li> in_mshhgr=1 : geographical mesh on the sphere with regular grid-spacing</li>
+<li> in_mshhgr=2 : f-plane with regular grid-spacing</li>
+<li> in_mshhgr=3 : beta-plane with regular grid-spacing</li>
+<li> in_mshhgr=4 : Mercator grid with T/U point at the equator</li>
+<li> in_mshhgr=5 : beta-plane with regular grid-spacing and rotated domain (GYRE configuration)</li>
+</ul>
+
+## namzgr
+The **namzgr** sub-namelist allows to choose the type of vertical grid (z-coordinate full steps, partial steps, sigma or hybrid coordinates) and the number of level.
+
+## namdmin
+The **namdmin** sub-namelist defines the minimum ocean depth. It could be defines in meter (>0) or in number of level (<0).
+
+## namzco
+The **namzco** sub-namelist defines parameters to compute z-coordinate vertical grid (**needed for all type of vertical grid**)
+<!-- By default, those parameters are defined the same way than in GLORYS (i.e. 75 vertical levels).<br/> -->
+
+## namzps
+The **namzps** sub-namelist defines extra parameters needed to define z-coordinates partial steps.
+
+## namsco
+The **namsco** sub-namelist defines extra parameters needed to define sigma or hybrid coordinates (not needed here).
+
+<!--The **namcla** sub-namelist defines cross land advection for exchanges through some straits only used for ORCA2 (see namgrd).-->
+
+## namlbc
+The **namlbc** sub-namelist defines lateral boundary conditions at the coast. It is needed to modify the fmask.
+
+## namwd
+The **namwd** sub-namelist defines the wetting and drying parameters if activated (see namzgr sub-namelist)
+
+## namgrd
+The **namgrd** sub-namelist allows to use configuration 1D or to choose vertical scale factors (e3.=dk or old definition).
+
+## namout
+Finally, this **namout** sub-namelist defines the number output file(s).<br/>
+@note To create the domain_cfg file, you should put **in_msh=0**.
+
+@sa For more information about how to create meshmask, see create_meshmask.f90
+
+<!-- ######################################################################  -->
+# Create layout (domain layout) # {#layout}
+
+To run faster your configuration you may need to run it on multiprocessor. To do so you first need to know on which domain layout and so on how many processor you could do it.
+.<br/>
+
+To create/compute the domain layout, you have to run :
+~~~~~~~~~~~~~~~~~~
+./SIREN/create_layout.exe create_layout.nam
+~~~~~~~~~~~~~~~~~~
+
+Here after is an example of namelist for *create_layout.exe*.<br/>
+In this example, you compute the domain layout on 40 processors.<br/>
+~~~~~~~~~~~
+&namlog
+/
+
+&namcfg
+   cn_varcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg"
+   cn_dimcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/dimension.cfg"
+/
+
+&namvar
+   cn_varfile = "Bathymetry:PATH/bathy_merged.nc"
+/
+
+&namout
+   in_nproc = 40
+/
+~~~~~~~~~~~
+
+Let's get describe this namelist more accurately.<br/>
+
+## namlog, namcfg
+As previously, we have the **namlog** and **namcfg** describe above.<br/>
+
+## namvar
+The **namvar** sub-namelist lists variables to be used.
+Mainly SIREN need Bathymetry to compute the domain layout, or at least the mask of your domain.
+
+## namout
+The **namout** sub-namelist defines the number of processor you want to work on.
+
+@sa For more information and options to create layout, see create_layout.f90
+
+<!-- ######################################################################  -->
+# Create initial state # {#restart}
+
+To run your configuration you need an inital state of the ocean.<br/>
+You could start from a restart file (with all NEMO variables fields at one
+time step). Or you could start from "partial" information about ocean state (Temperature and Salinity for example).
+
+SIREN allows you to create both of those initial state.<br/>
+To create the initial state, you have to run:<br/>
+~~~~~~~~~~~~~~~~~~
+./SIREN/create_restart.exe create_restart.nam
+~~~~~~~~~~~~~~~~~~
+
+Here after is an example of namelist for *create_restart.exe*.<br/>
+In this example, you create an initial state split on 81 "processors", and named restart_out.nc.<br/>
+The initial state is composed of temperature and salinity refined from an extraction of GLORYS fields.
+~~~~~~~~~~~~~~~~~~
+&namlog
+/
+
+&namcfg
+   cn_varcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg"
+   cn_dimcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/dimension.cfg"
+/
+
+&namsrc
+   cn_coord0 = "PATH/coordinates_ORCA025.nc"
+   in_perio0 = 4
+/
+
+&namtgt
+   cn_coord1 = "PATH/coord_fine.nc"
+   cn_bathy1 = "PATH/bathy_merged.nc"
+/
+
+&namzgr
+/
+
+&namzps
+/
+
+&namvar
+   cn_varfile = "votemper:GLORYS_gridT.nc",
+                "vosaline:GLORYS_gridS.nc"
+/
+
+&namnst
+   in_rhoi = 3
+   in_rhoj = 3
+/
+
+&namout
+   cn_fileout = "PATH/restart_out.nc"      
+   in_nproc = 81
+/
+~~~~~~~~~~~~~~~~~~
+Let's get describe this namelist more accurately.<br/>
+
+## namlog, namcfg
+As previously, we have the **namlog** and **namcfg** sub-namelists, as well as 
+
+## namsrc
+the **namsrc** sub-namelist to set parameters of the source/wide coordinates file (see above for more
+explanation).<br/>
+
+## namtgt
+Then the **namtgt** sub-namelist set parameters of the target/fine
+grid coordinates and bathymetry.<br/>
+
+## namzgr, namzps
+The **namzgr** and **namzps** sub-namelists define respectively parameters for vertical grid
+and partial step.<br>
+By default, those parameters are defined the same way than in GLORYS (i.e. 75 vertical levels).<br/>
+So you could let it empty.
+@note If you use forcing fields other than GLORYS, you have to be sure it uses the same vertical grid. In other case, you need to get information about the parametrisation use, and to put it in those sub-namelist (see create_restart.f90).
+
+## namvar
+the **namvar** sub-namelist lists variables to be used.<br/>
+Here we use *votemper* (temperature) get from *GLORYS_gridT.nc* file, and *vosaline*
+(salinity) get from *GLORYS_gridS.nc* file.
+@note To get all variables of a restart file. You have to use:
+~~~~~~~~~~~~~~~~~~
+cn_varfile = "all:PATH/restart.dimg"
+~~~~~~~~~~~~~~~~~~
+
+## namnst
+The **namnst** sub-namelist defines the subdomain refinment factor, as seen previously.<br/>
+
+## namout
+Finally, this **namout** sub-namelist defines the output files.<br/>
+Here we ask for output on 81 processors, with *restart_out.nc* as file "basename".<br/>
+So SIREN computes the optimal layout for 81 processors
+available,<br/>
+and split restart on output files named *restart_out_num.nc*, where *num* is the proc number.
+
+@note SIREN could also create the other fields you may need for
+your configuration.<br/>
+To do so, you just have to run *create_restart.exe* with other variable(s) from other input file(s).<br/>
+For example, to get runoff fields, you could use:
+~~~~~~~~~~~~~~~~~~
+cn_varfile = "sorunoff:PATH/runoff_GLORYS.nc"
+...
+cn_fileout = "PATH/runoff_out.nc"
+~~~~~~~~~~~~~~~~~~
+
+@sa For more information and options to create initial state or other fields, see
+create_restart.f90
+
+<!-- ######################################################################  -->
+# Create boundaries conditions # {#boundary}
+
+Finally to force your configuration, you may need boundaries conditions.<br/>
+NEMO read physical boundaries conditions from temperature, salinity, currents, and sea
+surface height.
+
+To create the boundaries condition with SIREN, you have to run:<br/>
+~~~~~~~~~~~~~~~~~~
+./SIREN/create_boundary.exe create_boundary.nam
+~~~~~~~~~~~~~~~~~~
+
+Here after is an example of namelist for *create_boundary.exe*.<br/>
+In this example, you create boundaries conditions named *boundary_out.nc* on
+each side of the domain.<br/>
+The boundaries contain information about temperature, salinity, currents and sea surface height refined from an extraction of GLORYS fields.
+~~~~~~~~~~~~~~~~~~
+&namlog
+/
+
+&namcfg
+   cn_varcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/variable.cfg"
+   cn_dimcfg = "PATH/NEMOGCM/TOOLS/SIREN/cfg/dimension.cfg"
+/
+
+&namsrc
+   cn_coord0 = "PATH/coordinates_ORCA025.nc"
+   in_perio0 = 4
+/
+
+&namtgt
+   cn_coord1 = "PATH/coord_fine.nc"
+   cn_bathy1 = "PATH/bathy_fine.nc"
+/
+
+&namzgr
+/
+
+&namzps
+/
+
+&namvar
+   cn_varfile="votemper:GLORYS_gridT.nc",
+              "vosaline:GLORYS_gridS.nc",
+              "vozocrtx:GLORYS_gridU.nc",
+              "vomecrty:GLORYS_gridV.nc",
+              "sossheig:GLORYS_grid2D.nc"
+/
+
+&namnst
+   in_rhoi = 3
+   in_rhoj = 3
+/
+
+&nambdy
+/
+
+&namout
+   cn_fileout = "PATH/boundary_out.nc"      
+/
+~~~~~~~~~~~~~~~~~~
+
+Let's get describe this namelist more accurately.<br/>
+
+## namlog, namcfg
+As previously, we have the **namlog** and **namcfg** sub-namelists, as well as 
+
+## namsrc
+the **namcrs** sub-namelist to set parameters of the source/wide coordinates file (see above for more
+explanation).<br/>
+
+## namtgt
+Then the **namtgt** sub-namelist set parameters of the target/fine
+grid coordinates and bathymetry.<br/>
+
+## namzgr, namzps
+The **namzgr** and **namzps** sub-namelists define respectively parameters for vertical grid
+and partial step.<br>
+By default, those parameters are defined the same way than in GLORYS (i.e. 75 vertical levels).<br/>
+So you could let it empty.
+@note If you use forcing fields other than GLORYS, you have to be sure it uses the same vertical grid. In other case, you need to get information about the parametrisation use, and to put it in those sub-namelist (see create_boundary.F90).
+
+## namvar
+the **namvar** sub-namelist lists variables to be used.<br/>
+Here we get *votemper* (temperature) from *GLORYS_gridT.nc* file, *vosaline*
+(salinity) from *GLORYS_gridS.nc* file, *vozocrtx* (zonal velocity) from
+*GLORYS_gridU.nc*, *vomecrty* (meridional velocity) from *GLORYS_gridV.nc*, and sossheig (sea surface
+height) from *GLORYS_grid2D.nc*.
+
+## namnst
+The **namnst** sub-namelist defines the subdomain refinment factor.<br/>
+
+## nambdy
+The **nambdy** sub-namelist defines the subdomain boundaries.<br/>
+By default SIREN tries to create boundaries for each side (Boundary is created if sea point exist on the second row of each side).<br/>
+So you could let this namelist empty.
+
+@note SIREN allows you to place boundaries away from the side of the domain.
+To do so you have to define your boundary.<br/>
+That means you have to give on fine
+grid the index of the boundary (how far from the border your boundary is),
+the width of your boundary, and finally first and last point of your boundary (the length of your boundary).<br/>
+So to define a north boundary, you have to add in the sub-namelist *nambdy*, the parameter:
+~~~~~~~~~~~~~~~~~~
+cn_north="index,first:last(width)"
+~~~~~~~~~~~~~~~~~~
+
+## namout
+Finally, this **namout** sub-namelist defines the output files.<br/>
+Here we ask for output with *boundary_out.nc* as file "basename".<br/>
+So SIREN creates output files named *boundary_out_west.nc*,
+*boundary_out_east.nc*, *boundary_out_north.nc*, and *boundary_out_south.nc*
+depending if boundary exist or not.
+
+@sa For more information and options to create boundaries condition, see
+create_boundary.F90
+
+# Create and run NEMO configuration # {#NEMOconf}
+
+So now you created all the input files you need for your physical configuration, you have to create the "NEMO configuration".<br/>
+To do so, go to the directory *NEMOGCM/CONFIG/*, and run:
+~~~~~~~~~~~~~~~~~~
+./makenemo -n MY_CONFIG -d "OPA_SRC"
+~~~~~~~~~~~~~~~~~~
+This creates your configuration "MY_CONFIG" in the directory *NEMOGCM/CONFIG*.<br/>
+you could check the cpp_keys used in file *cpp_MY_CONFIG.fcm*, and re-run *makenemo*
+if need be.
+
+Once *makenemo* has run successfully, the *opa* executable is available in
+directory *NEMOGCM/CONFIG/MY_CONFIG/EXP00*.<br/>
+Then you just have to put all your input files in this directory, fill the namelist *namelist_cfg*, and run:
+~~~~~~~~~~~~~~~~~~
+mpirun ./opa
+~~~~~~~~~~~~~~~~~~
+
+@note no surface forcing here.
+weighted function needed to do interpolation on the fly, could be created by WEIGHT tools already inside NEMO.
+
+@sa For more information about how to create NEMO configuration see [NEMO Quick Start Guide](http://www.nemo-ocean.eu/Using-NEMO/User-Guides/Basics/NEMO-Quick-Start-Guide).
+
+ <HR>
+   <b>
+   - @ref index
+   - @ref md_src_docsrc_1_install
+   - @ref md_src_docsrc_2_quickstart
+   - @ref md_src_docsrc_3_support_bug
+   - @ref md_src_docsrc_4_codingRules
+   - @ref md_src_docsrc_5_changeLog
+   - @ref todo
+   </b>
Index: /utils/tools_ticket2413/SIREN/src/docsrc/3_support_bug.md
===================================================================
--- /utils/tools_ticket2413/SIREN/src/docsrc/3_support_bug.md	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/docsrc/3_support_bug.md	(revision 12863)
@@ -0,0 +1,28 @@
+# Support
+
+# How to get support
+  If you have questions regarding the use of SIREN, please have a look at the [NEMO configuration manager forum](https://forge.ipsl.jussieu.fr/nemo/discussion/forum/2).<br/>
+  If you don't find an answer in the archives, feel free to register and post your question.
+
+# How to Help
+   The development of SIREN highly depends on your input!<br/>
+   If you are trying SIREN let me know what you think of it (do you miss certain features?). Even if you decide not to use it, please let me know why.
+
+# How to report a bug
+   If you believe you have found a new bug, please report it.<br/>
+   Before submitting a new bug, first search through the database if the same bug has already been submitted by others
+
+   If you send only a (vague) description of a bug, you are usually not very
+   helpful and it will cost much more time to figure out what you mean. In
+   the worst-case your bug report may even be completely ignored.
+
+ <HR>
+   <b>
+   - @ref index
+   - @ref md_src_docsrc_1_install
+   - @ref md_src_docsrc_2_quickstart
+   - @ref md_src_docsrc_3_support_bug
+   - @ref md_src_docsrc_4_codingRules
+   - @ref md_src_docsrc_5_changeLog
+   - @ref todo
+   </b>
Index: /utils/tools_ticket2413/SIREN/src/docsrc/4_codingRules.md
===================================================================
--- /utils/tools_ticket2413/SIREN/src/docsrc/4_codingRules.md	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/docsrc/4_codingRules.md	(revision 12863)
@@ -0,0 +1,101 @@
+# Coding Rules
+
+The conventions used in SIREN coding are based on the NEMO coding rules
+(see [NEMO coding
+conventions](http://www.nemo-ocean.eu/content/download/15483/73221/file/NEMO_coding.conv_v3.pdf)).<br/>
+However some modifications were added to improve readibility of the code.<br/>
+Some of the NEMO coding rules are reminded here, and extensions are described.
+
+@tableofcontents
+
+# Fortran Standard {#std}
+
+SIREN software adhere to strict __FORTRAN 95__ standard.<br/>
+There is only one exception. The use of functions _COMMAND_ARGUMENT_COUNT_ and
+_GET_COMMAND_ARGUMENT_.<br/>
+There exist no equivalent for those Fortran 03 intrinsec functions in Fortran
+95.<br/> At least none convenient for compilers tested (see @ref md_src_docsrc_1_install). 
+
+#  Free Form Source {#free}
+Free Form Source will be used, however a self imposed limit of 80 should
+enhance readibility.
+
+#  Indentation {#indent}
+Code as well as comments lines will be indented 3 characters for readibility.<br/>
+__Indentation should be write without hard tabs__.
+
+Example for vi  :
+~~~~~~~~~~~~~~~~~~~~~
+:set expandtab tabstop=3 shiftwidth=3
+~~~~~~~~~~~~~~~~~~~~~
+
+#  Naming conventions : variable {#namvar}
+All variables should be named as explicitly as possible.<br/>
+The naming conventions concerns prefix letters of these name, in order to
+identify the variable type and status.<br/> It must be composed of two
+letters defining type and status follow by an underscore.<br/>
+table below list the starting letters to be used for variable naming,
+depending on their type and status.
+
+ | Type / Status     | byte (integer(1)) <br/> __b__ | short (integer(2)) <br/> __s__ | integer(4) <br/> __i__  | integer(8) <br/> __k__ | real(4) <br/> __r__ | real(8) <br/> __d__ | logical <br/> __l__ | character <br/> __c__ | complex <br/> __y__ | structure <br/> __t__  |
+ | :----:            | :----: | :----: | :----: | :----: | :----: | :----: | :----: | :----: | :----: | :----: |
+ |global <br/> __g__           | bg_  | sg_  | ig_  | kg_  | rg_  | dg_  | lg_  | cg_  | yg_  | tg_  |
+ |global parameter <br/> __p__ | bp_  | sp_  | ip_  | kp_  | rp_  | dp_  | lp_  | cp_  | yp_  | tp_  |
+ |module <br/> __m__           | bm_  | sm_  | im_  | km_  | rm_  | dm_  | lm_  | cm_  | ym_  | tm_  |
+ |namelist <br/> __n__         | bn_  | sn_  | in_  | kn_  | rn_  | dn_  | ln_  | cn_  | yn_  | tn_  |
+ |dummy argument <br/> __d__   | bd_  | sd_  | id_  | kd_  | rd_  | dd_  | ld_  | cd_  | yd_  | td_  |
+ |local <br/> __l__            | bl_  | sl_  | il_  | kl_  | rl_  | dl_  | ll_  | cl_  | yl_  | tl_  |
+ |function result <br/> __f__  | bf_  | sf_  | if_  | kf_  | rf_  | df_  | lf_  | cf_  | yf_  | tf_  |
+ |loop control                 |      |      | j?   |      |      |      |      |      |      |      |
+
+# Naming conventions : structure {#namstr}
+The structure name should be written in capital letter, and start with
+__T__<br/> Example: TTRACER <br/>
+Variables inside the structure should be named as explicitly as possible.<br/>
+For those variables, the prefix naming conventions only concern the type of variable.<br/>
+It must be composed of one letter defining type follows by an
+underscore.<br/>
+see table of variable conventions.<br/>
+
+Example: __tl\_type\%i\_year__<br/> _year_ is an integer(4) variable in a local strucure
+named _type_. <br/>
+
+# Naming conventions : function-subroutine {#namsub}
+Functions or Subroutines are defined in a module.<br/>
+Their name should start with the module name then with their "functional" name. So it will be
+easy to find it.<br/>
+Example:<br/> a function to realise addition written in a module
+__math__ should be called __math\_add__.<br/>
+
+__PUBLIC__  function or subroutine should used one undescrore: _math_add_<br/>
+__PRIVATE__ function or subroutine should used two undescrores: _math__add_<br/>
+
+# Precision {#precision}
+__All variables should make use of kinds__.<br/>
+Numerical constant need to have a suffix of __kindvalue__
+
+# Declaration for global variable and constants {#global}
+All global data must be accompanied with a comment field on the same
+line.<br/>
+_Note that using doxygen (see [header](#header)), we will use symbol !< instead of !: as separator_
+
+# Implicit none {#implicit}
+All subroutines and functions will include an IMPLICIT NONE statement.
+
+# Header {#header}
+
+SIREN use __doxigen auto documentation__ tool.<br/>
+Information could be find on
+[doxygen](http://www.stack.nl/~dimitri/doxygen/index.html) web page.<br/>
+Some basic tag are described
+[here](http://www.msg.chem.iastate.edu/gamess/DoxygenRules.oct10.pdf).
+
+ <HR>
+   <b>
+   - @ref index
+   - @ref md_src_docsrc_1_install
+   - @ref md_src_docsrc_2_quickstart
+   - @ref md_src_docsrc_3_support_bug
+   - @ref md_src_docsrc_5_changeLog
+   - @ref todo
+   </b>
Index: /utils/tools_ticket2413/SIREN/src/docsrc/5_changeLog.md
===================================================================
--- /utils/tools_ticket2413/SIREN/src/docsrc/5_changeLog.md	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/docsrc/5_changeLog.md	(revision 12863)
@@ -0,0 +1,339 @@
+# Change log
+
+@tableofcontents
+
+# Release 2019-12-03 {#rev_2019-12-03}
+## New features
+- M src/iom_cdf.f90 :
+	- write netcdf file as netcdf4
+
+# Release 2019-11-05 {#rev_2019-11-05}
+## New features
+- M src/function.f90
+- M src/create_bathy.f90 :
+	- add help and version optional arguments
+	- update header for usage
+- M src/create_boundary.F90 :
+	- add help and version optional arguments
+	- update header for usage
+- M src/create_coord.f90 :
+	- add help and version optional arguments
+	- update header for usage
+- M src/create_layout.f90 :
+	- add help and version optional arguments
+	- update header for usage
+- M src/create_meshmask.f90 :
+	- add help and version optional arguments
+	- update header for usage
+- M src/create_restart.f90 :
+	- add help and version optional arguments
+	- update header for usage
+- M src/merge_bathy.f90 :
+	- add help and version optional arguments
+	- update header for usage
+- M src/function.f90 :
+	- add help and version functions
+- M src/global.f90 :
+	- add parameter for version, author, and date
+	- set SVN keyword Revision, Author, and Date 
+
+# Release 2019-10-18 {#rev_2019-10-18}
+## New Features
+- A templates/README
+- A templates/create_templates.py :
+	- script to create template of namelist from Siren sources
+## Changes
+- M templates/addline.nam :
+	- update template of namelist (with default value)
+- M templates/create_bathy.nam :
+	- update template of namelist (with default value)
+- M templates/create_boundary.nam :
+	- update template of namelist (with default value)
+- M templates/create_coord.nam :
+	- update template of namelist (with default value)
+- M templates/create_restart.nam :
+	- update template of namelist (with default value)
+- M templates/merge_bathy.nam :
+	- update template of namelist (with default value)
+
+# Release 2019-08-12 {#rev_2019-08-12}
+## Changes
+- src/create_bathy.f90 :
+	- use periodicity read from namelist, and store in multi structure
+- src/create_boundary.F90 :
+	- use periodicity read from namelist, and store in multi structure
+- src/create_restart.f90 :
+	- use periodicity read from namelist, and store in multi structure
+- src/mpp.f90 :
+	- change print format
+- src/multi.f90 :
+	- use periodicity read from namelist, and store in multi structure
+- templates/addline.nam :
+	- rename sub namelist namcrs to namsrc
+- templates/create_bathy.nam :
+	- rename sub namelist namcrs to namsrc
+	- rename sub namelist namfin to namtgt
+- templates/create_boundary.nam :
+	- rename sub namelist namcrs to namsrc
+- rename sub namelist namfin to namtgt
+- templates/create_coord.nam :
+	- rename sub namelist namcrs to namsrc
+- templates/create_restart.nam :
+	- rename sub namelist namcrs to namsrc
+	- rename sub namelist namfin to namtgt
+## Bug fixes
+- src/create_layout.f90 :
+	- add missing variable in logger namelist
+- src/multi.f90 :
+	- rewrite function to subroutine
+	- output filename string contains only filename (no more periodicity if given)
+
+# Release 2019-05-21 {#rev_2019-05-21}
+## New Features
+- src/date.f90 :
+	- add date_time subroutine
+## Changes
+- src/create_restart.f90 :
+	- force number of proc to one by default
+	- create and clean file structure to avoid memory leaks
+- src/file.f90 :
+	- add option to check dimension axis but not length
+- src/grid.f90 :
+	- do not use latitude variable to get pivot
+	- read only grid boundaries to handle huge file
+	- define as module variable im_max_overlap
+- src/iom.f90 :
+	- permit to write header and variable independantly
+	- split iom_write_file into write_header and write_var
+- src/iom_cdf.f90 :
+	- permit to write header and variable independantly
+	- split iom_cdf_write_file into write_header and write_var
+	- add dimension structure as optional argument
+	- do not check variable dimension if dimension forced
+- src/iom_dom.f90 :
+	- copy variable struct without array of value, then read array of value
+- src/iom_mpp.f90 :
+	- handle use of domain decomposition for monoproc file
+- src/iom_rstdimg.f90 :
+	- handle use of domain decomposition for monoproc file
+	- split iom_rstdimg_write_file into write_header and write_var
+- src/merge_bathy.f90 :
+	- create and clean file structure to avoid memory leaks
+- src/mpp.f90 :
+	- cosmetic change
+	- use mpp decomposition for writing netcdf
+	- force to use domain decomposition to enhance read of monoproc file
+	- add mpp__add_proc_arr
+	- handle use of domain decomposition for monoproc file
+- src/variable.f90 :
+	- permit to copy variable structure without value
+## Bug fixes
+- src/math.f90 :
+	- use the correct loop index to look for element bigger than pivot point
+- src/multi.f90 :
+	- compare each elt of cl_tabfile to cl_file
+
+# Release 2019-05-15 {#rev_2019-05-15}
+## New Features
+- src/addline_deg.f9 :
+	- new program to add line to all variable of the input file
+- src/create_layout.f90 :
+	- new program to create/compute the domain layout
+- src/create_meshmask.f90 :
+	- new program to create meshmask or domain.cfg
+- src/grid_hgr.f90 :
+	- new module needed to create meshmask
+- src/grid_zgr.f90 :
+	- new module needed to create meshmask
+- src/lbc.f90 :
+	- new module needed to create meshmask
+- src/create_bathy.f90 :
+	- optionaly, add random value to a flat bathymetry
+- src/global.f90 :
+	- add svn keyword properties
+- src/math.f90 :
+	- add function math_ortho
+	- add function math_euclid
+- src/multi.f90 :
+	- add function multi__get_perio
+- src/variable.f90 :
+	- add function var_chg_name to rename variable
+	- add output name to variable structure
+## Changes
+- src/create_bathy.f90 :
+	- add url path to global attributes of output file(s)
+	- create and clean file structure to avoid memory leaks
+	- check dimension of matrix for 'handmade' bathymetry
+	- check name and standard name for longitude and latitude 
+	- rewrite header (doc)
+	- rename sub namelist namcrs to namsrc
+	- rename sub namelist namfin to namtgt
+	- change NEMO path
+- src/create_boundary.F90 :
+	- add url path to global attributes of output file(s)
+	- explain how to fill Lateral Boundary Condition in NEMO namelist
+	- create and clean file structure to avoid memory leaks
+	- rewrite header (doc)
+	- rename sub namelist namcrs to namsrc
+	- rename sub namelist namfin to namtgt
+	- change NEMO path
+- src/create_coord.f90 :
+	- add url path to global attributes of output file(s)
+	- create and clean file structure to avoid memory leaks
+	- rewrite header (doc)
+	- rename sub namelist namcrs to namsrc
+- src/create_restart.f90 :
+	- add url path to global attributes of output file(s)
+	- check name and standard name for longitude and latitude
+	- rewrite header (doc)
+	- rename sub namelist namcrs to namsrc
+	- rename sub namelist namfin to namtgt
+	- change NEMO path
+- src/global.f90 :
+	- define svn url
+- src/merge_bathy.f90 :
+	- add url path to global attributes of output file(s)
+	- rewrite header (doc)
+	- rename sub namelist namcrs to namsrc
+	- rename sub namelist namfin to namtgt
+	- change NEMO path
+- src/create_meshmask.f90 :
+	- change NEMO path
+- src/mpp.f90 :
+	- copy file periodicity to mpp structure
+	- clean file, variable, and attributes structures
+	- deallocate file structure whatever happens
+	- do not split variable on domain decomposition, if only one procesor
+	- nullify array in layout structure
+	- nullify file structure inside mpp structure
+- src/attribute.f90 :
+	- nullify array inside attribute structure
+- src/boundary.f90 :
+	- nullify segment structure inside boundary structure
+- src/date.f90 :
+	- check time units CF convention, raise error if not
+- src/dimension.f90 :
+	- do not reshape array already order
+- src/file.f90 :
+	- clean variable, attributes, and dimension structures
+	- nullify variable, attributes structures inside file structure
+	- netcdf4 files identify as netcdf file
+- src/function.f90 :
+	- permit sign as first character
+- src/grid.f90 :
+	- do not use silicalim, or silicamax to get pivot point 
+	- check name and standard name for latitude
+- src/iom_cdf.f90 :
+	- clean variable, attributes, and dimension structures
+	- read array in netcdf file, level by level, and time step by time step
+	- apply scale factor and offset, level by level, and time step by time step
+	- check attribute array is allocated, before use it
+- src/iom_rstdimg.f90 :
+	- clean dimension structure
+- src/multi.f90 :
+	- create and clean file structure to avoid memory leaks
+	- fill value read from array of variable structure
+	- nullify mpp structure in multi file structure
+	- deallocate mpp structure whatever happens
+	- print periodicity
+- src/phycst.f90 :
+	- half reduce epsilon value
+- src/variable.f90 :
+	- use scalar instead of array, as transitional variable
+	- nullify attributes structure inside variable strcuture
+	- decompose array conversion on each dimension
+	- decompose array copy on each dimension
+	- deallocate attribute strucure whatever happens
+	- clean attribute strucure
+	- nullify array inside variable structure
+	- write fill value on array, level by level
+- src/docsrc/main.dox :
+	- add create_meshmask to SIREN tools list
+	- add create_layout to SIREN tools list
+- src/docsrc/1_install.md :
+	- change NEMO path
+- src/docsrc/2_quickstart.md :
+	- change link to SIREN inputs
+	- add description of create_meshmask
+	- add description of create_layout 
+## Bug fixes
+- src/function.f90 :
+	- permit negative exposant
+- src/iom_cdf.f90 :
+	- use dimid to look for the index of the dimension, and not as dimension index
+- src/mpp.f90 :
+	- netcdf proc indices from zero to N-1
+- src/variable.f90 :
+	- check if tg_varextra is allocated before clean it
+	- add case for units in hours
+	- read number of element for each dummy array in configuration file
+- src/attributes.f90 :
+	- read and use number of element for each dummy array in configuration file
+- src/multi.f90 :
+	- specify format output
+- src/dimension.f90 :
+	- read number of element for each dimension allowed in configuration file
+	- read number of element for each dummy array in configuration file
+
+# Release 2016-11-16 {#rev_2016-11-16}
+## New Features
+- create_meshmask.f90 program to create meshmask from coordinates and bathymetry files.
+- create_meshmask.f90 allows to write domain_cfg file.
+- merge_bathy.f90:
+	- allow to choose the number of boundary point with coarse grid value.
+- dimension.f90:
+	- dimension allowed read in configuration file.
+- variable.f90:
+	- allow to add scalar value.
+- create_meshmask.f90:
+	- choose vertical scale factors (e3.=dk[depth] or old definition).
+## Changes
+- create_coord.f90:
+	- allow to define sub domain with coarse grid indices or coordinates.
+- grid.f90:
+	-grid__get_closest_str:
+	- add function to get closest grid point using coarse grid coordinates strucutre.
+- iom_cdf.f90:
+	-iom_cdf__get_info:
+	- define cdf4 as cdf.
+- variable.f90:
+	- add subroutine to clean global array of extra information, and define logical for variable to be used.
+- create_coord.f90:
+	- dimension to be used select from configuration file.
+- create_bathy.f90:
+	- dimension to be used select from configuration file.
+- merge_bathy.f90:
+	- dimension to be used select from configuration file.
+- create_boundary.f90:
+	- dimension to be used select from configuration file.
+- create_restart.f90:
+	- dimension to be used select from configuration file.
+## Bug fixes
+- boundary.f90:
+	-boundary_check:
+	- take into account that boundaries are compute on T point, but expressed on U,V point.
+- grid.f90:
+	-grid__get_closest_str:
+	- use max of zero and east-west overlap instead of east-west overlap.
+- mpp.f90:
+	- compare index to td_lay number of proc instead of td_mpp (bug fix) .
+- iom_cdf.f90 :
+	- check if attribute cl_value is not bug (in read file)
+
+# Release 2016-07-01 {#rev_2016-07-01}
+
+## Changes
+## New Features
+## Bug fixes
+- correct check of boundary indices
+
+# Initial Release 2016-04-11 {#rev_2016-04-11}
+	<HR>
+	<b>
+	- @ref index
+	- @ref md_src_docsrc_1_install
+	- @ref md_src_docsrc_2_quickstart
+	- @ref md_src_docsrc_3_support_bug
+	- @ref md_src_docsrc_4_codingRules
+	- @ref todo
+	</b>
Index: /utils/tools_ticket2413/SIREN/src/docsrc/6_perio.md
===================================================================
--- /utils/tools_ticket2413/SIREN/src/docsrc/6_perio.md	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/docsrc/6_perio.md	(revision 12863)
@@ -0,0 +1,41 @@
+# NEMO periodicity
+
+NEMO periodicity is defined as follow :<br/> 
+<dl>
+<dt>closed boundary (in_perio=0)</dt>
+<dd>ghost cells (solid walls) are imposed at all model boundaries.</dd> 
+@image html perio0_20.png 
+<center>@image latex perio0_20.png 
+</center>
+<dt>cyclic east-west boundary (in_perio=1)</dt>
+<dd>first and last rows are closed, whilst the first column is set to the value of the last-but-one column and the last column to the value of the second one.</dd>  
+@image html perio1_20.png 
+<center>@image latex perio1_20.png 
+</center>
+<dt>symmetric boundary condition across the equator. (in_perio=2)</dt>
+<dd>last row, and first and last columns are closed. </dd> 
+@image html perio2_20.png 
+<center>@image latex perio2_20.png 
+</center>
+<dt>North fold boundary with a T -point pivot (in_perio=3)</dt>
+<dd>first row, and first and last columns are closed. </dd> 
+@image html perio3_20.png 
+<center>@image latex perio3_20.png 
+</center>
+<dt>North fold boundary with a T -point pivot and cyclic east-west boundary (in_perio=4)</dt>
+<dd>first row is closed. The first column is set to the value of the last-but-one column and the last column to the value of the second one. </dd> 
+@image html perio4_20.png 
+<center>@image latex perio4_20.png 
+</center>
+<dt>North fold boundary with a F -point pivot (in_perio=5)</dt>
+<dd>first row, and first and last columns are closed. </dd> 
+@image html perio5_20.png 
+<center>@image latex perio5_20.png 
+</center>
+<dt>North fold boundary with a F -point pivot and cyclic east-west boundary (in_perio=6)</dt>
+<dd>first row is closed. The first column is set to the value of the last-but-one column and the last column to the value of the second one.</dd> 
+@image html perio6_20.png 
+<center>@image latex perio6_20.png 
+</center>
+</dl>
+@sa For more information about NEMO periodicity, see _Model Boundary Condition_ chapter in [NEMO documentation](http://www.nemo-ocean.eu/About-NEMO/Reference-manuals))
Index: /utils/tools_ticket2413/SIREN/src/docsrc/main.dox
===================================================================
--- /utils/tools_ticket2413/SIREN/src/docsrc/main.dox	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/docsrc/main.dox	(revision 12863)
@@ -0,0 +1,30 @@
+/*!
+ @mainpage About 
+
+ SIREN is a software to set up regional configuration with [NEMO](http://www.nemo-ocean.eu).<br/> 
+ Actually SIREN creates the input files you need to run a NEMO regional configuration.<br/>
+ 
+ SIREN allows you to create your own regional configuration embedded in a wider one.<br/>
+
+ To know how to install SIREN see @ref md_src_docsrc_1_install.
+
+ You could find a tutorial for a quick start with SIREN in @ref md_src_docsrc_2_quickstart.<br/>
+ For more information about how to use each component of SIREN
+ - see create_coord.f90 to create fine grid coordinate file
+ - see create_bathy.f90 to create fine grid bathymetry
+ - see merge_bathy.f90 to merge fine grid bathymetry
+ - see create_meshmask.f90 to create mesh mask or domain_cfg file.
+ - see create_layout.f90 to create/compute the domain layout of your configuration.
+ - see create_restart.f90 to create initial state file, or other fields.
+ - see create_boundary.F90 to create boundary condition
+
+<HR>
+   <b>
+   - @ref md_src_docsrc_1_install
+   - @ref md_src_docsrc_2_quickstart
+   - @ref md_src_docsrc_3_support_bug
+   - @ref md_src_docsrc_4_codingRules
+   - @ref md_src_docsrc_5_changeLog
+   - @ref todo
+   </b>
+*/
Index: /utils/tools_ticket2413/SIREN/src/domain.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/domain.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/domain.f90	(revision 12863)
@@ -0,0 +1,1823 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief
+!> This module manage domain computation.
+!>
+!> @details
+!>    define type TDOM:<br/>
+!> @code
+!>    TYPE(TDOM) :: tl_dom
+!> @endcode
+!>
+!>    to initialize domain structure:<br/>
+!> @code
+!>    tl_dom=dom_init(td_mpp, [id_imin,] [id_imax,] [id_jmin,] [id_jmax],[cd_card])
+!> @endcode
+!>       - td_mpp  is mpp structure of an opened file.
+!>       - id_imin is i-direction sub-domain lower left  point indice
+!>       - id_imax is i-direction sub-domain upper right point indice 
+!>       - id_jmin is j-direction sub-domain lower left  point indice
+!>       - id_jmax is j-direction sub-domain upper right point indice
+!>       - cd_card is the cardinal name (for boundary case) 
+!> 
+!>    to get global domain dimension:<br/>
+!>    - tl_dom\%t_dim0
+!>
+!>    to get NEMO periodicity index of global domain:<br/>
+!>    - tl_dom\%i_perio0
+!>
+!>    to get NEMO pivot point index F(0),T(1):<br/>
+!>    - tl_dom\%i_pivot
+!>
+!>    to get East-West overlap of global domain:<br/>
+!>    - tl_dom\%i_ew0
+!>
+!>    to get selected sub domain dimension:<br/>
+!>    - tl_dom\%t_dim
+!>
+!>    to get NEMO periodicity index of sub domain:<br/>
+!>    - tl_dom\%i_perio
+!>
+!>    to get East-West overlap of sub domain:<br/>
+!>    - tl_dom\%i_ew
+!>
+!>    to get i-direction sub-domain lower left  point indice:<br/>
+!>    - tl_dom\%i_imin
+!>
+!>    to get i-direction sub-domain upper right point indice:<br/>
+!>    - tl_dom\%i_imax
+!>
+!>    to get j-direction sub-domain lower left  point indice:<br/>
+!>    - tl_dom\%i_jmin
+!>
+!>    to get j-direction sub-domain upper right point indice:<br/>
+!>    - tl_dom\%i_jmax
+!>
+!>    to get size of i-direction extra band:<br/>
+!>    - tl_dom\%i_iextra
+!>
+!>    to get size of j-direction extra band:<br/>
+!>    - tl_dom\%i_jextra
+!>
+!>    to get i-direction ghost cell number:<br/>
+!>    - tl_dom\%i_ighost
+!>
+!>    to get j-direction ghost cell number:<br/>
+!>    - tl_dom\%i_jghost
+!>
+!>    to get boundary index:<br/>
+!>    - tl_dom\%i_bdy
+!>       - 0 = no boundary
+!>       - 1 = north
+!>       - 2 = south 
+!>       - 3 = east 
+!>       - 4 = west
+!>
+!>    to clean domain structure:<br/>
+!> @code
+!>    CALL dom_clean(td_dom)
+!> @endcode
+!>       - td_dom is domain structure
+!>
+!>    to print information about domain structure:<br/>
+!> @code
+!>    CALL dom_print(td_dom)
+!> @endcode
+!>
+!>    to get East-West overlap (if any):<br/>
+!> @code
+!>    il_ew=dom_get_ew_overlap(td_lon)
+!> @endcode
+!>       - td_lon : longitude variable structure
+!>
+!>    to add extra bands to coarse grid domain (for interpolation):<br/>
+!> @code
+!>    CALL dom_add_extra( td_dom, id_iext, id_jext ) 
+!> @endcode
+!>       - td_dom is domain structure
+!>       - id_iext is i-direction size of extra bands
+!>       - id_jext is j-direction size of extra bands
+!> 
+!>    to remove extra bands from fine grid (after interpolation):<br/>
+!> @code
+!>    CALL dom_del_extra( td_var, td_dom, id_rho )
+!> @endcode
+!>       - td_var is variable structure to be changed
+!>       - td_dom is domain structure
+!>       - id_rho is a array of refinement factor following i- and j-direction
+!>    
+!>    to reset coarse grid domain witouht extra bands:<br/>
+!> @code
+!>    CALL dom_clean_extra( td_dom )
+!> @endcode
+!>
+!> @author
+!> J.Paul
+!>
+!> @date November, 2013 - Initial Version
+!> @date September, 2014
+!> - add header
+!> - use zero indice to defined cyclic or global domain
+!> @date October, 2014
+!> - use mpp file structure instead of file
+!> 
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE dom
+
+   USE kind                            ! F90 kind parameter
+   USE global                          ! global parameter
+   USE fct                             ! basic useful function
+   USE logger                          ! log file manager
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+   USE mpp                             ! mpp file manager
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   PUBLIC :: TDOM     !< domain structure
+
+   PRIVATE :: im_minext !< default minumum number of extraband
+
+   ! function and subroutine
+   PUBLIC :: dom_copy            !< copy domain structure
+   PUBLIc :: dom_clean           !< clean domain structure
+   PUBLIC :: dom_init            !< initialise domain structure
+   PUBLIC :: dom_print           !< print information about domain
+   PUBLIC :: dom_add_extra       !< add useful extra bands to coarse grid for interpolation
+   PUBLIC :: dom_clean_extra     !< reset domain without extra bands
+   PUBLIC :: dom_del_extra       !< remove extra point from fine grid after interpolation
+    
+   PRIVATE :: dom__init_mpp                 ! initialise domain structure, given mpp file structure
+   PRIVATE :: dom__define                   ! define sub domain indices
+                                            ! define sub domain indices for input domain with
+   PRIVATE :: dom__define_cyclic_north_fold ! - cyclic east-west boundary and north fold boundary condition.
+   PRIVATE :: dom__define_north_fold        ! - north fold boundary condition.
+   PRIVATE :: dom__define_symmetric         ! - symmetric boundary condition across the equator.
+   PRIVATE :: dom__define_cyclic            ! - cyclic east-west boundary.
+   PRIVATE :: dom__define_closed            ! - cyclic east-west boundary.
+                                            ! compute size of sub domain
+   PRIVATE :: dom__size_no_pole             ! - without north fold condition
+   PRIVATE :: dom__size_no_pole_overlap     ! - without north fold condition, and which overlap east-west boundary
+   PRIVATE :: dom__size_no_pole_no_overlap  ! - without north fold condition, and which do not overlap east-west boundary
+   PRIVATE :: dom__size_pole                ! - with north fold condition
+   PRIVATE :: dom__size_pole_overlap        ! - with north fold condition, and which overlap east-west boundary
+   PRIVATE :: dom__size_pole_no_overlap     ! - with north fold condition, and which do not overlap east-west boundary
+                                            ! compute size of
+   PRIVATE :: dom__size_global              ! - global domain
+   PRIVATE :: dom__size_semi_global         ! - semi global domain 
+   PRIVATE :: dom__copy_unit                ! copy attribute structure
+
+   TYPE TDOM !< domain structure
+      TYPE(TDIM), DIMENSION(ip_maxdim)  :: t_dim0  !< global domain dimension
+      TYPE(TDIM), DIMENSION(ip_maxdim)  :: t_dim   !< sub domain dimension
+      INTEGER(i4) :: i_perio0                      !< NEMO periodicity index of global domain
+      INTEGER(i4) :: i_ew0                         !< East-West overlap of global domain
+      INTEGER(i4) :: i_perio                       !< NEMO periodicity index of sub domain
+      INTEGER(i4) :: i_pivot                       !< NEMO pivot point index F(0),T(1)
+      INTEGER(i4) :: i_imin = 0                    !< i-direction sub-domain lower left  point indice
+      INTEGER(i4) :: i_imax = 0                    !< i-direction sub-domain upper right point indice
+      INTEGER(i4) :: i_jmin = 0                    !< j-direction sub-domain lower left  point indice
+      INTEGER(i4) :: i_jmax = 0                    !< j-direction sub-domain upper right point indice
+
+      INTEGER(i4) :: i_bdy = 0                     !< boundary index : 0 = no boundary
+                                                   !<                  1 = north
+                                                   !<                  2 = south 
+                                                   !<                  3 = east 
+                                                   !<                  4 = west 
+      INTEGER(i4), DIMENSION(2,2) :: i_ghost0 = 0   !< array of ghost cell factor of global domain
+      INTEGER(i4), DIMENSION(2,2) :: i_ghost  = 0   !< array of ghost cell factor of sub domain
+
+      INTEGER(i4), DIMENSION(2) :: i_iextra = 0    !< i-direction extra point
+      INTEGER(i4), DIMENSION(2) :: i_jextra = 0    !< j-direction extra point
+
+   END TYPE TDOM
+
+   INTEGER(i4), PARAMETER :: im_minext  = 2  !< default minumum number of extraband
+
+   INTERFACE dom_init
+      MODULE PROCEDURE dom__init_file
+      MODULE PROCEDURE dom__init_mpp
+   END INTERFACE dom_init
+
+   INTERFACE dom_copy
+      MODULE PROCEDURE dom__copy_unit  ! copy attribute structure
+   END INTERFACE
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION dom__copy_unit(td_dom) &
+         & RESULT (tf_dom)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy an domain structure in another one
+   !> @details 
+   !> dummy function to get the same use for all structure
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> structure (ex: tl_dom=dom_copy(dom_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date November, 2014 - Initial Version
+   !>
+   !> @param[in] td_dom   domain structure
+   !> @return copy of input domain structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TDOM), INTENT(IN)  :: td_dom
+
+      ! function
+      TYPE(TDOM)              :: tf_dom
+
+      ! local variable
+      !----------------------------------------------------------------
+
+      tf_dom=td_dom
+      
+   END FUNCTION dom__copy_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dom_print(td_dom)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine print some information about domain strucutre.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_dom dom structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TDOM), INTENT(IN) :: td_dom
+
+      ! local argument
+      CHARACTER(LEN=lc) :: cl_pivot
+      !----------------------------------------------------------------
+      SELECT CASE(td_dom%i_pivot)
+         CASE(0)
+            cl_pivot='F-point'
+         CASE(1)
+            cl_pivot='T-point'
+         CASE DEFAULT
+            cl_pivot='unknown'
+      END SELECT
+
+      WRITE(*,'((a,4(i0,1x)),(/a,i2,a,a),2(/a,2(i0,1x)),(/a,4(i0,1x)),(/a,i2/),&
+      &          4(/a,i0),4(/a,2(i0,1x)))') &
+      &  " global domain size ",td_dom%t_dim0(:)%i_len, &
+      &  " domain periodicity ",td_dom%i_perio0,", pivot: ",TRIM(cl_pivot),   &
+      &  " i-direction ghost cell factor of global domain  ",td_dom%i_ghost0(jp_I,:), &
+      &  " j-direction ghost cell factor of global domain  ",td_dom%i_ghost0(jp_J,:), &
+      &  " sub-domain size : ",td_dom%t_dim(:)%i_len,                         &
+      &  " sub domain periodicity ",td_dom%i_perio,                           &
+      &  " i-direction sub-domain lower left  point indice ",td_dom%i_imin,   &
+      &  " i-direction sub-domain upper right point indice ",td_dom%i_imax,   &
+      &  " j-direction sub-domain lower left  point indice ",td_dom%i_jmin,   &
+      &  " j-direction sub-domain upper right point indice ",td_dom%i_jmax,   &
+      &  " i-direction ghost cell factor                   ",td_dom%i_ghost(jp_I,:), &
+      &  " j-direction ghost cell factor                   ",td_dom%i_ghost(jp_J,:), &
+      &  " i-direction extra point for interpolation       ",td_dom%i_iextra(:), &
+      &  " j-direction extra point for interpolation       ",td_dom%i_jextra(:)
+
+   END SUBROUTINE dom_print
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION dom__init_mpp(td_mpp, id_imin, id_imax, id_jmin, id_jmax, cd_card) &
+         & RESULT (tf_dom)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This function intialise domain structure, given open file structure,
+   !> and sub domain indices. 
+   !> @details
+   !> sub domain indices are computed, taking into account coarse grid
+   !> periodicity, pivot point, and East-West overlap.
+   !>
+   !> @author J.Paul
+   !> @date June, 2013 - Initial Version
+   !> @date September, 2014
+   !> - add boundary index
+   !> - add ghost cell factor
+   !> @date October, 2014
+   !> - work on mpp file structure instead of file structure
+   !>
+   !> @param[in] td_mpp    mpp structure
+   !> @param[in] id_perio  grid periodicity
+   !> @param[in] id_imin   i-direction sub-domain lower left  point indice
+   !> @param[in] id_imax   i-direction sub-domain upper right point indice
+   !> @param[in] id_jmin   j-direction sub-domain lower left  point indice
+   !> @param[in] id_jmax   j-direction sub-domain upper right point indice
+   !> @param[in] cd_card   name of cardinal (for boundary)
+   !> @return domain structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP)      , INTENT(IN) :: td_mpp 
+
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_imin
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_imax
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_jmin
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_jmax
+
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_card
+
+      ! function
+      TYPE(TDOM)                   :: tf_dom
+
+      !local variable
+      !----------------------------------------------------------------
+
+      ! clean domain structure
+      CALL dom_clean(tf_dom)
+
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( &
+         &  " DOM INIT: no processor file associated to mpp "//&
+         &  TRIM(td_mpp%c_name))
+
+      ELSE
+         ! global domain define by file
+
+         ! look for boundary index
+         IF( PRESENT(cd_card) )THEN
+            SELECT CASE(TRIM(cd_card))
+               CASE('north')
+                  tf_dom%i_bdy=jp_north
+               CASE('south')
+                  tf_dom%i_bdy=jp_south
+               CASE('east')
+                  tf_dom%i_bdy=jp_east
+               CASE('west')
+                  tf_dom%i_bdy=jp_west
+               CASE DEFAULT
+                  ! no boundary
+                  tf_dom%i_bdy=0
+            END SELECT
+         ELSE
+            ! no boundary
+            tf_dom%i_bdy=0
+         ENDIF
+
+         ! use global dimension define by mpp file
+         tf_dom%t_dim0(:) = dim_copy(td_mpp%t_dim(:))
+
+         IF( td_mpp%i_perio < 0 .OR. td_mpp%i_perio > 6 )THEN
+            CALL logger_error("DOM INIT: invalid grid periodicity ("//&
+            &  TRIM(fct_str(td_mpp%i_perio))//&
+            &  ") you should use grid_get_perio to compute it")
+         ELSE
+            tf_dom%i_perio0=td_mpp%i_perio
+         ENDIF
+
+         ! global domain pivot point
+         SELECT CASE(tf_dom%i_perio0)
+            CASE(3,4)
+               tf_dom%i_pivot = 0
+            CASE(5,6)
+               tf_dom%i_pivot = 1
+            CASE DEFAULT
+               tf_dom%i_pivot = 0
+         END SELECT
+
+         ! add ghost cell factor of global domain
+         tf_dom%i_ghost0(:,:)=0
+         SELECT CASE(tf_dom%i_perio0)
+            CASE(0)
+               tf_dom%i_ghost0(:,:)=1
+            CASE(1)
+               tf_dom%i_ghost0(jp_J,:)=1
+            CASE(2)
+               tf_dom%i_ghost0(jp_I,:)=1
+               tf_dom%i_ghost0(jp_J,2)=1
+            CASE(3,5)
+               tf_dom%i_ghost0(jp_I,:)=1
+               tf_dom%i_ghost0(jp_J,1)=1
+            CASE(4,6)
+               tf_dom%i_ghost0(jp_J,1)=1
+         END SELECT
+
+         ! look for EW overlap
+         tf_dom%i_ew0=td_mpp%i_ew
+
+         ! initialise domain as global
+         tf_dom%i_imin = 1 
+         tf_dom%i_imax = tf_dom%t_dim0(1)%i_len
+
+         tf_dom%i_jmin = 1 
+         tf_dom%i_jmax = tf_dom%t_dim0(2)%i_len
+
+         ! sub domain dimension
+         tf_dom%t_dim(:) = dim_copy(td_mpp%t_dim(:))
+
+         ! define sub domain indices 
+         CALL dom__define(tf_dom, id_imin, id_imax, id_jmin, id_jmax)
+
+      ENDIF
+
+   END FUNCTION dom__init_mpp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION dom__init_file(td_file, id_imin, id_imax, id_jmin, id_jmax, cd_card) &
+         & RESULT (tf_dom)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This function intialise domain structure, given open file structure,
+   !> and sub domain indices. 
+   !> @details
+   !> sub domain indices are computed, taking into account coarse grid
+   !> periodicity, pivot point, and East-West overlap.
+   !>
+   !> @author J.Paul
+   !> @date June, 2013 - Initial Version
+   !> @date September, 2014
+   !> - add boundary index
+   !> - add ghost cell factor
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] id_perio  grid periodicity
+   !> @param[in] id_imin   i-direction sub-domain lower left  point indice
+   !> @param[in] id_imax   i-direction sub-domain upper right point indice
+   !> @param[in] id_jmin   j-direction sub-domain lower left  point indice
+   !> @param[in] id_jmax   j-direction sub-domain upper right point indice
+   !> @param[in] cd_card   name of cardinal (for boundary)
+   !> @return domain structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TFILE)      , INTENT(IN) :: td_file 
+
+      INTEGER(i4)      , INTENT(IN), OPTIONAL :: id_imin
+      INTEGER(i4)      , INTENT(IN), OPTIONAL :: id_imax
+      INTEGER(i4)      , INTENT(IN), OPTIONAL :: id_jmin
+      INTEGER(i4)      , INTENT(IN), OPTIONAL :: id_jmax
+
+      CHARACTER(LEN=*) , INTENT(IN), OPTIONAL :: cd_card
+
+      ! function
+      TYPE(TDOM)                    :: tf_dom
+
+      !local variable
+      !----------------------------------------------------------------
+
+      ! clean domain structure
+      CALL dom_clean(tf_dom)
+
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " DOM INIT: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+         ! global domain define by file
+
+         ! look for boundary index
+         IF( PRESENT(cd_card) )THEN
+            SELECT CASE(TRIM(cd_card))
+               CASE('north')
+                  tf_dom%i_bdy=jp_north
+               CASE('south')
+                  tf_dom%i_bdy=jp_south
+               CASE('east')
+                  tf_dom%i_bdy=jp_east
+               CASE('west')
+                  tf_dom%i_bdy=jp_west
+               CASE DEFAULT
+                  ! no boundary
+                  tf_dom%i_bdy=0
+            END SELECT
+         ELSE
+            ! no boundary
+            tf_dom%i_bdy=0
+         ENDIF
+
+         ! use global dimension define by file
+         tf_dom%t_dim0(:) = dim_copy(td_file%t_dim(:))
+
+         IF( td_file%i_perio < 0 .OR. td_file%i_perio > 6 )THEN
+            CALL logger_error("DOM INIT: invalid grid periodicity ("//&
+            &  TRIM(fct_str(td_file%i_perio))//&
+            &  ") you should use grid_get_perio to compute it")
+         ELSE
+            tf_dom%i_perio0=td_file%i_perio
+         ENDIF
+
+         ! global domain pivot point
+         SELECT CASE(tf_dom%i_perio0)
+            CASE(3,4)
+               tf_dom%i_pivot = 0
+            CASE(5,6)
+               tf_dom%i_pivot = 1
+            CASE DEFAULT
+               tf_dom%i_pivot = 0
+         END SELECT
+
+         ! add ghost cell factor of global domain
+         tf_dom%i_ghost0(:,:)=0
+         SELECT CASE(tf_dom%i_perio0)
+            CASE(0)
+               tf_dom%i_ghost0(:,:)=1
+            CASE(1)
+               tf_dom%i_ghost0(jp_J,:)=1
+            CASE(2)
+               tf_dom%i_ghost0(jp_I,:)=1
+               tf_dom%i_ghost0(jp_J,2)=1
+            CASE(3,5)
+               tf_dom%i_ghost0(jp_I,:)=1
+               tf_dom%i_ghost0(jp_J,1)=1
+            CASE(4,6)
+               tf_dom%i_ghost0(jp_J,1)=1
+         END SELECT
+
+         ! look for EW overlap
+         tf_dom%i_ew0=td_file%i_ew
+
+         ! initialise domain as global
+         tf_dom%i_imin = 1 
+         tf_dom%i_imax = tf_dom%t_dim0(1)%i_len
+
+         tf_dom%i_jmin = 1 
+         tf_dom%i_jmax = tf_dom%t_dim0(2)%i_len
+
+         ! sub domain dimension
+         tf_dom%t_dim(:) = dim_copy(td_file%t_dim(:))
+
+         ! define sub domain indices 
+         CALL dom__define(tf_dom, id_imin, id_imax, id_jmin, id_jmax)
+
+      ENDIF
+
+   END FUNCTION dom__init_file
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dom__define(td_dom, &
+         &                id_imin, id_imax, id_jmin, id_jmax)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This subroutine define sub domain indices, and compute the size 
+   !> of the sub domain.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_dom domain structure
+   !> @param[in] id_imin   i-direction sub-domain lower left  point indice
+   !> @param[in] id_imax   i-direction sub-domain upper right point indice
+   !> @param[in] id_jmin   j-direction sub-domain lower left  point indice
+   !> @param[in] id_jmax   j-direction sub-domain upper right point indice
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TDOM),  INTENT(INOUT) :: td_dom
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_imin
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_imax
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_jmin
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_jmax
+      !----------------------------------------------------------------
+
+      IF( PRESENT(id_imin) ) td_dom%i_imin = id_imin
+      IF( PRESENT(id_imax) ) td_dom%i_imax = id_imax
+
+      IF( PRESENT(id_jmin) ) td_dom%i_jmin = id_jmin
+      IF( PRESENT(id_jmax) ) td_dom%i_jmax = id_jmax
+
+      ! check indices
+      IF(( td_dom%i_imin < -1 .OR. td_dom%i_imin > td_dom%t_dim0(1)%i_len ).OR. &
+      &  ( td_dom%i_imax < -1 .OR. td_dom%i_imax > td_dom%t_dim0(1)%i_len ).OR. &
+      &  ( td_dom%i_jmin < -1 .OR. td_dom%i_jmin > td_dom%t_dim0(2)%i_len ).OR. &
+      &  ( td_dom%i_jmax < -1 .OR. td_dom%i_jmax > td_dom%t_dim0(2)%i_len ))THEN
+         CALL logger_debug("0 <= imin ("//TRIM(fct_str(id_imin))//") < "//&
+         &              TRIM(fct_str(td_dom%t_dim0(1)%i_len)))
+         CALL logger_debug("0 <= imax ("//TRIM(fct_str(id_imax))//") < "//&
+         &              TRIM(fct_str(td_dom%t_dim0(1)%i_len)))
+         CALL logger_debug("0 <= jmin ("//TRIM(fct_str(id_jmin))//") < "//&
+         &              TRIM(fct_str(td_dom%t_dim0(2)%i_len)))
+         CALL logger_debug("0 <= jmax ("//TRIM(fct_str(id_jmax))//") < "//&
+         &              TRIM(fct_str(td_dom%t_dim0(2)%i_len)))
+         CALL logger_fatal( "DOM INIT DEFINE: invalid grid definition."// &
+         &               " check min and max indices")
+      ELSE
+
+         ! force to select north fold
+         IF( td_dom%i_perio0 > 2 .AND. &
+         &   ( td_dom%i_jmax >= td_dom%t_dim0(2)%i_len-1 .OR. &
+         &     td_dom%i_jmax < td_dom%i_jmin .OR. &
+         &     td_dom%i_jmin == 0 ) )THEN
+            td_dom%i_jmax=0
+         ENDIF
+
+         ! force to use cyclic boundary
+         IF( ( td_dom%i_perio0 == 1 .OR. &
+         &     td_dom%i_perio0 == 4 .OR. &
+         &     td_dom%i_perio0 == 6 ) .AND. &
+         &   ( td_dom%i_imin == 0 .OR. td_dom%i_imax == 0 .OR. &
+         &     ABS(td_dom%i_imax-td_dom%i_imin)+1 == td_dom%t_dim0(1)%i_len ) &
+         &  )THEN
+            td_dom%i_imin = 0
+            td_dom%i_imax = 0
+         ENDIF
+
+         SELECT CASE(td_dom%i_perio0)
+            CASE(0) ! closed boundary
+               CALL logger_trace("DOM INIT DEFINE: closed boundary")
+               CALL dom__define_closed( td_dom )
+            CASE(1) ! cyclic east-west boundary
+               CALL logger_trace("DOM INIT DEFINE: cyclic east-west boundary")
+               CALL dom__define_cyclic( td_dom )
+            CASE(2) ! symmetric boundary condition across the equator
+               CALL logger_trace("DOM INIT DEFINE: symmetric boundary condition "//&
+               &                 " across the equator")
+               CALL dom__define_symmetric( td_dom )
+            CASE(3) ! North fold boundary (with a F-point pivot)  
+               CALL logger_trace("DOM INIT DEFINE: North fold boundary "//&
+               &                 "(with a F-point pivot)")
+               CALL dom__define_north_fold( td_dom )
+            CASE(5) ! North fold boundary (with a T-point pivot)
+               CALL logger_trace("DOM INIT DEFINE: North fold boundary "//&
+               &                 "(with a T-point pivot)")
+               CALL dom__define_north_fold( td_dom )
+            CASE(4) ! North fold boundary (with a F-point pivot) 
+                    ! and cyclic east-west boundary
+               CALL logger_trace("DOM INIT DEFINE:  North fold boundary "//&
+               &                 "(with a F-point pivot) and cyclic "//&
+               &                 "east-west boundary")
+               CALL dom__define_cyclic_north_fold( td_dom )
+            CASE(6) ! North fold boundary (with a T-point pivot) 
+                    ! and cyclic east-west boundary
+               CALL logger_trace("DOM INIT DEFINE: North fold boundary "//&
+               &                 "(with a T-point pivot) and cyclic "//&
+               &                 "east-west boundary")
+               CALL dom__define_cyclic_north_fold( td_dom )
+            CASE DEFAULT
+               CALL logger_error("DOM INIT DEFINE: invalid grid periodicity index")
+         END SELECT
+
+      ENDIF
+
+   END SUBROUTINE dom__define
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dom__define_cyclic_north_fold(td_dom)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This subroutine define sub domain indices from global domain with
+   !> cyclic east-west boundary and north fold boundary condition.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !> @date September, 2014
+   !> - use zero indice to defined cyclic or global domain
+   !>
+   !> @param[inout] td_dom domain strcuture
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TDOM), INTENT(INOUT) :: td_dom
+      !----------------------------------------------------------------
+
+      !CALL dom__check_EW_index( td_dom )
+
+      IF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 .AND. &
+      &   td_dom%i_jmin == 0 .AND. td_dom%i_jmax == 0 )THEN
+
+         CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//&
+         &  "domain to extract is global" )
+         ! coarse domain is global domain
+
+         CALL dom__size_global( td_dom )
+
+      ELSEIF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 .AND. &
+      &       td_dom%i_jmax == 0 )THEN
+
+         CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//&
+         &  "domain to extract is semi-global" )
+
+         CALL dom__size_semi_global( td_dom )
+
+      ELSEIF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 .AND. &
+      &       td_dom%i_jmax /= 0 )THEN
+
+         CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//&
+         &  "domain to extract is band of latidue" )
+
+         CALL dom__size_no_pole( td_dom )
+
+      ELSEIF( td_dom%i_jmax == 0 )THEN
+
+         CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//&
+         &  "domain to extract use north fold" )
+
+         CALL dom__size_pole( td_dom )
+
+      ELSEIF( td_dom%i_jmax /= 0 )THEN
+
+         CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//&
+         &  "domain to extract do not use north fold" )
+         ! no North Pole
+         
+         CALL dom__size_no_pole( td_dom )
+
+      ELSE
+
+         CALL logger_error("DOM DEFINE CYCLIC NORTH FOLD: "//&
+         &  "should have been an impossible case" )
+
+      ENDIF
+      
+   END SUBROUTINE dom__define_cyclic_north_fold
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dom__define_north_fold(td_dom)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This subroutine define sub domain indices from global domain 
+   !> with north fold boundary condition.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial verison
+   !>
+   !> @param[inout] td_dom domain strcuture
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TDOM), INTENT(INOUT) :: td_dom
+      !----------------------------------------------------------------
+
+      IF( td_dom%i_jmax /= 0 )THEN
+
+         CALL logger_trace("DOM DEFINE NORTH FOLD: "//&
+         &  "domain to extract has no north boundary" )
+         ! no North Pole
+         
+         CALL dom__size_no_pole_no_overlap( td_dom )
+
+      ELSE
+
+         CALL logger_trace("DOM DEFINE NORTH FOLD: "//&
+         &  "sub domain has north boundary" )
+
+         CALL dom__size_pole_no_overlap( td_dom )
+
+      ENDIF      
+
+   END SUBROUTINE dom__define_north_fold
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dom__define_symmetric(td_dom)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This subroutine define sub domain indices from global domain 
+   !> with symmetric boundary condition across the equator.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_dom domain strcuture
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TDOM), INTENT(INOUT) :: td_dom
+      !----------------------------------------------------------------
+
+      CALL dom__size_no_pole_no_overlap( td_dom )
+
+   END SUBROUTINE dom__define_symmetric
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dom__define_cyclic(td_dom)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This subroutine define sub domain indices from global domain
+   !> with cyclic east-west boundary.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_dom domain strcuture
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TDOM), INTENT(INOUT) :: td_dom
+      !----------------------------------------------------------------
+      
+      IF( td_dom%i_imin >= td_dom%i_imax )THEN
+         CALL logger_trace("DOM DEFINE CYCLIC: "//&
+         &  "domain to extract overlap east-west boundary")
+
+         CALL dom__size_no_pole_overlap( td_dom )
+
+      ELSE
+         ! id_imin < id_imax
+         CALL logger_trace("DOM DEFINE CYCLIC: "//&
+         &  "domain to extract do not overlap east-west boundary")
+
+         CALL dom__size_no_pole_no_overlap( td_dom )
+
+      ENDIF
+
+   END SUBROUTINE dom__define_cyclic
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dom__define_closed(td_dom)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This subroutine define sub domain indices from global domain
+   !> with closed boundaries.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_dom domain strcuture
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TDOM), INTENT(INOUT) :: td_dom
+      !----------------------------------------------------------------
+
+      CALL dom__size_no_pole_no_overlap( td_dom )
+
+   END SUBROUTINE dom__define_closed
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dom__size_global(td_dom)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute size of global domain 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_dom domain strcuture
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TDOM), INTENT(INOUT) :: td_dom
+      !----------------------------------------------------------------
+
+      td_dom%i_imin = 1                     
+      td_dom%i_imax = td_dom%t_dim0(1)%i_len
+
+      td_dom%i_jmin = 1 
+      td_dom%i_jmax = td_dom%t_dim0(2)%i_len
+
+      ! domain size
+      td_dom%t_dim(1)%i_len = td_dom%t_dim0(1)%i_len
+      td_dom%t_dim(2)%i_len = td_dom%t_dim0(2)%i_len
+
+      ! no ghost cell to add
+      td_dom%i_ghost(:,:)=0
+
+      ! periodicity
+      IF( td_dom%i_pivot == 0 )THEN ! 0-F
+         td_dom%i_perio=4
+         td_dom%i_pivot=0
+      ELSE ! 1-T
+         td_dom%i_perio=6
+         td_dom%i_pivot=1
+      ENDIF
+
+   END SUBROUTINE dom__size_global
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dom__size_semi_global(td_dom)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute size of a semi global domain 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_dom domain strcuture
+   !> @note never tested
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TDOM), INTENT(INOUT) :: td_dom
+
+      ! local variable
+      INTEGER(i4) :: il_imid   ! canadian bipole index (middle of global domain) 
+      !----------------------------------------------------------------
+
+      il_imid = td_dom%t_dim0(1)%i_len/2 + td_dom%i_pivot
+
+      td_dom%i_imin = 2
+      td_dom%i_imax = il_imid !td_dom%t_dim0(1)%i_len
+
+      IF( td_dom%i_jmin == 0 ) td_dom%i_jmin=1
+      td_dom%i_jmax = td_dom%t_dim0(2)%i_len
+
+      ! domain size
+      td_dom%t_dim(1)%i_len = td_dom%i_imax - &
+      &                       td_dom%i_imin + 1
+
+      td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - &
+      &                         td_dom%i_jmin + 1 ) +      &
+      &                         ( td_dom%t_dim0(2)%i_len - &
+      &                           td_dom%i_jmin + 1 ) - 2    ! remove north fold condition ?
+
+      ! ghost cell to add
+      td_dom%i_ghost(:,:)=1
+
+      ! periodicity
+      IF( td_dom%i_pivot == 0 )THEN !0-F
+         td_dom%i_perio=3
+         td_dom%i_pivot=0
+      ELSE !1-T
+         td_dom%i_perio=5
+         td_dom%i_pivot=1
+      ENDIF
+
+   END SUBROUTINE dom__size_semi_global
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dom__size_no_pole(td_dom)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute size of sub domain without north fold
+   !> condition
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_dom domain strcuture
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TDOM), INTENT(INOUT) :: td_dom
+      !----------------------------------------------------------------
+
+      IF( td_dom%i_jmax == 0 )THEN
+         CALL logger_fatal("DOM SIZE NO POLE: invalid domain. "//&
+         &  "can not get north pole from this coarse grid. "//&
+         &  "check namelist and coarse grid periodicity." )
+      ENDIF
+
+      IF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 .OR. &
+      &   td_dom%i_imin > td_dom%i_imax )THEN
+         CALL logger_trace("DOM SIZE NO POLE: "// &
+         &  "domain to extract overlap east-west boundary")
+
+         CALL dom__size_no_pole_overlap( td_dom )
+
+      ELSE
+         ! id_imin < id_imax
+         CALL logger_trace("DOM SIZE NO POLE: "// &
+         &  "domain to extract do not overlap east-west boundary")
+
+         CALL dom__size_no_pole_no_overlap( td_dom )
+
+      ENDIF
+
+   END SUBROUTINE dom__size_no_pole
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dom__size_pole(td_dom)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute size of sub domain with north fold
+   !> condition.
+   !>
+   !> @author J.Paul
+   !> @date April, 2013 - Initial version
+   !>
+   !> @param[inout] td_dom domain strcuture
+   !> @note never tested
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TDOM), INTENT(INOUT) :: td_dom
+      !----------------------------------------------------------------
+
+      IF( td_dom%i_imin >= td_dom%i_imax )THEN
+         CALL logger_trace("DOM SIZE POLE: "//&
+         &  "domain to extract overlap east-west boundary")
+         CALL dom__size_pole_overlap( td_dom )
+      ELSEIF( td_dom%i_imin < td_dom%i_imax )THEN
+         CALL logger_trace("DOM SIZE POLE: "//&
+         &  "domain to extract do not overlap east-west boundary")
+         CALL dom__size_pole_no_overlap( td_dom )
+      ENDIF
+
+   END SUBROUTINE dom__size_pole
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dom__size_no_pole_overlap(td_dom)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute size of sub domain without north fold
+   !> condition, and which overlap east-west boundary
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_dom domain strcuture
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TDOM), INTENT(INOUT) :: td_dom
+      !----------------------------------------------------------------
+
+      IF( td_dom%i_jmax == 0 )THEN
+         CALL logger_fatal("DOM SIZE NO POLE OVERLAP: invalid domain. "//&
+         &  "can not get north pole from this coarse grid. "//&
+         &  "check namelist and coarse grid periodicity." )
+      ENDIF
+
+      IF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 )THEN
+         ! domain to extract with east west cyclic boundary
+         CALL logger_trace("DOM SIZE NO POLE OVERLAP: "//&
+         &  "domain to extract has cyclic east-west boundary")
+
+         td_dom%i_imin = 1
+         td_dom%i_imax = td_dom%t_dim0(1)%i_len
+
+         td_dom%t_dim(1)%i_len = td_dom%t_dim0(1)%i_len
+
+         ! no ghost cell
+         td_dom%i_ghost(jp_I,:)=0
+
+         ! periodicity
+         td_dom%i_perio=1
+
+      ELSE
+
+         ! id_imin > id_imax
+         ! extract domain overlap east-west boundary
+
+         td_dom%t_dim(1)%i_len = td_dom%i_imax + &
+         &                       td_dom%t_dim0(1)%i_len - td_dom%i_imin + 1 - & 
+         &                       td_dom%i_ew0     ! remove cyclic boundary
+
+         ! add ghost cell
+         td_dom%i_ghost(jp_I,:)=1
+
+         ! periodicity
+         td_dom%i_perio=0
+
+      ENDIF
+
+      td_dom%t_dim(2)%i_len = td_dom%i_jmax - &
+      &                       td_dom%i_jmin + 1
+
+      ! add ghost cell
+      td_dom%i_ghost(jp_J,:)=1
+
+   END SUBROUTINE dom__size_no_pole_overlap
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dom__size_no_pole_no_overlap(td_dom)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute size of sub domain without north fold
+   !> condition, and which do not overlap east-west boundary
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_dom domain strcuture
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TDOM), INTENT(INOUT) :: td_dom
+      !----------------------------------------------------------------
+
+      IF( td_dom%i_jmax == 0 )THEN
+         CALL logger_fatal("DOM SIZE NO POLE NO OVERLAP: invalid domain. "//&
+         &  "can not get north pole from this coarse grid. "//&
+         &  "check domain indices and grid periodicity." )
+      ENDIF
+
+      IF( td_dom%i_imin == 0 .OR. td_dom%i_imax == 0 )THEN
+         CALL logger_fatal("DOM SIZE NO POLE NO OVERLAP: invalid domain. "//&
+         &  "can not overlap East-West boundary with this coarse grid. "//&
+         &  "check domain indices and grid periodicity." )
+      ENDIF
+
+      td_dom%t_dim(1)%i_len = td_dom%i_imax - & 
+      &                       td_dom%i_imin + 1 
+
+      td_dom%t_dim(2)%i_len = td_dom%i_jmax - &
+      &                       td_dom%i_jmin + 1
+      
+      ! add ghost cell
+      td_dom%i_ghost(:,:)=1
+
+      ! periodicity
+      td_dom%i_perio=0
+
+   END SUBROUTINE dom__size_no_pole_no_overlap
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dom__size_pole_overlap(td_dom)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute size of sub domain with north fold
+   !> condition, and which overlap east-west boundary
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_dom domain strcuture
+   !> @note never tested
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TDOM), INTENT(INOUT) :: td_dom
+
+      ! local variable
+      INTEGER(i4) :: il_idom1  ! extract domain size, east part
+      INTEGER(i4) :: il_idom2  ! extract domain size, west part
+      INTEGER(i4) :: il_imid   ! cananadian bipole index (middle of global domain) 
+      !----------------------------------------------------------------
+
+      CALL logger_trace("DOM SIZE POLE OVERLAP: "//&
+      &  "asian bipole inside domain to extract")
+
+      il_imid = td_dom%t_dim0(1)%i_len/2 + td_dom%i_pivot
+
+      il_idom1 = td_dom%t_dim0(1)%i_len - td_dom%i_imin + 1
+      il_idom2 = td_dom%i_imax
+      
+      IF( il_idom1 > il_imid .OR. il_idom2 > il_imid )THEN
+
+         CALL logger_trace("DOM SIZE POLE OVERLAP: "//&
+         &  "canadian bipole inside domain to extract")
+         td_dom%i_imin = 0
+         td_dom%i_imax = 0
+
+         IF( td_dom%i_jmin == 0 .AND. td_dom%i_jmax == 0 )THEN
+            CALL dom__size_global( td_dom )
+         ELSE
+            CALL dom__size_semi_global( td_dom )
+         ENDIF
+
+         ! periodicity
+         td_dom%i_perio=0
+
+      ELSEIF( il_idom1 > il_idom2 )THEN
+
+         ! east part bigger than west part
+         CALL logger_trace("DOM SIZE POLE OVERLAP: east part bigger than west part ")
+         ! to respect symmetry around asian bipole
+         td_dom%i_imax = il_idom1
+
+         IF( td_dom%i_jmin == 0 ) td_dom%i_jmin = 1 
+         ! north pole
+         td_dom%i_jmax = td_dom%t_dim0(2)%i_len
+
+         ! compute size
+         td_dom%t_dim(1)%i_len = il_idom1  !! no ghost cell ??
+         td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - &
+         &                         td_dom%i_jmin + 1 ) + &   
+         &                         ( td_dom%t_dim0(2)%i_len - &
+         &                         td_dom%i_jmin + 1 ) - 2   ! remove north fold condition ?
+
+         ! add ghost cell
+         td_dom%i_ghost(:,:)=1
+
+         ! periodicity
+         td_dom%i_perio=0
+
+      ELSE ! il_idom2 >= il_idom1
+
+         ! west part bigger than east part
+         CALL logger_trace("DOM SIZE POLE OVERLAP: west part bigger than east part ")
+
+         ! to respect symmetry around asian bipole
+         td_dom%i_imin = td_dom%t_dim0(1)%i_len - il_idom2 + 1
+
+         IF( td_dom%i_jmin == 0 ) td_dom%i_jmin = 1 
+         ! north pole
+         td_dom%i_jmax=td_dom%t_dim0(2)%i_len
+
+         ! compute size
+         td_dom%t_dim(1)%i_len = il_idom2
+         td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - &
+         &                         td_dom%i_jmin + 1 ) + &
+         &                         ( td_dom%t_dim0(2)%i_len - &
+         &                         td_dom%i_jmin + 1 ) - 2
+
+         ! add ghost cell
+         td_dom%i_ghost(:,:)=1
+         
+         ! periodicity
+         td_dom%i_perio=0
+
+      ENDIF
+
+   END SUBROUTINE dom__size_pole_overlap
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dom__size_pole_no_overlap(td_dom)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute size of sub domain with north fold
+   !> condition, and which do not overlap east-west boundary
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_dom domain strcuture
+   !> @note never tested
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TDOM), INTENT(INOUT) :: td_dom
+
+      ! local variable
+      INTEGER(i4) :: il_idom1  ! extract domain size, east part
+      INTEGER(i4) :: il_idom2  ! extract domain size, west part
+      INTEGER(i4) :: il_mid    ! canadian biple index ?
+      !----------------------------------------------------------------
+
+      IF( td_dom%i_imin == 0 .OR. td_dom%i_imax == 0 .OR. &
+      &   td_dom%i_imin > td_dom%i_imax )THEN
+         CALL logger_fatal("DOM SIZE POLE NO OVERLAP: invalid domain. "//&
+         &  "can not overlap East-West boundary with this coarse grid. "//&
+         &  "check namelist and coarse grid periodicity." )
+      ENDIF
+
+      CALL logger_trace("DOM SIZE POLE NO OVERLAP: "//&
+      &  "no asian bipole inside domain to extract")
+
+      IF( td_dom%i_jmin==0 ) td_dom%i_jmin = 1
+      IF( td_dom%i_jmax==0 ) td_dom%i_jmax = td_dom%t_dim0(2)%i_len
+
+      ! 
+      il_mid = td_dom%t_dim0(1)%i_len/2 + td_dom%i_pivot
+
+      IF( (td_dom%i_imin < il_mid .AND. td_dom%i_imax < il_mid) .OR. &
+      &   (td_dom%i_imin > il_mid .AND. td_dom%i_imax > il_mid) )THEN
+         CALL logger_trace("DOM SIZE POLE NO OVERLAP: "//&
+         &  "no canadian bipole inside domain to extract")
+
+         td_dom%t_dim(1)%i_len = td_dom%i_imax - &
+         &                       td_dom%i_imin + 1
+
+         td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - &
+         &                       td_dom%i_jmin + 1 ) + &
+         &                       ( td_dom%t_dim0(2)%i_len - &
+         &                       td_dom%i_jmin + 1 ) - 2 ! remove north fold condition ?
+
+         ! add ghost cell
+         td_dom%i_ghost(:,:)=1
+
+         ! periodicity
+         td_dom%i_perio=0
+
+      ELSE ! id_imin < il_mid .AND. id_imax > il_mid
+         CALL logger_trace("DOM SIZE POLE NO OVERLAP: "//&
+         &  "canadian bipole inside domain to extract")
+
+         il_idom1 = td_dom%i_imax - (il_mid - 1)
+         il_idom2 = il_mid  - td_dom%i_imin
+         IF( il_idom1 > il_idom2 )THEN
+            ! east part bigger than west part
+            CALL logger_trace("DOM SIZE POLE NO OVERLAP: east part bigger than west part ")
+            ! to respect symmetry around canadian bipole
+            td_dom%i_imin = il_mid - il_idom1
+
+            td_dom%t_dim(1)%i_len = il_idom1 + 1
+            td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - &
+            &                         td_dom%i_jmin + 1 ) + & 
+            &                         ( td_dom%t_dim0(2)%i_len - &
+            &                         td_dom%i_jmin + 1 ) &   
+            &                         - 2 - 2 * td_dom%i_pivot    ! remove north fold condition ?
+
+            ! add ghost cell
+            td_dom%i_ghost(:,:)=1
+
+            ! periodicity
+            td_dom%i_perio=0
+
+         ELSE ! il_idom2 >= il_idom1
+            ! west part bigger than east part
+            CALL logger_trace("DOM SIZE POLE NO OVERLAP: west part bigger than east part ")
+            ! to respect symmetry around canadian bipole
+
+            td_dom%i_imax = il_mid + il_idom2
+
+            td_dom%t_dim(1)%i_len = il_idom2 + 1
+            td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len -  &
+            &                         td_dom%i_jmin + 1 ) +     & 
+            &                         ( td_dom%t_dim0(2)%i_len -  &
+            &                         td_dom%i_jmax + 1 )       & 
+            &                         - 2 - 2 * td_dom%i_pivot  !  remove north fold condition ?
+
+            ! add ghost cell
+            td_dom%i_ghost(:,:)=1
+
+            ! periodicity
+            td_dom%i_perio=0            
+
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE dom__size_pole_no_overlap
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dom_add_extra(td_dom, id_iext, id_jext)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine add extra bands to coarse domain to get enough point for
+   !>  interpolation...
+   !>
+   !> @details
+   !>  - domain periodicity is take into account.<br/>
+   !>  - domain indices are changed, and size of extra bands are saved.<br/>
+   !>  - optionaly, i- and j- direction size of extra bands could be specify 
+   !> (default=im_minext)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !> @date September, 2014
+   !> - take into account number of ghost cell
+   !> @date February, 2016
+   !> - number of extra point is the MAX (not the MIN) of zero and asess value. 
+   !>
+   !> @param[inout] td_dom domain strcuture
+   !> @param [in] id_iext  i-direction size of extra bands (default=im_minext)
+   !> @param [in] id_jext  j-direction size of extra bands (default=im_minext)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TDOM) ,  INTENT(INOUT) :: td_dom
+      INTEGER(i4),  INTENT(IN   ), OPTIONAL :: id_iext
+      INTEGER(i4),  INTENT(IN   ), OPTIONAL :: id_jext
+
+      ! local variable
+      INTEGER(i4) :: il_iext
+      INTEGER(i4) :: il_jext
+
+      ! loop indices
+      !----------------------------------------------------------------
+      ! init
+      il_iext=im_minext
+      IF( PRESENT(id_iext) ) il_iext=id_iext
+
+      il_jext=im_minext
+      IF( PRESENT(id_jext) ) il_jext=id_jext
+
+      td_dom%i_iextra(:)=0
+      td_dom%i_jextra(:)=0
+
+      IF( td_dom%i_imin == 1                       .AND. &
+      &   td_dom%i_imax == td_dom%t_dim0(1)%i_len  .AND. &
+      &   td_dom%i_jmin == 1                       .AND. &
+      &   td_dom%i_jmax == td_dom%t_dim0(2)%i_len )THEN
+         ! global
+         ! nothing to be done
+      ELSE
+
+         IF( td_dom%i_imin == 1                       .AND. &
+         &   td_dom%i_imax == td_dom%t_dim0(1)%i_len )THEN
+            ! EW cyclic
+            ! nothing to be done
+         ELSE
+            IF( td_dom%i_ew0 < 0 )THEN
+               ! EW not cyclic
+               IF( td_dom%i_imin - il_iext > td_dom%i_ghost0(jp_I,1)*ip_ghost )THEN
+                  td_dom%i_iextra(1) = il_iext
+                  td_dom%i_imin      = td_dom%i_imin - td_dom%i_iextra(1)
+               ELSE ! td_dom%i_imin - il_iext <= td_dom%i_ghost0(jp_I,1)*ip_ghost
+                  td_dom%i_iextra(1) = MAX(0, &
+                  &                         td_dom%i_imin - &
+                  &                         td_dom%i_ghost0(jp_I,1)*ip_ghost -1)
+                  td_dom%i_imin      = td_dom%i_imin - td_dom%i_iextra(1)
+               ENDIF
+
+               IF( td_dom%i_imax + il_iext < &
+               &   td_dom%t_dim0(1)%i_len - td_dom%i_ghost0(jp_I,2)*ip_ghost )THEN
+                  td_dom%i_iextra(2) = il_iext
+                  td_dom%i_imax      = td_dom%i_imax + td_dom%i_iextra(2)
+               ELSE ! td_dom%i_imax + il_iext >= &
+                    !  td_dom%t_dim0(1)%i_len - td_dom%i_ghost0(jp_I,2)*ip_ghost
+                  td_dom%i_iextra(2) = MAX( 0, &
+                  &                         td_dom%t_dim0(1)%i_len - &
+                  &                         td_dom%i_ghost0(jp_I,2)*ip_ghost - &
+                  &                         td_dom%i_imax )
+                  td_dom%i_imax      = td_dom%i_imax + td_dom%i_iextra(2)
+               ENDIF
+
+            ELSE ! td_dom%i_ew0 >= 0
+
+               ! EW cyclic
+               IF( td_dom%i_imin - il_iext > 0 )THEN
+                  td_dom%i_iextra(1) = il_iext
+                  td_dom%i_imin      = td_dom%i_imin - td_dom%i_iextra(1)
+               ELSE ! td_dom%i_imin - il_iext <= 0
+                  td_dom%i_iextra(1) = il_iext
+                  td_dom%i_imin      = td_dom%t_dim0(1)%i_len + &
+                  &                     td_dom%i_imin - td_dom%i_iextra(1) -&
+                  &                     td_dom%i_ew0
+               ENDIF
+
+               IF( td_dom%i_imax + il_iext <= td_dom%t_dim0(1)%i_len )THEN
+                  td_dom%i_iextra(2) = il_iext
+                  td_dom%i_imax      = td_dom%i_imax + td_dom%i_iextra(2)
+               ELSE ! td_dom%i_imax + il_iext > td_dom%t_dim0(1)%i_len
+                  td_dom%i_iextra(2) = il_iext
+                  td_dom%i_imax      = td_dom%i_imax + td_dom%i_iextra(2) - &
+                  &                     (td_dom%t_dim0(1)%i_len-td_dom%i_ew0) 
+               ENDIF               
+            ENDIF
+
+         ENDIF
+
+         IF( td_dom%i_jmin == 1                       .AND. &
+         &   td_dom%i_jmax == td_dom%t_dim0(2)%i_len )THEN
+            ! nothing to be done
+         ELSE
+
+            IF( td_dom%i_jmin - il_jext > td_dom%i_ghost0(jp_J,1)*ip_ghost )THEN
+               td_dom%i_jextra(1) = il_jext
+               td_dom%i_jmin      = td_dom%i_jmin - td_dom%i_jextra(1)
+            ELSE ! td_dom%i_jmin - il_jext <= td_dom%i_ghost0(jp_J,1)*ip_ghost
+               td_dom%i_jextra(1) = MAX( 0, &
+               &                         td_dom%i_jmin - &
+               &                         td_dom%i_ghost0(jp_J,1)*ip_ghost - 1)
+               td_dom%i_jmin      = td_dom%i_jmin - td_dom%i_jextra(1)
+            ENDIF
+
+            IF( td_dom%i_jmax + il_jext < &
+            &   td_dom%t_dim0(2)%i_len - td_dom%i_ghost0(jp_J,2)*ip_ghost )THEN
+               td_dom%i_jextra(2) = il_jext
+               td_dom%i_jmax      = td_dom%i_jmax + td_dom%i_jextra(2)
+            ELSE ! td_dom%i_jmax + il_jext >= &
+                 !  td_dom%t_dim0(2)%i_len - td_dom%i_ghost0(jp_J,2)*ip_ghost
+               td_dom%i_jextra(2) = MAX( 0, &
+               &                         td_dom%t_dim0(2)%i_len - &
+               &                         td_dom%i_ghost0(jp_J,2)*ip_ghost - &
+               &                         td_dom%i_jmax )
+               td_dom%i_jmax      = td_dom%i_jmax + td_dom%i_jextra(2)
+            ENDIF
+         ENDIF         
+
+      ENDIF
+
+      IF( td_dom%i_imin <= td_dom%i_imax )THEN
+         td_dom%t_dim(1)%i_len = td_dom%i_imax - td_dom%i_imin +1 
+      ELSE ! td_dom%i_imin > td_dom%i_imax
+         td_dom%t_dim(1)%i_len = td_dom%i_imax + &
+         &                       td_dom%t_dim0(1)%i_len - td_dom%i_imin + 1 - &
+         &                       td_dom%i_ew0 ! remove overlap
+      ENDIF
+
+      td_dom%t_dim(2)%i_len = td_dom%i_jmax-td_dom%i_jmin+1
+
+
+   END SUBROUTINE dom_add_extra
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dom_clean_extra(td_dom)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine clean coarse grid domain structure. 
+   !> it remove extra point added. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_dom domain strcuture
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TDOM) , INTENT(INOUT) :: td_dom
+
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! change domain
+      td_dom%i_imin         = td_dom%i_imin + td_dom%i_iextra(1)
+      td_dom%i_jmin         = td_dom%i_jmin + td_dom%i_jextra(1)
+
+      td_dom%i_imax         = td_dom%i_imax - td_dom%i_iextra(2)
+      td_dom%i_jmax         = td_dom%i_jmax - td_dom%i_jextra(2)
+
+      td_dom%t_dim(1)%i_len = td_dom%t_dim(1)%i_len - &
+      &                          td_dom%i_iextra(1) - &
+      &                          td_dom%i_iextra(2)
+      td_dom%t_dim(2)%i_len = td_dom%t_dim(2)%i_len - &
+      &                          td_dom%i_jextra(1) - &
+      &                          td_dom%i_jextra(2)
+
+      td_dom%i_iextra(:)=0
+      td_dom%i_jextra(:)=0
+
+   END SUBROUTINE dom_clean_extra
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dom_del_extra(td_var, td_dom, id_rho, ld_coord)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine delete extra band, from fine grid variable value, 
+   !> and dimension, taking into account refinement factor.
+   !>
+   !> @details
+   !> @note This subroutine should be used before clean domain structure.
+   !>
+   !> @warning if work on coordinates grid, do not remove all extra point.
+   !> save value on ghost cell. 
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !> @date September, 2014
+   !> - take into account boundary for one point size domain
+   !> @date December, 2014
+   !> - add special case for coordinates file.
+   !>
+   !> @param[inout] td_var variable strcuture
+   !> @param[in] td_dom    domain strcuture
+   !> @param[in] id_rho    array of refinement factor
+   !> @param[in] ld_coord  work on coordinates file or not
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR)               , INTENT(INOUT) :: td_var
+      TYPE(TDOM)               , INTENT(IN   ) :: td_dom
+      INTEGER(i4), DIMENSION(:), INTENT(IN   ), OPTIONAL :: id_rho
+      LOGICAL                  , INTENT(IN   ), OPTIONAL :: ld_coord
+
+      ! local variable
+      INTEGER(i4) :: il_iextra
+      INTEGER(i4) :: il_jextra
+
+      INTEGER(i4) :: il_imin
+      INTEGER(i4) :: il_imax
+      INTEGER(i4) :: il_jmin
+      INTEGER(i4) :: il_jmax
+      
+      INTEGER(i4), DIMENSION(2)   :: il_rho
+      INTEGER(i4), DIMENSION(2,2) :: il_ghost
+
+      REAL(dp)   , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      LOGICAL     :: ll_coord
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( PRESENT(id_rho) )THEN
+         ! work on coarse grid
+         il_rho(:)=id_rho(jp_I:jp_J)
+      ELSE
+         ! work on fine grid
+         il_rho(:)=1
+      ENDIF
+
+      ll_coord=.false.
+      IF( PRESENT(ld_coord) ) ll_coord=ld_coord
+
+      IF( .NOT. ASSOCIATED(td_var%d_value) )THEN
+         CALL logger_error("DOM DEL EXTRA: no value associated to "//&
+         &     "variable "//TRIM(td_var%c_name) )
+      ELSE
+         ! get variable right domain
+         IF( ALL(td_var%t_dim(1:2)%l_use) )THEN
+
+            ALLOCATE(dl_value(td_var%t_dim(1)%i_len, &
+            &                 td_var%t_dim(2)%i_len, &
+            &                 td_var%t_dim(3)%i_len, &
+            &                 td_var%t_dim(4)%i_len) )
+            dl_value(:,:,:,:)=td_var%d_value(:,:,:,:)
+
+            il_iextra=SUM(td_dom%i_iextra(:))*il_rho(jp_I)
+            il_jextra=SUM(td_dom%i_jextra(:))*il_rho(jp_J)
+
+            il_ghost(:,:)=0
+            IF( ll_coord )THEN
+               il_ghost(:,:)=td_dom%i_ghost(:,:)
+            ENDIF
+
+            IF( il_iextra >= td_var%t_dim(1)%i_len )THEN
+               ! case one point size dimension
+               SELECT CASE(td_dom%i_bdy) 
+
+                  CASE(jp_north,jp_east)
+
+                     CALL logger_info("DOM DEL EXTRA: special case for north"//&
+                     &                " or east boundary.")
+                     IF( td_dom%i_iextra(1) <= 0 )THEN
+                        il_imin= 1
+                        il_ghost(jp_I,1) = 0
+                     ELSE
+                        il_imin= 1 + (td_dom%i_iextra(1)-1)*il_rho(jp_I) + 1 &
+                        &        - il_ghost(jp_I,1)
+                     ENDIF
+                     IF( td_dom%i_iextra(2) <= 0 )THEN;
+                        il_imax= td_var%t_dim(1)%i_len
+                        il_ghost(jp_I,2) = 0
+                     ELSE
+                        il_imax= td_var%t_dim(1)%i_len - &
+                        &          td_dom%i_iextra(2)*il_rho(jp_I) &
+                        &        + il_ghost(jp_I,2)
+                     ENDIF
+
+                  CASE(jp_south,jp_west)
+
+                     CALL logger_info("DOM DEL EXTRA: special case for south"//&
+                     &                " or west boundary.")
+                     IF( td_dom%i_iextra(1) <= 0 )THEN
+                        il_imin= 1
+                        il_ghost(jp_I,1) = 0
+                     ELSE
+                        il_imin= 1 + td_dom%i_iextra(1)*il_rho(jp_I) &
+                        &        - il_ghost(jp_I,1)
+                     ENDIF
+                     IF( td_dom%i_iextra(2) <= 0 )THEN
+                        il_imax= td_var%t_dim(1)%i_len
+                        il_ghost(jp_I,2) = 0
+                     ELSE
+                        il_imax= td_var%t_dim(1)%i_len - &
+                        &          (td_dom%i_iextra(2)-1)*il_rho(jp_I) - 1 &
+                        &        + il_ghost(jp_I,2)
+                     ENDIF
+
+                  CASE DEFAULT
+
+                     IF( MOD(il_iextra-td_var%t_dim(1)%i_len,2)==0 )THEN
+                        ! case one point size dimension with even refinment
+                        CALL logger_fatal("DOM DEL EXTRA: should have been"//&
+                        &                 "an impossible case: domain of "//&
+                        &                 " one point size and even refinment.")
+                     ELSE
+                        il_imin= 1 + &
+                        &        (td_dom%i_iextra(1)-1)*il_rho(jp_I) + &
+                        &        (il_rho(jp_I)-1)/2 + 1                &
+                        &        - il_ghost(jp_I,1)
+                        il_imax= td_var%t_dim(1)%i_len - &
+                        &        (td_dom%i_iextra(2)-1)*il_rho(jp_I) - &
+                        &        (il_rho(jp_I)-1)/2 - 1                &
+                        &        + il_ghost(jp_I,2)
+                     ENDIF
+
+               END SELECT
+
+               td_var%t_dim(1)%i_len = 1 + SUM(il_ghost(jp_I,:))
+
+            ELSE
+               ! general case
+               il_imin=1                     + td_dom%i_iextra(1)*il_rho(jp_I) &
+               &                             - il_ghost(jp_I,1)
+               il_imax=td_var%t_dim(1)%i_len - td_dom%i_iextra(2)*il_rho(jp_I) &
+               &                             + il_ghost(jp_I,2)
+
+               td_var%t_dim(1)%i_len=td_var%t_dim(1)%i_len - il_iextra &
+               &                                         + SUM(il_ghost(jp_I,:))
+            ENDIF
+
+            IF( il_jextra >= td_var%t_dim(2)%i_len )THEN
+               ! case one point size dimension
+               SELECT CASE(td_dom%i_bdy) 
+
+                  CASE(jp_north,jp_east)
+
+                     IF( td_dom%i_jextra(1) <= 0 )THEN
+                        il_jmin= 1
+                        il_ghost(jp_J,1) = 0
+                     ELSE
+                        il_jmin= 1 + (td_dom%i_jextra(1)-1)*il_rho(jp_J) + 1 &
+                        &        - il_ghost(jp_J,1)
+                     ENDIF
+                     IF( td_dom%i_jextra(2) <= 0 )THEN
+                        il_jmax= td_var%t_dim(2)%i_len
+                        il_ghost(jp_J,2) = 0
+                     ELSE
+                        il_jmax= td_var%t_dim(2)%i_len - &
+                        &          td_dom%i_jextra(2)*il_rho(jp_J) &
+                        &        + il_ghost(jp_J,2)
+                     ENDIF
+
+                  CASE(jp_south,jp_west)
+
+                     IF( td_dom%i_iextra(2) <= 0 )THEN
+                        il_jmin= 1
+                        il_ghost(jp_J,1) = 0
+                     ELSE
+                        il_jmin= 1 + td_dom%i_jextra(1)*il_rho(jp_J) &
+                        &        - il_ghost(jp_J,1)
+                     ENDIF
+                     IF( td_dom%i_jextra(2) <= 0 )THEN
+                        il_jmax= td_var%t_dim(2)%i_len
+                        il_ghost(jp_J,2) = 0
+                     ELSE
+                        il_jmax= td_var%t_dim(2)%i_len - &
+                        &          (td_dom%i_jextra(2)-1)*il_rho(jp_J) - 1 &
+                        &        + il_ghost(jp_J,2)
+                     ENDIF
+
+                  CASE DEFAULT
+
+                     IF( MOD(il_jextra-td_var%t_dim(2)%i_len,2)==0 )THEN
+                        ! case one point size dimension with even refinment
+                        CALL logger_fatal("DOM DEL EXTRA: should have been"//&
+                        &                 "an impossible case: domain of "//&
+                        &                 " one point size and even refinment.")
+                     ELSE
+                        il_jmin= 1 + &
+                        &        (td_dom%i_jextra(1)-1)*il_rho(jp_J) + &
+                        &        (il_rho(jp_J)-1)/2 + 1 &
+                        &        - il_ghost(jp_J,1)
+                        il_jmax= td_var%t_dim(2)%i_len - &
+                        &        (td_dom%i_jextra(2)-1)*il_rho(jp_J) - &
+                        &        (il_rho(jp_J)-1)/2 - 1 &
+                        &        + il_ghost(jp_J,2)
+                     ENDIF
+
+               END SELECT
+
+               td_var%t_dim(2)%i_len = 1 + SUM(il_ghost(jp_J,:))
+
+            ELSE
+               ! general case
+               il_jmin=1                     + td_dom%i_jextra(1)*il_rho(jp_J) &
+               &                             - il_ghost(jp_J,1)
+               il_jmax=td_var%t_dim(2)%i_len - td_dom%i_jextra(2)*il_rho(jp_J) &
+               &                             + il_ghost(jp_J,2)
+
+                td_var%t_dim(2)%i_len= td_var%t_dim(2)%i_len - il_jextra &
+                &                                        + SUM(il_ghost(jp_J,:))
+            ENDIF
+
+            DEALLOCATE(td_var%d_value)
+            ALLOCATE(td_var%d_value(td_var%t_dim(1)%i_len, &
+            &                       td_var%t_dim(2)%i_len, &
+            &                       td_var%t_dim(3)%i_len, &
+            &                       td_var%t_dim(4)%i_len) )
+
+            td_var%d_value(:,:,:,:)=dl_value(il_imin:il_imax, &
+            &                                il_jmin:il_jmax, &
+            &                                :, :)
+            DEALLOCATE(dl_value)
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE dom_del_extra
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE dom_clean(td_dom)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine clean domain structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_dom domain strcuture
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TDOM),  INTENT(INOUT) :: td_dom
+
+      ! local variable
+      TYPE(TDOM) :: tl_dom ! empty dom structure
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      CALL logger_info( "DOM CLEAN: reset domain " )
+
+      ! del dimension
+      DO ji=ip_maxdim,1,-1
+         CALL dim_clean( td_dom%t_dim0(ji) )
+      ENDDO
+
+      ! replace by empty structure
+      td_dom=tl_dom
+
+   END SUBROUTINE dom_clean
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE dom
Index: /utils/tools_ticket2413/SIREN/src/extrap.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/extrap.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/extrap.f90	(revision 12863)
@@ -0,0 +1,1382 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief 
+!> This module manage extrapolation.
+!>
+!> @details
+!>    Extrapolation method to be used is specify inside variable 
+!>    strcuture, as array of string character.<br/> 
+!>    - td_var\%c_extrap(1) string character is the interpolation name choose between:
+!>       - 'dist_weight'
+!>       - 'min_error'
+!>
+!>    @note Extrapolation method could be specify for each variable in namelist _namvar_,
+!>    defining string character _cn\_varinfo_. By default _dist_weight_.<br/>
+!>    Example:
+!>       - cn_varinfo='varname1:ext=dist_weight', 'varname2:ext=min_error'
+!>
+!>    to detect point to be extrapolated:<br/>
+!> @code
+!>    il_detect(:,:,:)=extrap_detect(td_var)
+!> @endcode
+!>       - il_detect(:,:,:) is 3D array of point to be extrapolated
+!>       - td_var  is coarse grid variable to be extrapolated
+!>
+!>    to extrapolate variable:<br/>
+!> @code
+!>    CALL extrap_fill_value( td_var, [id_radius])
+!> @endcode
+!>       - td_var  is coarse grid variable to be extrapolated
+!>       - id_radius is radius of the halo used to compute extrapolation [optional]
+!>
+!>    to add extraband to the variable (to be extrapolated):<br/>
+!> @code
+!>    CALL extrap_add_extrabands(td_var, [id_isize,] [id_jsize] )
+!> @endcode
+!>       - td_var is variable structure
+!>       - id_isize : i-direction size of extra bands [optional]
+!>       - id_jsize : j-direction size of extra bands [optional]
+!>
+!>    to delete extraband of a variable:<br/>
+!> @code
+!>    CALL extrap_del_extrabands(td_var, [id_isize,] [id_jsize] )
+!> @endcode
+!>       - td_var is variable structure
+!>       - id_isize : i-direction size of extra bands [optional]
+!>       - id_jsize : j-direction size of extra bands [optional]
+!>
+!> @warning _FillValue must not be zero (use var_chg_FillValue())
+!>
+!> @author
+!> J.Paul
+!>
+!> @date November, 2013 - Initial Version
+!> @date September, 2014
+!> - add header
+!> @date June, 2015
+!> - extrapolate all land points (_FillValue)
+!> - move deriv function to math module
+!> @date July, 2015
+!> - compute extrapolation from north west to south east, 
+!> and from south east to north west
+!>
+!> @todo
+!> - create module for each extrapolation method
+!> - smooth extrapolated points
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE extrap
+
+   USE netcdf                          ! nf90 library
+   USE kind                            ! F90 kind parameter
+   USE phycst                          ! physical constant
+   USE global                          ! global variable
+   USE fct                             ! basic useful function
+   USE date                            ! date manager
+   USE logger                          ! log file manager
+   USE math                            ! mathematical function
+   USE att                             ! attribute manager
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   PRIVATE :: im_minext    !< default minumum number of point to extrapolate
+   PRIVATE :: im_mincubic  !< default minumum number of point to extrapolate for cubic interpolation
+
+   ! function and subroutine
+   PUBLIC :: extrap_detect         !< detected point to be extrapolated
+   PUBLIC :: extrap_fill_value     !< extrapolate value over detected point 
+   PUBLIC :: extrap_add_extrabands !< add extraband to the variable (to be extrapolated) 
+   PUBLIC :: extrap_del_extrabands !< delete extraband of the variable 
+
+   PRIVATE :: extrap__detect_wrapper      ! detected point to be extrapolated wrapper
+   PRIVATE :: extrap__detect              ! detected point to be extrapolated
+   PRIVATE :: extrap__fill_value_wrapper  ! extrapolate value over detected point wrapper 
+   PRIVATE :: extrap__fill_value          ! extrapolate value over detected point 
+   PRIVATE :: extrap__3D                  !
+   PRIVATE :: extrap__3D_min_error_coef   !
+   PRIVATE :: extrap__3D_min_error_fill   !
+   PRIVATE :: extrap__3D_dist_weight_coef !
+   PRIVATE :: extrap__3D_dist_weight_fill ! 
+
+   INTEGER(i4), PARAMETER :: im_minext  = 2  !< default minumum number of point to extrapolate
+   INTEGER(i4), PARAMETER :: im_mincubic= 4  !< default minumum number of point to extrapolate for cubic interpolation
+
+   INTERFACE extrap_detect
+      MODULE PROCEDURE extrap__detect_wrapper     !< detected point to be extrapolated
+   END INTERFACE extrap_detect
+
+   INTERFACE extrap_fill_value
+      MODULE PROCEDURE extrap__fill_value_wrapper !< detected point to be interpolated
+   END INTERFACE extrap_fill_value
+   
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION extrap__detect(td_var0) &
+         &  RESULT (if_detect)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function detected point to be extrapolated, given variable structure.
+   !> 
+   !> @details 
+   !> optionaly, you could sepcify fine grid level, refinment factor (default 1), 
+   !> offset between fine and coarse grid (default compute from refinment factor
+   !> as offset=(rho-1)/2), number of point to be extrapolated in each direction
+   !> (default im_minext).<br/>
+   !>
+   !> First coarsening fine grid level, if need be, then select point near 
+   !> grid point already inform.
+   !>
+   !> @note point to be extrapolated are selected using FillValue, 
+   !> so to avoid mistake FillValue should not be zero (use var_chg_FillValue)
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - do not use level to select points to be extrapolated
+   !>
+   !> @param[in] td_var0   coarse grid variable to extrapolate
+   !> @return array of point to be extrapolated
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) ,                      INTENT(IN   ) :: td_var0
+
+      ! function
+      INTEGER(i4), DIMENSION(td_var0%t_dim(1)%i_len,&
+      &                      td_var0%t_dim(2)%i_len,&
+      &                      td_var0%t_dim(3)%i_len ) :: if_detect
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji0
+      INTEGER(i4) :: jj0
+      INTEGER(i4) :: jk0
+      !----------------------------------------------------------------
+
+      ! force to extrapolated all points
+      if_detect(:,:,:)=1
+
+      ! do not compute grid point already inform
+      DO jk0=1,td_var0%t_dim(3)%i_len
+         DO jj0=1,td_var0%t_dim(2)%i_len
+            DO ji0=1,td_var0%t_dim(1)%i_len
+               IF( td_var0%d_value(ji0,jj0,jk0,1) /= td_var0%d_fill )THEN
+                  if_detect(ji0,jj0,jk0)=0
+               ENDIF
+            ENDDO
+         ENDDO
+      ENDDO
+
+   END FUNCTION extrap__detect
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION extrap__detect_wrapper(td_var) &
+         & RESULT (if_detect)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function sort variable to be extrapolated, depending on number of
+   !> dimentsion, then detected point to be extrapolated.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - select all land points for extrapolation
+   !>
+   !> @param[in] td_var    coarse grid variable to extrapolate
+   !> @return 3D array of point to be extrapolated
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) ,                 INTENT(IN   ) :: td_var
+
+      ! function
+      INTEGER(i4), DIMENSION(td_var%t_dim(1)%i_len,&
+      &                      td_var%t_dim(2)%i_len,&
+      &                      td_var%t_dim(3)%i_len ) :: if_detect
+
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+      ! init
+      if_detect(:,:,:)=0
+
+      IF( .NOT. ANY(td_var%t_dim(1:3)%l_use) )THEN
+         ! no dimension I-J-K used
+         CALL logger_debug(" EXTRAP DETECT: nothing done for variable"//&
+            &              TRIM(td_var%c_name) )
+      ELSE IF( ALL(td_var%t_dim(1:3)%l_use) )THEN
+         
+         ! detect point to be extrapolated on I-J-K
+         CALL logger_debug(" EXTRAP DETECT: detect point "//&
+            &              " for variable "//TRIM(td_var%c_name) )
+         
+      if_detect(:,:,:)=extrap__detect( td_var )
+
+      ELSE IF( ALL(td_var%t_dim(1:2)%l_use) )THEN
+
+         ! detect point to be extrapolated on I-J
+         CALL logger_debug(" EXTRAP DETECT: detect horizontal point "//&
+            &              " for variable "//TRIM(td_var%c_name) )
+         
+         if_detect(:,:,1:1)=extrap__detect( td_var )
+
+      ELSE IF( td_var%t_dim(3)%l_use )THEN
+         
+         ! detect point to be extrapolated on K
+         CALL logger_debug(" EXTRAP DETECT: detect vertical point "//&
+            &              " for variable "//TRIM(td_var%c_name) )
+         
+         if_detect(1:1,1:1,:)=extrap__detect( td_var )
+
+      ENDIF              
+
+      CALL logger_debug(" EXTRAP DETECT: "//&
+         &  TRIM(fct_str(SUM(if_detect(:,:,:))))//&
+         &  " points to be extrapolated" )
+      
+   END FUNCTION extrap__detect_wrapper
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE extrap__fill_value_wrapper(td_var, id_radius)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine select method to be used for extrapolation.
+   !> If need be, increase number of points to be extrapolated.
+   !> Finally launch extrap__fill_value.
+   !> 
+   !> @details
+   !> optionaly, you could specify :<br/>
+   !>  - refinment factor (default 1)
+   !>  - offset between fine and coarse grid (default compute from refinment factor
+   !> as offset=(rho-1)/2) 
+   !>  - number of point to be extrapolated in each direction (default im_minext)
+   !>  - radius of the halo used to compute extrapolation
+   !>  - maximum number of iteration
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - select all land points for extrapolation
+   !>
+   !> @param[inout] td_var    variable structure
+   !> @param[in] id_radius    radius of the halo used to compute extrapolation 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) ,                  INTENT(INOUT) :: td_var
+      INTEGER(i4),                  INTENT(IN   ), OPTIONAL :: id_radius
+
+      ! local variable
+      INTEGER(i4) :: il_radius
+
+      CHARACTER(LEN=lc) :: cl_method
+
+      ! loop indices
+      !----------------------------------------------------------------
+      IF( .NOT. ASSOCIATED(td_var%d_value) )THEN
+         CALL logger_error("EXTRAP FILL VALUE: no value "//&
+         &  "associted to variable "//TRIM(td_var%c_name) )
+      ELSE
+
+         SELECT CASE(TRIM(td_var%c_extrap(1)))
+            CASE('min_error')
+               cl_method='min_error'
+            CASE DEFAULT
+               cl_method='dist_weight'
+
+               !update variable structure
+               td_var%c_extrap(1)='dist_weight'
+         END SELECT
+
+         ! number of point use to compute box
+         il_radius=1
+         IF( PRESENT(id_radius) ) il_radius=id_radius
+         IF( il_radius < 0 )THEN
+            CALL logger_error("EXTRAP FILL VALUE: invalid "//&
+            &  " radius of the box used to compute extrapolation "//&
+            &  "("//TRIM(fct_str(il_radius))//")")
+         ENDIF
+
+         CALL logger_info("EXTRAP FILL: extrapolate "//TRIM(td_var%c_name)//&
+         &  " using "//TRIM(cl_method)//" method." )
+
+         CALL extrap__fill_value( td_var, cl_method, &
+         &                        il_radius )
+ 
+      ENDIF
+
+   END SUBROUTINE extrap__fill_value_wrapper
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE extrap__fill_value(td_var, cd_method, id_radius)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute point to be extrapolated, then extrapolate point.
+   !> 
+   !> @details 
+   !> optionaly, you could specify :<br/>
+   !>  - refinment factor (default 1)
+   !>  - offset between fine and coarse grid (default compute from refinment factor
+   !> as offset=(rho-1)/2) 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - select all land points for extrapolation
+   !>
+   !> @param[inout] td_var    variable structure
+   !> @param[in] cd_method    extrapolation method
+   !> @param[in] id_radius    radius of the halo used to compute extrapolation
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR)      ,                 INTENT(INOUT) :: td_var
+      CHARACTER(LEN=*),                 INTENT(IN   ) :: cd_method
+      INTEGER(i4)     ,                 INTENT(IN   ) :: id_radius
+
+      ! local variable
+      CHARACTER(LEN=lc)                            :: cl_extrap
+
+      INTEGER(i4), DIMENSION(:,:,:)  , ALLOCATABLE :: il_detect
+
+      TYPE(TATT)                                   :: tl_att
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      !1- detect point to be extrapolated
+      ALLOCATE( il_detect( td_var%t_dim(1)%i_len, &
+      &                    td_var%t_dim(2)%i_len, &
+      &                    td_var%t_dim(3)%i_len) )
+
+      il_detect(:,:,:) = extrap_detect( td_var )
+
+      !2- add attribute to variable
+      cl_extrap=fct_concat(td_var%c_extrap(:))
+      tl_att=att_init('extrapolation',cl_extrap)
+      CALL var_move_att(td_var, tl_att)
+
+      CALL att_clean(tl_att)
+
+      IF( ALL(il_detect(:,:,:)==1) )THEN
+         CALL logger_warn(" EXTRAP FILL: "//&
+            &  " can not extrapolate "//TRIM(td_var%c_name)//&
+            &  ". no value inform." )
+      ELSE
+         CALL logger_info(" EXTRAP FILL: "//&
+            &              TRIM(fct_str(SUM(il_detect(:,:,:))))//&
+            &              " point(s) to extrapolate " )
+
+         CALL logger_info(" EXTRAP FILL: method "//&
+            &  TRIM(cd_method) )
+
+         !3- extrapolate
+         CALL extrap__3D(td_var%d_value(:,:,:,:), td_var%d_fill, &
+         &               il_detect(:,:,:),                       &
+         &               cd_method, id_radius )
+      ENDIF
+
+      DEALLOCATE(il_detect)
+
+   END SUBROUTINE extrap__fill_value
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE extrap__3D(dd_value, dd_fill, id_detect,&
+         &               cd_method, id_radius)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute point to be extrapolated in 3D array.
+   !> 
+   !> @details 
+   !> in case of 'min_error' method:<br/>
+   !>    - compute derivative in i-, j- and k- direction
+   !>    - compute minimum error coefficient (distance to center of halo)
+   !>    - compute extrapolatd values by calculated minimum error using taylor expansion 
+   !> in case of 'dist_weight' method:<br/>
+   !>    - compute distance weight coefficient (inverse of distance to center of halo) 
+   !>    - compute extrapolatd values using Inverse Distance Weighting
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - compute coef indices to be used
+   !> - bug fix: force coef indice to 1, for dimension lenth equal to 1
+   !>
+   !> @param[inout] dd_value  3D array of variable to be extrapolated
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[inout] id_detect array of point to extrapolate
+   !> @param[in] cd_method    extrapolation method
+   !> @param[in] id_radius    radius of the halo used to compute extrapolation
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)   , DIMENSION(:,:,:,:), INTENT(INOUT) :: dd_value
+      REAL(dp)   ,                     INTENT(IN   ) :: dd_fill
+      INTEGER(i4), DIMENSION(:,:,:)  , INTENT(INOUT) :: id_detect
+      CHARACTER(LEN=*),                INTENT(IN   ) :: cd_method
+      INTEGER(i4),                     INTENT(IN   ) :: id_radius
+
+      ! local variable
+      INTEGER(i4)                                :: il_imin
+      INTEGER(i4)                                :: il_imax
+      INTEGER(i4)                                :: il_jmin
+      INTEGER(i4)                                :: il_jmax
+      INTEGER(i4)                                :: il_kmin
+      INTEGER(i4)                                :: il_kmax
+      INTEGER(i4)                                :: il_iter
+      INTEGER(i4)                                :: il_radius
+      INTEGER(i4)                                :: il_i1
+      INTEGER(i4)                                :: il_i2
+      INTEGER(i4)                                :: il_j1
+      INTEGER(i4)                                :: il_j2
+      INTEGER(i4)                                :: il_k1
+      INTEGER(i4)                                :: il_k2
+
+      INTEGER(i4), DIMENSION(4)                  :: il_shape
+      INTEGER(i4), DIMENSION(3)                  :: il_dim
+
+      INTEGER(i4), DIMENSION(:,:,:), ALLOCATABLE :: il_detect
+
+      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_dfdx
+      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_dfdy
+      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_dfdz
+      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_coef
+
+      LOGICAL                                    :: ll_iter
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      il_shape(:)=SHAPE(dd_value)
+
+      ALLOCATE( il_detect( il_shape(1), il_shape(2), il_shape(3)) )
+
+      SELECT CASE(TRIM(cd_method))
+      CASE('min_error')
+         DO jl=1,il_shape(4)
+
+            ! initialise table of point to be extrapolated
+            il_detect(:,:,:)=id_detect(:,:,:)
+
+            il_iter=1
+            DO WHILE( ANY(il_detect(:,:,:)==1) )
+               ! change extend value to minimize number of iteration
+               il_radius=id_radius+(il_iter-1)
+               ll_iter=.TRUE.
+
+               ALLOCATE( dl_dfdx(il_shape(1), il_shape(2), il_shape(3)) ) 
+               ALLOCATE( dl_dfdy(il_shape(1), il_shape(2), il_shape(3)) ) 
+               ALLOCATE( dl_dfdz(il_shape(1), il_shape(2), il_shape(3)) ) 
+
+               ! compute derivative in i-direction
+               dl_dfdx(:,:,:)=dd_fill
+               IF( il_shape(1) > 1 )THEN
+                  dl_dfdx(:,:,:)=math_deriv_3D( dd_value(:,:,:,jl), &
+                     &                          dd_fill, 'I' )
+               ENDIF
+
+               ! compute derivative in j-direction
+               dl_dfdy(:,:,:)=dd_fill
+               IF( il_shape(2) > 1 )THEN
+                  dl_dfdy(:,:,:)=math_deriv_3D( dd_value(:,:,:,jl), &
+                     &                          dd_fill, 'J' )
+               ENDIF
+ 
+               ! compute derivative in k-direction
+               dl_dfdz(:,:,:)=dd_fill
+               IF( il_shape(3) > 1 )THEN
+                  dl_dfdz(:,:,:)=math_deriv_3D( dd_value(:,:,:,jl), &
+                     &                          dd_fill, 'K' )
+               ENDIF
+ 
+               il_dim(1)=2*il_radius+1
+               IF( il_shape(1) < 2*il_radius+1 ) il_dim(1)=1
+               il_dim(2)=2*il_radius+1
+               IF( il_shape(2) < 2*il_radius+1 ) il_dim(2)=1
+               il_dim(3)=2*il_radius+1
+               IF( il_shape(3) < 2*il_radius+1 ) il_dim(3)=1
+
+               ALLOCATE( dl_coef(il_dim(1), il_dim(2), il_dim(3)) ) 
+
+               dl_coef(:,:,:)=extrap__3D_min_error_coef(dd_value( 1:il_dim(1), &
+               &                                                  1:il_dim(2), &
+               &                                                  1:il_dim(3), &
+               &                                                  jl ))
+
+               DO jk=1,il_shape(3)
+                  ! from North West(1,1) to South East(il_shape(1),il_shape(2))
+                  IF( ALL(il_detect(:,:,jk) == 0) ) CYCLE
+                  DO jj=1,il_shape(2)
+                     IF( ALL(il_detect(:,jj,jk) == 0) ) CYCLE
+                     DO ji=1,il_shape(1)
+
+                        IF( il_detect(ji,jj,jk) == 1 )THEN
+                          
+                           il_imin=MAX(ji-il_radius,1)
+                           il_imax=MIN(ji+il_radius,il_shape(1))
+                           ! coef indices to be used
+                           il_i1 = il_radius-(ji-il_imin)+1
+                           il_i2 = il_radius+(il_imax-ji)+1
+                           IF( il_dim(1) == 1 )THEN
+                              il_imin=ji
+                              il_imax=ji
+                              ! coef indices to be used
+                              il_i1 = 1
+                              il_i2 = 1
+                           ENDIF
+
+
+                           il_jmin=MAX(jj-il_radius,1)
+                           il_jmax=MIN(jj+il_radius,il_shape(2))
+                           ! coef indices to be used
+                           il_j1 = il_radius-(jj-il_jmin)+1
+                           il_j2 = il_radius+(il_jmax-jj)+1
+                           IF( il_dim(2) == 1 )THEN
+                              il_jmin=jj
+                              il_jmax=jj
+                              ! coef indices to be used
+                              il_j1 = 1
+                              il_j2 = 1
+                           ENDIF
+
+                           il_kmin=MAX(jk-il_radius,1)
+                           il_kmax=MIN(jk+il_radius,il_shape(3))
+                           ! coef indices to be used
+                           il_k1 = il_radius-(jk-il_kmin)+1
+                           il_k2 = il_radius+(il_kmax-jk)+1
+                           IF( il_dim(3) == 1 )THEN
+                              il_kmin=jk
+                              il_kmax=jk
+                              ! coef indices to be used
+                              il_k1 = 1
+                              il_k2 = 1
+                           ENDIF
+
+                           dd_value(ji,jj,jk,jl)=extrap__3D_min_error_fill( &
+                           &  dd_value( il_imin:il_imax, &
+                           &            il_jmin:il_jmax, &
+                           &            il_kmin:il_kmax,jl ), dd_fill, il_radius, &
+                           &  dl_dfdx(  il_imin:il_imax, &
+                           &            il_jmin:il_jmax, &
+                           &            il_kmin:il_kmax ), &
+                           &  dl_dfdy(  il_imin:il_imax, &
+                           &            il_jmin:il_jmax, &
+                           &            il_kmin:il_kmax ), &
+                           &  dl_dfdz(  il_imin:il_imax, &
+                           &            il_jmin:il_jmax, &
+                           &            il_kmin:il_kmax ), &
+                           &  dl_coef(il_i1:il_i2, &
+                           &          il_j1:il_j2, &
+                           &          il_k1:il_k2) )
+
+                           IF( dd_value(ji,jj,jk,jl) /= dd_fill )THEN
+                              il_detect(ji,jj,jk)= 0
+                              ll_iter=.FALSE.
+                           ENDIF
+
+                        ENDIF
+
+                     ENDDO
+                  ENDDO
+                  ! from South East(il_shape(1),il_shape(2)) to North West(1,1)
+                  IF( ALL(il_detect(:,:,jk) == 0) ) CYCLE
+                  DO jj=il_shape(2),1,-1
+                     IF( ALL(il_detect(:,jj,jk) == 0) ) CYCLE
+                     DO ji=il_shape(1),1,-1
+
+                        IF( il_detect(ji,jj,jk) == 1 )THEN
+                          
+                           il_imin=MAX(ji-il_radius,1)
+                           il_imax=MIN(ji+il_radius,il_shape(1))
+                           ! coef indices to be used
+                           il_i1 = il_radius-(ji-il_imin)+1
+                           il_i2 = il_radius+(il_imax-ji)+1
+                           IF( il_dim(1) == 1 )THEN
+                              il_imin=ji
+                              il_imax=ji
+                              ! coef indices to be used
+                              il_i1 = 1
+                              il_i2 = 1
+                           ENDIF
+
+
+                           il_jmin=MAX(jj-il_radius,1)
+                           il_jmax=MIN(jj+il_radius,il_shape(2))
+                           ! coef indices to be used
+                           il_j1 = il_radius-(jj-il_jmin)+1
+                           il_j2 = il_radius+(il_jmax-jj)+1
+                           IF( il_dim(2) == 1 )THEN
+                              il_jmin=jj
+                              il_jmax=jj
+                              ! coef indices to be used
+                              il_j1 = 1
+                              il_j2 = 1
+                           ENDIF
+
+                           il_kmin=MAX(jk-il_radius,1)
+                           il_kmax=MIN(jk+il_radius,il_shape(3))
+                           ! coef indices to be used
+                           il_k1 = il_radius-(jk-il_kmin)+1
+                           il_k2 = il_radius+(il_kmax-jk)+1
+                           IF( il_dim(3) == 1 )THEN
+                              il_kmin=jk
+                              il_kmax=jk
+                              ! coef indices to be used
+                              il_k1 = 1
+                              il_k2 = 1
+                           ENDIF
+
+                           dd_value(ji,jj,jk,jl)=extrap__3D_min_error_fill( &
+                           &  dd_value( il_imin:il_imax, &
+                           &            il_jmin:il_jmax, &
+                           &            il_kmin:il_kmax,jl ), dd_fill, il_radius, &
+                           &  dl_dfdx(  il_imin:il_imax, &
+                           &            il_jmin:il_jmax, &
+                           &            il_kmin:il_kmax ), &
+                           &  dl_dfdy(  il_imin:il_imax, &
+                           &            il_jmin:il_jmax, &
+                           &            il_kmin:il_kmax ), &
+                           &  dl_dfdz(  il_imin:il_imax, &
+                           &            il_jmin:il_jmax, &
+                           &            il_kmin:il_kmax ), &
+                           &  dl_coef(il_i1:il_i2, &
+                           &          il_j1:il_j2, &
+                           &          il_k1:il_k2) )
+
+                           IF( dd_value(ji,jj,jk,jl) /= dd_fill )THEN
+                              il_detect(ji,jj,jk)= 0
+                              ll_iter=.FALSE.
+                           ENDIF
+
+                        ENDIF
+
+                     ENDDO
+                  ENDDO
+               ENDDO
+
+               DEALLOCATE( dl_dfdx )
+               DEALLOCATE( dl_dfdy )
+               DEALLOCATE( dl_dfdz )
+               DEALLOCATE( dl_coef )
+
+               IF( ll_iter ) il_iter=il_iter+1
+            ENDDO
+         ENDDO
+
+      CASE DEFAULT ! 'dist_weight'
+         DO jl=1,il_shape(4)
+
+            ! intitialise table of poitn to be extrapolated
+            il_detect(:,:,:)=id_detect(:,:,:)
+
+            il_iter=1
+            DO WHILE( ANY(il_detect(:,:,:)==1) )
+               ! change extend value to minimize number of iteration
+               il_radius=id_radius+(il_iter-1)
+               ll_iter=.TRUE.
+
+               il_dim(1)=2*il_radius+1
+               IF( il_shape(1) < 2*il_radius+1 ) il_dim(1)=1
+               il_dim(2)=2*il_radius+1
+               IF( il_shape(2) < 2*il_radius+1 ) il_dim(2)=1
+               il_dim(3)=2*il_radius+1
+               IF( il_shape(3) < 2*il_radius+1 ) il_dim(3)=1
+               
+               ALLOCATE( dl_coef(il_dim(1), il_dim(2), il_dim(3)) )
+
+               dl_coef(:,:,:)=extrap__3D_dist_weight_coef(dd_value(1:il_dim(1),&
+               &                                                   1:il_dim(2),&
+               &                                                   1:il_dim(3),&
+               &                                                   jl ) )
+               
+               DO jk=1,il_shape(3)
+                  ! from North West(1,1) to South East(il_shape(1),il_shape(2))
+                  IF( ALL(il_detect(:,:,jk) == 0) ) CYCLE
+                  DO jj=1,il_shape(2)
+                     IF( ALL(il_detect(:,jj,jk) == 0) ) CYCLE
+                     DO ji=1,il_shape(1)
+
+                        IF( il_detect(ji,jj,jk) == 1 )THEN
+                           
+                           il_imin=MAX(ji-il_radius,1)
+                           il_imax=MIN(ji+il_radius,il_shape(1))
+                           ! coef indices to be used
+                           il_i1 = il_radius-(ji-il_imin)+1
+                           il_i2 = il_radius+(il_imax-ji)+1
+                           IF( il_dim(1) == 1 )THEN
+                              il_imin=ji
+                              il_imax=ji
+                              ! coef indices to be used
+                              il_i1 = 1
+                              il_i2 = 1
+                           ENDIF
+
+                           il_jmin=MAX(jj-il_radius,1)
+                           il_jmax=MIN(jj+il_radius,il_shape(2))
+                           ! coef indices to be used
+                           il_j1 = il_radius-(jj-il_jmin)+1
+                           il_j2 = il_radius+(il_jmax-jj)+1
+                           IF( il_dim(2) == 1 )THEN
+                              il_jmin=jj
+                              il_jmax=jj
+                              ! coef indices to be used
+                              il_j1 = 1
+                              il_j2 = 1
+                           ENDIF
+
+                           il_kmin=MAX(jk-il_radius,1)
+                           il_kmax=MIN(jk+il_radius,il_shape(3))
+                           ! coef indices to be used
+                           il_k1 = il_radius-(jk-il_kmin)+1
+                           il_k2 = il_radius+(il_kmax-jk)+1
+                           IF( il_dim(3) == 1 )THEN
+                              il_kmin=jk
+                              il_kmax=jk
+                              ! coef indices to be used
+                              il_k1 = 1
+                              il_k2 = 1
+                           ENDIF
+
+                           dd_value(ji,jj,jk,jl)=extrap__3D_dist_weight_fill( &
+                           &  dd_value( il_imin:il_imax, &
+                           &            il_jmin:il_jmax, &
+                           &            il_kmin:il_kmax, &
+                           &            jl), dd_fill, il_radius, &
+                           &  dl_coef(il_i1:il_i2, &
+                           &          il_j1:il_j2, &
+                           &          il_k1:il_k2) )
+
+                           IF( dd_value(ji,jj,jk,jl) /= dd_fill )THEN
+                              il_detect(ji,jj,jk)= 0
+                              ll_iter=.FALSE.
+                           ENDIF
+
+                        ENDIF
+
+                     ENDDO
+                  ENDDO
+                  ! from South East(il_shape(1),il_shape(2)) to North West(1,1)
+                  IF( ALL(il_detect(:,:,jk) == 0) ) CYCLE
+                  DO jj=il_shape(2),1,-1
+                     IF( ALL(il_detect(:,jj,jk) == 0) ) CYCLE
+                     DO ji=il_shape(1),1,-1
+
+                        IF( il_detect(ji,jj,jk) == 1 )THEN
+                           
+                           il_imin=MAX(ji-il_radius,1)
+                           il_imax=MIN(ji+il_radius,il_shape(1))
+                           ! coef indices to be used
+                           il_i1 = il_radius-(ji-il_imin)+1
+                           il_i2 = il_radius+(il_imax-ji)+1
+                           IF( il_dim(1) == 1 )THEN
+                              il_imin=ji
+                              il_imax=ji
+                              ! coef indices to be used
+                              il_i1 = 1
+                              il_i2 = 1
+                           ENDIF
+
+                           il_jmin=MAX(jj-il_radius,1)
+                           il_jmax=MIN(jj+il_radius,il_shape(2))
+                           ! coef indices to be used
+                           il_j1 = il_radius-(jj-il_jmin)+1
+                           il_j2 = il_radius+(il_jmax-jj)+1
+                           IF( il_dim(2) == 1 )THEN
+                              il_jmin=jj
+                              il_jmax=jj
+                              ! coef indices to be used
+                              il_j1 = 1
+                              il_j2 = 1
+                           ENDIF
+
+                           il_kmin=MAX(jk-il_radius,1)
+                           il_kmax=MIN(jk+il_radius,il_shape(3))
+                           ! coef indices to be used
+                           il_k1 = il_radius-(jk-il_kmin)+1
+                           il_k2 = il_radius+(il_kmax-jk)+1
+                           IF( il_dim(3) == 1 )THEN
+                              il_kmin=jk
+                              il_kmax=jk
+                              ! coef indices to be used
+                              il_k1 = 1
+                              il_k2 = 1
+                           ENDIF
+
+                           dd_value(ji,jj,jk,jl)=extrap__3D_dist_weight_fill( &
+                           &  dd_value( il_imin:il_imax, &
+                           &            il_jmin:il_jmax, &
+                           &            il_kmin:il_kmax, &
+                           &            jl), dd_fill, il_radius, &
+                           &  dl_coef(il_i1:il_i2, &
+                           &          il_j1:il_j2, &
+                           &          il_k1:il_k2) )
+
+                           IF( dd_value(ji,jj,jk,jl) /= dd_fill )THEN
+                              il_detect(ji,jj,jk)= 0
+                              ll_iter=.FALSE.
+                           ENDIF
+
+                        ENDIF
+
+                     ENDDO
+                  ENDDO
+               ENDDO
+               CALL logger_info(" EXTRAP 3D: "//&
+               &              TRIM(fct_str(SUM(il_detect(:,:,:))))//&
+               &              " point(s) to extrapolate " )
+            
+               DEALLOCATE( dl_coef )
+               IF( ll_iter ) il_iter=il_iter+1
+            ENDDO
+         ENDDO            
+      END SELECT
+
+      DEALLOCATE( il_detect )
+
+   END SUBROUTINE extrap__3D
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION extrap__3D_min_error_coef(dd_value) &
+         & RESULT (df_value)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function compute coefficient for min_error extrapolation.
+   !> 
+   !> @details 
+   !> coefficients are  "grid distance" to the center of the box 
+   !> choosed to compute extrapolation.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - decrease weight of third dimension
+   !>
+   !> @param[in] dd_value  3D array of variable to be extrapolated
+   !> @return 3D array of coefficient for minimum error extrapolation
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)   , DIMENSION(:,:,:), INTENT(IN) :: dd_value
+
+      ! function
+      REAL(dp), DIMENSION(SIZE(dd_value(:,:,:),DIM=1), &
+      &                   SIZE(dd_value(:,:,:),DIM=2), &
+      &                   SIZE(dd_value(:,:,:),DIM=3) ) :: df_value
+
+      ! local variable
+      INTEGER(i4), DIMENSION(3) :: il_shape
+
+      INTEGER(i4) :: il_imid
+      INTEGER(i4) :: il_jmid
+      INTEGER(i4) :: il_kmid
+
+      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_dist
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      ! init
+      df_value(:,:,:)=0
+
+      il_shape(:)=SHAPE(dd_value(:,:,:))
+
+      il_imid=INT(REAL(il_shape(1),sp)*0.5+1)
+      il_jmid=INT(REAL(il_shape(2),sp)*0.5+1)
+      il_kmid=INT(REAL(il_shape(3),sp)*0.5+1)
+
+      ALLOCATE( dl_dist(il_shape(1),il_shape(2),il_shape(3)) )
+
+      DO jk=1,il_shape(3)
+         DO jj=1,il_shape(2)
+            DO ji=1,il_shape(1)
+
+               ! compute distance
+               ! "vertical weight" is lower than horizontal 
+               dl_dist(ji,jj,jk) = (ji-il_imid)**2 + &
+               &                   (jj-il_jmid)**2 + &
+               &                 3*(jk-il_kmid)**2
+
+               IF( dl_dist(ji,jj,jk) /= 0 )THEN
+                  dl_dist(ji,jj,jk)=SQRT( dl_dist(ji,jj,jk) )
+               ENDIF
+
+            ENDDO
+         ENDDO
+      ENDDO
+
+      WHERE( dl_dist(:,:,:) /= 0 )
+         df_value(:,:,:)=dl_dist(:,:,:)
+      END WHERE
+
+      DEALLOCATE( dl_dist )
+
+   END FUNCTION extrap__3D_min_error_coef
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION extrap__3D_min_error_fill(dd_value, dd_fill, id_radius,&
+         &                                 dd_dfdx, dd_dfdy, dd_dfdz,   &
+         &                                 dd_coef) &
+         & RESULT (df_value)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function compute extrapolatd value by calculated minimum error using
+   !> taylor expansion
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] dd_value  3D array of variable to be extrapolated
+   !> @param[in] dd_fill   FillValue of variable
+   !> @param[in] id_radius radius of the halo used to compute extrapolation
+   !> @param[in] dd_dfdx   derivative of function in i-direction
+   !> @param[in] dd_dfdy   derivative of function in j-direction
+   !> @param[in] dd_dfdz   derivative of function in k-direction
+   !> @param[in] dd_coef   array of coefficient for min_error extrapolation 
+   !> @return extrapolatd value
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)   , DIMENSION(:,:,:), INTENT(IN) :: dd_value
+      REAL(dp)   ,                   INTENT(IN) :: dd_fill
+      INTEGER(i4),                   INTENT(IN) :: id_radius
+      REAL(dp)   , DIMENSION(:,:,:), INTENT(IN) :: dd_dfdx
+      REAL(dp)   , DIMENSION(:,:,:), INTENT(IN) :: dd_dfdy
+      REAL(dp)   , DIMENSION(:,:,:), INTENT(IN) :: dd_dfdz
+      REAL(dp)   , DIMENSION(:,:,:), INTENT(IN) :: dd_coef
+
+      ! function
+      REAL(dp)                                  :: df_value
+
+      ! local variable
+      INTEGER(i4), DIMENSION(3) :: il_shape
+      INTEGER(i4), DIMENSION(3) :: il_ind
+
+      INTEGER(i4), DIMENSION(:,:,:), ALLOCATABLE :: il_mask
+      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_error
+
+      INTEGER(i4) :: il_min
+      ! loop indices
+
+      !----------------------------------------------------------------
+
+      ! init
+      df_value=dd_fill
+
+      il_min=MAX(1,(SIZE(dd_value(:,:,:)))/(1+id_radius*2))
+
+      IF( COUNT(dd_value(:,:,:) /= dd_fill) >= il_min )THEN
+
+         il_shape(:)=SHAPE(dd_value(:,:,:))
+         ALLOCATE( il_mask( il_shape(1),il_shape(2),il_shape(3)) )
+         ALLOCATE( dl_error(il_shape(1),il_shape(2),il_shape(3)) )
+
+         ! compute error
+         dl_error(:,:,:)=0.
+         il_mask(:,:,:)=0
+         WHERE( dd_dfdx(:,:,:) /= dd_fill )
+            dl_error(:,:,:)=dd_coef(:,:,:)*dd_dfdx(:,:,:)
+            il_mask(:,:,:)=1
+         END WHERE
+         WHERE( dd_dfdy(:,:,:) /= dd_fill  )
+            dl_error(:,:,:)=(dl_error(:,:,:)+dd_coef(:,:,:)*dd_dfdy(:,:,:))
+            il_mask(:,:,:)=1
+         END WHERE
+         WHERE( dd_dfdz(:,:,:) /= dd_fill  )
+            dl_error(:,:,:)=(dl_error(:,:,:)+dd_coef(:,:,:)*dd_dfdz(:,:,:))
+            il_mask(:,:,:)=1
+         END WHERE
+
+         ! get minimum error indices
+         il_ind(:)=MINLOC(dl_error(:,:,:),il_mask(:,:,:)==1)
+
+         ! return value
+         IF( ALL(il_ind(:)/=0) )THEN
+            df_value=dd_value(il_ind(1),il_ind(2),il_ind(3))
+         ENDIF
+
+         DEALLOCATE( il_mask )
+         DEALLOCATE( dl_error )
+
+      ENDIF
+
+   END FUNCTION extrap__3D_min_error_fill
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION extrap__3D_dist_weight_coef(dd_value) &
+         & RESULT (df_value)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function compute coefficient for inverse distance weighted method 
+   !> 
+   !> @details 
+   !> coefficients are inverse "grid distance" to the center of the box choosed to compute
+   !> extrapolation.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - decrease weight of third dimension
+   !>
+   !> @param[in] dd_value  3D array of variable to be extrapolated
+   !> @return 3D array of coefficient for inverse distance weighted extrapolation
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp), DIMENSION(:,:,:), INTENT(IN) :: dd_value
+
+      ! function
+      REAL(dp), DIMENSION(SIZE(dd_value(:,:,:),DIM=1), &
+      &                   SIZE(dd_value(:,:,:),DIM=2), &
+      &                   SIZE(dd_value(:,:,:),DIM=3) ) :: df_value
+
+      ! local variable
+      INTEGER(i4), DIMENSION(3) :: il_shape
+
+      INTEGER(i4) :: il_imid
+      INTEGER(i4) :: il_jmid
+      INTEGER(i4) :: il_kmid
+
+      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_dist
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      ! init
+      df_value(:,:,:)=0
+
+      il_shape(:)=SHAPE(dd_value(:,:,:))
+
+      il_imid=INT(REAL(il_shape(1),sp)*0.5+1,i4)
+      il_jmid=INT(REAL(il_shape(2),sp)*0.5+1,i4)
+      il_kmid=INT(REAL(il_shape(3),sp)*0.5+1,i4)
+
+      ALLOCATE( dl_dist(il_shape(1),il_shape(2),il_shape(3)) )
+
+      DO jk=1,il_shape(3)
+         DO jj=1,il_shape(2)
+            DO ji=1,il_shape(1)
+
+               ! compute distance
+               ! "vertical weight" is lower than horizontal 
+               dl_dist(ji,jj,jk) = (ji-il_imid)**2 + &
+               &                   (jj-il_jmid)**2 + &
+               &                 3*(jk-il_kmid)**2
+
+               IF( dl_dist(ji,jj,jk) /= 0 )THEN
+                  dl_dist(ji,jj,jk)=SQRT( dl_dist(ji,jj,jk) )
+               ENDIF
+
+            ENDDO
+         ENDDO
+      ENDDO
+
+      WHERE( dl_dist(:,:,:) /= 0 ) 
+         df_value(:,:,:)=1./dl_dist(:,:,:)
+      END WHERE
+
+      DEALLOCATE( dl_dist )
+
+   END FUNCTION extrap__3D_dist_weight_coef
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION extrap__3D_dist_weight_fill(dd_value, dd_fill, id_radius, &
+         &                              dd_coef) &
+         &  RESULT (df_value)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function compute extrapolatd value using inverse distance weighted
+   !> method
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] dd_value  3D array of variable to be extrapolated
+   !> @param[in] dd_fill   FillValue of variable
+   !> @param[in] id_radius radius of the halo used to compute extrapolation
+   !> @param[in] dd_coef   3D array of coefficient for inverse distance weighted extrapolation 
+   !> @return extrapolatd value
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)   , DIMENSION(:,:,:), INTENT(IN) :: dd_value
+      REAL(dp)   ,                   INTENT(IN) :: dd_fill
+      INTEGER(i4),                   INTENT(IN) :: id_radius
+      REAL(dp)   , DIMENSION(:,:,:), INTENT(IN) :: dd_coef
+
+      ! function
+      REAL(dp)                                  :: df_value
+
+      ! local variable
+      INTEGER(i4), DIMENSION(3) :: il_shape
+
+      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_value
+      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_coef
+
+      INTEGER(i4) :: il_min
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      ! init
+      df_value=dd_fill
+
+      il_min=MAX(1,(SIZE(dd_value(:,:,:)))/(1+id_radius*2))
+
+      IF( COUNT(dd_value(:,:,:)/= dd_fill) >= il_min )THEN
+
+         il_shape(:)=SHAPE(dd_value(:,:,:))
+         ALLOCATE( dl_value( il_shape(1),il_shape(2),il_shape(3)) )
+         ALLOCATE( dl_coef( il_shape(1),il_shape(2),il_shape(3)) )
+
+         dl_value(:,:,:)=0
+         dl_coef(:,:,:)=0
+
+         DO jk=1,il_shape(3)
+            DO jj=1,il_shape(2)
+               DO ji=1,il_shape(1)
+
+                  IF( dd_value(ji,jj,jk) /= dd_fill )THEN
+                     ! compute factor
+                     dl_value(ji,jj,jk)=dd_coef(ji,jj,jk)*dd_value(ji,jj,jk)
+                     dl_coef(ji,jj,jk)=dd_coef(ji,jj,jk)
+                  ENDIF
+
+               ENDDO
+            ENDDO
+         ENDDO
+
+
+         ! return value
+         IF( SUM( dl_coef(:,:,:) ) /= 0 )THEN
+            df_value = SUM( dl_value(:,:,:) )/SUM( dl_coef(:,:,:) )
+         ENDIF
+
+         DEALLOCATE( dl_value )
+         DEALLOCATE( dl_coef )
+
+      ENDIF
+
+   END FUNCTION extrap__3D_dist_weight_fill
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE extrap_add_extrabands(td_var, id_isize, id_jsize)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine add to the variable (to be extrapolated) an 
+   !> extraband of N points at north,south,east and west boundaries.
+   !> 
+   !> @details
+   !> optionaly you could specify size of extra bands in i- and j-direction
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_var variable 
+   !> @param[in] id_isize  i-direction size of extra bands (default=im_minext)
+   !> @param[in] id_jsize  j-direction size of extra bands (default=im_minext)
+   !> @todo
+   !> - invalid special case for grid with north fold
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) , INTENT(INOUT)  :: td_var
+      INTEGER(i4), INTENT(IN   ), OPTIONAL :: id_isize
+      INTEGER(i4), INTENT(IN   ), OPTIONAL :: id_jsize
+
+      ! local variable
+      REAL(dp), DIMENSION(:,:,:,:) , ALLOCATABLE :: dl_value
+
+      INTEGER(i4) :: il_isize
+      INTEGER(i4) :: il_jsize
+      INTEGER(i4) :: il_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: ij
+      !----------------------------------------------------------------
+      il_isize=im_minext
+      IF(PRESENT(id_isize)) il_isize=id_isize
+      IF( il_isize < im_minext .AND. &
+      &   TRIM(td_var%c_interp(1)) == 'cubic' )THEN
+         CALL logger_warn("EXTRAP ADD EXTRABANDS: size of extrabands "//&
+         &  "should be at least "//TRIM(fct_str(im_minext))//" for "//&
+         &  " cubic interpolation ")
+      ENDIF
+
+      il_jsize=im_minext
+      IF(PRESENT(id_jsize)) il_jsize=id_jsize
+      IF( il_jsize < im_minext .AND. &
+      &   TRIM(td_var%c_interp(1)) == 'cubic' )THEN
+         CALL logger_warn("EXTRAP ADD EXTRABANDS: size of extrabands "//&
+         &  "should be at least "//TRIM(fct_str(im_minext))//" for "//&
+         &  " cubic interpolation ")
+      ENDIF
+
+      IF( .NOT. td_var%t_dim(1)%l_use ) il_isize=0
+      IF( .NOT. td_var%t_dim(2)%l_use ) il_jsize=0
+
+      CALL logger_trace( "EXTRAP ADD EXTRABANDS: dimension change "//&
+      &              "in variable "//TRIM(td_var%c_name) )
+
+      ! add extrabands in variable
+      ALLOCATE(dl_value( td_var%t_dim(1)%i_len, &
+      &                  td_var%t_dim(2)%i_len, &
+      &                  td_var%t_dim(3)%i_len, &
+      &                  td_var%t_dim(4)%i_len ))
+
+      dl_value(:,:,:,:)=td_var%d_value(:,:,:,:)
+
+
+      td_var%t_dim(1)%i_len = td_var%t_dim(1)%i_len + 2*il_isize
+      td_var%t_dim(2)%i_len = td_var%t_dim(2)%i_len + 2*il_jsize
+
+      DEALLOCATE(td_var%d_value)
+      ALLOCATE( td_var%d_value(td_var%t_dim(1)%i_len, &
+      &                        td_var%t_dim(2)%i_len, &
+      &                        td_var%t_dim(3)%i_len, &
+      &                        td_var%t_dim(4)%i_len ) )
+
+      ! intialise
+      td_var%d_value(:,:,:,:)=td_var%d_fill
+
+      ! fill center
+      td_var%d_value( 1+il_isize:td_var%t_dim(1)%i_len-il_isize, &
+      &               1+il_jsize:td_var%t_dim(2)%i_len-il_jsize, &
+      &                :,:) = dl_value(:,:,:,:)
+
+      ! special case for overlap
+      IF( td_var%i_ew >= 0 .AND. il_isize /= 0 )THEN
+         DO ji=1,il_isize
+            ! from east to west
+            il_tmp=td_var%t_dim(1)%i_len-td_var%i_ew+ji-2*il_isize
+            td_var%d_value(ji,:,:,:) = td_var%d_value(il_tmp,:,:,:)
+
+            ! from west to east
+            ij=td_var%t_dim(1)%i_len-ji+1
+            il_tmp=td_var%i_ew-ji+2*il_isize+1
+            td_var%d_value(ij,:,:,:) = td_var%d_value(il_tmp,:,:,:)
+         ENDDO
+      ENDIF
+
+      DEALLOCATE( dl_value )
+
+   END SUBROUTINE extrap_add_extrabands
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE extrap_del_extrabands(td_var, id_isize, id_jsize)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine remove of the variable an extraband 
+   !> of N points at north,south,east and west boundaries.
+   !> 
+   !> @details
+   !> optionaly you could specify size of extra bands in i- and j-direction
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_var variable 
+   !> @param[in] id_isize  i-direction size of extra bands (default=im_minext)
+   !> @param[in] id_jsize  j-direction size of extra bands (default=im_minext)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) , INTENT(INOUT) :: td_var
+      INTEGER(i4), INTENT(IN   ), OPTIONAL :: id_isize
+      INTEGER(i4), INTENT(IN   ), OPTIONAL :: id_jsize
+
+      ! local variable
+      REAL(dp), DIMENSION(:,:,:,:) , ALLOCATABLE :: dl_value
+
+      INTEGER(i4) :: il_isize
+      INTEGER(i4) :: il_jsize
+ 
+      INTEGER(i4) :: il_imin
+      INTEGER(i4) :: il_imax
+      INTEGER(i4) :: il_jmin
+      INTEGER(i4) :: il_jmax
+
+      ! loop indices
+      !----------------------------------------------------------------
+      il_isize=im_minext
+      IF(PRESENT(id_isize)) il_isize=id_isize
+
+      il_jsize=im_minext
+      IF(PRESENT(id_jsize)) il_jsize=id_jsize
+
+      IF( .NOT. td_var%t_dim(1)%l_use ) il_isize=0
+      IF( .NOT. td_var%t_dim(2)%l_use ) il_jsize=0
+
+      CALL logger_trace( "EXTRAP DEL EXTRABANDS: dimension change "//&
+      &              "in variable "//TRIM(td_var%c_name) )
+
+      ! add extrabands in variable
+      ALLOCATE(dl_value( td_var%t_dim(1)%i_len, &
+      &                  td_var%t_dim(2)%i_len, &
+      &                  td_var%t_dim(3)%i_len, &
+      &                  td_var%t_dim(4)%i_len ))
+
+      dl_value(:,:,:,:)=td_var%d_value(:,:,:,:)
+
+      ! fill center
+      il_imin=1+il_isize
+      il_imax=td_var%t_dim(1)%i_len-il_isize
+
+      il_jmin=1+il_jsize
+      il_jmax=td_var%t_dim(2)%i_len-il_jsize
+      
+      td_var%t_dim(1)%i_len = td_var%t_dim(1)%i_len - 2*il_isize
+      td_var%t_dim(2)%i_len = td_var%t_dim(2)%i_len - 2*il_jsize
+
+      DEALLOCATE(td_var%d_value)
+      ALLOCATE( td_var%d_value(td_var%t_dim(1)%i_len, &
+      &                        td_var%t_dim(2)%i_len, &
+      &                        td_var%t_dim(3)%i_len, &
+      &                        td_var%t_dim(4)%i_len ) )
+
+      ! intialise
+      td_var%d_value(:,:,:,:)=td_var%d_fill
+
+      td_var%d_value(:,:,:,:)=dl_value(il_imin:il_imax,&
+      &                                il_jmin:il_jmax,&
+      &                                :,:)
+
+      DEALLOCATE( dl_value )
+
+   END SUBROUTINE extrap_del_extrabands
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE extrap
Index: /utils/tools_ticket2413/SIREN/src/file.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/file.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/file.f90	(revision 12863)
@@ -0,0 +1,2270 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+!> @brief 
+!> This module manage file structure.
+!>
+!> @details
+!>    define type TFILE:<br/>
+!> @code
+!>    TYPE(TFILE) :: tl_file
+!> @endcode
+!>
+!>    to initialize a file structure:<br/>
+!> @code
+!>    tl_file=file_init(cd_file [,cd_type] [,ld_wrt] [,cd_grid])
+!%    tl_file=file_init(cd_file [,cd_type] [,ld_wrt] [,id_ew] [,id_perio] [,id_pivot] [,cd_grid])
+!> @endcode
+!>       - cd_file is the file name
+!>       - cd_type is the type of the file ('cdf', 'dimg') [optional]
+!>       - ld_wrt  file in write mode or not [optional]
+!%       - id_ew is the number of point for east-west overlap [optional]
+!%       - id_perio is the NEMO periodicity index [optional]
+!%       - id_pivot is the NEMO pivot point index F(0),T(1) [optional]
+!>       - cd_grid is the grid type (default 'ARAKAWA-C')
+!>
+!>    to get file name:<br/>
+!>    - tl_file\%c_name
+!>
+!>    to get file id (units):<br/>
+!>    - tl_file\%i_id
+!>    
+!>    to get the type of the file (cdf, cdf4, dimg):<br/>
+!>    - tl_file\%c_type
+!> 
+!>    to know if file was open in write mode:<br/>
+!>    - tl_file\%l_wrt
+!>
+!>    to get the record length of the file:<br/>
+!>    - tl_file\%i_recl
+!>
+!>    Files variables<br/>
+!>    to get the number of variable in the file:<br/>
+!>    - tl_file\%i_nvar
+!>
+!>    to get the array of variable structure associated to the file:<br/>
+!>    - tl_file\%t_var(:)
+!>
+!>    Files attributes<br/>
+!>    to get the nmber of global attributes of the file:<br/>
+!>    - tl_file\%i_natt
+!>
+!>    to get the array of attributes structure associated to the file:<br/>
+!>    - tl_file\%t_att(:)
+!>
+!>    Files dimensions<br/>
+!>    to get the number of dimension used in the file:<br/>
+!>    - tl_file\%i_ndim
+!>
+!>    to get the array of dimension structure (4 elts) associated to the
+!>    file:<br/>
+!>    - tl_file\%t_dim(:)
+!>
+!>    to print information about file structure:<br/>
+!> @code
+!>    CALL file_print(td_file)
+!> @endcode
+!>
+!>    to clean file structure:<br/>
+!> @code
+!>    CALL file_clean(td_file)
+!> @endcode
+!>
+!>    to add a global attribute structure in file structure:<br/>
+!> @code
+!>    CALL file_add_att(td_file, td_att)
+!> @endcode
+!>       - td_att is an attribute structure
+!>
+!>    to add a dimension structure in file structure:<br/>
+!> @code
+!>    CALL file_add_dim(td_file, td_dim)
+!> @endcode
+!>       - td_dim is a dimension structure
+!>
+!>    to add a variable structure in file structure:<br/>
+!> @code
+!>    CALL file_add_var(td_file, td_var)
+!> @endcode
+!>       - td_var is a variable structure
+!>
+!>    to delete a global attribute structure in file structure:<br/>
+!> @code
+!>    CALL file_del_att(td_file, td_att)
+!> @endcode
+!>       - td_att is an attribute structure
+!>
+!>    to delete a dimension structure in file structure:<br/>
+!> @code
+!>    CALL file_del_dim(td_file, td_dim)
+!> @endcode
+!>       - td_dim is a dimension structure
+!>
+!>    to delete a variable structure in file structure:<br/>
+!> @code
+!>    CALL file_del_var(td_file, td_var)
+!> @endcode
+!>       - td_var is a variable structure
+!>
+!>    to overwrite one attribute structure in file structure:<br/>
+!> @code
+!>    CALL file_move_att(td_file, td_att)
+!> @endcode
+!>       - td_att is an attribute structure
+!>
+!>    to  overwrite one dimension strucutre in file structure:<br/>
+!> @code
+!>    CALL file_move_dim(td_file, td_dim)
+!> @endcode
+!>       - td_dim is a dimension structure
+!>
+!>    to overwrite one variable  structure in file structure:<br/>
+!> @code
+!>    CALL file_move_var(td_file, td_var)
+!> @endcode
+!>       - td_var is a variable structure
+!> 
+!>    to check if file and variable structure share same dimension:<br/>
+!> @code
+!>    ll_check_dim = file_check_var_dim(td_file, td_var)
+!> @endcode
+!>       - td_var is a variable structure
+!>
+!> @author
+!> J.Paul
+!>
+!> @date November, 2013 - Initial Version
+!> @date November, 2014 
+!> - Fix memory leaks bug
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE file
+
+   USE kind                            ! F90 kind parameter
+   USE global                          ! global variable
+   USE fct                             ! basic useful function
+   USE logger                          ! log file manager
+   USE dim                             ! dimension manager
+   USE att                             ! attribute manager
+   USE var                             ! variable manager
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   PUBLIC :: TFILE   !< file structure
+
+   ! function and subroutine
+   PUBLIC :: file_copy           !< copy file structure
+   PUBLIC :: file_print          !< print information about file structure
+   PUBLIC :: file_clean          !< clean file structure
+   PUBLIC :: file_init           !< initialize file structure
+   PUBLIC :: file_add_att        !< add one attribute structure in file structure
+   PUBLIC :: file_add_var        !< add one variable  structure in file structure
+   PUBLIC :: file_add_dim        !< add one dimension strucutre in file structure
+   PUBLIC :: file_del_att        !< delete one attribute structure of file structure
+   PUBLIC :: file_del_var        !< delete one variable  structure of file structure
+   PUBLIC :: file_del_dim        !< delete one dimension strucutre of file structure
+   PUBLIC :: file_move_att       !< overwrite one attribute structure in file structure
+   PUBLIC :: file_move_var       !< overwrite one variable  structure in file structure
+   PUBLIC :: file_move_dim       !< overwrite one dimension strucutre in file structure
+   PUBLIC :: file_check_var_dim  !< check if file and variable structure use same dimension.
+   PUBLIC :: file_get_type       !< get type of file
+   PUBLIC :: file_get_id         !< get file id
+   PUBLIC :: file_rename         !< rename file name
+   PUBLIC :: file_add_suffix     !< add suffix to file name
+ 
+   PRIVATE :: file__clean_unit    ! clean file structure
+   PRIVATE :: file__clean_arr     ! clean array of file structure
+   PRIVATE :: file__del_var_name ! delete a variable structure in file structure, given variable name or standard name
+   PRIVATE :: file__del_var_str  ! delete a variable structure in file structure, given variable structure
+   PRIVATE :: file__del_att_name ! delete a attribute structure in file structure, given attribute name
+   PRIVATE :: file__del_att_str  ! delete a attribute structure in file structure, given attribute structure
+   PRIVATE :: file__get_number   ! get number in file name without suffix
+   PRIVATE :: file__get_suffix   ! get suffix of file name
+   PRIVATE :: file__copy_unit    ! copy file structure
+   PRIVATE :: file__copy_arr     ! copy array of file structure
+   PRIVATE :: file__rename_char  ! rename file name, given processor number.
+   PRIVATE :: file__rename_str   ! rename file name, given file structure.
+
+   TYPE TFILE !< file structure
+
+      ! general 
+      CHARACTER(LEN=lc)                 :: c_name = ""       !< file name
+      CHARACTER(LEN=lc)                 :: c_type = ""       !< type of the file (cdf, cdf4, dimg)
+      INTEGER(i4)                       :: i_id   = 0        !< file id
+      LOGICAL                           :: l_wrt  = .FALSE.  !< read or write mode
+      INTEGER(i4)                       :: i_nvar = 0        !< number of variable
+      TYPE(TVAR), DIMENSION(:), POINTER :: t_var  => NULL()  !< file variables
+
+      CHARACTER(LEN=lc)                 :: c_grid = 'ARAKAWA-C' !< grid type
+
+      INTEGER(i4)                       :: i_ew    =-1       !< east-west overlap
+      INTEGER(i4)                       :: i_perio =-1       !< NEMO periodicity index
+      INTEGER(i4)                       :: i_pivot =-1       !< NEMO pivot point index F(0),T(1)
+
+      INTEGER(i4)                       :: i_depthid = 0     !< variable id of depth
+      INTEGER(i4)                       :: i_timeid  = 0     !< variable id of time
+
+      ! netcdf file
+      INTEGER(i4)                       :: i_ndim  = 0       !< number of dimensions used in the file
+      INTEGER(i4)                       :: i_natt  = 0       !< number of global attributes in the file
+      INTEGER(i4)                       :: i_uldid = 0       !< id of the unlimited dimension in the file
+      LOGICAL                           :: l_def   = .FALSE. !< define mode or not
+      TYPE(TATT), DIMENSION(:), POINTER :: t_att   => NULL() !< global attributes
+      TYPE(TDIM), DIMENSION(ip_maxdim)  :: t_dim             !< dimension structure
+      
+      ! dimg file
+      INTEGER(i4)                       :: i_recl = 0        !< record length (binary file)
+      INTEGER(i4)                       :: i_n0d  = 0        !< number of scalar variable
+      INTEGER(i4)                       :: i_n1d  = 0        !< number of 1D variable
+      INTEGER(i4)                       :: i_n2d  = 0        !< number of 2D variable
+      INTEGER(i4)                       :: i_n3d  = 0        !< number of 3D variable
+      INTEGER(i4)                       :: i_rhd  = 0        !< record of the header infos (last record)
+
+      ! mpp
+      ! only use for massively parallel processing
+      INTEGER(i4)                       :: i_pid  = -1       !< processor id (start to 1)
+      INTEGER(i4)                       :: i_impp = 0        !< i-indexes for mpp-subdomain left bottom
+      INTEGER(i4)                       :: i_jmpp = 0        !< j-indexes for mpp-subdomain left bottom
+      INTEGER(i4)                       :: i_lci  = 0        !< i-dimensions of subdomain
+      INTEGER(i4)                       :: i_lcj  = 0        !< j-dimensions of subdomain
+      INTEGER(i4)                       :: i_ldi  = 0        !< first indoor i-indices
+      INTEGER(i4)                       :: i_ldj  = 0        !< first indoor j-indices
+      INTEGER(i4)                       :: i_lei  = 0        !< last  indoor i-indices
+      INTEGER(i4)                       :: i_lej  = 0        !< last  indoor j-indices
+
+      LOGICAL                           :: l_ctr  = .FALSE.  !< domain is on border
+      LOGICAL                           :: l_use  = .FALSE.  !< domain is used
+
+      ! only use to draw domain decomposition when initialize with mpp_init
+      INTEGER(i4)                       :: i_iind = 0        !< i-direction indices
+      INTEGER(i4)                       :: i_jind = 0        !< j-direction indices
+
+   END TYPE TFILE
+
+   INTERFACE file_clean
+      MODULE PROCEDURE file__clean_unit
+      MODULE PROCEDURE file__clean_arr
+   END INTERFACE file_clean
+
+   INTERFACE file_del_var
+      MODULE PROCEDURE file__del_var_name
+      MODULE PROCEDURE file__del_var_str
+   END INTERFACE file_del_var
+
+   INTERFACE file_del_att
+      MODULE PROCEDURE file__del_att_name
+      MODULE PROCEDURE file__del_att_str
+   END INTERFACE file_del_att
+   
+   INTERFACE file_rename
+      MODULE PROCEDURE file__rename_char
+      MODULE PROCEDURE file__rename_str
+   END INTERFACE file_rename
+
+    INTERFACE file_copy
+      MODULE PROCEDURE file__copy_unit   
+      MODULE PROCEDURE file__copy_arr    
+   END INTERFACE
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION file__copy_unit(td_file) &
+         & RESULT (tf_file)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy file structure in another one
+   !> @details 
+   !> file variable and attribute value are copied in a temporary array, 
+   !> so input and output file structure value do not point on the same 
+   !> "memory cell", and so on are independant. 
+   !>
+   !> @note new file is assume to be closed.
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> structure (ex: tl_file=file_copy(file_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>   
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2014
+   !> - use function instead of overload assignment operator 
+   !> (to avoid memory leak)
+   !> @date January, 2019
+   !> - clean variable structure
+   !> 
+   !> @param[in] td_file  file structure
+   !> @return copy of input file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TFILE), INTENT(IN) :: td_file
+
+      ! function
+      TYPE(TFILE)             :: tf_file
+
+      ! local variable
+      TYPE(TVAR) :: tl_var
+      TYPE(TATT) :: tl_att
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      CALL logger_trace("FILE COPY: file "//TRIM(td_file%c_name) )
+
+      ! copy file variable
+      tf_file%c_name = TRIM(td_file%c_name)
+      tf_file%c_type = TRIM(td_file%c_type)
+      ! file1 should be closed even if file2 is opened right now
+      tf_file%i_id   = 0
+      tf_file%l_wrt  = td_file%l_wrt
+      tf_file%i_nvar = td_file%i_nvar
+
+      tf_file%c_grid = td_file%c_grid
+
+      tf_file%i_ew   = td_file%i_ew
+      tf_file%i_perio= td_file%i_perio
+      tf_file%i_pivot= td_file%i_pivot
+
+      tf_file%i_depthid = td_file%i_depthid
+      tf_file%i_timeid  = td_file%i_timeid
+
+      ! copy variable structure
+      IF( ASSOCIATED(tf_file%t_var) )THEN
+         CALL var_clean(tf_file%t_var(:))
+         DEALLOCATE(tf_file%t_var)
+      ENDIF
+      IF( ASSOCIATED(td_file%t_var) .AND. tf_file%i_nvar > 0 )THEN
+         ALLOCATE( tf_file%t_var(tf_file%i_nvar) )
+         DO ji=1,tf_file%i_nvar
+            tl_var = var_copy(td_file%t_var(ji))
+            tf_file%t_var(ji) = var_copy(tl_var)
+            ! clean
+            CALL var_clean(tl_var)
+         ENDDO
+      ENDIF
+      
+      ! copy netcdf variable
+      tf_file%i_ndim   = td_file%i_ndim
+      tf_file%i_natt   = td_file%i_natt
+      tf_file%i_uldid  = td_file%i_uldid
+      tf_file%l_def    = td_file%l_def
+
+      ! copy dimension
+      tf_file%t_dim(:) = dim_copy(td_file%t_dim(:))
+      
+      ! copy attribute structure
+      IF( ASSOCIATED(tf_file%t_att) )THEN
+         CALL att_clean(tf_file%t_att(:))
+         DEALLOCATE(tf_file%t_att)
+      ENDIF
+      IF( ASSOCIATED(td_file%t_att) .AND. tf_file%i_natt > 0 )THEN
+         ALLOCATE( tf_file%t_att(tf_file%i_natt) )
+         DO ji=1,tf_file%i_natt
+            tl_att = att_copy(td_file%t_att(ji))
+            tf_file%t_att(ji) = att_copy(tl_att)
+         ENDDO
+      ENDIF
+
+      ! clean
+      CALL att_clean(tl_att)
+
+      ! copy dimg variable
+      tf_file%i_recl = td_file%i_recl
+      tf_file%i_n0d  = td_file%i_n0d
+      tf_file%i_n1d  = td_file%i_n1d
+      tf_file%i_n2d  = td_file%i_n2d
+      tf_file%i_n3d  = td_file%i_n3d 
+      tf_file%i_rhd  = td_file%i_rhd
+      
+      ! copy mpp variable
+      tf_file%i_pid  = td_file%i_pid
+      tf_file%i_impp = td_file%i_impp
+      tf_file%i_jmpp = td_file%i_jmpp
+      tf_file%i_lci  = td_file%i_lci
+      tf_file%i_lcj  = td_file%i_lcj
+      tf_file%i_ldi  = td_file%i_ldi
+      tf_file%i_ldj  = td_file%i_ldj
+      tf_file%i_lei  = td_file%i_lei
+      tf_file%i_lej  = td_file%i_lej
+      tf_file%l_ctr  = td_file%l_ctr
+      tf_file%l_use  = td_file%l_use
+      tf_file%i_iind = td_file%i_iind
+      tf_file%i_jind = td_file%i_jind
+
+   END FUNCTION file__copy_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION file__copy_arr(td_file) &
+         & RESULT (tf_file)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy a array of file structure in another one
+   !> @details 
+   !> file variable and attribute value are copied in a temporary array, 
+   !> so input and output file structure value do not point on the same 
+   !> "memory cell", and so on are independant. 
+   !>
+   !> @note new file is assume to be closed.
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> structure (ex: tl_file=file_copy(file_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>   
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2014
+   !> - use function instead of overload assignment operator 
+   !> (to avoid memory leak)
+   !>
+   !> @param[in] td_file  file structure
+   !> @return copy of input array of file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TFILE), DIMENSION(:), INTENT(IN   ) :: td_file
+
+      ! function
+      TYPE(TFILE), DIMENSION(SIZE(td_file(:))) :: tf_file
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=1,SIZE(td_file(:))
+         tf_file(ji)=file_copy(td_file(ji))
+      ENDDO
+
+   END FUNCTION file__copy_arr
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION file_init(cd_file, cd_type, ld_wrt, &
+         &                        id_ew, id_perio, id_pivot,&
+         &                        cd_grid) &
+         & RESULT (tf_file)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize file structure.<br/> 
+   !> @details
+   !> If cd_type is not specify, check if file name include '.nc' or
+   !> '.dimg'<br/>
+   !> Optionally, you could specify:<br/>
+   !> - write mode (default .FALSE., ld_wrt)
+   !> - East-West overlap (id_ew)
+   !> - NEMO periodicity index (id_perio)
+   !> - NEMO pivot point index F(0),T(1) (id_pivot)
+   !> - grid type (default: 'ARAKAWA-C')
+   !>
+   !> @details
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] cd_file   file name
+   !> @param[in] cd_type   file type ('cdf', 'dimg')
+   !> @param[in] ld_wrt    write mode (default .FALSE.)
+   !> @param[in] id_ew     east-west overlap
+   !> @param[in] id_perio  NEMO periodicity index
+   !> @param[in] id_pivot  NEMO pivot point index F(0),T(1)
+   !> @param[in] cd_grid   grid type (default 'ARAKAWA-C')
+   !> @return file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_file
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_type
+      LOGICAL         , INTENT(IN), OPTIONAL :: ld_wrt
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_ew
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_perio
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_pivot
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_grid
+
+      ! function
+      TYPE(TFILE)                  :: tf_file
+
+      ! local variable
+      TYPE(TATT)  :: tl_att
+      !----------------------------------------------------------------
+
+      ! clean file
+      CALL file_clean(tf_file)
+
+      tf_file%c_name=TRIM(ADJUSTL(cd_file))
+      CALL logger_trace("FILE INIT: initialize file "//TRIM(tf_file%c_name))
+
+      ! check type
+      IF( PRESENT(cd_type) )THEN
+         SELECT CASE(TRIM(cd_type))
+            CASE('cdf')
+               tf_file%c_type='cdf'
+            CASE('dimg')
+               tf_file%c_type='dimg'
+            CASE DEFAULT
+               CALL logger_error( " FILE INIT: can't initialize file "//&
+               &               TRIM(tf_file%c_name)//" : type unknown " )
+         END SELECT
+      ELSE
+         CALL logger_debug("FILE INIT: look for file type "//TRIM(tf_file%c_name))
+         tf_file%c_type=TRIM(file_get_type(cd_file))
+      ENDIF
+
+      ! create some global attribute
+      IF( TRIM(tf_file%c_type) == 'cdf' )THEN
+         tl_att=att_init("Conventions","CF-1.5")
+         CALL file_add_att(tf_file,tl_att)
+      ENDIF
+     
+      tl_att=att_init("Grid",TRIM(tf_file%c_grid))
+      CALL file_add_att(tf_file,tl_att)
+
+      IF( PRESENT(ld_wrt) )THEN
+         tf_file%l_wrt=ld_wrt
+      ENDIF
+
+      IF( PRESENT(id_ew) )THEN
+         tf_file%i_ew=id_ew
+         IF( id_ew >= 0 )THEN
+            tl_att=att_init('ew_overlap',id_ew)
+            CALL file_move_att(tf_file, tl_att)
+         ENDIF
+      ENDIF
+
+      IF( PRESENT(id_perio) )THEN
+         tf_file%i_perio=id_perio
+         IF( id_perio >= 0 )THEN
+            tl_att=att_init('periodicity',id_perio)
+            CALL file_move_att(tf_file, tl_att)
+         ENDIF
+      ENDIF
+
+      IF( PRESENT(id_pivot) )THEN
+         tf_file%i_pivot=id_pivot
+         IF( id_pivot > 0 )THEN
+            tl_att=att_init('pivot_point',id_pivot)
+            CALL file_move_att(tf_file, tl_att)
+         ENDIF
+      ENDIF
+
+      IF( PRESENT(cd_grid) )THEN
+         tf_file%c_grid=cd_grid
+      ENDIF
+
+      ! clean
+      CALL att_clean(tl_att)
+
+   END FUNCTION file_init
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION file_get_type(cd_file) &
+         & RESULT (cf_type)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This function get type of file, given file name.
+   !> @details
+   !> Actually it get suffix of the file name, and compare it to 'nc', 'cdf' or
+   !> 'dimg'<br/>
+   !> If no suffix or suffix not identify, we assume file is dimg
+   !
+   !> @details
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2019
+   !> - netcdf4 files identify as netcdf file 
+   !>
+   !> @param[in] cd_file   file name
+   !> @return type of file
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_file
+
+      ! function
+      CHARACTER(LEN=lc)            :: cf_type
+
+      !local variable
+      CHARACTER(LEN=lc) :: cl_suffix
+      !----------------------------------------------------------------
+
+      cl_suffix=file__get_suffix(cd_file)
+      SELECT CASE( TRIM(fct_lower(cl_suffix)) )
+         CASE('.nc','.cdf','.nc4')
+            CALL logger_debug(" FILE GET TYPE: file "//TRIM(cd_file)//" is cdf")
+            ! Warning : type could be change to cdf4 when opening file.
+            cf_type='cdf'
+         CASE('.dimg')
+            CALL logger_debug(" FILE GET TYPE: file "//TRIM(cd_file)//" is dimg" )
+            cf_type='dimg'
+         CASE DEFAULT
+            CALL logger_warn(" FILE GET TYPE: type unknown, we assume file: "//&
+            &              TRIM(cd_file)//" is dimg ")
+            cf_type='dimg'
+      END SELECT
+
+   END FUNCTION file_get_type
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION file_check_var_dim(td_file, td_var, ld_chklen) &
+         & RESULT (lf_dim)
+   !-------------------------------------------------------------------
+   !> @brief This function check that variable dimension to be used 
+   !> of both variable and file structure are convenient (axis, length).
+   !
+   !> @details
+   !> optionaly you could choose to not check length
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2017
+   !> - add option to not check dimension length
+   !
+   !> @param[in] td_file   file structure
+   !> @param[in] td_var    variable structure
+   !> @param[in] ld_chklen check length
+   !> @return true if dimension of variable and file structure agree
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(IN) :: td_file
+      TYPE(TVAR),  INTENT(IN) :: td_var
+      LOGICAL,     INTENT(IN), OPTIONAL :: ld_chklen
+
+      ! function
+      LOGICAL                 :: lf_dim
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_dim
+      LOGICAL           :: ll_error
+      LOGICAL           :: ll_warn 
+      LOGICAL           :: ll_chklen
+      LOGICAL           :: ll_use
+      LOGICAL           :: ll_len
+
+      INTEGER(i4)       :: il_ind
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      lf_dim=.TRUE.
+
+      CALL logger_debug( " FILE CHECK VAR DIM: check: "//TRIM(td_var%c_name) )
+      ! check dimension length
+      ll_chklen=.TRUE.
+      IF( PRESENT(ld_chklen) ) ll_chklen=ld_chklen
+
+      ! check used dimension 
+      ll_error=.FALSE.
+      ll_warn=.FALSE.
+      DO ji=1,ip_maxdim
+         il_ind=dim_get_index( td_file%t_dim(:), &
+         &                     TRIM(td_var%t_dim(ji)%c_name), &
+         &                     TRIM(td_var%t_dim(ji)%c_sname))
+
+         IF( il_ind /= 0 )THEN
+            ll_use=(td_var%t_dim(ji)%l_use .AND. td_file%t_dim(il_ind)%l_use)
+
+            ll_len=.TRUE.
+            IF( ll_chklen )THEN
+               ! check dimension length
+               ll_len=(td_var%t_dim(ji)%i_len == td_file%t_dim(il_ind)%i_len)
+            ENDIF
+            IF( ll_use .AND. .NOT. ll_len )THEN
+               IF( INDEX( TRIM(td_var%c_axis), &
+               &          TRIM(fct_upper(td_var%t_dim(ji)%c_name))) == 0 )THEN
+                  ll_warn=.TRUE.
+               ELSE
+                  ll_error=.TRUE.
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDDO
+
+      IF( ll_error )THEN
+
+         cl_dim='(/'
+         DO ji = 1, td_file%i_ndim
+            IF( td_file%t_dim(ji)%l_use )THEN
+               cl_dim=TRIM(cl_dim)//&
+               &  TRIM(fct_upper(td_file%t_dim(ji)%c_sname))//':'//&
+               &  TRIM(fct_str(td_file%t_dim(ji)%i_len))//','
+            ENDIF
+         ENDDO
+         cl_dim=TRIM(cl_dim)//'/)'
+         CALL logger_debug( " file dimension: "//TRIM(cl_dim) )
+
+         cl_dim='(/'
+         DO ji = 1, td_var%i_ndim
+            IF( td_var%t_dim(ji)%l_use )THEN
+               cl_dim=TRIM(cl_dim)//&
+               &  TRIM(fct_upper(td_var%t_dim(ji)%c_sname))//':'//&
+               &  TRIM(fct_str(td_var%t_dim(ji)%i_len))//','
+            ENDIF
+         ENDDO
+         cl_dim=TRIM(cl_dim)//'/)'
+         CALL logger_debug( " variable dimension: "//TRIM(cl_dim) )
+
+         lf_dim=.FALSE.
+
+         CALL logger_error( &
+         &  " FILE CHECK VAR DIM: variable and file dimension differ"//&
+         &  " for variable "//TRIM(td_var%c_name)//&
+         &  " and file "//TRIM(td_file%c_name))
+
+      ELSEIF( ll_warn )THEN
+         CALL logger_warn( &
+         &  " FILE CHECK VAR DIM: variable and file dimension differ"//&
+         &  " for variable "//TRIM(td_var%c_name)//&
+         &  " and file "//TRIM(td_file%c_name)//". you should use"//&
+         &  " var_check_dim to remove useless dimension.")
+      ELSE
+
+         IF( td_var%i_ndim >  td_file%i_ndim )THEN
+            CALL logger_info("FILE CHECK VAR DIM: variable "//&
+            &  TRIM(td_var%c_name)//" use more dimension than file "//&
+            &  TRIM(td_file%c_name)//" do until now.")
+         ENDIF
+
+      ENDIF
+
+   END FUNCTION file_check_var_dim
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE file_add_var(td_file, td_var)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add a variable structure in a file structure.<br/>
+   !> Do not overwrite, if variable already in file structure.
+   !
+   !> @note variable value is suppose to be ordered ('x','y','z','t')
+   !
+   !> @details
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014
+   !> - add dimension in file if need be
+   !> - do not reorder dimension from variable, before put in file
+   !> @date September, 2015
+   !> - check variable dimension expected
+   !> @date January, 2019
+   !> - clean variable structure
+   !>
+   !> @param[inout] td_file   file structure
+   !> @param[in] td_var       variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+      TYPE(TVAR) , INTENT(INOUT) :: td_var
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      !INTEGER(i4) :: il_rec
+      INTEGER(i4) :: il_ind
+
+      TYPE(TVAR), DIMENSION(:), ALLOCATABLE :: tl_var
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( TRIM(td_file%c_name) == '' )THEN
+
+         CALL logger_debug( " FILE ADD VAR: you should have used file_init before "//&
+         & "running file_add_var" )
+         CALL logger_error( " FILE ADD VAR: structure file unknown" )
+
+      ELSE
+         ! check if variable exist
+         IF( TRIM(td_var%c_name) == '' .AND. &
+         &   TRIM(td_var%c_stdname) == '' )THEN
+            CALL logger_error(" FILE ADD VAR: variable without name ")
+         ELSE
+            ! check if variable already in file structure
+            il_ind=0
+            IF( ASSOCIATED(td_file%t_var) )THEN
+               il_ind=var_get_index( td_file%t_var(:), td_var%c_name,   &
+               &                                       td_var%c_stdname )
+            ENDIF
+            CALL logger_debug( &
+            &  " FILE ADD VAR: ind "//TRIM(fct_str(il_ind)) )
+            IF( il_ind /= 0 )THEN
+
+               CALL logger_error( &
+               &  " FILE ADD VAR: variable "//TRIM(td_var%c_name)//&
+               &  ", standard name "//TRIM(td_var%c_stdname)//&
+               &  ", already in file "//TRIM(td_file%c_name) )
+
+               DO ji=1,td_file%i_nvar
+                  CALL logger_debug( " ADD VAR: in file : &
+                  &  variable "//TRIM(td_file%t_var(ji)%c_name)//&
+                  &  ", standard name "//TRIM(td_file%t_var(ji)%c_stdname) )
+               ENDDO
+
+            ELSE
+
+               CALL logger_debug( &
+               &  " FILE ADD VAR: add variable "//TRIM(td_var%c_name)//&
+               &  ", standard name "//TRIM(td_var%c_stdname)//&
+               &  ", in file "//TRIM(td_file%c_name) )
+
+               ! check used dimension 
+               IF( file_check_var_dim(td_file, td_var) )THEN
+
+                  ! check variable dimension expected
+                  CALL var_check_dim(td_var)
+
+                  ! update dimension if need be
+                  DO ji=1,ip_maxdim
+                     IF( td_var%t_dim(ji)%l_use .AND. &
+                     &   .NOT. td_file%t_dim(ji)%l_use )THEN
+                        CALL file_add_dim(td_file,td_var%t_dim(ji))
+                     ENDIF
+                  ENDDO
+
+                  ! get index of new variable
+                  SELECT CASE(td_var%i_ndim)
+                     CASE(0)
+                        il_ind=td_file%i_n0d+1
+                        !il_rec=0
+                     CASE(1)
+                        il_ind=td_file%i_n0d+td_file%i_n1d+1
+                        !il_rec=1
+                     CASE(2)
+                        il_ind=td_file%i_n0d+td_file%i_n1d+td_file%i_n2d+1
+                        !il_rec=1
+                     CASE(3,4)
+                        il_ind=td_file%i_n0d+td_file%i_n1d+td_file%i_n2d+td_file%i_n3d+1
+                        !il_rec=td_file%t_dim(3)%i_len
+                  END SELECT
+
+                  IF( td_file%i_nvar > 0 )THEN
+                  ! already other variable in file structure
+                     ALLOCATE( tl_var(td_file%i_nvar), stat=il_status )
+                     IF(il_status /= 0 )THEN
+
+                        CALL logger_error( &
+                        &  " FILE ADD VAR: not enough space to put variables "//&
+                        &  "from "//TRIM(td_file%c_name)//&
+                        &  " in variable structure")
+
+                     ELSE
+
+                        ! save temporary variable of file structure
+                        tl_var(:)=var_copy(td_file%t_var(:))
+
+                        CALL var_clean( td_file%t_var(:) )
+                        DEALLOCATE(td_file%t_var)
+                        ALLOCATE( td_file%t_var(td_file%i_nvar+1), &
+                        &         stat=il_status)
+                        IF(il_status /= 0 )THEN
+
+                           CALL logger_error( &
+                           &  " FILE ADD VAR: not enough space to put variable "//&
+                           &  "in file structure "//TRIM(td_file%c_name) )
+
+                        ENDIF
+
+                        ! copy variable in file before
+                        ! variable with less than or equal dimension that new variable
+                        IF( il_ind > 1 )THEN
+                           td_file%t_var( 1:il_ind-1 ) = var_copy(tl_var(1:il_ind-1))
+                        ENDIF
+
+                        IF( il_ind < td_file%i_nvar+1 )THEN
+                           ! variable with more dimension than new variable
+                           td_file%t_var( il_ind+1 : td_file%i_nvar+1 ) = &
+                           &        var_copy( tl_var(il_ind : td_file%i_nvar) )
+                        ENDIF
+
+                        ! clean
+                        CALL var_clean(tl_var(:))
+                     ENDIF
+                     DEALLOCATE(tl_var)
+
+                  ELSE
+                  ! no variable in file structure
+                     IF( ASSOCIATED(td_file%t_var) )THEN
+                        CALL var_clean(td_file%t_var(:))
+                        DEALLOCATE(td_file%t_var)
+                     ENDIF
+                     ALLOCATE( td_file%t_var(td_file%i_nvar+1), stat=il_status )
+                     IF(il_status /= 0 )THEN
+
+                        CALL logger_error( &
+                        &  " FILE ADD VAR: not enough space to put variable "//&
+                        &  "in file structure "//TRIM(td_file%c_name) )
+
+                     ENDIF
+
+                  ENDIF
+
+                  ! add new variable in array of variable
+                  ALLOCATE( tl_var(1), stat=il_status )
+                  IF(il_status /= 0 )THEN
+
+                     CALL logger_error( &
+                     &  " FILE ADD VAR: not enough space to put variables from "//&
+                     &  TRIM(td_var%c_name)//" in variable structure")
+
+                  ELSE
+                     tl_var(1)=var_copy(td_var)
+                     ! remove old id
+                     tl_var(1)%i_id=0
+
+                     ! update dimension name in new variable
+                     tl_var(1)%t_dim(:)%c_name = td_file%t_dim(:)%c_name
+                  
+                     ! add new variable
+                     td_file%t_var(il_ind)=var_copy(tl_var(1))
+
+                     ! update number of variable
+                     td_file%i_nvar=td_file%i_nvar+1
+                     SELECT CASE(tl_var(1)%i_ndim)
+                        CASE(0)
+                           td_file%i_n0d=td_file%i_n0d+1
+                        CASE(1)
+                           td_file%i_n1d=td_file%i_n1d+1
+                        CASE(2)
+                           td_file%i_n2d=td_file%i_n2d+1
+                        CASE(3,4)
+                           td_file%i_n3d=td_file%i_n3d+1
+                     END SELECT
+
+                     ! update variable id
+                     td_file%t_var(il_ind)%i_id=var_get_unit(td_file%t_var(:))
+
+                     ! update dimension used
+                     td_file%t_dim(:)%l_use=.FALSE.
+                     DO ji=1,ip_maxdim
+                        IF( ANY(td_file%t_var(:)%t_dim(ji)%l_use) )THEN
+                           td_file%t_dim(ji)%l_use=.TRUE.
+                        ENDIF
+                     ENDDO
+
+                     ! update number of dimension
+                     td_file%i_ndim=COUNT(td_file%t_dim(:)%l_use)
+
+                     ! clean
+                     CALL var_clean( tl_var(:) )
+                  ENDIF
+                  DEALLOCATE(tl_var)
+
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE file_add_var
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE file__del_var_name(td_file, cd_name)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine delete a variable structure 
+   !> in file structure, given variable name or standard name.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 
+   !> - define local variable structure to avoid mistake with pointer
+   !>
+   !> @param[inout] td_file   file structure
+   !> @param[in] cd_name      variable name or standard name
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE)     , INTENT(INOUT) :: td_file
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+
+      ! local variable
+      INTEGER(i4)       :: il_ind
+      TYPE(TVAR)        :: tl_var
+      !----------------------------------------------------------------
+
+      ! check if file opened
+      IF( TRIM(td_file%c_name) == '' )THEN
+
+         CALL logger_error( " FILE DEL VAR NAME: file structure unknown ")
+         CALL logger_debug( " FILE DEL VAR NAME: you should have used file_init before "//&
+         & "running file_del_var" )
+
+      ELSE
+
+         IF( td_file%i_nvar /= 0 )THEN
+
+            ! get the variable index, in file variable structure
+            il_ind=0
+            IF( ASSOCIATED(td_file%t_var) )THEN
+               il_ind=var_get_index(td_file%t_var(:), cd_name )
+            ENDIF
+
+            IF( il_ind /= 0 )THEN
+   
+               tl_var=var_copy(td_file%t_var(il_ind))
+               CALL file_del_var(td_file, tl_var)
+               ! clean
+               CALL var_clean(tl_var)
+            ELSE
+
+               CALL logger_debug( &
+               &  " FILE DEL VAR NAME: there is no variable with name or "//&
+               &  "standard name "//TRIM(cd_name)//" in file "//&
+               &  TRIM(td_file%c_name))
+
+            ENDIF
+
+         ELSE
+            CALL logger_debug( " FILE DEL VAR NAME: "//&
+            &        "no variable associated to file "//&
+            &        TRIM(td_file%c_name) )
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE file__del_var_name
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE file__del_var_str(td_file, td_var)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine delete a variable structure 
+   !> in file structure, given variable structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2019
+   !> - clean variable structure
+   !>
+   !> @param[inout] td_file   file structure
+   !> @param[in] td_var       variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+      TYPE(TVAR),  INTENT(IN)    :: td_var
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_ind
+      INTEGER(i4) :: il_rec
+      TYPE(TVAR), DIMENSION(:), ALLOCATABLE :: tl_var
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! check if file opened
+      IF( TRIM(td_file%c_name) == '' )THEN
+
+         CALL logger_error( " FILE DEL VAR: file structure unknown ")
+         CALL logger_debug( " FILE DEL VAR: you should have used "//&
+         &  "file_init before running file_del_var" )      
+
+      ELSE
+
+         ! check if variable is member of a file
+         IF( td_var%l_file )THEN
+            CALL logger_warn( &
+            &  " FILE DEL VAR: variable "//TRIM(td_var%c_name)//&
+            &  ", belong to file "//TRIM(td_file%c_name)//&
+            &  " and can not be removed.")
+         ELSE
+            ! check if variable already in file structure
+            il_ind=0
+            IF( ASSOCIATED(td_file%t_var) )THEN
+               il_ind=var_get_index( td_file%t_var(:), td_var%c_name, &
+               &                                       td_var%c_stdname )
+            ENDIF
+
+            IF( il_ind == 0 )THEN
+
+               CALL logger_warn( "FILE DEL VAR: no variable "//&
+               &     TRIM(td_var%c_name)//", in file "//TRIM(td_file%c_name) )
+
+               DO ji=1,td_file%i_nvar
+                  CALL logger_debug( "FILE DEL VAR: in file "//&
+                  &  TRIM(td_file%t_var(ji)%c_name)//", standard name "//&
+                  &  TRIM(td_file%t_var(ji)%c_stdname) )
+               ENDDO
+
+            ELSE
+               
+               CALL logger_trace( "FILE DEL VAR: delete variable "//&
+               &  TRIM(td_var%c_name)//", from file "//TRIM(td_file%c_name) )
+
+               ALLOCATE( tl_var(td_file%i_nvar-1), stat=il_status )
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( &
+                  &  " FILE DEL VAR: not enough space to put variables from "//&
+                  &  TRIM(td_file%c_name)//" in temporary variable structure")
+
+               ELSE
+
+                  ! save temporary variable's file structure
+                  IF( il_ind > 1 )THEN
+                     tl_var(1:il_ind-1)=var_copy(td_file%t_var(1:il_ind-1))
+                  ENDIF
+
+                  IF( il_ind < td_file%i_nvar )THEN
+                     tl_var(il_ind:)=var_copy(td_file%t_var(il_ind+1:))
+                  ENDIF
+
+                  ! new number of variable in file
+                  td_file%i_nvar=td_file%i_nvar-1
+                  SELECT CASE(td_var%i_ndim)
+                     CASE(0)
+                        td_file%i_n0d=td_file%i_n0d-1
+                        il_rec=0
+                     CASE(1)
+                        td_file%i_n1d=td_file%i_n1d-1
+                        il_rec=1
+                     CASE(2)
+                        td_file%i_n2d=td_file%i_n2d-1
+                        il_rec=1
+                     CASE(3,4)
+                        td_file%i_n3d=td_file%i_n3d-1
+                        il_rec=td_file%t_dim(3)%i_len
+                  END SELECT
+
+                  CALL var_clean( td_file%t_var(:) )
+                  DEALLOCATE(td_file%t_var)
+
+                  IF( td_file%i_nvar > 0 )THEN
+                     ALLOCATE( td_file%t_var(td_file%i_nvar), stat=il_status )
+                     IF(il_status /= 0 )THEN
+
+                        CALL logger_error( " FILE DEL VAR: not enough space"//&
+                        &  "to put variables in file structure "//&
+                        &  TRIM(td_file%c_name) )
+
+                     ENDIF
+
+                     ! copy attribute in file before
+                     td_file%t_var(:)=var_copy(tl_var(:))
+
+                     ! update dimension used
+                     td_file%t_dim(:)%l_use=.FALSE.
+                     DO ji=1,ip_maxdim
+                        IF( ANY(td_file%t_var(:)%t_dim(ji)%l_use) )THEN
+                           td_file%t_dim(ji)%l_use=.TRUE.
+                        ENDIF
+                     ENDDO
+
+                     ! update number of dimension
+                     td_file%i_ndim=COUNT(td_file%t_dim(:)%l_use)
+
+                  ENDIF
+
+                  ! clean
+                  CALL var_clean(tl_var(:))
+               ENDIF 
+               DEALLOCATE(tl_var)
+
+            ENDIF
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE file__del_var_str
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE file_move_var(td_file, td_var)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine overwrite variable structure 
+   !> in file structure.
+   !
+   !> @warning change variable id in file structure.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_file   file structure
+   !> @param[in] td_var       variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+      TYPE(TVAR),  INTENT(IN)    :: td_var
+
+      ! local variable
+      TYPE(TVAR) :: tl_var
+      !----------------------------------------------------------------
+
+      ! copy variable
+      tl_var=var_copy(td_var)
+
+      ! remove variable with same name or standard name
+      CALL file_del_var(td_file, tl_var)
+
+      ! add new variable
+      CALL file_add_var(td_file, tl_var)
+
+      ! clean
+      CALL var_clean(tl_var)
+
+   END SUBROUTINE file_move_var
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE file_add_att(td_file, td_att)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add a global attribute 
+   !> in a file structure.<br/>
+   !> Do not overwrite, if attribute already in file structure.
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2019
+   !> - clean attribute structure
+   !>
+   !> @param[inout] td_file   file structure
+   !> @param[in] td_att       attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+      TYPE(TATT),  INTENT(IN)    :: td_att
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_ind
+      TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! check if file opened
+      IF( TRIM(td_file%c_name) == '' )THEN
+
+         CALL logger_error( " FILE ADD ATT: file structure unknown ")
+         CALL logger_debug( " FILE ADD ATT: you should have used file_init before "//&
+         & "running file_add_att" )      
+
+      ELSE
+
+         ! check if attribute already in file structure
+         il_ind=0
+         IF( ASSOCIATED(td_file%t_att) )THEN
+            il_ind=att_get_index( td_file%t_att(:), td_att%c_name )
+         ENDIF
+
+         IF( il_ind /= 0 )THEN
+         
+            CALL logger_error( &
+            &  " FILE ADD ATT: attribute "//TRIM(td_att%c_name)//&
+            &  ", already in file "//TRIM(td_file%c_name) )
+
+            DO ji=1,td_file%i_natt
+               CALL logger_debug( &
+               &  " FILE ADD ATT: in file "//TRIM(td_file%t_att(ji)%c_name) )
+            ENDDO
+
+         ELSE
+            
+            CALL logger_trace( &
+            &  " FILE ADD ATT: add attribute "//TRIM(td_att%c_name)//&
+            &  ", in file "//TRIM(td_file%c_name) )
+
+            IF( td_file%i_natt > 0 )THEN
+            ! already other attribute in file structure
+               ALLOCATE( tl_att(td_file%i_natt), stat=il_status )
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( &
+                  &  " FILE ADD ATT: not enough space to put attributes from "//&
+                  &  TRIM(td_file%c_name)//" in temporary attribute structure")
+
+               ELSE
+
+                  ! save temporary global attribute's file structure
+                  tl_att(:)=att_copy(td_file%t_att(:))
+
+                  CALL att_clean( td_file%t_att(:) )
+                  DEALLOCATE(td_file%t_att)
+                  ALLOCATE( td_file%t_att(td_file%i_natt+1), stat=il_status )
+                  IF(il_status /= 0 )THEN
+
+                     CALL logger_error( &
+                     &  " FILE ADD ATT: not enough space to put attributes "//&
+                     &  "in file structure "//TRIM(td_file%c_name) )
+
+                  ENDIF
+
+                  ! copy attribute in file before
+                  td_file%t_att(1:td_file%i_natt)=att_copy(tl_att(:))
+
+                   ! clean
+                  CALL att_clean(tl_att(:))
+               ENDIF
+               DEALLOCATE(tl_att)
+
+            ELSE
+            ! no attribute in file structure
+               IF( ASSOCIATED(td_file%t_att) )THEN
+                  CALL att_clean(td_file%t_att(:))
+                  DEALLOCATE(td_file%t_att)
+               ENDIF
+
+               ALLOCATE( td_file%t_att(td_file%i_natt+1), stat=il_status )
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( &
+                  &  " FILE ADD ATT: not enough space to put attributes "//&
+                  &  "in file structure "//TRIM(td_file%c_name) )
+
+               ENDIF
+            ENDIF
+            ! add new attribute
+            td_file%t_att(td_file%i_natt+1)=att_copy(td_att)
+
+            ! update number of attribute
+            td_file%i_natt=td_file%i_natt+1
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE file_add_att
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE file__del_att_name(td_file, cd_name)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine delete a global attribute structure 
+   !> in file structure, given attribute name.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 
+   !> - define local attribute structure to avoid mistake
+   !> with pointer
+   !> @date January, 2019
+   !> - clean attribute structure
+   !>
+   !> @param[inout] td_file   file structure
+   !> @param[in] cd_name      attribute name
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE)     , INTENT(INOUT) :: td_file
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+
+      ! local variable
+      INTEGER(i4)       :: il_ind
+      TYPE(TATT)        :: tl_att
+      !----------------------------------------------------------------
+
+      ! check if file opened
+      IF( TRIM(td_file%c_name) == '' )THEN
+
+         CALL logger_error( " FILE DEL ATT NAME: file structure unknown ")
+         CALL logger_debug( " FILE DEL ATT NAME: you should have "//&
+         &  "used file_init before running file_del_att" )
+
+      ELSE
+
+         IF( td_file%i_natt /= 0 )THEN
+
+            ! get the variable id, in file variable structure
+            il_ind=0
+            IF( ASSOCIATED(td_file%t_att) )THEN
+               il_ind=att_get_index(td_file%t_att(:), cd_name )
+            ENDIF
+
+            IF( il_ind /= 0 )THEN
+   
+               tl_att=att_copy(td_file%t_att(il_ind))
+               CALL file_del_att(td_file, tl_att)
+               ! clean
+               CALL att_clean(tl_att)
+            ELSE
+
+               CALL logger_debug( &
+               &  " FILE DEL ATT NAME: there is no attribute with name "//&
+               &  TRIM(cd_name)//" in file "//TRIM(td_file%c_name))
+
+            ENDIF
+
+         ELSE
+            CALL logger_debug( " FILE DEL ATT NAME: no attribute "//&
+            &  "associated to file "//TRIM(td_file%c_name) )
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE file__del_att_name
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE file__del_att_str(td_file, td_att)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine delete a global attribute structure 
+   !> from file structure, given attribute structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2019
+   !> - clean attribute structure
+   !>
+   !> @param[inout] td_file   file structure
+   !> @param[in] td_att       attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+      TYPE(TATT),  INTENT(IN)    :: td_att
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_ind
+      TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! check if file opened
+      IF( TRIM(td_file%c_name) == '' )THEN
+
+         CALL logger_error( " FILE DEL ATT: file structure unknown ")
+         CALL logger_debug( " FILE DEL ATT: you should have used "//&
+         &  "file_init before running file_del_att" )      
+
+      ELSE
+
+         ! check if attribute already in file structure
+         il_ind=0
+         IF( ASSOCIATED(td_file%t_att) )THEN
+            il_ind=att_get_index( td_file%t_att(:), td_att%c_name )
+         ENDIF
+
+         IF( il_ind == 0 )THEN
+
+            CALL logger_error( &
+            &  " FILE DEL ATT: no attribute "//TRIM(td_att%c_name)//&
+            &  ", in file "//TRIM(td_file%c_name) )
+
+         ELSE
+            
+            CALL logger_trace( &
+            &  " FILE DEL ATT: del attribute "//TRIM(td_att%c_name)//&
+            &  ", in file "//TRIM(td_file%c_name) )
+
+            ALLOCATE( tl_att(td_file%i_natt-1), stat=il_status )
+            IF(il_status /= 0 )THEN
+
+               CALL logger_error( &
+               &  " FILE ADD ATT: not enough space to put attributes from "//&
+               &  TRIM(td_file%c_name)//" in temporary attribute structure")
+
+            ELSE
+
+               ! save temporary global attribute's file structure
+               IF( il_ind > 1 )THEN
+                  tl_att(1:il_ind-1)=att_copy(td_file%t_att(1:il_ind-1))
+               ENDIF
+
+               IF( il_ind < td_file%i_natt )THEN
+                  tl_att(il_ind:)=att_copy(td_file%t_att(il_ind+1:))
+               ENDIF
+
+               CALL att_clean( td_file%t_att(:) )
+               DEALLOCATE(td_file%t_att)
+
+               ! new number of attribute in file
+               td_file%i_natt=td_file%i_natt-1
+
+               ALLOCATE( td_file%t_att(td_file%i_natt), stat=il_status )
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( &
+                  &  " FILE ADD ATT: not enough space to put attributes "//&
+                  &  "in file structure "//TRIM(td_file%c_name) )
+
+               ENDIF
+
+               ! copy attribute in file before
+               td_file%t_att(1:td_file%i_natt)=att_copy(tl_att(:))
+
+               ! clean 
+               CALL att_clean(tl_att(:))
+            ENDIF 
+            DEALLOCATE(tl_att)
+
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE file__del_att_str
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE file_move_att(td_file, td_att)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine move a global attribute structure 
+   !> from file structure.
+   !> @warning change attribute id in file structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_file   file structure
+   !> @param[in] td_att       attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+      TYPE(TATT),  INTENT(IN)    :: td_att
+
+      ! local variable
+      TYPE(TATT)  :: tl_att
+      INTEGER(i4) :: il_ind
+      !----------------------------------------------------------------
+
+      ! copy attribute
+      tl_att=att_copy(td_att)
+
+      IF( ASSOCIATED(td_file%t_att) )THEN
+         il_ind=att_get_index(td_file%t_att(:),TRIM(tl_att%c_name))
+         IF( il_ind /= 0 )THEN
+            ! remove attribute with same name
+            CALL file_del_att(td_file, tl_att)
+         ENDIF
+      ENDIF
+
+      ! add new attribute
+      CALL file_add_att(td_file, tl_att)
+
+       ! clean
+       CALL att_clean(tl_att)
+
+   END SUBROUTINE file_move_att
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE file_add_dim(td_file, td_dim)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add a dimension structure in file 
+   !> structure.
+   !> Do not overwrite, if dimension already in file structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014
+   !> - do not reorder dimension, before put in file
+   !>
+   !> @param[inout] td_file   file structure
+   !> @param[in] td_dim       dimension structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE)     , INTENT(INOUT) :: td_file
+      TYPE(TDIM)      , INTENT(IN   ) :: td_dim
+
+      ! local variable
+      INTEGER(i4) :: il_ind
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( TRIM(td_file%c_name) == '' )THEN
+
+         CALL logger_error( " FILE ADD DIM: file structure unknown ")
+         CALL logger_debug( " FILE ADD DIM: you should have used "//&
+         &  "file_init before running file_add_dim" )      
+
+      ELSE
+
+         IF( td_file%i_ndim <= ip_maxdim )THEN
+
+            ! check if dimension already in file structure
+            il_ind=dim_get_index(td_file%t_dim(:), td_dim%c_sname)
+            IF( il_ind /= 0 )THEN
+               IF( td_file%t_dim(il_ind)%l_use )THEN
+                  CALL logger_error( &
+                  &  "FILE ADD DIM: dimension "//TRIM(td_dim%c_name)//&
+                  &  ", short name "//TRIM(td_dim%c_sname)//&
+                  &  ", already used in file "//TRIM(td_file%c_name) )
+               ELSE
+                  ! replace dimension
+                  td_file%t_dim(il_ind)=dim_copy(td_dim)
+                  td_file%t_dim(il_ind)%i_id=il_ind
+                  td_file%t_dim(il_ind)%l_use=.TRUE.
+               ENDIF
+            ELSE
+               IF( td_file%i_ndim == ip_maxdim )THEN
+                  CALL logger_error( &
+                  &  "FILE ADD DIM: can not add dimension "//TRIM(td_dim%c_name)//&
+                  &  ", short name "//TRIM(td_dim%c_sname)//&
+                  &  ", in file "//TRIM(td_file%c_name)//". Already "//&
+                  &  TRIM(fct_str(ip_maxdim))//" dimensions." )
+               ELSE
+                  ! search empty dimension
+                  DO ji=1,ip_maxdim
+                     IF( td_file%t_dim(ji)%i_id == 0 )THEN
+                        il_ind=ji 
+                        EXIT
+                     ENDIF
+                  ENDDO
+ 
+                  ! add new dimension    
+                  td_file%t_dim(il_ind)=dim_copy(td_dim)
+                  ! update number of attribute
+                  td_file%i_ndim=COUNT(td_file%t_dim(:)%l_use)
+
+                  td_file%t_dim(il_ind)%i_id=td_file%i_ndim
+                  td_file%t_dim(il_ind)%l_use=.TRUE.
+               ENDIF               
+            ENDIF
+
+         ELSE
+            CALL logger_error( &
+            &  " FILE ADD DIM: too much dimension in file "//&
+            &  TRIM(td_file%c_name)//" ("//TRIM(fct_str(td_file%i_ndim))//")")
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE file_add_dim
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE file_del_dim(td_file, td_dim)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine delete a dimension structure in file 
+   !> structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2019
+   !> - clean dimension structure
+   !>
+   !> @param[inout] td_file   file structure
+   !> @param[in] td_dim       dimension structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE)     , INTENT(INOUT) :: td_file
+      TYPE(TDIM)      , INTENT(IN   ) :: td_dim
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_ind
+
+      TYPE(TDIM), DIMENSION(:), ALLOCATABLE  :: tl_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( TRIM(td_file%c_name) == '' )THEN
+
+         CALL logger_error( " FILE DEL DIM: file structure unknown ")
+         CALL logger_debug( " FILE DEL DIM: you should have used "//&
+         &  "file_init before running file_del_dim" )      
+
+      ELSE
+
+         ! check if dimension already in file structure
+         il_ind=dim_get_index(td_file%t_dim(:), td_dim%c_sname)
+         IF( il_ind == 0 )THEN
+
+            CALL logger_error( &
+            &  "FILE DEL DIM: no dimension "//TRIM(td_dim%c_name)//&
+            &  ", short name "//TRIM(td_dim%c_sname)//&
+            &  ", in file "//TRIM(td_file%c_name) )
+
+         ELSE
+            ALLOCATE( tl_dim(td_file%i_ndim-1), stat=il_status )
+            IF(il_status /= 0 )THEN
+
+               CALL logger_error( &
+               &  "FILE DEL DIM: not enough space to put dimensions from "//&
+               &  TRIM(td_file%c_name)//" in temporary dimension structure")
+
+            ELSE            
+               ! save temporary dimension's mpp structure
+               tl_dim( 1 : il_ind-1 ) = dim_copy(td_file%t_dim(1 : il_ind-1))
+               tl_dim( il_ind : td_file%i_ndim-1 ) = &
+               &      dim_copy(td_file%t_dim(il_ind+1 : td_file%i_ndim))
+
+               ! remove dimension from file
+               CALL dim_clean(td_file%t_dim(:))
+               ! copy dimension in file, except one
+               td_file%t_dim(1:td_file%i_ndim)=dim_copy(tl_dim(:))
+
+               ! update number of dimension
+               td_file%i_ndim=td_file%i_ndim-1
+
+               ! update dimension id
+               DO ji=1,td_file%i_ndim
+                  td_file%t_dim(ji)%i_id=ji
+               ENDDO
+
+               ! clean
+               CALL dim_clean(tl_dim(:))
+            ENDIF
+            DEALLOCATE(tl_dim)
+
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE file_del_dim
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE file_move_dim(td_file, td_dim)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine move a dimension structure 
+   !> in file structure.
+   !> @warning change dimension order in file structure. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_file   file structure
+   !> @param[in] td_dim       dimension structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE)     , INTENT(INOUT) :: td_file
+      TYPE(TDIM)      , INTENT(IN   ) :: td_dim
+
+      ! local variable
+      INTEGER(i4) :: il_ind
+      INTEGER(i4) :: il_dimid
+      !----------------------------------------------------------------
+      IF( td_file%i_ndim <= ip_maxdim )THEN
+
+         ! check if dimension already in mpp structure
+         il_ind=dim_get_index(td_file%t_dim(:), td_dim%c_name, td_dim%c_sname)
+         IF( il_ind /= 0 )THEN
+
+            il_dimid=td_file%t_dim(il_ind)%i_id
+            ! replace dimension
+            td_file%t_dim(il_ind)=dim_copy(td_dim)
+            td_file%t_dim(il_ind)%i_id=il_dimid
+            td_file%t_dim(il_ind)%l_use=.TRUE.
+
+         ELSE
+            CALL file_add_dim(td_file, td_dim)
+         ENDIF
+
+      ELSE
+         CALL logger_error( &
+         &  "FILE MOVE DIM: too much dimension in mpp "//&
+         &  TRIM(td_file%c_name)//" ("//TRIM(fct_str(td_file%i_ndim))//")")
+      ENDIF
+
+   END SUBROUTINE file_move_dim
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE file_print(td_file)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine print some information about file strucutre.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_file   file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(IN) :: td_file
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_mode
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      cl_mode='READ'
+      IF( td_file%l_wrt ) cl_mode='WRITE'
+
+      WRITE(*,'((a,a),2(/3x,a,a),4(/3x,a,i0))')&
+      &  "File : ",TRIM(td_file%c_name), &
+      &  " type : ",TRIM(td_file%c_type), &
+      &  " mode : ",TRIM(cl_mode), &
+      &  " id   : ",td_file%i_id, &
+      &  " ndim : ",td_file%i_ndim, &
+      &  " natt : ",td_file%i_natt, &
+      &  " nvar : ",td_file%i_nvar
+
+      SELECT CASE(TRIM(td_file%c_type))
+         CASE('cdf')
+            WRITE(*,'((/3x,a,a),(/3x,a,i3))')&
+            &  "define mode : ",TRIM(fct_str(td_file%l_def)),&
+            &  "unlimited id : ",td_file%i_uldid
+         CASE('dimg')
+            WRITE(*,'(5(/3x,a,i0))')&
+            &  " record length : ",td_file%i_recl, &
+            &  " n0d : ",td_file%i_n0d, &
+            &  " n1d : ",td_file%i_n1d, &
+            &  " n2d : ",td_file%i_n2d, &
+            &  " n3d : ",td_file%i_n3d
+      END SELECT
+
+      ! print dimension
+      IF(  td_file%i_ndim /= 0 )THEN
+         WRITE(*,'(/a)') " File dimension"
+         DO ji=1,ip_maxdim
+            IF( td_file%t_dim(ji)%l_use )THEN
+               CALL dim_print(td_file%t_dim(ji))
+            ENDIF
+         ENDDO
+      ENDIF
+
+      ! print global attribute
+      IF( td_file%i_natt /= 0 )THEN
+         WRITE(*,'(/a)') " File attribute"
+         DO ji=1,td_file%i_natt
+            CALL att_print(td_file%t_att(ji))
+         ENDDO
+      ENDIF
+
+      ! print variable
+      IF( td_file%i_nvar /= 0 )THEN
+         WRITE(*,'(/a)') " File variable"
+         DO ji=1,td_file%i_nvar
+            CALL var_print(td_file%t_var(ji),.FALSE.)
+         ENDDO
+      ENDIF
+
+   END SUBROUTINE file_print
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION file__get_suffix(cd_file) &
+         & RESULT (cf_suffix)
+   !-------------------------------------------------------------------
+   !> @brief This function get suffix of file name.
+   !> @details
+   !> we assume suffix is define as alphanumeric character following the
+   !> last '.' in file name.<br/>
+   !> If no suffix is found, return empty character.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] cd_file   file structure
+   !> @return suffix
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_file
+
+      ! function
+      CHARACTER(LEN=lc)            :: cf_suffix
+   
+      ! local variable
+      INTEGER(i4) :: il_ind
+      !----------------------------------------------------------------
+
+      CALL logger_trace( "FILE GET SUFFIX: look for suffix in file name "//&
+      &               TRIM(cd_file) )
+
+      il_ind=INDEX(TRIM(cd_file),'.',BACK=.TRUE.)
+      IF( il_ind /= 0 )THEN
+         ! read number in basename
+         READ( cd_file(il_ind:),'(a)' ) cf_suffix
+
+         IF( fct_is_num(cf_suffix(2:)) )THEN
+            cf_suffix=''
+         ENDIF
+
+      ELSE
+         cf_suffix=''
+      ENDIF
+
+   END FUNCTION file__get_suffix
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION file__get_number(cd_file) &
+         & RESULT (cf_number)
+   !-------------------------------------------------------------------
+   !> @brief This function get number in file name without suffix.
+   !> @details
+   !> Actually it get the number following the last separator.
+   !> separator could be '.' or '_'.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 
+   !> - add case to not return date (yyyymmdd) at the end of filename
+   !> @date February, 2015 
+   !> - add case to not return release number
+   !> we assume release number only on one digit (ex : file_v3.5.nc)
+   !>
+   !> @param[in] cd_file   file name (without suffix)
+   !> @return character file number.
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      CHARACTER(LEN=lc), INTENT(IN) :: cd_file
+
+      ! function
+      CHARACTER(LEN=lc)             :: cf_number
+
+      ! local variable
+      INTEGER(i4) :: il_indmax
+      INTEGER(i4) :: il_ind
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! get number position in file name
+      il_indmax=0
+      DO ji=1,ip_nsep
+         il_ind=INDEX(TRIM(cd_file),TRIM(cp_sep(ji)),BACK=.TRUE.)
+         IF( il_ind > il_indmax )THEN
+            il_indmax=il_ind
+         ENDIF
+      ENDDO
+
+      IF( il_indmax /= 0 )THEN
+         ! read number in basename
+         READ( cd_file(il_indmax:),'(a)' ) cf_number
+
+         IF( .NOT. fct_is_num(cf_number(2:)) )THEN
+            cf_number=''
+         ELSEIF( LEN(TRIM(cf_number))-1 == 8 )THEN
+            ! date case yyyymmdd
+            cf_number=''
+         ELSEIF( LEN(TRIM(cf_number))-1 == 1 )THEN
+            ! release number case 
+            cf_number=''
+         ENDIF
+      ELSE
+         cf_number=''
+      ENDIF
+
+   END FUNCTION file__get_number
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION file__rename_char(cd_file, id_num) &
+         & RESULT (cf_file)
+   !-------------------------------------------------------------------
+   !> @brief This function rename file name, given processor number.
+   !> @details
+   !> If no processor number is given, return file name without number
+   !> If processor number is given, return file name with new number
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] id_num    processor number (start to 1)
+   !> @return file name
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_file
+      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_num
+
+      ! function
+      CHARACTER(LEN=lc)            :: cf_file
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_suffix
+      CHARACTER(LEN=lc) :: cl_file
+      CHARACTER(LEN=lc) :: cl_number
+      CHARACTER(LEN=lc) :: cl_base
+      CHARACTER(LEN=lc) :: cl_sep
+      CHARACTER(LEN=lc) :: cl_format
+      INTEGER(i4)       :: il_ind
+      INTEGER(i4)       :: il_numlen
+      !----------------------------------------------------------------
+
+      ! get suffix
+      cl_suffix=file__get_suffix(cd_file)
+      IF( TRIM(cl_suffix) /= '' )THEN
+         il_ind=INDEX(TRIM(cd_file),TRIM(cl_suffix(1:1)),BACK=.TRUE.)
+         cl_file=TRIM(cd_file(:il_ind-1))
+      ELSE
+         cl_file=TRIM(cd_file)
+      ENDIF
+
+      cl_number=file__get_number(cl_file)
+      IF( TRIM(cl_number) /= '' )THEN
+         il_ind=INDEX(TRIM(cl_file),TRIM(cl_number(1:1)),BACK=.TRUE.)
+         cl_base=TRIM(cl_file(:il_ind-1))
+
+         cl_sep=TRIM(cl_number(1:1))
+         il_numlen=LEN(TRIM(cl_number))-1
+      ELSE
+         cl_base=TRIM(cl_file)
+         il_numlen=4
+         cl_sep='_'
+      ENDIF
+
+      IF( PRESENT(id_num) )THEN
+         ! format
+         WRITE(cl_format,'(a,i1.1,a,i1.1,a)') '(a,a,i',il_numlen,'.',il_numlen,',a)'
+         WRITE(cf_file,cl_format) TRIM(cl_base),TRIM(cl_sep),id_num,TRIM(cl_suffix)
+      ELSE
+         WRITE(cf_file,'(a,a)') TRIM(cl_base),TRIM(cl_suffix)
+      ENDIF
+      CALL logger_trace(" FILE RENAME : "//TRIM(cf_file))
+
+   END FUNCTION file__rename_char
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION file__rename_str(td_file, id_num) &
+         & RESULT (tf_file)
+   !-------------------------------------------------------------------
+   !> @brief This function rename file name, given file structure.
+   !> @details
+   !> If no processor number is given, return file name without number
+   !> I processor number is given, return file name with new number
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] id_num    processor number (start to 1)
+   !> @return file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(IN) :: td_file
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_num
+
+      ! function
+      TYPE(TFILE)             :: tf_file
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_name
+      !----------------------------------------------------------------
+
+      ! change name
+      cl_name=TRIM( file_rename(td_file%c_name, id_num) )
+
+      tf_file=file_init(TRIM(cl_name), TRIM(td_file%c_type))
+
+   END FUNCTION file__rename_str
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION file_add_suffix(cd_file, cd_type) &
+         & RESULT (cf_file)
+   !-------------------------------------------------------------------
+   !> @brief This function add suffix to file name.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_file   file structure
+   !> @return file name
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_file
+      CHARACTER(LEN=*), INTENT(IN) :: cd_type
+
+      ! function
+      CHARACTER(LEN=lc)            :: cf_file
+
+      ! local variable
+      INTEGER(i4)       :: il_ind
+      CHARACTER(LEN=lc) :: cl_file
+      CHARACTER(LEN=lc) :: cl_suffix
+      !----------------------------------------------------------------
+
+      ! get suffix 
+      cl_suffix=file__get_suffix(cd_file)
+      IF( TRIM(cl_suffix) /= '' )THEN
+         il_ind=INDEX(TRIM(cd_file),TRIM(cl_suffix(1:1)),BACK=.TRUE.)
+         cl_file=TRIM(cd_file(:il_ind-1))
+      ELSE
+         cl_file=TRIM(cd_file)
+      ENDIF
+
+      SELECT CASE(TRIM(cd_type))
+         CASE('cdf')
+            cf_file=TRIM(cl_file)//TRIM(cl_suffix)
+         CASE('dimg')
+            IF( TRIM(cl_suffix) /= '' )THEN
+               cf_file=TRIM(cl_file)//'.dimg'
+            ELSE
+               cf_file=TRIM(cl_file)
+            ENDIF
+         CASE DEFAULT
+            CALL logger_error(" FILE ADD SUFFIX: type unknown "//TRIM(cd_type))
+      END SELECT
+
+   END FUNCTION file_add_suffix
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE file__clean_unit(td_file)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine clean file strcuture.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Inital version
+   !> @date January, 2019
+   !> - nullify attribute structure inside file structure
+   !> - nullify variable structure inside file structure
+   !>
+   !> @param[inout] td_file   file strcuture
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TFILE),  INTENT(INOUT) :: td_file
+
+      ! local variable
+      TYPE(TFILE) :: tl_file ! empty file structure
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      CALL logger_trace( &
+      &  " FILE CLEAN: reset file "//TRIM(td_file%c_name) )
+
+      ! del attribute
+      IF( ASSOCIATED( td_file%t_att ) )THEN
+         CALL att_clean( td_file%t_att(:) )
+         DEALLOCATE(td_file%t_att)
+         NULLIFY(td_file%t_att)
+      ENDIF
+
+      ! del dimension
+      IF( td_file%i_ndim /= 0 )THEN
+         CALL dim_clean( td_file%t_dim(:) )
+      ENDIF
+
+      ! del variable
+      IF( ASSOCIATED( td_file%t_var ) )THEN
+         CALL var_clean( td_file%t_var(:) )
+         DEALLOCATE(td_file%t_var)
+         NULLIFY(td_file%t_var)
+      ENDIF
+
+      ! replace by empty structure
+      td_file=file_copy(tl_file)
+
+   END SUBROUTINE file__clean_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE file__clean_arr(td_file)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine clean file array of file strcuture.
+   !>
+   !> @author J.Paul
+   !> @date Marsh, 2014 - Inital version
+   !>
+   !> @param[inout] td_file   array file strcuture
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TFILE), DIMENSION(:), INTENT(INOUT) :: td_file
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=SIZE(td_file(:)),1,-1
+         CALL file_clean(td_file(ji))
+      ENDDO
+
+   END SUBROUTINE file__clean_arr
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION file_get_id(td_file, cd_name) &
+         & RESULT (if_id)
+   !-------------------------------------------------------------------
+   !> @brief This function return the file id, in a array of file
+   !> structure,  given file name. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_file   array of file structure
+   !> @param[in] cd_name   file name
+   !> @return file id in array of file structure (0 if not found)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE)     , DIMENSION(:), INTENT(IN) :: td_file
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+
+      ! function
+      INTEGER(i4)                                :: if_id
+
+      ! local variable
+      INTEGER(i4) :: il_size
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      if_id=0
+      il_size=SIZE(td_file(:))
+
+      ! check if file is in array of file structure
+      DO ji=1,il_size
+         ! look for file name
+         IF( fct_lower(td_file(ji)%c_name) == fct_lower(cd_name) )THEN
+         
+            if_id=td_file(ji)%i_id
+            EXIT
+
+         ENDIF
+      ENDDO
+
+   END FUNCTION file_get_id
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION file_get_unit(td_file) &
+         & RESULT (if_unit)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function get the next unused unit in array of file structure.
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[in] td_file   array of file 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TFILE), DIMENSION(:), INTENT(IN   ) :: td_file
+
+      ! function
+      INTEGER(i4)                              :: if_unit
+
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+
+      if_unit=MAXVAL(td_file(:)%i_id)+1
+
+   END FUNCTION file_get_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE file
+
Index: /utils/tools_ticket2413/SIREN/src/filter.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/filter.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/filter.f90	(revision 12863)
@@ -0,0 +1,1322 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief This module is filter manager.
+!>
+!> @details Filtering method to be used is specify inside variable strcuture,
+!>    as array of string character.<br/>
+!>    td_var\%c_filter(1) string character is the filter name choose between:<br/>
+!>       - 'hann'
+!>          - rad < cutoff : @f$ filter=0.5+0.5*COS(\pi*\frac{rad}{cutoff}) @f$
+!>          - rad > cutoff : @f$ filter=0 @f$
+!>       - 'hamming'
+!>          - rad < cutoff : @f$ filter=0.54+0.46*COS(\pi*\frac{rad}{cutoff}) @f$
+!>          - rad > cutoff : @f$ filter=0 @f$               
+!>       - 'blackman'
+!>          - rad < cutoff : @f$ filter=0.42 + 0.5*COS(\pi*\frac{rad}{cutoff}) + 
+!>                                      0.08*COS(2\pi*\frac{rad}{cutoff}) @f$
+!>          - rad > cutoff : @f$ filter=0 @f$
+!>       - 'gauss'
+!>          - @f$filter=exp(-(\alpha * rad^2) / (2*cutoff^2))@f$
+!>       - 'butterworth'
+!>          - @f$ filer=1 / (1+(rad^2 / cutoff^2)^{\alpha}) @f$
+!>             .
+!>
+!>       with @f$ rad= \sqrt{(dist-radius)^2} @f$
+!>
+!>    td_var\%c_filter(2) string character is the number of turn to be done<br/>
+!>    td_var\%c_filter(3) string character is the cut-off frequency 
+! >                       (count in number of mesh grid)<br/>
+!>    td_var\%c_filter(4) string character is the halo radius 
+!>                        (count in number of mesh grid)<br/>
+!>    td_var\%c_filter(5) string character is the alpha parameter 
+!>                        (for gauss and butterworth method)<br/>
+!>    
+!>    @note Filter method could be specify for each variable in namelist _namvar_,
+!>    defining string character _cn\_varinfo_. None by default.<br/>
+!>    Filter method parameters are informed inside bracket.
+!>       - @f$\alpha@f$ parameter is added for _gauss_ and _butterworth_ methods
+!> 
+!>    The number of turn is specify using '*' separator.<br/>
+!>    Example:
+!>       - cn_varinfo='varname1:flt=2*hamming(@f$cutoff@f$,@f$radius@f$)', 
+!>                    'varname2:flt=gauss(@f$cutoff@f$,@f$radius@f$,@f$\alpha@f$)'
+!>
+!>    to filter variable value:<br/>
+!> @code
+!>    CALL filter_fill_value( td_var )
+!> @endcode
+!>       - td_var is variable structure
+!>
+!> @author
+!> J.Paul
+!>
+!> @date November, 2013 - Initial Version
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE filter
+
+   USE kind                            ! F90 kind parameter
+   USE phycst                          ! physical constant
+   USE logger                          ! log file manager
+   USE fct                             ! basic usefull function
+   use att                             ! attribute manager
+   USE var                             ! variable manager
+   USE extrap                          ! extrapolation manager
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+
+
+   ! function and subroutine
+   PUBLIC :: filter_fill_value   !< filter variable value
+
+   PRIVATE :: filter__fill_value_wrapper !
+   PRIVATE :: filter__fill_value         !
+   PRIVATE :: filter__3D_fill_value      ! 
+   PRIVATE :: filter__2D_fill_value      !
+   PRIVATE :: filter__2D                 !
+   PRIVATE :: filter__2D_coef            !
+   PRIVATE :: filter__2D_hann            !
+   PRIVATE :: filter__2D_hamming         !
+   PRIVATE :: filter__2D_blackman        !
+   PRIVATE :: filter__2D_gauss           !
+   PRIVATE :: filter__2D_butterworth     !
+   PRIVATE :: filter__1D_fill_value      !
+   PRIVATE :: filter__1D                 !
+   PRIVATE :: filter__1D_coef            !
+   PRIVATE :: filter__1D_hann            !
+   PRIVATE :: filter__1D_hamming         !
+   PRIVATE :: filter__1D_blackman        !
+   PRIVATE :: filter__1D_gauss           !
+   PRIVATE :: filter__1D_butterworth     !
+
+   INTERFACE filter_fill_value
+      MODULE PROCEDURE filter__fill_value_wrapper
+   END INTERFACE filter_fill_value
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE filter__fill_value_wrapper(td_var)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine filter variable value.
+   !>
+   !> @details
+   !> it checks if filtering method is available,
+   !>  gets parameter value, and launch filter__fill_value 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_filter
+      CHARACTER(LEN=lc) :: cl_method
+      INTEGER(I4)       :: il_radius
+      INTEGER(I4)       :: il_nturn
+      REAL(dp)          :: dl_cutoff 
+      REAL(dp)          :: dl_alpha
+
+      TYPE(TATT)        :: tl_att
+
+      ! loop indices
+      INTEGER(I4) :: jl
+      !----------------------------------------------------------------
+
+      IF( .NOT. ASSOCIATED(td_var%d_value) )THEN
+         CALL logger_error("FILTER FILL VALUE: no array of value "//&
+         &  "associted to variable "//TRIM(td_var%c_name) )
+      ELSE
+
+         SELECT CASE(TRIM(td_var%c_filter(1)))
+
+         CASE DEFAULT
+         
+            CALL logger_trace("FILTER FILL VALUE: no filter selected "//&
+            &  "for variable "//TRIM(td_var%c_name))
+
+         CASE('hann','hamming','blackman','gauss','butterworth')
+
+            cl_method=TRIM(td_var%c_filter(1))
+
+            ! look for number of turn to be done
+            READ(td_var%c_filter(2),*) il_nturn
+            IF( il_nturn < 0 )THEN
+               CALL logger_error("FILTER FILL VALUE: invalid "//&
+               &  "number of turn ("//TRIM(td_var%c_filter(2))//")")
+            ENDIF
+
+            ! look for cut-off frequency
+            dl_cutoff=2
+            IF( TRIM(td_var%c_filter(3)) /= '' )THEN
+               READ(td_var%c_filter(3),*) dl_cutoff
+            ENDIF
+            IF( dl_cutoff < 0 )THEN
+               CALL logger_error("FILTER FILL VALUE: invalid cut-off "//&
+               &  "frequency ("//TRIM(td_var%c_filter(3))//")")
+            ENDIF
+
+            ! look for halo size
+            il_radius=1
+            IF( TRIM(td_var%c_filter(4)) /= '' )THEN
+               READ(td_var%c_filter(4),*) il_radius
+            ENDIF
+            IF( il_radius < 0 )THEN
+               CALL logger_error("FILTER FILL VALUE: invalid halo radius "//&
+               &  " ("//TRIM(td_var%c_filter(4))//")")
+            ENDIF
+
+            IF( REAL(2*il_radius+1,dp) < dl_cutoff )THEN
+               CALL logger_error("FILTER FILL VALUE: radius of halo and "//&
+               &  "spatial cut-off frequency are not suitable.")
+            ENDIF
+
+            ! look for alpha parameter
+            dl_alpha=2
+            IF( TRIM(td_var%c_filter(5)) /= '' )THEN
+               READ(td_var%c_filter(5),*) dl_alpha
+            ENDIF
+
+            SELECT CASE(TRIM(cl_method))
+            CASE('gauss','butterworth')
+               CALL logger_info("FILTER FILL VALUE: filtering "//&
+               &   " variable "//TRIM(td_var%c_name)//&
+               &   " using "//TRIM(fct_str(il_nturn))//" turn"//&
+               &   " of "//TRIM(cl_method)//" method,"//&
+               &   " with cut-off frequency of "//&
+               &        TRIM(fct_str(REAL(dl_cutoff,sp)))//&
+               &   ", halo's radius of "//&
+               &        TRIM(fct_str(il_radius))//&
+               &   ", and alpha parameter of "//&
+               &        TRIM(fct_str(REAL(dl_alpha,sp))) )
+            CASE DEFAULT
+               CALL logger_info("FILTER FILL VALUE: filtering "//&
+               &   " variable "//TRIM(td_var%c_name)//&
+               &   " using "//TRIM(fct_str(il_nturn))//" turn"//&
+               &   " of "//TRIM(cl_method)//" method,"//&
+               &   " with cut-off frequency of "//&
+               &        TRIM(fct_str(REAL(dl_cutoff,sp)))//&
+               &   " and halo's radius of "//&
+               &        TRIM(fct_str(il_radius)) )
+            END SELECT
+      
+            IF( .NOT. ANY(td_var%t_dim(1:3)%l_use) )THEN
+               ! no dimension I-J-K used
+               CALL logger_debug("FILTER FILL VALUE: no filtering can "//&
+               &  "be done for variable "//TRIM(td_var%c_name))
+            ELSE 
+
+               ! add attribute to variable
+               SELECT CASE(TRIM(cl_method))
+               CASE('gauss','butterworth')
+                  cl_filter=TRIM(fct_str(il_nturn))//'*'//TRIM(cl_method)//&
+                  &                    '('//TRIM(fct_str(REAL(dl_cutoff,sp)))//","//&
+                  &                         TRIM(fct_str(il_radius))//","//&
+                  &                         TRIM(fct_str(REAL(dl_alpha,sp)))//')'
+               CASE DEFAULT
+                  cl_filter=TRIM(fct_str(il_nturn))//'*'//TRIM(cl_method)//&
+                  &                    '('//TRIM(fct_str(REAL(dl_cutoff,sp)))//","//&
+                  &                         TRIM(fct_str(il_radius))//')'
+               END SELECT
+               tl_att=att_init('filter',cl_filter)
+               CALL var_move_att(td_var,tl_att)
+               ! clean
+               CALL att_clean(tl_att)
+
+               DO jl=1,il_nturn
+                  CALL filter__fill_value( td_var, TRIM(cl_method),  & 
+                  &                        dl_cutoff, il_radius, dl_alpha )
+               ENDDO
+            ENDIF               
+
+         END SELECT
+
+      ENDIF
+   END SUBROUTINE filter__fill_value_wrapper
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE filter__fill_value(td_var, cd_name, &
+         &                       dd_cutoff, id_radius, dd_alpha)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine filtering variable value, given cut-off frequency
+   !> halo radius and alpha parameter.
+   !> 
+   !> @details 
+   !>    First extrabands are added to array of variable value.
+   !>    Then values are extrapolated, before apply filter.
+   !>    Finally extrabands are removed.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable 
+   !> @param[in] cd_name   filter name
+   !> @param[in] dd_cutoff cut-off frequency
+   !> @param[in] id_radius filter halo radius
+   !> @param[in] dd_alpha  filter parameter
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR)      , INTENT(INOUT) :: td_var
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+      REAL(dp)        , INTENT(IN   ) :: dd_cutoff 
+      INTEGER(I4)     , INTENT(IN   ) :: id_radius
+      REAL(dp)        , INTENT(IN   ) :: dd_alpha
+
+      ! local variable
+      TYPE(TVAR)                                         :: tl_mask
+
+      INTEGER(i1)      , DIMENSION(:,:,:,:), ALLOCATABLE :: bl_mask
+
+      ! loop indices
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      CALL logger_debug("FILTER: "//TRIM(fct_str(td_var%d_fill)) )
+
+      !1-add extraband
+      CALL extrap_add_extrabands(td_var, id_radius, id_radius)
+
+      !2-compute mask
+      ALLOCATE(bl_mask(td_var%t_dim(1)%i_len, &
+      &                td_var%t_dim(2)%i_len, &
+      &                td_var%t_dim(3)%i_len, &
+      &                td_var%t_dim(4)%i_len) )
+
+      bl_mask(:,:,:,:)=1
+      WHERE(td_var%d_value(:,:,:,:)==td_var%d_fill) bl_mask(:,:,:,:)=0      
+
+      tl_mask=var_init('tmask', bl_mask(:,:,:,:))
+
+      DEALLOCATE(bl_mask)
+
+      !3-extrapolate
+      CALL extrap_fill_value( td_var ) !, id_iext=id_radius, id_jext=id_radius )
+
+      !4-filtering
+      DO jl=1,td_var%t_dim(4)%i_len
+         IF( ALL(td_var%t_dim(1:3)%l_use) )THEN
+            ! dimension I-J-K used
+            CALL filter__3D_fill_value( td_var%d_value(:,:,:,jl),       &
+            &                           td_var%d_fill, TRIM(cd_name), &
+            &                           dd_cutoff, id_radius, dd_alpha)
+         ELSE IF( ALL(td_var%t_dim(1:2)%l_use) )THEN 
+            ! dimension I-J used
+            CALL filter__2D_fill_value( td_var%d_value(:,:,1,jl),       &
+            &                           td_var%d_fill, TRIM(cd_name), &
+            &                           dd_cutoff, id_radius, dd_alpha)         
+         ELSE IF( td_var%t_dim(3)%l_use )THEN 
+            ! dimension K used
+            CALL filter__1D_fill_value( td_var%d_value(1,1,:,jl),       &
+            &                           td_var%d_fill, TRIM(cd_name), &
+            &                           dd_cutoff, id_radius, dd_alpha)         
+         ENDIF
+      ENDDO
+
+      !5-keep original mask
+      WHERE( tl_mask%d_value(:,:,:,:) == 0 )
+         td_var%d_value(:,:,:,:)=td_var%d_fill
+      END WHERE
+
+      ! clean
+      CALL var_clean(tl_mask)
+
+      !6-remove extraband
+      CALL extrap_del_extrabands(td_var, id_radius, id_radius)
+
+   END SUBROUTINE filter__fill_value
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE filter__3D_fill_value(dd_value, dd_fill, cd_name, &
+         &                          dd_cutoff, id_radius, dd_alpha)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute filtered value of 3D array. 
+   !>
+   !> @details
+   !>    First compute filter coefficient.
+   !>    Then apply it on each level of variable value.
+   !>
+   !> @warning array of value should have been already extrapolated before
+   !> running this subroutine.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] dd_value  array of value to be filtered 
+   !> @param[in] dd_fill      fill value 
+   !> @param[in] cd_name      filter name
+   !> @param[in] dd_cutoff    cut-off frequency
+   !> @param[in] id_radius    filter halo radius
+   !> @param[in] dd_alpha     filter parameter
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      REAL(dp)        , DIMENSION(:,:,:), INTENT(INOUT) :: dd_value
+      REAL(dp)        ,                   INTENT(IN   ) :: dd_fill
+      CHARACTER(LEN=*),                   INTENT(IN   ) :: cd_name
+      REAL(dp)        ,                   INTENT(IN   ) :: dd_cutoff
+      INTEGER(i4)     ,                   INTENT(IN   ) :: id_radius
+      REAL(dp)        ,                   INTENT(IN   ) :: dd_alpha      
+
+      ! local variable
+      INTEGER(i4), DIMENSION(3)                :: il_shape
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_coef
+
+      ! loop indices
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+      
+      il_shape(:)=SHAPE(dd_value(:,:,:))
+
+      ALLOCATE( dl_coef(2*id_radius+1,2*id_radius+1) )
+
+      dl_coef(:,:)=filter__2D_coef(cd_name, dd_cutoff, id_radius, dd_alpha)
+
+      DO jk=1,il_shape(3)
+         CALL filter__2D(dd_value(:,:,jk), dd_fill,dl_coef(:,:),id_radius)
+      ENDDO
+
+      DEALLOCATE( dl_coef )
+
+   END SUBROUTINE filter__3D_fill_value
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE filter__2D_fill_value(dd_value, dd_fill, cd_name, &
+         &                          dd_cutoff, id_radius, dd_alpha)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute filtered value of 2D array.
+   !>
+   !> @details
+   !>    First compute filter coefficient.
+   !>    Then apply it on variable value.
+   !>
+   !> @warning array of value should have been already extrapolated before
+   !> running this subroutine.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] dd_value  array of value to be filtered 
+   !> @param[in] dd_fill      fill value 
+   !> @param[in] cd_name      filter name
+   !> @param[in] dd_cutoff    cut-off frequency
+   !> @param[in] id_radius    filter halo radius
+   !> @param[in] dd_alpha     filter parameter
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)        , DIMENSION(:,:), INTENT(INOUT) :: dd_value
+      REAL(dp)        ,                 INTENT(IN   ) :: dd_fill
+      CHARACTER(LEN=*),                 INTENT(IN   ) :: cd_name
+      REAL(dp)        ,                 INTENT(IN   ) :: dd_cutoff
+      INTEGER(i4)     ,                 INTENT(IN   ) :: id_radius
+      REAL(dp)        ,                 INTENT(IN   ) :: dd_alpha      
+
+      ! local variable
+
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_coef
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ALLOCATE( dl_coef(2*id_radius+1,2*id_radius+1) )
+
+      dl_coef(:,:)=filter__2D_coef(cd_name, dd_cutoff, id_radius, dd_alpha)
+
+      CALL filter__2D(dd_value(:,:), dd_fill, dl_coef(:,:), id_radius)
+
+      DEALLOCATE( dl_coef )
+
+   END SUBROUTINE filter__2D_fill_value
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE filter__1D_fill_value(dd_value, dd_fill, cd_name, &
+         &                          dd_cutoff, id_radius, dd_alpha)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute filtered value of 1D array.
+   !>
+   !> @details
+   !>    First compute filter coefficient.
+   !>    Then apply it on variable value.
+   !>
+   !> @warning array of value should have been already extrapolated before
+   !> running this subroutine.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] dd_value  array of value to be filtered 
+   !> @param[in] dd_fill      fill value 
+   !> @param[in] cd_name      filter name
+   !> @param[in] dd_cutoff    cut-off frequency
+   !> @param[in] id_radius    filter halo radius
+   !> @param[in] dd_alpha     filter parameter
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      REAL(dp)        , DIMENSION(:), INTENT(INOUT) :: dd_value
+      REAL(dp)        ,               INTENT(IN   ) :: dd_fill
+      CHARACTER(LEN=*),               INTENT(IN   ) :: cd_name
+      REAL(dp)        ,               INTENT(IN   ) :: dd_cutoff
+      INTEGER(i4)     ,               INTENT(IN   ) :: id_radius
+      REAL(dp)        ,               INTENT(IN   ) :: dd_alpha      
+
+      ! local variable
+
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_coef
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ALLOCATE( dl_coef(2*id_radius+1) )
+
+      dl_coef(:)=filter__1D_coef(cd_name, dd_cutoff, id_radius, dd_alpha)
+
+      CALL filter__1D(dd_value(:), dd_fill, dl_coef(:),id_radius)
+
+      DEALLOCATE( dl_coef )
+
+   END SUBROUTINE filter__1D_fill_value
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE filter__2D(dd_value, dd_fill, dd_coef, id_radius)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine filtered 2D array of value 
+   !>
+   !> @details
+   !>    loop on first and second dimension, 
+   !>    and apply coefficient 2D array on each point
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] dd_value  array of value to be filtered 
+   !> @param[in] dd_fill      fill value 
+   !> @param[in] dd_coef      filter coefficent array
+   !> @param[in] id_radius    filter halo radius
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      REAL(dp)        , DIMENSION(:,:), INTENT(INOUT) :: dd_value
+      REAL(dp)        ,                 INTENT(IN   ) :: dd_fill 
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_coef 
+      INTEGER(i4)     ,                 INTENT(IN   ) :: id_radius
+
+      ! local variable
+      INTEGER(i4), DIMENSION(2)                :: il_shape
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_value
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_halo
+
+      ! loop indices
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      il_shape(:)=SHAPE(dd_value(:,:))
+
+      ALLOCATE(dl_value(il_shape(1),il_shape(2)))
+      dl_value(:,:)=dd_value(:,:)
+
+      ALLOCATE(dl_halo(2*id_radius+1,2*id_radius+1))
+
+      DO jj=1+id_radius,il_shape(2)-id_radius
+         DO ji=1+id_radius,il_shape(1)-id_radius
+
+            dl_halo(:,:)=dd_fill
+            dl_halo(:,:)=dl_value(ji-id_radius:ji+id_radius, &
+            &                     jj-id_radius:jj+id_radius)
+
+            dd_value(ji,jj)=SUM(dl_halo(:,:)*dd_coef(:,:))
+
+         ENDDO
+      ENDDO
+
+      DEALLOCATE(dl_halo)
+      DEALLOCATE(dl_value)
+
+   END SUBROUTINE filter__2D
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE filter__1D(dd_value, dd_fill, dd_coef, id_radius)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine filtered 1D array of value  
+   !>
+   !> @details
+   !>    loop on first dimension, 
+   !>    and apply coefficient 1D array on each point
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] dd_value  array of value to be filtered 
+   !> @param[in] dd_fill      fill value 
+   !> @param[in] dd_coef      filter coefficent array
+   !> @param[in] id_radius    filter halo radius
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      REAL(dp)        , DIMENSION(:), INTENT(INOUT) :: dd_value
+      REAL(dp)        ,               INTENT(IN   ) :: dd_fill 
+      REAL(dp)        , DIMENSION(:), INTENT(IN   ) :: dd_coef 
+      INTEGER(i4)     ,               INTENT(IN   ) :: id_radius
+
+      ! local variable
+      INTEGER(i4), DIMENSION(1)              :: il_shape
+      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      il_shape(:)=SHAPE(dd_value(:))
+
+      ALLOCATE(dl_value(2*id_radius+1))
+
+      DO ji=1+id_radius,il_shape(1)-id_radius
+
+         dl_value(:)=dd_fill
+         dl_value(:)=dd_value(ji-id_radius:ji+id_radius)
+
+         dd_value(ji)=SUM(dl_value(:)*dd_coef(:))
+
+      ENDDO
+
+      DEALLOCATE(dl_value)
+
+   END SUBROUTINE filter__1D
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION filter__2D_coef(cd_name, dd_cutoff, id_radius, dd_alpha) &
+         & RESULT (df_coef)
+   !-------------------------------------------------------------------
+   !> @brief This function compute filter coefficient. 
+   !>
+   !> @details
+   !> 
+   !> filter could be choose between :
+   !> - hann
+   !> - hamming
+   !> - blackman
+   !> - gauss
+   !> - butterworth
+   !> Cut-off frequency could be specify.
+   !> As well as a filter parameter for gauss and butterworth filter
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] cd_name   filter name
+   !> @param[in] dd_cutoff cut-off frequency
+   !> @param[in] id_radius filter halo radius
+   !> @param[in] dd_alpha  filter parameter 
+   !> @return array of filter coefficient
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+      REAL(dp)        , INTENT(IN) :: dd_cutoff
+      INTEGER(i4)     , INTENT(IN) :: id_radius
+      REAL(dp)        , INTENT(IN) :: dd_alpha
+
+      ! function
+      REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: df_coef
+
+      ! local variable
+
+      ! loop indices
+      !----------------------------------------------------------------
+      IF( REAL(id_radius,dp) < dd_cutoff )THEN
+         CALL logger_warn("FILTER COEF: radius of the filter halo "//&
+         &  "is lower than cut-off frequency")
+      ENDIF
+
+      SELECT CASE(TRIM(fct_lower(cd_name)))
+      CASE('hann')
+         df_coef(:,:)=filter__2D_hann(dd_cutoff, id_radius)
+      CASE('hamming')
+         df_coef(:,:)=filter__2D_hamming(dd_cutoff, id_radius)
+      CASE('blackman')
+         df_coef(:,:)=filter__2D_blackman(dd_cutoff, id_radius)
+      CASE('gauss')
+         df_coef(:,:)=filter__2D_gauss(dd_cutoff, id_radius, dd_alpha)
+      CASE('butterworth')
+         df_coef(:,:)=filter__2D_butterworth(dd_cutoff, id_radius, dd_alpha)
+      CASE DEFAULT
+         CALL logger_error("FILTER COEF: invalid filter name :"//TRIM(cd_name))
+      END SELECT
+
+   END FUNCTION filter__2D_coef
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION filter__1D_coef(cd_name, dd_cutoff, id_radius, dd_alpha) &
+         & RESULT (df_coef)
+   !-------------------------------------------------------------------
+   !> @brief This function compute filter coefficient. 
+   !>
+   !> @details
+   !> 
+   !> filter could be choose between :
+   !> - hann
+   !> - hamming
+   !> - blackman
+   !> - gauss
+   !> - butterworth
+   !> Cut-off frequency could be specify.
+   !> As well as a filter parameter for gauss an butterworth filter
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] cd_name   filter name
+   !> @param[in] dd_cutoff cut-off frequency
+   !> @param[in] id_radius filter halo radius
+   !> @param[in] dd_alpha  filter parameter 
+   !> @return array of filter coefficient
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+      REAL(dp)        , INTENT(IN) :: dd_cutoff
+      INTEGER(i4)     , INTENT(IN) :: id_radius
+      REAL(dp)        , INTENT(IN) :: dd_alpha
+
+      ! function
+      REAL(dp), DIMENSION(2*id_radius+1) :: df_coef
+
+      ! local variable
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      SELECT CASE(TRIM(fct_lower(cd_name)))
+      CASE('hann')
+         df_coef(:)=filter__1D_hann(dd_cutoff, id_radius)
+      CASE('hamming')
+         df_coef(:)=filter__1D_hamming(dd_cutoff, id_radius)
+      CASE('blackman')
+         df_coef(:)=filter__1D_blackman(dd_cutoff, id_radius)
+      CASE('gauss')
+         df_coef(:)=filter__1D_gauss(dd_cutoff, id_radius, dd_alpha)
+      CASE('butterworth')
+         df_coef(:)=filter__1D_butterworth(dd_cutoff, id_radius, dd_alpha)
+      CASE DEFAULT
+         CALL logger_error("FILTER COEF: invalid filter name :"//TRIM(cd_name))
+      END SELECT
+
+   END FUNCTION filter__1D_coef
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION filter__1D_hann(dd_cutoff, id_radius) &
+         & RESULT (df_coef)
+   !-------------------------------------------------------------------
+   !> @brief This function compute coefficient for HANN filter.
+   !>
+   !> @details
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] dd_cutoff cut-off frequency
+   !> @param[in] id_radius filter halo radius
+   !> @return array of hann filter coefficient 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      REAL(dp)        , INTENT(IN) :: dd_cutoff 
+      INTEGER(i4)     , INTENT(IN) :: id_radius
+
+      ! function
+      REAL(dp), DIMENSION(2*id_radius+1) :: df_coef
+
+      ! local variable
+      REAL(dp) :: dl_rad
+      REAL(dp) :: dl_sum
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( dd_cutoff < 1 )THEN
+         CALL logger_error("FILTER COEF: cut-off frequency "//&
+         &  "should be greater than or equal to 1. No filter will be apply ")
+         df_coef(:)=0.
+         df_coef(id_radius+1)=1.
+      ELSE
+         DO ji=1,2*id_radius+1
+
+            dl_rad=SQRT(REAL(ji-id_radius+1,dp)**2 )
+            
+            IF( dl_rad < dd_cutoff )THEN
+               df_coef(ji)=0.5 + 0.5*COS(dp_pi*dl_rad/dd_cutoff)
+            ELSE
+               df_coef(ji)=0
+            ENDIF
+
+         ENDDO
+
+         ! normalize
+         dl_sum=SUM(df_coef(:))
+
+         df_coef(:)=df_coef(:)/dl_sum
+      ENDIF
+
+   END FUNCTION filter__1D_hann
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION filter__2D_hann(dd_cutoff, id_radius) &
+         & RESULT (df_coef)
+   !-------------------------------------------------------------------
+   !> @brief This function compute coefficient for HANN filter.
+   !>
+   !> @details
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] dd_cutoff cut-off frequency
+   !> @param[in] id_radius filter halo radius
+   !> @return array of hann filter coefficient 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      REAL(dp)   , INTENT(IN) :: dd_cutoff 
+      INTEGER(i4), INTENT(IN) :: id_radius
+
+      ! function
+      REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: df_coef
+
+      ! local variable
+      REAL(dp) :: dl_rad
+      REAL(dp) :: dl_sum
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      IF( dd_cutoff < 1.0_dp )THEN
+         CALL logger_error("FILTER COEF: cut-off frequency "//&
+         &  "should be greater than or equal to 1. No filter will be apply ")
+         df_coef(:,:)=0.
+         df_coef(id_radius+1,id_radius+1)=1.
+      ELSE
+         DO jj=1,2*id_radius+1
+            DO ji=1,2*id_radius+1
+
+               ! radius
+               dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 + &
+               &             REAL(jj-(id_radius+1),dp)**2 )
+               
+               IF( dl_rad < dd_cutoff )THEN
+                  df_coef(ji,jj)=0.5 + 0.5*COS(dp_pi*dl_rad/dd_cutoff)
+               ELSE
+                  df_coef(ji,jj)=0
+               ENDIF
+
+            ENDDO
+         ENDDO
+
+         ! normalize
+         dl_sum=SUM(df_coef(:,:))
+
+         df_coef(:,:)=df_coef(:,:)/dl_sum
+      ENDIF
+
+   END FUNCTION filter__2D_hann
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION filter__1D_hamming(dd_cutoff, id_radius) &
+         & RESULT (df_coef)
+   !-------------------------------------------------------------------
+   !> @brief This function compute coefficient for HAMMING filter.
+   !>
+   !> @details
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] dd_cutoff cut-off frequency
+   !> @param[in] id_radius filter halo radius
+   !> @return array of hamming filter coefficient 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      REAL(dp)        , INTENT(IN) :: dd_cutoff 
+      INTEGER(i4)     , INTENT(IN) :: id_radius
+
+      ! function
+      REAL(dp), DIMENSION(2*id_radius+1) :: df_coef
+
+      ! local variable
+      REAL(dp) :: dl_rad
+      REAL(dp) :: dl_sum
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( dd_cutoff < 1 )THEN
+         CALL logger_error("FILTER COEF: cut-off frequency "//&
+         &  "should be greater than or equal to 1. No filter will be apply ")
+         df_coef(:)=0.
+         df_coef(id_radius+11)=1.
+      ELSE
+         DO ji=1,2*id_radius+1
+
+            dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 )
+         
+            IF( dl_rad < dd_cutoff )THEN
+               df_coef(ji)= 0.54 + 0.46*COS(dp_pi*dl_rad/dd_cutoff)
+            ELSE
+               df_coef(ji)=0
+            ENDIF
+
+         ENDDO
+
+         ! normalize
+         dl_sum=SUM(df_coef(:))
+
+         df_coef(:)=df_coef(:)/dl_sum
+      ENDIF
+
+   END FUNCTION filter__1D_hamming
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION filter__2D_hamming(dd_cutoff, id_radius) &
+         & RESULT (df_coef)
+   !-------------------------------------------------------------------
+   !> @brief This function compute coefficient for HAMMING filter.
+   !>
+   !> @details
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] dd_cutoff cut-off frequency
+   !> @param[in] id_radius filter halo radius
+   !> @return array of hamming filter coefficient 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      REAL(dp)        , INTENT(IN) :: dd_cutoff 
+      INTEGER(i4)     , INTENT(IN) :: id_radius
+
+      ! function
+      REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: df_coef
+
+      ! local variable
+      REAL(dp) :: dl_rad
+      REAL(dp) :: dl_sum
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      IF( dd_cutoff < 1 )THEN
+         CALL logger_error("FILTER COEF: cut-off frequency "//&
+         &  "should be greater than or equal to 1. No filter will be apply ")
+         df_coef(:,:)=0.
+         df_coef(id_radius+1,id_radius+1)=1.
+      ELSE
+         DO jj=1,2*id_radius+1
+            DO ji=1,2*id_radius+1
+
+               dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 + &
+                  &          REAL(jj-(id_radius+1),dp)**2 )
+            
+               IF( dl_rad < dd_cutoff )THEN
+                  df_coef(ji,jj)= 0.54 + 0.46*COS(dp_pi*dl_rad/dd_cutoff)
+               ELSE
+                  df_coef(ji,jj)=0
+               ENDIF
+
+            ENDDO
+         ENDDO
+
+         ! normalize
+         dl_sum=SUM(df_coef(:,:))
+
+         df_coef(:,:)=df_coef(:,:)/dl_sum
+      ENDIF
+
+   END FUNCTION filter__2D_hamming
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION filter__1D_blackman(dd_cutoff, id_radius) &
+         & RESULT (df_coef)
+   !-------------------------------------------------------------------
+   !> @brief This function compute coefficient for BLACKMAN filter.
+   !>
+   !> @details
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] dd_cutoff cut-off frequency
+   !> @param[in] id_radius filter halo radius
+   !> @return array of blackman filter coefficient 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      REAL(dp)        , INTENT(IN) :: dd_cutoff
+      INTEGER(i4)     , INTENT(IN) :: id_radius
+
+      ! function
+      REAL(dp), DIMENSION(2*id_radius+1) :: df_coef
+
+      ! local variable
+      REAL(dp) :: dl_rad
+      REAL(dp) :: dl_sum
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( dd_cutoff < 1 )THEN
+         CALL logger_error("FILTER COEF: cut-off frequency "//&
+         &  "should be greater than or equal to 1. No filter will be apply ")
+         df_coef(:)=0.
+         df_coef(id_radius+1)=1.
+      ELSE      
+         DO ji=1,2*id_radius+1
+
+            dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 )
+            
+            IF( dl_rad < dd_cutoff )THEN
+               df_coef(ji)= 0.42 + 0.5 *COS(  dp_pi*dl_rad/dd_cutoff) &
+                  &              + 0.08*COS(2*dp_pi*dl_rad/dd_cutoff)
+            ELSE
+               df_coef(ji)=0
+            ENDIF                                
+
+         ENDDO
+
+         ! normalize
+         dl_sum=SUM(df_coef(:))
+
+         df_coef(:)=df_coef(:)/dl_sum
+      ENDIF
+
+   END FUNCTION filter__1D_blackman
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION filter__2D_blackman(dd_cutoff, id_radius) &
+         & RESULT (df_coef)
+   !-------------------------------------------------------------------
+   !> @brief This function compute coefficient for BLACKMAN filter.
+   !>
+   !> @details
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] dd_cutoff cut-off frequency
+   !> @param[in] id_radius filter halo radius
+   !> @return array of blackman filter coefficient 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      REAL(dp)        , INTENT(IN) :: dd_cutoff 
+      INTEGER(i4)     , INTENT(IN) :: id_radius
+
+      ! function
+      REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: df_coef
+
+      ! local variable
+      REAL(dp) :: dl_rad
+      REAL(dp) :: dl_sum
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      IF( dd_cutoff < 1 )THEN
+         CALL logger_error("FILTER COEF: cut-off frequency "//&
+         &  "should be greater than or equal to 1. No filter will be apply ")
+         df_coef(:,:)=0.
+         df_coef(id_radius+1,id_radius+1)=1.
+      ELSE      
+         DO jj=1,2*id_radius+1
+            DO ji=1,2*id_radius+1
+
+               dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 + &
+               &             REAL(jj-(id_radius+1),dp)**2 )
+               
+               IF( dl_rad < dd_cutoff )THEN
+                  df_coef(ji,jj)= 0.42 + 0.5 *COS(  dp_pi*dl_rad/dd_cutoff) &
+                     &                 + 0.08*COS(2*dp_pi*dl_rad/dd_cutoff)
+               ELSE
+                  df_coef(ji,jj)=0
+               ENDIF                                
+
+            ENDDO
+         ENDDO
+
+         ! normalize
+         dl_sum=SUM(df_coef(:,:))
+
+         df_coef(:,:)=df_coef(:,:)/dl_sum
+      ENDIF
+
+   END FUNCTION filter__2D_blackman
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION filter__1D_gauss(dd_cutoff, id_radius, dd_alpha) &
+         & RESULT (df_coef)
+   !-------------------------------------------------------------------
+   !> @brief This function compute coefficient for GAUSS filter.
+   !>
+   !> @details
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] dd_cutoff cut-off frequency
+   !> @param[in] id_radius filter halo radius
+   !> @param[in] dd_alpha  filter parameter
+   !> @return array of gauss filter coefficient 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      REAL(dp)        , INTENT(IN) :: dd_cutoff 
+      INTEGER(i4)     , INTENT(IN) :: id_radius
+      REAL(dp)        , INTENT(IN) :: dd_alpha 
+
+      ! function
+      REAL(dp), DIMENSION(2*id_radius+1) :: df_coef
+
+      ! local variable
+      REAL(dp) :: dl_rad
+      REAL(dp) :: dl_sum
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( dd_cutoff < 1 )THEN
+         CALL logger_error("FILTER COEF: cut-off frequency "//&
+         &  "should be greater than or equal to 1. No filter will be apply ")
+         df_coef(:)=0.
+         df_coef(id_radius+1)=1.
+      ELSE
+         DO ji=1,2*id_radius+1
+
+            dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 )
+            
+            df_coef(ji)=EXP(-(dd_alpha*dl_rad**2)/(2*dd_cutoff**2))
+
+         ENDDO
+
+         ! normalize
+         dl_sum=SUM(df_coef(:))
+
+         df_coef(:)=df_coef(:)/dl_sum
+      ENDIF
+
+   END FUNCTION filter__1D_gauss
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION filter__2D_gauss(dd_cutoff, id_radius, dd_alpha) &
+         & RESULT (df_coef)
+   !-------------------------------------------------------------------
+   !> @brief This function compute coefficient for GAUSS filter.
+   !>
+   !> @details
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] dd_cutoff cut-off frequency
+   !> @param[in] id_radius filter halo radius
+   !> @param[in] dd_alpha  filter parameter
+   !> @return array of gauss filter coefficient 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      REAL(dp)        , INTENT(IN) :: dd_cutoff 
+      INTEGER(i4)     , INTENT(IN) :: id_radius
+      REAL(dp)        , INTENT(IN) :: dd_alpha 
+
+      ! function
+      REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: df_coef
+
+      ! local variable
+      REAL(dp) :: dl_rad
+      REAL(dp) :: dl_sum
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      IF( dd_cutoff < 1 )THEN
+         CALL logger_error("FILTER COEF: cut-off frequency "//&
+         &  "should be greater than or equal to 1. No filter will be apply ")
+         df_coef(:,:)=0.
+         df_coef(id_radius+1,id_radius+1)=1.
+      ELSE
+         DO jj=1,2*id_radius+1
+            DO ji=1,2*id_radius+1
+
+               dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 + &
+                  &          REAL(jj-(id_radius+1),dp)**2 )
+               
+               df_coef(ji,jj)=EXP(-(dd_alpha*dl_rad**2)/(2*dd_cutoff**2))
+
+            ENDDO
+         ENDDO
+
+         ! normalize
+         dl_sum=SUM(df_coef(:,:))
+
+         df_coef(:,:)=df_coef(:,:)/dl_sum
+      ENDIF
+
+   END FUNCTION filter__2D_gauss
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION filter__1D_butterworth(dd_cutoff, id_radius, dd_alpha) &
+         & RESULT (df_coef)
+   !-------------------------------------------------------------------
+   !> @brief This function compute coefficient for BUTTERWORTH filter.
+   !>
+   !> @details
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] dd_cutoff cut-off frequency
+   !> @param[in] id_radius filter halo radius
+   !> @param[in] dd_alpha  filter parameter
+   !> @return array of butterworth filter coefficient 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      REAL(dp)        , INTENT(IN) :: dd_cutoff 
+      INTEGER(i4)     , INTENT(IN) :: id_radius
+      REAL(dp)        , INTENT(IN) :: dd_alpha 
+
+      ! function
+      REAL(dp), DIMENSION(2*id_radius+1) :: df_coef
+
+      ! local variable
+      REAL(dp) :: dl_rad
+      REAL(dp) :: dl_sum
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( dd_cutoff <= 1 )THEN
+         CALL logger_error("FILTER COEF: cut-off frequency "//&
+         &  "should be greater than 1. No filter will be apply ")
+         df_coef(:)=0.
+         df_coef(id_radius+1)=1.
+      ELSE
+         DO ji=1,2*id_radius+1
+
+            dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 )
+            
+            df_coef(ji)= 1 / (1+(dl_rad**2/dd_cutoff**2)**dd_alpha)
+
+         ENDDO
+
+         ! normalize
+         dl_sum=SUM(df_coef(:))
+
+         df_coef(:)=df_coef(:)/dl_sum
+      ENDIF
+
+   END FUNCTION filter__1D_butterworth
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION filter__2D_butterworth(dd_cutoff,  id_radius, dd_alpha) &
+         & RESULT (df_coef)
+   !-------------------------------------------------------------------
+   !> @brief This function compute coefficient for BUTTERWORTH filter.
+   !>
+   !> @details
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] dd_cutoff cut-off frequency
+   !> @param[in] id_radius filter halo radius
+   !> @param[in] dd_alpha  filter parameter
+   !> @return array of butterworth filter coefficient 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      REAL(dp)        , INTENT(IN) :: dd_cutoff 
+      INTEGER(i4)     , INTENT(IN) :: id_radius
+      REAL(dp)        , INTENT(IN) :: dd_alpha 
+
+      ! function
+      REAL(dp), DIMENSION(2*id_radius+1,2*id_radius+1) :: df_coef
+
+      ! local variable
+      REAL(dp) :: dl_rad
+      REAL(dp) :: dl_sum
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      IF( dd_cutoff <= 1 )THEN
+         CALL logger_error("FILTER COEF: cut-off frequency "//&
+         &  "should be greater than 1. No filter will be apply ")
+         df_coef(:,:)=0.
+         df_coef(id_radius+1,id_radius+1)=1.
+      ELSE
+         DO jj=1,2*id_radius+1
+            DO ji=1,2*id_radius+1
+
+               dl_rad= SQRT( REAL(ji-(id_radius+1),dp)**2 + &
+                  &          REAL(jj-(id_radius+1),dp)**2 )
+               
+               df_coef(ji,jj)= 1 / (1+(dl_rad**2/dd_cutoff**2)**dd_alpha)
+
+            ENDDO
+         ENDDO
+
+         ! normalize
+         dl_sum=SUM(df_coef(:,:))
+
+         df_coef(:,:)=df_coef(:,:)/dl_sum
+      ENDIF
+
+   END FUNCTION filter__2D_butterworth
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE filter
+
Index: /utils/tools_ticket2413/SIREN/src/function.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/function.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/function.f90	(revision 12863)
@@ -0,0 +1,1300 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief
+!> This module groups some basic useful function.
+!>
+!> @details
+!>  to get free I/O unit number:<br/>
+!> @code
+!>  il_id=fct_getunit()
+!> @endcode
+!>
+!>  to convert "numeric" to string character:<br/>
+!> @code
+!>  cl_string=fct_str(numeric)
+!> @endcode
+!>  - "numeric" could be integer, real, or logical
+!>
+!>  to concatenate "numeric" to a string character:<br/>
+!> @code
+!>  cl_str=cd_char//num
+!> @endcode
+!>  - cd_char is the string character
+!>  - num is the numeric value (integer, real or logical)  
+!>
+!>  to concatenate all the element of a character array:<br/> 
+!> @code
+!>  cl_string=fct_concat(cd_arr [,cd_sep])
+!> @endcode
+!>  - cd_arr is a 1D array of character
+!>  - cd_sep is a separator character to add between each element of cd_arr 
+!> [optional]
+!>
+!>  to convert character from lower to upper case:<br/>
+!> @code
+!>  cl_upper=fct_upper(cd_var)
+!> @endcode
+!>
+!>  to convert character from upper to lower case:<br/>
+!> @code
+!>  cl_lower=fct_lower(cd_var)
+!> @endcode
+!>
+!>  to check if character is numeric
+!> @code
+!>  ll_is_num=fct_is_num(cd_var)
+!> @endcode
+!>
+!>  to check if character is real
+!> @code
+!>  ll_is_real=fct_is_real(cd_var)
+!> @endcode
+!>
+!>  to split string into substring and return one of the element:<br/>  
+!> @code
+!>  cl_str=fct_split(cd_string ,id_ind [,cd_sep])
+!> @endcode
+!>  - cd_string is a string of character
+!>  - id_ind is the indice of the lement to extract
+!>  - cd_sep is the separator use to split cd_string (default '|')
+!>
+!>  to get basename (name without path):<br/>
+!> @code
+!>  cl_str=fct_basename(cd_string [,cd_sep])
+!> @endcode
+!>  - cd_string is the string filename
+!>  - cd_sep is the separator ti be used (default '/')
+!>
+!>  to get dirname (path of the filename):<br/>
+!> @code
+!>  cl_str=fct_dirname(cd_string [,cd_sep])
+!> @endcode
+!>  - cd_string is the string filename
+!>  - cd_sep is the separator ti be used (default '/')
+!>  
+!> to create a pause statement:<br/>
+!> @code
+!> CALL fct_pause(cd_msg)
+!> @endcode
+!>    - cd_msg : message to be added [optional]
+!>
+!> to handle frotran error:<br/>
+!> @code
+!> CALL fct_err(id_status)
+!> @endcode
+!> 
+!> to show help message:<br/>
+!> @code
+!> CALL fct_help(cd_filename, cd_err)
+!> @endcode
+!>    - cd_filename : file name
+!>    - cd_err      : error message [optional]
+!>
+!> to show Siren's version:<br/>
+!> @code
+!> CALL fct_version(cd_filename)
+!> @endcode
+!>    - cd_filename : file name
+!>
+!> 
+!> @author
+!> J.Paul
+!>
+!> @date November, 2013 - Initial Version
+!> @date September, 2014 
+!> - add header
+!> @date October, 2019
+!> - add help and version function
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE fct
+
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! function and subroutine
+   PUBLIC :: fct_getunit  !< returns free unit number
+   PUBLIC :: fct_str      !< convert numeric to string character
+   PUBLIC :: OPERATOR(//) !< concatenate operator
+   PUBLIC :: fct_concat   !< concatenate all the element of a character array
+   PUBLIC :: fct_upper    !< convert character from lower to upper case
+   PUBLIC :: fct_lower    !< convert character from upper to lower case
+   PUBLIC :: fct_is_num   !< check if character is numeric
+   PUBLIC :: fct_is_real  !< check if character is real
+   PUBLIC :: fct_split    !< split string into substring
+   PUBLIC :: fct_basename !< return basename (name without path)
+   PUBLIC :: fct_dirname  !< return dirname (path without filename)
+   PUBLIC :: fct_pause    !< pause statement
+   PUBLIC :: fct_err      !< handle fortran error status
+   PUBLIC :: fct_help     !< show help message
+   PUBLIC :: fct_version  !< show Siren's version
+
+   PRIVATE :: fct__i1_str ! convert integer(1) to string character
+   PRIVATE :: fct__i2_str ! convert integer(2) to string character
+   PRIVATE :: fct__i4_str ! convert integer(4) to string character
+   PRIVATE :: fct__i8_str ! convert integer(8) to string character
+   PRIVATE :: fct__r4_str ! convert real(4) to string character
+   PRIVATE :: fct__r8_str ! convert real(8) to string character
+   PRIVATE :: fct__l_str  ! convert logical to string character
+   PRIVATE :: fct__i1_cat ! concatenate integer(1) to string character
+   PRIVATE :: fct__i2_cat ! concatenate integer(2) to string character
+   PRIVATE :: fct__i4_cat ! concatenate integer(4) to string character
+   PRIVATE :: fct__i8_cat ! concatenate integer(8) to string character
+   PRIVATE :: fct__r4_cat ! concatenate real(4) to string character
+   PRIVATE :: fct__r8_cat ! concatenate real(8) to string character
+   PRIVATE :: fct__l_cat  ! concatenate logical to string character
+   PRIVATE :: fct__split_space ! split string into substring using space as separator
+
+   INTERFACE fct_str
+      MODULE PROCEDURE fct__i1_str ! convert integer(1) to string character
+      MODULE PROCEDURE fct__i2_str ! convert integer(2) to string character
+      MODULE PROCEDURE fct__i4_str ! convert integer(4) to string character
+      MODULE PROCEDURE fct__i8_str ! convert integer(8) to string character
+      MODULE PROCEDURE fct__r4_str ! convert real(4) to string character
+      MODULE PROCEDURE fct__r8_str ! convert real(8) to string character
+      MODULE PROCEDURE fct__l_str  ! convert logical to string character
+   END INTERFACE fct_str
+
+   INTERFACE OPERATOR(//)
+      MODULE PROCEDURE fct__i1_cat ! concatenate integer(1) to string character
+      MODULE PROCEDURE fct__i2_cat ! concatenate integer(2) to string character
+      MODULE PROCEDURE fct__i4_cat ! concatenate integer(4) to string character
+      MODULE PROCEDURE fct__i8_cat ! concatenate integer(8) to string character
+      MODULE PROCEDURE fct__r4_cat ! concatenate real(4) to string character
+      MODULE PROCEDURE fct__r8_cat ! concatenate real(8) to string character
+      MODULE PROCEDURE fct__l_cat  ! concatenate logical to string character
+   END INTERFACE
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION fct__i1_cat(cd_char, bd_val) &
+         & RESULT(cf_str)
+   !------------------------------------------------------------------- 
+   !> @brief This function concatenate character and integer(1) (as character). 
+   !>
+   !> @author J.Paul 
+   !> @date September, 2014 - Initial Version 
+   !>
+   !> @param[in] cd_char   string character
+   !> @param[in] bd_val    integer(1) variable value
+   !> @return string character 
+   !------------------------------------------------------------------- 
+ 
+      IMPLICIT NONE
+ 
+      ! arguments
+      CHARACTER(LEN=lc), INTENT(IN) :: cd_char
+      INTEGER(i1),       INTENT(IN) :: bd_val
+
+      ! function
+      CHARACTER(LEN=lc)             :: cf_str
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_val
+      !---------------------------------------------------------------- 
+ 
+      cl_val = fct_str(bd_val)
+      cf_str = TRIM(cd_char)//TRIM(cl_val)
+
+   END FUNCTION fct__i1_cat 
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION fct__i2_cat(cd_char, sd_val) &
+         & RESULT(cf_str)
+   !------------------------------------------------------------------- 
+   !> @brief This function concatenate character and integer(2) (as character). 
+   !>
+   !> @author J.Paul 
+   !> @date September, 2014 - Initial Version 
+   !>
+   !> @param[in] cd_char   string character
+   !> @param[in] sd_val    integer(2) variable value
+   !> @return string character 
+   !------------------------------------------------------------------- 
+ 
+      IMPLICIT NONE
+ 
+      ! arguments
+      CHARACTER(LEN=lc), INTENT(IN) :: cd_char
+      INTEGER(i2),       INTENT(IN) :: sd_val
+
+      ! function
+      CHARACTER(LEN=lc)             :: cf_str
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_val
+      !---------------------------------------------------------------- 
+ 
+      cl_val = fct_str(sd_val)
+      cf_str = TRIM(cd_char)//TRIM(cl_val)
+
+   END FUNCTION fct__i2_cat 
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION fct__i4_cat(cd_char, id_val) &
+         & RESULT(cf_str)
+   !------------------------------------------------------------------- 
+   !> @brief This function concatenate character and integer(4) (as character). 
+   !>
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   !>
+   !> @param[in] cd_char   string character
+   !> @param[in] id_val    integer(4) variable value
+   !> @return string character 
+   !------------------------------------------------------------------- 
+ 
+      IMPLICIT NONE
+ 
+      ! arguments
+      CHARACTER(LEN=lc), INTENT(IN) :: cd_char
+      INTEGER(i4),       INTENT(IN) :: id_val
+
+      ! function
+      CHARACTER(LEN=lc)             :: cf_str
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_val
+      !---------------------------------------------------------------- 
+ 
+      cl_val = fct_str(id_val)
+      cf_str = TRIM(cd_char)//TRIM(cl_val)
+
+   END FUNCTION fct__i4_cat 
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION fct__i8_cat(cd_char, kd_val) &
+         & RESULT(cf_str)
+   !------------------------------------------------------------------- 
+   !> @brief This function concatenate character and integer(8) (as character). 
+   !>
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   !>
+   !> @param[in] cd_char   string character
+   !> @param[in] kd_val    integer(8) variable value
+   !> @return string character 
+   !------------------------------------------------------------------- 
+ 
+      IMPLICIT NONE
+ 
+      ! arguments
+      CHARACTER(LEN=lc), INTENT(IN) :: cd_char
+      INTEGER(i8),       INTENT(IN) :: kd_val
+
+      ! function
+      CHARACTER(LEN=lc)             :: cf_str
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_val
+      !---------------------------------------------------------------- 
+ 
+      cl_val = fct_str(kd_val)
+      cf_str = TRIM(cd_char)//TRIM(cl_val)
+
+   END FUNCTION fct__i8_cat 
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION fct__r4_cat(cd_char, rd_val) &
+         & RESULT(cf_str)
+   !------------------------------------------------------------------- 
+   !> @brief This function concatenate character and real(4) (as character). 
+   !>
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   !>
+   !> @param[in] cd_char   string character
+   !> @param[in] rd_val    real(4) variable value
+   !> @return string character 
+   !------------------------------------------------------------------- 
+ 
+      IMPLICIT NONE
+ 
+      ! arguments
+      CHARACTER(LEN=lc), INTENT(IN) :: cd_char
+      REAL(sp),          INTENT(IN) :: rd_val
+
+      ! function
+      CHARACTER(LEN=lc)             :: cf_str
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_val
+      !---------------------------------------------------------------- 
+ 
+      cl_val = fct_str(rd_val)
+      cf_str = TRIM(cd_char)//TRIM(cl_val)
+
+   END FUNCTION fct__r4_cat 
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION fct__r8_cat(cd_char, dd_val) &
+         & RESULT(cf_str)
+   !------------------------------------------------------------------- 
+   !> @brief This function concatenate character and real(8) (as character). 
+   !>
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   !>
+   !> @param[in] cd_char   string character
+   !> @param[in] dd_val    real(8) variable value
+   !> @return string character 
+   !------------------------------------------------------------------- 
+ 
+      IMPLICIT NONE
+ 
+      ! arguments
+      CHARACTER(LEN=lc), INTENT(IN) :: cd_char
+      REAL(dp),          INTENT(IN) :: dd_val
+
+      ! function
+      CHARACTER(LEN=lc)             :: cf_str
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_val
+      !---------------------------------------------------------------- 
+ 
+      cl_val = fct_str(dd_val)
+      cf_str = TRIM(cd_char)//TRIM(cl_val)
+
+   END FUNCTION fct__r8_cat 
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION fct__l_cat(cd_char, ld_val) &
+         & RESULT(cf_str)
+   !------------------------------------------------------------------- 
+   !> @brief This function concatenate character and logical (as character). 
+   !>
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   !>
+   !> @param[in] cd_char   string character
+   !> @param[in] ld_val    logical variable value
+   !> @return string character 
+   !------------------------------------------------------------------- 
+
+      IMPLICIT NONE
+ 
+      ! arguments
+      CHARACTER(LEN=lc), INTENT(IN) :: cd_char
+      LOGICAL,           INTENT(IN) :: ld_val
+
+      ! function
+      CHARACTER(LEN=lc)             :: cf_str
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_val
+      !---------------------------------------------------------------- 
+ 
+      cl_val = fct_str(ld_val)
+      cf_str = TRIM(cd_char)//TRIM(cl_val)
+
+   END FUNCTION fct__l_cat 
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION fct_getunit() &
+         & RESULT(if_unit)
+   !------------------------------------------------------------------- 
+   !> @brief This function returns the next available I/O unit number. 
+   !>
+   !> @author J.Paul 
+   !> @date November, 2013 - Initial Version 
+   !>
+   !> @return file id 
+   !------------------------------------------------------------------- 
+
+      IMPLICIT NONE
+ 
+      ! function
+      INTEGER(i4) :: if_unit
+
+      ! local variable 
+      LOGICAL ::  ll_opened 
+      !---------------------------------------------------------------- 
+      ! initialise 
+      if_unit = 10 
+ 
+      INQUIRE(UNIT=if_unit, OPENED=ll_opened) 
+      DO WHILE( ll_opened ) 
+         if_unit = if_unit + 1 
+         INQUIRE(UNIT=if_unit, OPENED=ll_opened)  
+      ENDDO 
+ 
+   END FUNCTION fct_getunit 
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE fct_err(id_status)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine handle Fortran status.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] id_status
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      INTEGER(i4),       INTENT(IN) :: id_status
+      !----------------------------------------------------------------
+
+      IF( id_status /= 0 )THEN
+         !CALL ERRSNS() ! not F95 standard
+         PRINT *, "FORTRAN ERROR ", id_status
+         !STOP
+      ENDIF
+
+   END SUBROUTINE fct_err
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE fct_pause(cd_msg)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine  create a pause statement
+   !>
+   !> @author J.Paul
+   !> @date November, 2014 - Initial Version
+   !>
+   !> @param[in] cd_msg optional message to be added
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL  :: cd_msg
+      !----------------------------------------------------------------
+
+      IF( PRESENT(cd_msg) )THEN
+         WRITE( *, * ) 'Press Enter to continue '//TRIM(cd_msg)
+      ELSE
+         WRITE( *, * ) 'Press Enter to continue'
+      ENDIF
+      READ( *, * )
+
+   END SUBROUTINE fct_pause
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION fct__l_str(ld_var) &
+         & RESULT(cf_str)
+   !-------------------------------------------------------------------
+   !> @brief This function convert logical to string character.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] ld_var logical variable
+   !> @return character of this integer variable
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      LOGICAL, INTENT(IN) :: ld_var
+
+      ! function
+      CHARACTER(LEN=lc)   :: cf_str
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      !----------------------------------------------------------------
+
+      WRITE(cl_tmp,*) ld_var
+      cf_str=TRIM(ADJUSTL(cl_tmp))
+
+   END FUNCTION fct__l_str
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION fct__i1_str(bd_var) &
+         & RESULT(cf_str)
+   !-------------------------------------------------------------------
+   !> @brief This function convert integer(1) to string character.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] bd_var integer(1) variable
+   !> @return character of this integer variable
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      INTEGER(i1), INTENT(IN) :: bd_var
+
+      ! function
+      CHARACTER(LEN=lc)       :: cf_str
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      !----------------------------------------------------------------
+
+      WRITE(cl_tmp,*) bd_var
+      cf_str=TRIM(ADJUSTL(cl_tmp))
+
+   END FUNCTION fct__i1_str
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION fct__i2_str(sd_var) &
+         & RESULT(cf_str)
+   !-------------------------------------------------------------------
+   !> @brief This function convert integer(2) to string character.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] sd_var integer(2) variable
+   !> @return character of this integer variable
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      INTEGER(i2), INTENT(IN) :: sd_var
+
+      ! function
+      CHARACTER(LEN=lc)       :: cf_str
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      !----------------------------------------------------------------
+
+      WRITE(cl_tmp,*) sd_var
+      cf_str=TRIM(ADJUSTL(cl_tmp))
+
+   END FUNCTION fct__i2_str
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION fct__i4_str(id_var) &
+         & RESULT(cf_str)
+   !-------------------------------------------------------------------
+   !> @brief This function convert integer(4) to string character.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] id_var integer(4) variable
+   !> @return character of this integer variable
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      INTEGER(i4), INTENT(IN) :: id_var
+
+      ! function
+      CHARACTER(LEN=lc)       :: cf_str
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      !----------------------------------------------------------------
+
+      WRITE(cl_tmp,*) id_var
+      cf_str=TRIM(ADJUSTL(cl_tmp))
+
+   END FUNCTION fct__i4_str
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION fct__i8_str(kd_var) &
+         & RESULT(cf_str)
+   !-------------------------------------------------------------------
+   !> @brief This function convert integer(8) to string character.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] kd_var integer(8) variable
+   !> @return character of this integer variable
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      INTEGER(i8), INTENT(IN) :: kd_var
+
+      ! function
+      CHARACTER(LEN=lc)       :: cf_str
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      !----------------------------------------------------------------
+
+      WRITE(cl_tmp,*) kd_var
+      cf_str=TRIM(ADJUSTL(cl_tmp))
+
+   END FUNCTION fct__i8_str
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION fct__r4_str(rd_var) &
+         & RESULT(cf_str)
+   !-------------------------------------------------------------------
+   !> @brief This function convert real(4) to string character.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] rd_var real(4) variable
+   !> @return character of this real variable
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      REAL(sp), INTENT(IN) :: rd_var
+
+      ! function
+      CHARACTER(LEN=lc)    :: cf_str
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      !----------------------------------------------------------------
+
+      WRITE(cl_tmp,*) rd_var
+      cf_str=TRIM(ADJUSTL(cl_tmp))
+
+   END FUNCTION fct__r4_str
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION fct__r8_str(dd_var) &
+         & RESULT(cf_str)
+   !-------------------------------------------------------------------
+   !> @brief This function convert real(8) to string character.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] dd_var real(8) variable
+   !> @return character of this real variable
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      REAL(dp), INTENT(IN) :: dd_var
+
+      ! function
+      CHARACTER(LEN=lc)    :: cf_str
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      !----------------------------------------------------------------
+
+      WRITE(cl_tmp,*) dd_var
+      cf_str=TRIM(ADJUSTL(cl_tmp))
+
+   END FUNCTION fct__r8_str
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION fct_concat(cd_arr,cd_sep) &
+         & RESULT(cf_str)
+   !-------------------------------------------------------------------
+   !> @brief This function concatenate all the element of a character array 
+   !> in a character string.
+   !> @details
+   !> optionnally a separator could be added between each element.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] cd_arr array of character
+   !> @param[in] cd_sep separator character
+   !> @return character
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      CHARACTER(*), DIMENSION(:), INTENT(IN) :: cd_arr
+      CHARACTER(*),               INTENT(IN), OPTIONAL :: cd_sep
+
+      ! function
+      CHARACTER(LEN=lc)                      :: cf_str
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_sep
+      INTEGER(i4)       :: il_size
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      cl_sep=''
+      IF(PRESENT(cd_sep)) cl_sep=cd_sep
+
+      il_size=SIZE(cd_arr)
+      cf_str=''
+      cl_tmp=''
+      DO ji=1,il_size
+
+         WRITE(cl_tmp,*) TRIM(cf_str)//TRIM(ADJUSTL(cd_arr(ji)))//TRIM(cl_sep)
+         cf_str=TRIM(ADJUSTL(cl_tmp))
+      
+      ENDDO
+
+   END FUNCTION fct_concat
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION fct_lower(cd_var) &
+         & RESULT(cf_str)
+   !-------------------------------------------------------------------
+   !> @brief This function convert string character upper case to lower case.
+   !>
+   !> @details
+   !> The function IACHAR returns the ASCII value of the character passed 
+   !> as argument. The ASCII code has the uppercase alphabet starting at 
+   !> code 65, and the lower case one at code 101, therefore 
+   !> IACHAR('a')- IACHAR('A') would be the difference between the uppercase
+   !> and the lowercase codes.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] cd_var character
+   !> @return lower case character
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      CHARACTER(*), INTENT(IN) :: cd_var
+
+      ! function
+      CHARACTER(LEN=lc)        :: cf_str
+
+      ! local variable
+      INTEGER(i4)                                  :: il_nletter ! number of letters in variable
+      CHARACTER(LEN=lc)                            :: cl_var
+      CHARACTER(LEN=lc), DIMENSION(:), ALLOCATABLE :: cl_tmp
+
+      INTEGER(i4) :: il_icode    ! ASCII value
+      INTEGER(i4) :: il_lacode   ! ASCII value of the lower case 'a'
+      INTEGER(i4) :: il_uacode   ! ASCII value of the upper case 'A'
+      INTEGER(i4) :: il_uzcode   ! ASCII value of the upper case 'z'
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      il_lacode=IACHAR('a')
+      il_uacode=IACHAR('A')
+      il_uzcode=IACHAR('Z')
+
+      cl_var=TRIM(ADJUSTL(cd_var))
+      il_nletter=LEN(TRIM(cl_var))
+      ALLOCATE(cl_tmp(il_nletter))
+      DO ji=1,il_nletter
+         il_icode=IACHAR(cl_var(ji:ji))
+         IF( il_icode >= il_uacode .AND. il_icode <= il_uzcode )THEN
+            ! upper case
+            cl_tmp(ji)=TRIM(CHAR(il_icode + (il_lacode - il_uacode) ))
+         ELSE
+            ! lower case and other character
+            cl_tmp(ji)=TRIM(CHAR(il_icode))
+         ENDIF
+      ENDDO
+
+      cf_str=TRIM(ADJUSTL(fct_concat(cl_tmp(:))))
+      DEALLOCATE(cl_tmp)
+
+   END FUNCTION fct_lower
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION fct_upper(cd_var) &
+         & RESULT(cf_str)
+   !-------------------------------------------------------------------
+   !> @brief This function convert string character lower case to upper case.
+   !>
+   !> @details
+   !> The function IACHAR returns the ASCII value of the character passed 
+   !> as argument. The ASCII code has the uppercase alphabet starting at 
+   !> code 65, and the lower case one at code 101, therefore 
+   !> IACHAR('a')- IACHAR('A') would be the difference between the uppercase
+   !> and the lowercase codes.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] cd_var character
+   !> @return upper case character
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      CHARACTER(*), INTENT(IN) :: cd_var
+
+      ! function
+      CHARACTER(LEN=lc)        :: cf_str
+
+      ! local variable
+      INTEGER(i4)                                  :: il_nletter ! number of letters in cd_var
+      CHARACTER(LEN=lc)                            :: cl_var
+      CHARACTER(LEN=lc), DIMENSION(:), ALLOCATABLE :: cl_tmp
+
+      INTEGER(i4) :: il_icode    ! ASCII value
+      INTEGER(i4) :: il_lacode   ! ASCII value of the lower case 'a'
+      INTEGER(i4) :: il_uacode   ! ASCII value of the upper case 'A'
+      INTEGER(i4) :: il_lzcode   ! ASCII value of the lower case 'z'
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      il_lacode=ICHAR('a')
+      il_uacode=ICHAR('A')
+      il_lzcode=IACHAR('z')
+
+      cl_var=TRIM(ADJUSTL(cd_var))
+      il_nletter=LEN(TRIM(cl_var))
+      ALLOCATE(cl_tmp(il_nletter))
+      DO ji=1,il_nletter
+         il_icode=IACHAR(cl_var(ji:ji))
+         IF( il_icode >= il_lacode .AND. il_icode <= il_lzcode )THEN
+            ! lower case
+            cl_tmp(ji)=CHAR(il_icode - (il_lacode - il_uacode) )
+         ELSE
+            ! upper case and other character
+            cl_tmp(ji)=CHAR(il_icode)
+         ENDIF
+      ENDDO
+
+      cf_str=TRIM(ADJUSTL(fct_concat(cl_tmp(:))))
+      DEALLOCATE(cl_tmp)
+
+   END FUNCTION fct_upper
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION fct_is_num(cd_var) &
+         & RESULT(lf_numeric)
+   !-------------------------------------------------------------------
+   !> @brief This function check if character is numeric.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] cd_var character
+   !> @return character is numeric
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_var
+
+      ! function
+      LOGICAL                      :: lf_numeric
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=1,LEN(TRIM(cd_var))
+         IF( IACHAR(cd_var(ji:ji)) >= IACHAR('0') .AND. &
+         &   IACHAR(cd_var(ji:ji)) <= IACHAR('9') )THEN
+            lf_numeric=.TRUE.
+         ELSE
+            lf_numeric=.FALSE.
+            EXIT
+         ENDIF
+      ENDDO
+
+   END FUNCTION fct_is_num
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION fct_is_real(cd_var) &
+         & RESULT(lf_real)
+   !-------------------------------------------------------------------
+   !> @brief This function check if character is real number.
+   !>
+   !> @details
+   !> it permits exponantial and decimal number
+   !> exemple :  1e6, 2.3
+   !>
+   !> @author J.Paul
+   !> @date June, 2015 - Initial Version
+   !> @date April, 2018
+   !> - permit negative exposant 
+   !> - permit sign as first character 
+   !>
+   !> @param[in] cd_var character
+   !> @return character is real number
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_var
+   
+      ! function
+      LOGICAL                      :: lf_real
+
+      ! local variables
+      LOGICAL :: ll_exp
+      LOGICAL :: ll_dec
+   
+      ! loop indices
+      INTEGER :: ji
+      !----------------------------------------------------------------
+   
+      ll_exp=.TRUE.
+      ll_dec=.FALSE.
+      DO ji=1,LEN(TRIM(cd_var))
+         IF( IACHAR(cd_var(ji:ji)) >= IACHAR('0') .AND. &
+         &   IACHAR(cd_var(ji:ji)) <= IACHAR('9') )THEN
+   
+            lf_real=.TRUE.
+            ll_exp=.FALSE.
+      
+         ELSEIF( TRIM(fct_lower(cd_var(ji:ji)))=='e' )THEN
+         
+            IF( ll_exp .OR. ji== LEN(TRIM(cd_var)) )THEN
+               lf_real=.FALSE.
+               EXIT
+            ELSE 
+               ll_exp=.TRUE.
+            ENDIF
+
+         ELSEIF( TRIM(cd_var(ji:ji))=='+' )THEN
+            IF( ji /= 1 )THEN
+               lf_real=.FALSE.
+               EXIT
+            ELSE
+               lf_real=.TRUE.
+            ENDIF
+         
+         ELSEIF( TRIM(cd_var(ji:ji))=='-' )THEN
+         
+            IF( ji <= 1 )THEN
+               IF( ji /= 1 )THEN
+                  lf_real=.FALSE.
+                  EXIT
+               ELSE
+                  lf_real=.TRUE.
+               ENDIF
+            ELSE ! ji > 1
+               IF( TRIM(fct_lower(cd_var(ji-1:ji-1)))/='e' )THEN
+                  lf_real=.FALSE.
+                  EXIT
+               ELSE
+                  lf_real=.TRUE.
+               ENDIF
+            ENDIF
+
+         ELSEIF( TRIM(cd_var(ji:ji))=='.' )THEN
+   
+            IF( ll_dec )THEN
+               lf_real=.FALSE.
+               EXIT
+            ELSE
+               lf_real=.TRUE.
+               ll_dec=.TRUE.
+            ENDIF
+   
+         ELSE
+   
+            lf_real=.FALSE.
+            EXIT
+   
+         ENDIF
+      ENDDO
+   
+   END FUNCTION fct_is_real
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION fct_split(cd_string, id_ind, cd_sep) &
+         & RESULT(cf_elt)
+   !-------------------------------------------------------------------
+   !> @brief This function split string of character 
+   !> using separator character, by default '|',
+   !> and return the element on index ind.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] cd_string string of character
+   !> @param[in] id_ind    indice
+   !> @param[in] cd_sep    separator character
+   !> @return return the element of index id_ind
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_string
+      INTEGER(i4)     , INTENT(IN) :: id_ind
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_sep
+
+      ! function
+      CHARACTER(LEN=lc)            :: cf_elt
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_sep
+      CHARACTER(LEN=lc) :: cl_string
+
+      INTEGER(i4) :: il_sep
+      INTEGER(i4) :: il_lsep
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! initialize
+      cf_elt=''
+      cl_string=ADJUSTL(cd_string)
+
+      ! get separator
+      cl_sep='|'
+      IF( PRESENT(cd_sep) )THEN
+         IF( cd_sep==' ')THEN
+            cl_sep=' '
+         ELSE
+            cl_sep=TRIM(ADJUSTL(cd_sep))
+         ENDIF
+      ENDIF
+      
+      IF( cl_sep /= ' ' )THEN
+         ! get separator index
+         il_sep=INDEX( TRIM(cl_string), TRIM(cl_sep) )
+         il_lsep=LEN(TRIM(cl_sep)) 
+
+         IF( il_sep /= 0 )THEN
+            cf_elt=TRIM(ADJUSTL(cl_string(1:il_sep-1)))
+         ELSE
+            cf_elt=TRIM(ADJUSTL(cl_string))
+         ENDIF
+
+         ji=1
+         DO WHILE( il_sep /= 0 .AND. ji /= id_ind )
+            
+            ji=ji+1
+            
+            cl_string=TRIM(cl_string(il_sep+il_lsep:))
+            il_sep=INDEX( TRIM(cl_string), TRIM(cl_sep) )
+
+            IF( il_sep /= 0 )THEN
+               cf_elt=TRIM(ADJUSTL(cl_string(1:il_sep-1)))
+            ELSE
+               cf_elt=TRIM(ADJUSTL(cl_string))
+            ENDIF
+
+         ENDDO
+
+         IF( ji /= id_ind ) cf_elt=''
+      ELSE
+         cf_elt=fct__split_space(TRIM(cl_string), id_ind)
+      ENDIF
+
+   END FUNCTION fct_split
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION fct__split_space(cd_string, id_ind) &
+         & RESULT(cf_elt)
+   !-------------------------------------------------------------------
+   !> @brief This function split string of character 
+   !> using space as separator, 
+   !> and return the element on index ind.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] cd_string string of character
+   !> @param[in] id_ind    indice
+   !> @return return the element of index id_ind
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_string
+      INTEGER(i4)     , INTENT(IN) :: id_ind
+
+      ! function
+      CHARACTER(LEN=lc)            :: cf_elt
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_string
+
+      INTEGER(i4) :: il_sep
+      INTEGER(i4) :: il_lsep
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! initialize
+      cf_elt=''
+      cl_string=ADJUSTL(cd_string)
+
+      ! get separator index
+      il_sep=INDEX( TRIM(cl_string), ' ' )
+      il_lsep=LEN(' ') 
+
+      IF( il_sep /= 0 )THEN
+         cf_elt=TRIM(ADJUSTL(cl_string(1:il_sep-1)))
+      ELSE
+         cf_elt=TRIM(ADJUSTL(cl_string))
+      ENDIF
+
+      ji=1
+      DO WHILE( il_sep /= 0 .AND. ji /= id_ind )
+         
+         ji=ji+1
+         
+         cl_string=TRIM(cl_string(il_sep+il_lsep:))
+         il_sep=INDEX( TRIM(cl_string), ' ' )
+
+         IF( il_sep /= 0 )THEN
+            cf_elt=TRIM(ADJUSTL(cl_string(1:il_sep-1)))
+         ELSE
+            cf_elt=TRIM(ADJUSTL(cl_string))
+         ENDIF
+
+      ENDDO
+
+      IF( ji /= id_ind ) cf_elt=''
+
+   END FUNCTION fct__split_space
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION fct_basename(cd_string, cd_sep) &
+         & RESULT(cf_file)
+   !-------------------------------------------------------------------
+   !> @brief This function return basename of a filename.
+   !>
+   !> @details
+   !> Actually it splits filename using sperarator '/'
+   !> and return last string character.<br/>
+   !> Optionally you could specify another separator.
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] cd_string filename
+   !> @param[in] cd_sep    separator character
+   !> @return basename (filename without path)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_string
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_sep
+
+      ! function
+      CHARACTER(LEN=lc)            :: cf_file
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_sep
+      CHARACTER(LEN=lc) :: cl_string
+      INTEGER(i4)       :: il_sep
+      
+      ! loop indices
+      !----------------------------------------------------------------
+      ! initialize
+      cl_string=TRIM(ADJUSTL(cd_string))
+
+      ! get separator
+      cl_sep='/'
+      IF( PRESENT(cd_sep) ) cl_sep=TRIM(ADJUSTL(cd_sep))
+
+      il_sep=INDEX( TRIM(cl_string), TRIM(cl_sep), BACK=.TRUE.)
+      cf_file=TRIM(cl_string(il_sep+1:))
+
+   END FUNCTION fct_basename
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION fct_dirname(cd_string, cd_sep) &
+         & RESULT(cf_dir)
+   !-------------------------------------------------------------------
+   !> @brief This function return dirname of a filename.
+   !>
+   !> @details
+   !> Actually it splits filename using sperarator '/'
+   !> and return all except last string character.<br/>
+   !> Optionally you could specify another separator.
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] cd_string filename
+   !> @param[in] cd_sep    separator character
+   !> @return dirname (path of the filename)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_string
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_sep
+
+      ! function
+      CHARACTER(LEN=lc)            :: cf_dir
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_sep
+      CHARACTER(LEN=lc) :: cl_string
+      INTEGER(i4)       :: il_sep
+      
+      ! loop indices
+      !----------------------------------------------------------------
+      ! initialize
+      cl_string=TRIM(ADJUSTL(cd_string))
+
+      ! get separator
+      cl_sep='/'
+      IF( PRESENT(cd_sep) ) cl_sep=TRIM(ADJUSTL(cd_sep))
+
+      il_sep=INDEX( TRIM(cl_string), TRIM(cl_sep), BACK=.TRUE.)
+      IF( il_sep == 0 )THEN
+         cf_dir=''
+      ELSE
+         cf_dir=TRIM(cl_string(1:il_sep))
+      ENDIF
+
+   END FUNCTION fct_dirname
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE fct_help(cd_filename, cd_err)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function show help message.
+   !> 
+   !> @details 
+   !>  Optionaly, print error detected
+   !>
+   !> @author J.Paul
+   !> @date October, 2019 - Initial Version
+   !>
+   !> @param[in] cd_filename   file name 
+   !> @param[in] cd_err        error message
+   !>
+   !> @return print help message
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_filename
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_err
+      !----------------------------------------------------------------
+
+      PRINT '( /,   a,/)', 'USAGE: '//TRIM(cd_filename)//' namelist [-v] [-h]'
+      PRINT '(   2x,a,/)', 'positional arguments:'
+      PRINT '(   5x,a   )',    'namelist                       '//TRIM(cd_filename)//" namelist"
+      PRINT '( /,5x,a,/)', 'NB : a template of the namelist could be created running (in templates directory):'
+      PRINT '(   8x,a  )',    'python create_templates.py '//TRIM(cd_filename)
+      PRINT '( /,2x,a,/)', 'optional arguments:'
+      PRINT '(   5x,a  )',    "-h, --help                      display this help and exit"
+      PRINT '(   5x,a,/)',    "-v, --version                   output Siren's version information and exit"
+      IF (PRESENT(cd_err)) THEN
+         PRINT '(2x,a,/)', 'ERROR DETECTED:'
+         PRINT '(5x,a,/)', TRIM(cd_err)
+      ENDIF
+
+   END SUBROUTINE fct_help
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE fct_version(cd_filename)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function show the version of Siren.
+   !> 
+   !> @author J.Paul
+   !> @date October, 2019 - Initial Version
+   !>
+   !> @param[in] cd_filename   file name 
+   !>
+   !> @return print version message
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_filename
+      !----------------------------------------------------------------
+
+      PRINT '( /, a,/)', 'PROGRAM: Siren - '//TRIM(cd_filename)
+      PRINT '(2x,2a  )', 'Revision of last commit : ', TRIM(fct_split(fct_split(cp_version,2,'$'),2,'Revision:'))
+      PRINT '(2x,2a  )', 'Author   of last commit : ', TRIM(fct_split(fct_split(cp_author,2,'$'),2,'Author:'))
+      PRINT '(2x,2a  )', 'Date     of last commit : ', TRIM(fct_split(fct_split(cp_date,2,'$'),2,'Date:'))
+      PRINT '(2x,2a,/)', 'SVN URL                 : ', TRIM(fct_split(fct_split(fct_split(cp_url,2,'$'),2,'URL:'),1,'/src/global.f90'))
+
+   END SUBROUTINE fct_version
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE fct
+
Index: /utils/tools_ticket2413/SIREN/src/global.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/global.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/global.f90	(revision 12863)
@@ -0,0 +1,150 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief This module defines global variables and parameters.
+!>
+!> @author
+!> J.paul
+!>
+!> @date November, 2013 - Initial Version
+!> @date September, 2015
+!> - define fill value for each variable type
+!> @date January, 2019
+!> - define svn URL variable
+!> @date October, 2019
+!> - define svn Revision, Date, and Author variable
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE global
+
+   USE kind                         ! F90 kind parameter
+   USE netcdf
+
+   IMPLICIT NONE
+
+   PUBLIC :: dp_fill         !< default fill value
+   PUBLIC :: ip_nsep         !< number of separator listed
+   PUBLIC :: ip_ncom         !< number of comment character listed
+   PUBLIC :: cp_sep          !< list of separator
+   PUBLIC :: cp_com          !< list of comment character
+
+   PUBLIC :: ip_npoint       !< number of point on ARAKAWA C-grid 
+   PUBLIC :: jp_T            !< indice for T-point on ARAKAWA C-grid
+   PUBLIC :: jp_U            !< indice for U-point on ARAKAWA C-grid
+   PUBLIC :: jp_V            !< indice for V-point on ARAKAWA C-grid
+   PUBLIC :: jp_F            !< indice for F-point on ARAKAWA C-grid
+   PUBLIC :: cp_grid_point   !< list of grid_point character
+
+   PUBLIC :: ip_maxdim       !< maximum number of dimension to be used
+   PUBLIC :: jp_I            !< indice for I-direction
+   PUBLIC :: jp_J            !< indice for J-direction
+   PUBLIC :: jp_K            !< indice for K-direction
+   PUBLIC :: jp_L            !< indice for L-direction
+   PUBLIC :: cp_dimorder     !< dimension order
+
+   PUBLIC :: ip_maxvar       !< maximum number of variable
+   PUBLIC :: ip_maxmtx       !< matrix variable maximum dimension
+   PUBLIC :: ip_maxseg       !< maximum number of segment
+   PUBLIC :: ip_ghost        !< number of ghost cell
+
+   PUBLIC :: ip_ninterp      !< number of available interpolation method
+   PUBLIC :: cp_interp_list  !< list of interpolation name
+   
+   PUBLIC :: ip_nextrap      !< number of available extrapolation method
+   PUBLIC :: cp_extrap_list  !< list of extrapolation name
+   
+   PUBLIC :: ip_nfilter      !< number of available filter
+   PUBLIC :: cp_filter_list  !< list of filter name
+
+   PUBLIC :: ip_ncard        !< number of cardinal point
+   PUBLIC :: cp_card         !< array of cardinal point
+   PUBLIC :: jp_north        !< indice for north boundary
+   PUBLIC :: jp_south        !< indice for south boundary
+   PUBLIC :: jp_east         !< indice for east  boundary
+   PUBLIC :: jp_west         !< indice for west  boundary
+
+   PUBLIC :: ip_maxdimcfg    !< maximum dimension in configuration file
+   PUBLIC :: ip_maxdumcfg    !< maximum dummy variable in configuration file
+   PUBLIC :: cp_url          !< svn url
+
+   ! NOTE_avoid_public_variables_if_possible
+
+   INTEGER(i4)                             , PARAMETER :: ip_maxvar =200   !< maximum number of variable
+   INTEGER(i4)                             , PARAMETER :: ip_maxmtx =50    !< matrix variable maximum dimension (cf create_bathy)
+   INTEGER(i4)                             , PARAMETER :: ip_maxseg =10    !< maximum number of segment for each boundary
+
+   INTEGER(i4)                             , PARAMETER :: ip_nsep=2        !< number of separator listed
+   CHARACTER(1)     , DIMENSION(ip_nsep)   , PARAMETER :: cp_sep = (/'.','_'/) !< list of separator 
+
+   INTEGER(i4)                             , PARAMETER :: ip_ncom=2        !< number of comment character listed
+   CHARACTER(1)     , DIMENSION(ip_ncom)   , PARAMETER :: cp_com = (/'#','!'/) !< list of comment character 
+    
+   INTEGER(i4)                             , PARAMETER :: ip_ghost=1       !< number of ghost cell
+
+   INTEGER(i4)                             , PARAMETER :: ip_ninterp=3
+   CHARACTER(LEN=lc), DIMENSION(ip_ninterp), PARAMETER :: cp_interp_list = &
+   &  (/ 'nearest', &
+   &     'cubic  ', &
+   &     'linear '  /)
+
+   INTEGER(i4)                             , PARAMETER :: ip_nextrap=2
+   CHARACTER(LEN=lc), DIMENSION(ip_nextrap), PARAMETER :: cp_extrap_list = &
+   &  (/ 'dist_weight', &
+   &     'min_error  ' /)
+
+   INTEGER(i4)                             , PARAMETER :: ip_nfilter=5
+   CHARACTER(LEN=lc), DIMENSION(ip_nfilter), PARAMETER :: cp_filter_list = &
+   &  (/ 'butterworth', &
+   &     'blackman   ', &
+   &     'hamming    ', &
+   &     'hann       ', &
+   &     'gauss      '/)
+
+   REAL(dp)                                , PARAMETER :: dp_fill_i1=NF90_FILL_BYTE   !< byte fill value
+   REAL(dp)                                , PARAMETER :: dp_fill_i2=NF90_FILL_SHORT  !< short fill value
+   REAL(dp)                                , PARAMETER :: dp_fill_i4=NF90_FILL_INT    !< INT fill value
+   REAL(dp)                                , PARAMETER :: dp_fill_sp=NF90_FILL_FLOAT  !< real fill value
+   REAL(dp)                                , PARAMETER :: dp_fill=NF90_FILL_DOUBLE    !< double fill value
+
+   INTEGER(i4)                             , PARAMETER :: ip_npoint=4
+   INTEGER(i4)                             , PARAMETER :: jp_T=1
+   INTEGER(i4)                             , PARAMETER :: jp_U=2
+   INTEGER(i4)                             , PARAMETER :: jp_V=3
+   INTEGER(i4)                             , PARAMETER :: jp_F=4
+   CHARACTER(LEN=1), DIMENSION(ip_npoint)  , PARAMETER :: cp_grid_point = &
+   &  (/ 'T', 'U', 'V', 'F' /)
+
+
+   INTEGER(i4)                             , PARAMETER :: ip_maxdimcfg=10 !< maximum dimension in configuration file
+   INTEGER(i4)                             , PARAMETER :: ip_maxdim=4
+   INTEGER(i4)                             , PARAMETER :: jp_I=1
+   INTEGER(i4)                             , PARAMETER :: jp_J=2
+   INTEGER(i4)                             , PARAMETER :: jp_K=3
+   INTEGER(i4)                             , PARAMETER :: jp_L=4
+   CHARACTER(LEN=ip_maxdim)                , PARAMETER :: cp_dimorder = 'xyzt' !< dimension order to output
+
+   INTEGER(i4)                             , PARAMETER :: ip_ncard=4
+   CHARACTER(LEN=lc), DIMENSION(ip_ncard)  , PARAMETER :: cp_card = &
+   &  (/ 'north', &
+   &     'south', &
+   &     'east ', &
+   &     'west ' /)
+
+   INTEGER(i4)                             , PARAMETER :: jp_north=1
+   INTEGER(i4)                             , PARAMETER :: jp_south=2
+   INTEGER(i4)                             , PARAMETER :: jp_east =3
+   INTEGER(i4)                             , PARAMETER :: jp_west =4
+
+   INTEGER(i4)                             , PARAMETER :: ip_maxdumcfg = 10 !< maximum dummy variable, dimension, or attribute 
+                                                                            !< in configuration file
+
+   CHARACTER(LEN=lc)                       , PARAMETER :: cp_url="$URL$"    !< svn url
+   CHARACTER(LEN=lc)                       , PARAMETER :: cp_version = "$Revision$"
+   CHARACTER(LEN=lc)                       , PARAMETER :: cp_author = "$Author$"
+   CHARACTER(LEN=lc)                       , PARAMETER :: cp_date = "$Date$"
+
+END MODULE global
+
Index: /utils/tools_ticket2413/SIREN/src/grid.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/grid.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/grid.f90	(revision 12863)
@@ -0,0 +1,6430 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief This module is grid manager.
+!>
+!> @details
+!>    to get NEMO pivot point index:<br/>
+!> @code
+!>    il_pivot=grid_get_pivot(td_file)
+!> @endcode
+!>       - il_pivot is NEMO pivot point index F(0), T(1)
+!>       - td_file is mpp structure 
+!>
+!>    to get NEMO periodicity index:<br/>
+!> @code
+!>    il_perio=grid_get_perio(td_file)
+!> @endcode
+!>       - il_perio is NEMO periodicity index (0,1,2,3,4,5,6)
+!>       - td_file is mpp structure
+!>
+!>    to check domain validity:<br/>
+!> @code
+!>    CALL grid_check_dom(td_coord, id_imin, id_imax, id_jmin, id_jmax)
+!> @endcode
+!>       - td_coord is coordinates mpp structure
+!>       - id_imin is i-direction lower left  point indice
+!>       - id_imax is i-direction upper right point indice
+!>       - id_jmin is j-direction lower left  point indice
+!>       - id_jmax is j-direction upper right point indice
+!>
+!>    to get closest coarse grid indices of fine grid domain:<br/>
+!> @code
+!>    il_index(:,:)=grid_get_coarse_index(td_coord0, td_coord1,
+!>                                      [id_rho,] [cd_point])
+!> @endcode
+!>    or 
+!> @code
+!>    il_index(:,:)=grid_get_coarse_index(td_lon0, td_lat0, td_coord1,
+!>                                      [id_rho,] [cd_point])
+!> @endcode
+!>    or
+!> @code
+!>    il_index(:,:)=grid_get_coarse_index(td_coord0, td_lon1, td_lat1,
+!>                                      [id_rho,] [cd_point])
+!> @endcode
+!>    or
+!> @code
+!>    il_index(:,:)=grid_get_coarse_index(td_lon0, td_lat0, td_lon1, td_lat1,
+!>                                      [id_rho,] [cd_point])
+!> @endcode
+!>       - il_index(:,:) is  coarse grid indices (/ (/ imin0, imax0 /), 
+!> (/ jmin0, jmax0 /) /)
+!>       - td_coord0 is coarse grid coordinate mpp structure 
+!>       - td_coord1 is fine grid coordinate mpp structure
+!>       - td_lon0 is coarse grid longitude variable structure 
+!>       - td_lat0 is coarse grid latitude  variable structure 
+!>       - td_lon1 is fine   grid longitude variable structure 
+!>       - td_lat1 is fine   grid latitude  variable structure 
+!>       - id_rho is array of refinment factor (default 1)
+!>       - cd_point is Arakawa grid point (default 'T')
+!>
+!>    to know if grid is global:<br/>
+!> @code
+!>    ll_global=grid_is_global(td_lon, td_lat)
+!> @endcode
+!>       - td_lon is longitude variable structure
+!>       - td_lat is latitude variable structure
+!>   
+!>    to know if grid contains north fold:<br/>
+!> @code
+!>    ll_north=grid_is_north_fold(td_lat)
+!> @endcode
+!>       - td_lat is latitude variable structure    
+!>
+!>    to get coarse grid indices of the closest point from one fine grid 
+!> point:<br/>
+!> @code
+!>    il_index(:)=grid_get_closest(dd_lon0(:,:), dd_lat0(:,:), dd_lon1, dd_lat1
+!>                                 [,dd_fill] [,cd_pos])
+!> @endcode
+!>       - il_index(:) is  coarse grid indices (/ i0, j0 /)
+!>       - dd_lon0 is coarse grid array of longitude value (real(8))
+!>       - dd_lat0 is coarse grid array of latitude  value (real(8))
+!>       - dd_lon1 is fine grid longitude value (real(8))
+!>       - dd_lat1 is fine grid latitude  value (real(8))
+!>       - dd_fill
+!>       - cd_pos
+!>
+!>    to compute distance between a point A and grid points:<br/>
+!> @code
+!>    il_dist(:,:)=grid_distance(dd_lon, dd_lat, dd_lonA, dd_latA)
+!> @endcode
+!>       - il_dist(:,:) is array of distance between point A and grid points
+!>       - dd_lon is array of longitude value (real(8))
+!>       - dd_lat is array of longitude value (real(8))
+!>       - dd_lonA is longitude of point A (real(8))
+!>       - dd_latA is latitude  of point A (real(8))
+!>
+!>    to get offset between fine grid and coarse grid:<br/> 
+!> @code
+!>    il_offset(:,:)=grid_get_fine_offset(td_coord0, 
+!>                                        id_imin0, id_jmin0, id_imax0, id_jmax0,
+!>                                        td_coord1
+!>                                        [,id_rho] [,cd_point])
+!> @endcode
+!>    or
+!> @code
+!>    il_offset(:,:)=grid_get_fine_offset(dd_lon0, dd_lat0, 
+!>                                        id_imin0, id_jmin0,id_imax0, id_jmax0,
+!>                                        td_coord1 
+!>                                        [,id_rho] [,cd_point])
+!> @endcode
+!>    or
+!> @code
+!>    il_offset(:,:)=grid_get_fine_offset(td_coord0, 
+!>                                        id_imin0, id_jmin0, id_imax0, id_jmax0,
+!>                                        dd_lon1, dd_lat1 
+!>                                        [,id_rho] [,cd_point])
+!> @endcode
+!>    or
+!> @code
+!>    il_offset(:,:)=grid_get_fine_offset(dd_lon0, dd_lat0,
+!>                                        id_imin0, id_jmin0, id_imax0, id_jmax0,
+!>                                        dd_lon1, dd_lat1
+!>                                        [,id_rho] [,cd_point])
+!> @endcode
+!>       - il_offset(:,:) is offset array 
+!>    (/ (/ i_offset_left, i_offset_right /), (/ j_offset_lower, j_offset_upper /) /)
+!>       - td_coord0 is coarse grid coordinate mpp structure 
+!>       - dd_lon0  is coarse grid longitude array (real(8))
+!>       - dd_lat0  is coarse grid latitude  array (real(8))
+!>       - id_imin0 is coarse grid lower left  corner i-indice of fine grid 
+!> domain
+!>       - id_jmin0 is coarse grid lower left  corner j-indice of fine grid 
+!> domain
+!>       - id_imax0 is coarse grid upper right corner i-indice of fine grid 
+!> domain
+!>       - id_jmax0 is coarse grid upper right corner j-indice of fine grid 
+!> domain
+!>       - td_coord1 is fine grid coordinate mpp structure
+!>       - dd_lon1  is fine   grid longitude array (real(8))
+!>       - dd_lat1  is fine   grid latitude  array (real(8))
+!>       - id_rho is array of refinment factor (default 1)
+!>       - cd_point is Arakawa grid point (default 'T')
+!>
+!>    to check fine and coarse grid coincidence:<br/>
+!> @code
+!>    CALL grid_check_coincidence(td_coord0, td_coord1, 
+!>                                id_imin0, id_imax0, id_jmin0, id_jmax0
+!>                                ,id_rho)
+!> @endcode
+!>       - td_coord0 is coarse grid coordinate mpp structure
+!>       - td_coord1 is fine   grid coordinate mpp structure
+!>       - id_imin0  is coarse grid lower left  corner i-indice of fine grid 
+!> domain
+!>       - id_imax0  is coarse grid upper right corner i-indice of fine grid 
+!> domain
+!>       - id_jmin0  is coarse grid lower left  corner j-indice of fine grid 
+!> domain
+!>       - id_jmax0  is coarse grid upper right corner j-indice of fine grid 
+!> domain 
+!>       - id_rho    is array of refinement factor 
+!>
+!>    to add ghost cell at boundaries:<br/>
+!> @code
+!>    CALL grid_add_ghost(td_var, id_ghost)
+!> @endcode
+!>       - td_var is array of variable structure
+!>       - id_ghost is 2D array of ghost cell factor
+!>
+!>    to delete ghost cell at boundaries:<br/>
+!> @code
+!>    CALL grid_del_ghost(td_var, id_ghost)
+!> @endcode
+!>       - td_var is array of variable structure
+!>       - id_ghost is 2D array of ghost cell factor
+!>
+!>    to get ghost cell factor (use or not):<br/>
+!> @code
+!>    il_factor(:)= grid_get_ghost( td_var )
+!> @endcode
+!>    or
+!> @code
+!>    il_factor(:)= grid_get_ghost( td_mpp )
+!> @endcode
+!>       - il_factor(:) is  array of ghost cell factor (0 or 1)
+!>       - td_var  is variable structure
+!>       - td_mpp is mpp sturcture
+!>
+!>    to compute closed sea domain:<br/>
+!> @code
+!>    il_mask(:,:)=grid_split_domain(td_var, [id_level])
+!> @endcode
+!>       - il_mask(:,:) is domain mask
+!>       - td_var is variable strucutre
+!>       - id_level is level to be used [optional] 
+!>
+!>    to fill small closed sea with _FillValue:<br/>
+!> @code
+!>    CALL grid_fill_small_dom(td_var, id_mask, [id_minsize])
+!> @endcode
+!>       - td_var  is variable structure
+!>       - id_mask is domain mask (from grid_split_domain)
+!>       - id_minsize is minimum size of sea to be kept [optional]
+!>
+!> @author
+!> J.Paul
+!>
+!> @date November, 2013 - Initial Version
+!> @date September, 2014
+!> - add header
+!> @date October, 2014
+!> - use mpp file structure instead of file
+!> @date February, 2015
+!> - add function grid_fill_small_msk to fill small domain inside bigger one
+!> @date February, 2016
+!> - improve way to check coincidence (bug fix)
+!> - manage grid cases for T,U,V or F point, with even or odd refinment (bug fix)
+!> @date April, 2016
+!> - add function to get closest grid point using coarse grid coordinates strucutre 
+!> @date May, 2019
+!> - define as module variable im_max_overlap
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE grid
+
+   USE netcdf
+   USE kind                            ! F90 kind parameter
+   USE fct                             ! basic usefull function
+   USE global                          ! global parameter
+   USE phycst                          ! physical constant
+   USE logger                          ! log file manager
+   USE file                            ! file manager
+   USE att                             ! attribute manager
+   USE var                             ! variable manager
+   USE dim                             ! dimension manager
+   USE iom                             ! I/O manager
+   USE mpp                             ! MPP manager
+   USE dom                             ! domain manager
+   USE iom_mpp                         ! MPP I/O manager
+   USE iom_dom                         ! DOM I/O manager
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   INTEGER(i4), PARAMETER :: im_max_overlap = 5
+
+   ! function and subroutine
+   PUBLIC :: grid_get_info             !< get information about mpp global domain (pivot, perio, ew)
+   PUBLIC :: grid_get_pivot            !< get NEMO pivot point index
+   PUBLIC :: grid_get_perio            !< get NEMO periodicity index
+   PUBLIC :: grid_get_ew_overlap       !< get East West overlap
+   PUBLIC :: grid_check_dom            !< check domain validity 
+   PUBLIC :: grid_get_coarse_index     !< get closest coarse grid indices of fine grid domain.
+   PUBLIC :: grid_is_global            !< check if grid is global or not
+   PUBLIC :: grid_is_north_fold
+   PUBLIC :: grid_get_closest          !< return closest coarse grid point from another point
+   PUBLIC :: grid_distance             !< compute grid distance to a point
+   PUBLIC :: grid_get_fine_offset      !< get fine grid offset
+   PUBLIC :: grid_check_coincidence    !< check fine and coarse grid coincidence
+   PUBLIC :: grid_add_ghost            !< add ghost cell at boundaries.
+   PUBLIC :: grid_del_ghost            !< delete ghost cell at boundaries.
+   PUBLIC :: grid_get_ghost            !< return ghost cell factor
+   PUBLIC :: grid_split_domain         !< compute closed sea domain 
+   PUBLIC :: grid_fill_small_dom       !< fill small closed sea with fill value 
+   PUBLIC :: grid_fill_small_msk       !< fill small domain inside bigger one 
+
+                                     ! get closest coarse grid indices of fine grid domain
+   PRIVATE :: grid__get_coarse_index_ff ! - using coarse and fine grid coordinates files
+   PRIVATE :: grid__get_coarse_index_cf ! - using coarse grid array of lon,lat and fine grid coordinates files
+   PRIVATE :: grid__get_coarse_index_fc ! - using coarse grid coordinates files, and fine grid array of lon,lat
+   PRIVATE :: grid__get_coarse_index_cc ! - using coarse and fine grid array of lon,lat
+
+                                     ! return closest coarse grid point from another point
+   PRIVATE :: grid__get_closest_str    ! - using coarse grid coordinates strucutre
+   PRIVATE :: grid__get_closest_arr    ! - using coarse grid array of lon,lat
+
+                                     ! get offset between fine and coarse grid
+   PRIVATE :: grid__get_fine_offset_ff ! - using coarse and fine grid coordinates files
+   PRIVATE :: grid__get_fine_offset_cf ! - using coarse grid array of lon,lat and fine grid coordinates files
+   PRIVATE :: grid__get_fine_offset_fc ! - using coarse grid coordinates files, and fine grid array of lon,lat
+   PRIVATE :: grid__get_fine_offset_cc ! - using coarse and fine grid array of lon,lat
+
+                                     ! get information about global domain (pivot, perio, ew)
+   PRIVATE :: grid__get_info_mpp      ! - using mpp files structure
+   PRIVATE :: grid__get_info_file     ! - using files structure
+
+                                     ! get NEMO pivot point index
+   PRIVATE :: grid__get_pivot_mpp      ! - using mpp files structure
+   PRIVATE :: grid__get_pivot_file     ! - using files structure
+   PRIVATE :: grid__get_pivot_var      ! - using variable structure
+   PRIVATE :: grid__get_pivot_varT   ! compute NEMO pivot point index for variable on grid T 
+   PRIVATE :: grid__get_pivot_varU   ! compute NEMO pivot point index for variable on grid U
+   PRIVATE :: grid__get_pivot_varV   ! compute NEMO pivot point index for variable on grid V
+   PRIVATE :: grid__get_pivot_varF   ! compute NEMO pivot point index for variable on grid F
+
+                                     ! get NEMO periodicity index
+   PRIVATE :: grid__get_perio_mpp      ! - using mpp files structure
+   PRIVATE :: grid__get_perio_file     ! - using files structure
+   PRIVATE :: grid__get_perio_var      ! - using variable structure
+
+                                     ! get East West overlap
+   PRIVATE :: grid__get_ew_overlap_mpp  ! - using mpp files structure
+   PRIVATE :: grid__get_ew_overlap_file ! - using files structure
+   PRIVATE :: grid__get_ew_overlap_var  ! - using longitude variable structure
+
+                                    ! return ghost cell factor
+   PRIVATE :: grid__get_ghost_mpp      ! - using mpp files structure
+   PRIVATE :: grid__get_ghost_var      ! - using array of lon,lat
+   PRIVATE :: grid__check_corner    ! check that fine grid is inside coarse grid
+   PRIVATE :: grid__check_lat       ! check that fine grid latitude are inside coarse grid latitude
+   
+   INTERFACE  grid_get_info
+      MODULE PROCEDURE grid__get_info_mpp
+      MODULE PROCEDURE grid__get_info_file
+   END INTERFACE grid_get_info
+
+   INTERFACE  grid_get_pivot
+      MODULE PROCEDURE grid__get_pivot_mpp
+      MODULE PROCEDURE grid__get_pivot_file
+      MODULE PROCEDURE grid__get_pivot_var
+   END INTERFACE grid_get_pivot
+
+   INTERFACE  grid_get_perio
+      MODULE PROCEDURE grid__get_perio_mpp
+      MODULE PROCEDURE grid__get_perio_file
+      MODULE PROCEDURE grid__get_perio_var
+   END INTERFACE grid_get_perio
+
+   INTERFACE  grid_get_ew_overlap
+      MODULE PROCEDURE grid__get_ew_overlap_mpp
+      MODULE PROCEDURE grid__get_ew_overlap_file
+      MODULE PROCEDURE grid__get_ew_overlap_var
+   END INTERFACE grid_get_ew_overlap
+
+   INTERFACE  grid_get_ghost
+      MODULE PROCEDURE grid__get_ghost_var
+      MODULE PROCEDURE grid__get_ghost_mpp
+   END INTERFACE  grid_get_ghost
+
+   INTERFACE  grid_get_closest
+      MODULE PROCEDURE grid__get_closest_str
+      MODULE PROCEDURE grid__get_closest_arr
+   END INTERFACE  grid_get_closest
+
+   INTERFACE  grid_get_coarse_index
+      MODULE PROCEDURE grid__get_coarse_index_ff
+      MODULE PROCEDURE grid__get_coarse_index_cf
+      MODULE PROCEDURE grid__get_coarse_index_fc
+      MODULE PROCEDURE grid__get_coarse_index_cc
+   END INTERFACE grid_get_coarse_index
+
+   INTERFACE  grid_get_fine_offset
+      MODULE PROCEDURE grid__get_fine_offset_ff
+      MODULE PROCEDURE grid__get_fine_offset_fc
+      MODULE PROCEDURE grid__get_fine_offset_cf
+      MODULE PROCEDURE grid__get_fine_offset_cc
+   END INTERFACE grid_get_fine_offset   
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid__get_info_file(td_file)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine get information about global domain, given file
+   !> strucutre.
+   !>
+   !> @details
+   !> open edge files then:
+   !> - compute NEMO pivot point 
+   !> - compute NEMO periodicity
+   !> - compute East West overlap
+   !>
+   !> @note need all processor files to be there
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !>
+   !> @param[inout] td_file file structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      INTEGER(i4) :: il_ew
+      INTEGER(i4) :: il_pivot
+      INTEGER(i4) :: il_perio
+      INTEGER(i4) :: il_attid
+
+      TYPE(TATT)  :: tl_att
+
+      TYPE(TFILE) :: tl_file
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! initialise
+      il_pivot=-1
+      il_perio=-1
+      il_ew   =-1 
+
+      ! copy structure
+      tl_file=file_copy(td_file)
+
+      ! open file to be used
+      CALL iom_open(tl_file)
+
+      IF( td_file%i_perio >= 0 .AND. td_file%i_perio <= 6 )THEN
+         il_perio=td_file%i_perio
+      ELSE
+         ! look for attribute in file
+         il_attid=att_get_index(tl_file%t_att(:),'periodicity')
+         IF( il_attid /= 0 )THEN
+            il_perio=INT(tl_file%t_att(il_attid)%d_value(1),i4)
+         ENDIF
+      ENDIF
+
+      IF( td_file%i_ew >= 0 )THEN
+         il_ew=td_file%i_ew
+      ELSE
+         ! look for attribute in file
+         il_attid=att_get_index(tl_file%t_att(:),'ew_overlap')
+         IF( il_attid /= 0 )THEN
+            il_ew=INT(tl_file%t_att(il_attid)%d_value(1),i4)
+         ENDIF
+      ENDIF
+
+      SELECT CASE(il_perio)
+      CASE(3,4)
+         il_pivot=0
+      CASE(5,6)
+         il_pivot=1
+      CASE(0,1,2)
+         il_pivot=1
+      END SELECT
+      
+      IF( il_pivot < 0 .OR. il_pivot > 1 )THEN
+         ! get pivot
+         il_pivot=grid_get_pivot(tl_file)
+      ENDIF
+
+      IF( il_perio < 0 .OR. il_perio > 6 )THEN
+         ! get periodicity
+         il_perio=grid_get_perio(tl_file, il_pivot)
+      ENDIF
+
+      IF( il_ew < 0 )THEN
+         ! get periodicity
+         il_ew=grid_get_ew_overlap(tl_file)
+      ENDIF
+
+      ! close
+      CALL iom_close(tl_file)
+
+      !save in file structure
+      td_file%i_ew=il_ew
+      td_file%i_pivot=il_pivot
+      td_file%i_perio=il_perio
+
+      ! save in variable of file structure
+      tl_att=att_init("ew_overlap",il_ew)
+      DO ji=1,td_file%i_nvar
+         IF( td_file%t_var(ji)%t_dim(jp_I)%l_use )THEN
+            CALL var_move_att(td_file%t_var(ji),tl_att)
+         ENDIF
+      ENDDO
+
+      ! clean 
+      CALL file_clean(tl_file)
+      CALL att_clean(tl_att)
+
+      IF( td_file%i_perio == -1 )THEN
+         CALL logger_fatal("GRID GET INFO: can not read or compute "//&
+         &  "domain periodicity from file "//TRIM(td_file%c_name)//"."//&
+         &  " you have to inform periodicity in namelist.")
+      ENDIF
+
+   END SUBROUTINE grid__get_info_file
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid__get_info_mpp(td_mpp)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine get information about global domain, given mpp
+   !> structure.
+   !>
+   !> @details
+   !> open edge files then:
+   !> - compute NEMO pivot point 
+   !> - compute NEMO periodicity
+   !> - compute East West overlap
+   !>
+   !> @note need all processor files
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !>
+   !> @param[in] td_mpp mpp structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP) , INTENT(INOUT) :: td_mpp
+
+      ! local variable
+      INTEGER(i4) :: il_ew
+      INTEGER(i4) :: il_pivot
+      INTEGER(i4) :: il_perio
+      INTEGER(i4) :: il_attid
+
+      TYPE(TATT)  :: tl_att
+
+      TYPE(TMPP)  :: tl_mpp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+      ! initialise
+      il_pivot=-1
+      il_perio=-1
+      il_ew   =-1
+
+      CALL logger_info("GRID GET INFO: look for "//TRIM(td_mpp%c_name))
+      ! copy structure
+      tl_mpp=mpp_copy(td_mpp)
+      ! select edge files
+      CALL mpp_get_contour(tl_mpp)
+      ! open mpp file to be used
+      CALL iom_mpp_open(tl_mpp)
+
+      IF( td_mpp%i_perio >= 0 .AND. td_mpp%i_perio <= 6 )THEN
+         il_perio=td_mpp%i_perio
+      ELSE
+         ! look for attribute in mpp files
+         il_attid=att_get_index(tl_mpp%t_proc(1)%t_att(:),'periodicity')
+         IF( il_attid /= 0 )THEN
+            il_perio=INT(tl_mpp%t_proc(1)%t_att(il_attid)%d_value(1),i4)
+         ENDIF
+      ENDIF
+ 
+      IF( td_mpp%i_ew >= 0 )THEN
+         il_ew=td_mpp%i_ew
+      ELSE
+         ! look for attribute in mpp files
+         il_attid=att_get_index(tl_mpp%t_proc(1)%t_att(:),'ew_overlap')
+         IF( il_attid /= 0 )THEN
+            il_ew=INT(tl_mpp%t_proc(1)%t_att(il_attid)%d_value(1),i4)
+         ENDIF
+      ENDIF
+
+      CALL logger_info("GRID GET INFO: perio "//TRIM(fct_str(il_perio)))
+
+      SELECT CASE(il_perio)
+         CASE(3,4)
+            il_pivot=1
+         CASE(5,6)
+            il_pivot=0
+         CASE(0,1,2)
+            il_pivot=1
+      END SELECT
+
+      IF( il_pivot < 0 .OR. il_pivot > 1 )THEN
+         ! get pivot
+         CALL logger_info("GRID GET INFO: look for pivot ")
+         il_pivot=grid_get_pivot(tl_mpp)
+      ENDIF
+
+      IF( il_perio < 0 .OR. il_perio > 6 )THEN
+         ! get periodicity
+         CALL logger_info("GRID GET INFO: look for perio ")
+         il_perio=grid_get_perio(tl_mpp, il_pivot)
+      ENDIF
+
+      IF( il_ew < 0 )THEN
+         ! get periodicity
+         CALL logger_info("GRID GET INFO: look for overlap ")
+         il_ew=grid_get_ew_overlap(tl_mpp)
+      ENDIF
+
+      ! close
+      CALL iom_mpp_close(tl_mpp)
+
+      !save in mpp structure
+      td_mpp%i_ew=il_ew
+      td_mpp%i_pivot=il_pivot
+      td_mpp%i_perio=il_perio
+
+      ! save in variable of mpp structure
+      IF( ASSOCIATED(td_mpp%t_proc) )THEN
+         tl_att=att_init("ew_overlap",il_ew)
+         DO jj=1,td_mpp%i_nproc
+            DO ji=1,td_mpp%t_proc(jj)%i_nvar
+               IF( td_mpp%t_proc(jj)%t_var(ji)%t_dim(jp_I)%l_use )THEN
+                  CALL var_move_att(td_mpp%t_proc(jj)%t_var(ji),tl_att)
+               ENDIF
+            ENDDO
+         ENDDO
+      ENDIF
+
+      ! clean 
+      CALL mpp_clean(tl_mpp)
+      CALL att_clean(tl_att)
+
+      IF( td_mpp%i_perio == -1 )THEN
+         CALL logger_fatal("GRID GET INFO: can not read or compute "//&
+         &  "domain periodicity from mpp "//TRIM(td_mpp%c_name)//"."//&
+         &  " you have to inform periodicity in namelist.")
+      ENDIF
+
+   END SUBROUTINE grid__get_info_mpp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__get_pivot_var(td_var) &
+         & RESULT (if_pivot)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This function compute NEMO pivot point index of the input variable.
+   !> - F-point : 0
+   !> - T-point : 1
+   !>
+   !> @details
+   !> check north points of latitude grid (indices jpj to jpj-3) depending on which grid point
+   !> (T,F,U,V) variable is defined
+   !> 
+   !> @note variable must be at least 2D variable, and should not be coordinate
+   !> variable (i.e lon, lat)
+   !> 
+   !> @warning 
+   !> - do not work with ORCA2 grid (T-point)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !> @date September, 2014
+   !> - add dummy loop in case variable not over right point.
+   !> @date October, 2014
+   !> - work on variable structure instead of file structure
+   !>
+   !> @param[in] td_lat  latitude variable structure
+   !> @param[in] td_var  variable structure
+   !> @return pivot point index
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR), INTENT(IN) :: td_var
+
+      ! function
+      INTEGER(i4)            :: if_pivot
+
+      ! local variable
+      INTEGER(i4), DIMENSION(ip_maxdim)            :: il_dim
+
+      REAL(dp)   , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+      ! intitalise
+      if_pivot=-1
+
+      IF( .NOT. ASSOCIATED(td_var%d_value) .OR. &
+         &.NOT. ALL(td_var%t_dim(1:2)%l_use) )THEN
+         CALL logger_error("GRID GET PIVOT: can not compute pivot point"//&
+            &  " with variable "//TRIM(td_var%c_name)//"."//&
+            &  " no value associated or missing dimension.")
+      ELSE
+         il_dim(:)=td_var%t_dim(:)%i_len
+
+         ALLOCATE(dl_value(il_dim(1),4,1,1))
+         ! extract value
+         dl_value(:,:,:,:)=td_var%d_value( 1:il_dim(1),          &
+            &                              il_dim(2)-3:il_dim(2),&
+            &                              1:1,                  &
+            &                              1:1 )
+
+         SELECT CASE(TRIM(td_var%c_point))
+         CASE('T')
+            if_pivot=grid__get_pivot_varT(dl_value)
+         CASE('U')
+            if_pivot=grid__get_pivot_varU(dl_value)
+         CASE('V')
+            if_pivot=grid__get_pivot_varV(dl_value)
+         CASE('F')
+            if_pivot=grid__get_pivot_varF(dl_value)
+         END SELECT
+
+         ! dummy loop in case variable not over right point 
+         ! (ex: nav_lon over U-point)
+         IF( if_pivot == -1 )THEN
+            
+            ! no pivot point found
+            CALL logger_warn("GRID GET PIVOT: something wrong "//&
+               &  "when computing pivot point with variable "//&
+               &  TRIM(td_var%c_name))
+
+            DO jj=1,ip_npoint
+               SELECT CASE(TRIM(cp_grid_point(jj)))
+               CASE('T')
+                  CALL logger_debug("GRID GET PIVOT: check variable on point T")
+                  if_pivot=grid__get_pivot_varT(dl_value)
+               CASE('U')
+                  CALL logger_debug("GRID GET PIVOT: check variable on point U")
+                  if_pivot=grid__get_pivot_varU(dl_value)
+               CASE('V')
+                  CALL logger_debug("GRID GET PIVOT: check variable on point V")
+                  if_pivot=grid__get_pivot_varV(dl_value)
+               CASE('F')
+                  CALL logger_debug("GRID GET PIVOT: check variable on point F")
+                  if_pivot=grid__get_pivot_varF(dl_value)
+               END SELECT
+
+               IF( if_pivot /= -1 )THEN
+                  CALL logger_info("GRID GET PIVOT: variable "//&
+                     &  TRIM(td_var%c_name)//" seems to be on grid point "//&
+                     &  TRIM(cp_grid_point(jj)) )
+                  EXIT
+               ENDIF
+
+            ENDDO
+         ENDIF
+
+         IF( if_pivot == -1 )THEN
+            CALL logger_warn("GRID GET PIVOT: not able to found pivot point. "//&
+               &             "Force to use pivot point T.")
+            if_pivot = 1
+         ENDIF
+
+         ! clean
+         DEALLOCATE(dl_value)
+
+      ENDIF
+
+   END FUNCTION grid__get_pivot_var
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__get_pivot_varT(dd_value) &
+         & RESULT (if_pivot)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This function compute NEMO pivot point index for variable on grid T.
+   !>
+   !> @details
+   !> - F-point : 0
+   !> - T-point : 1
+   !>
+   !> @note array of value must be only the top border of the domain.
+   !> 
+   !> @author J.Paul
+   !> @date October, 2014 - Initial version
+   !>
+   !> @param[in] dd_value array of value
+   !> @return pivot point index
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      REAL(dp), DIMENSION(:,:,:,:), INTENT(IN) :: dd_value
+
+      ! function
+      INTEGER(i4)                              :: if_pivot
+
+      ! local variable
+      INTEGER(i4)                       :: il_midT
+      INTEGER(i4)                       :: il_midF
+
+      INTEGER(i4)                       :: it1
+      INTEGER(i4)                       :: it2
+      INTEGER(i4)                       :: jt1
+      INTEGER(i4)                       :: jt2
+
+      INTEGER(i4)                       :: if1
+      INTEGER(i4)                       :: if2
+      INTEGER(i4)                       :: jf1
+      INTEGER(i4)                       :: jf2
+
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
+
+      LOGICAL                           :: ll_check
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! intitalise
+      if_pivot=-1
+
+      il_dim(:)=SHAPE(dd_value(:,:,:,:))
+
+      ! T-point pivot !case of ORCA2, ORCA025, ORCA12 grid
+      jt1=4  ; jt2=2 
+      il_midT=il_dim(1)/2+1
+
+      ! F-point pivot !case of ORCA05 grid
+      jf1=4 ; jf2=3
+      il_midF=il_dim(1)/2
+
+      ! check T-point pivot
+      DO ji=2,il_midT
+         ll_check=.TRUE.
+         it1=ji
+         it2=il_dim(1)-(ji-2)
+         IF( dd_value(it1,jt1,1,1) /= dd_value(it2,jt2,1,1) )THEN
+            ll_check=.FALSE.
+            EXIT
+         ENDIF
+      ENDDO
+
+      IF( ll_check )THEN
+         CALL logger_info("GRID GET PIVOT: T-pivot")
+         if_pivot=1
+      ELSE
+
+         ! check F-point pivot
+         DO ji=1,il_midF
+            ll_check=.TRUE.
+            if1=ji
+            if2=il_dim(1)-(ji-1)
+            IF( dd_value(if1,jf1,1,1) /= dd_value(if2,jf2,1,1) )THEN
+               ll_check=.FALSE.
+               EXIT
+            ENDIF
+         ENDDO
+
+         IF( ll_check )THEN
+            CALL logger_info("GRID GET PIVOT: F-pivot")
+            if_pivot=0
+         ENDIF
+
+      ENDIF
+
+   END FUNCTION grid__get_pivot_varT
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__get_pivot_varU(dd_value) &
+         & RESULT (if_pivot)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This function compute NEMO pivot point index for variable on grid U.
+   !>
+   !> @details
+   !> - F-point : 0
+   !> - T-point : 1
+   !>
+   !> @note array of value must be only the top border of the domain.
+   !> 
+   !> @author J.Paul
+   !> @date October, 2014 - Initial version
+   !>
+   !> @param[in] dd_value array of value
+   !> @return pivot point index
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      REAL(dp), DIMENSION(:,:,:,:), INTENT(IN) :: dd_value
+
+      ! function
+      INTEGER(i4)                              :: if_pivot
+
+      ! local variable
+      INTEGER(i4)                       :: il_midT
+      INTEGER(i4)                       :: il_midF
+
+      INTEGER(i4)                       :: it1
+      INTEGER(i4)                       :: it2
+      INTEGER(i4)                       :: jt1
+      INTEGER(i4)                       :: jt2
+
+      INTEGER(i4)                       :: if1
+      INTEGER(i4)                       :: if2
+      INTEGER(i4)                       :: jf1
+      INTEGER(i4)                       :: jf2
+
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
+
+      LOGICAL                           :: ll_check
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! intitalise
+      if_pivot=-1
+
+      il_dim(:)=SHAPE(dd_value(:,:,:,:))
+
+      ! T-point pivot !case of ORCA2, ORCA025, ORCA12 grid
+      jt1=4 ; jt2=2 
+      il_midT=il_dim(1)/2+1
+
+      ! F-point pivot !case of ORCA05 grid
+      jf1=4 ; jf2=3
+      il_midF=il_dim(1)/2
+
+      ! check T-point pivot
+      DO ji=1,il_midT
+         ll_check=.TRUE.
+         it1=ji
+         it2=il_dim(1)-(ji-2)
+         IF( dd_value(it1,jt1,1,1) /= dd_value(it2-1,jt2,1,1) )THEN
+            ll_check=.FALSE.
+            EXIT
+         ENDIF
+      ENDDO
+
+      IF( ll_check )THEN
+         CALL logger_info("GRID GET PIVOT: T-pivot")
+         if_pivot=1
+      ELSE
+
+         ! check F-point pivot
+         DO ji=1,il_midF
+            ll_check=.TRUE.
+            if1=ji
+            if2=il_dim(1)-(ji-1)
+            IF( dd_value(if1,jf1,1,1) /= dd_value(if2-1,jf2,1,1) )THEN
+               ll_check=.FALSE.
+               EXIT
+            ENDIF
+         ENDDO
+
+         IF( ll_check )THEN
+            CALL logger_info("GRID GET PIVOT: F-pivot")
+            if_pivot=0
+         ENDIF
+
+      ENDIF
+
+   END FUNCTION grid__get_pivot_varU
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__get_pivot_varV(dd_value) &
+         & RESULT (if_pivot)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This function compute NEMO pivot point index for variable on grid V.
+   !>
+   !> @details
+   !> - F-point : 0
+   !> - T-point : 1
+   !>
+   !> @note array of value must be only the top border of the domain.
+   !> 
+   !> @author J.Paul
+   !> @date October, 2014 - Initial version
+   !>
+   !> @param[in] dd_value array of value
+   !> @return pivot point index
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      REAL(dp), DIMENSION(:,:,:,:), INTENT(IN) :: dd_value
+
+      ! function
+      INTEGER(i4)                              :: if_pivot
+
+      ! local variable
+      INTEGER(i4)                       :: il_midT
+      INTEGER(i4)                       :: il_midF
+
+      INTEGER(i4)                       :: it1
+      INTEGER(i4)                       :: it2
+      INTEGER(i4)                       :: jt1
+      INTEGER(i4)                       :: jt2
+
+      INTEGER(i4)                       :: if1
+      INTEGER(i4)                       :: if2
+      INTEGER(i4)                       :: jf1
+      INTEGER(i4)                       :: jf2
+
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
+
+      LOGICAL                           :: ll_check
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! intitalise
+      if_pivot=-1
+
+      il_dim(:)=SHAPE(dd_value(:,:,:,:))
+
+      ! T-point pivot !case of ORCA2, ORCA025, ORCA12 grid
+      jt1=4 ; jt2=2 
+      il_midT=il_dim(1)/2+1
+
+      ! F-point pivot !case of ORCA05 grid
+      jf1=4 ; jf2=3
+      il_midF=il_dim(1)/2
+
+      ! check T-point pivot
+      DO ji=2,il_midT
+         ll_check=.TRUE.
+         it1=ji
+         it2=il_dim(1)-(ji-2)
+         IF( dd_value(it1,jt1,1,1) /= dd_value(it2,jt2-1,1,1) )THEN
+            ll_check=.FALSE.
+            EXIT
+         ENDIF
+      ENDDO
+
+      IF( ll_check )THEN
+         CALL logger_info("GRID GET PIVOT: T-pivot")
+         if_pivot=1
+      ELSE
+
+         ! check F-point pivot
+         DO ji=1,il_midF
+            ll_check=.TRUE.
+            if1=ji
+            if2=il_dim(1)-(ji-1)
+            IF( dd_value(if1,jf1,1,1) /= dd_value(if2,jf2-1,1,1) )THEN
+               ll_check=.FALSE.
+               EXIT
+            ENDIF
+         ENDDO
+
+         IF( ll_check )THEN
+            CALL logger_info("GRID GET PIVOT: F-pivot")
+            if_pivot=0
+         ENDIF
+
+      ENDIF
+
+   END FUNCTION grid__get_pivot_varV
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__get_pivot_varF(dd_value) &
+         & RESULT (if_pivot)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This function compute NEMO pivot point index for variable on grid F.
+   !>
+   !> @details
+   !> - F-point : 0
+   !> - T-point : 1
+   !>
+   !> @note array of value must be only the top border of the domain.
+   !> 
+   !> @author J.Paul
+   !> @date October, 2014 - Initial version
+   !>
+   !> @param[in] dd_value array of value
+   !> @return pivot point index
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      REAL(dp), DIMENSION(:,:,:,:), INTENT(IN) :: dd_value
+
+      ! function
+      INTEGER(i4)                              :: if_pivot
+
+      ! local variable
+      INTEGER(i4)                       :: il_midT
+      INTEGER(i4)                       :: il_midF
+
+      INTEGER(i4)                       :: it1
+      INTEGER(i4)                       :: it2
+      INTEGER(i4)                       :: jt1
+      INTEGER(i4)                       :: jt2
+
+      INTEGER(i4)                       :: if1
+      INTEGER(i4)                       :: if2
+      INTEGER(i4)                       :: jf1
+      INTEGER(i4)                       :: jf2
+
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
+
+      LOGICAL                           :: ll_check
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! intitalise
+      if_pivot=-1
+
+      il_dim(:)=SHAPE(dd_value(:,:,:,:))
+
+      ! T-point pivot !case of ORCA2, ORCA025, ORCA12 grid
+      jt1=4 ; jt2=2 
+      il_midT=il_dim(1)/2+1
+
+      ! F-point pivot !case of ORCA05 grid
+      jf1=4 ; jf2=3
+      il_midF=il_dim(1)/2
+
+      ! check T-point pivot
+      DO ji=1,il_midT
+         ll_check=.TRUE.
+         it1=ji
+         it2=il_dim(1)-(ji-2)
+         IF( dd_value(it1,jt1,1,1) /= dd_value(it2-1,jt2-1,1,1) )THEN
+            ll_check=.FALSE.
+            EXIT
+         ENDIF
+      ENDDO
+
+      IF( ll_check )THEN
+         CALL logger_info("GRID GET PIVOT: T-pivot")
+         if_pivot=1
+      ELSE
+
+         ! check F-point pivot
+         DO ji=1,il_midF
+            ll_check=.TRUE.
+            if1=ji
+            if2=il_dim(1)-(ji-1)
+            IF( dd_value(if1,jf1,1,1) /= dd_value(if2-1,jf2-1,1,1) )THEN
+               ll_check=.FALSE.
+               EXIT
+            ENDIF
+         ENDDO
+
+         IF( ll_check )THEN
+            CALL logger_info("GRID GET PIVOT: F-pivot")
+            if_pivot=0
+         ENDIF
+
+      ENDIF
+
+   END FUNCTION grid__get_pivot_varF
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__get_pivot_file(td_file) &
+         & RESULT (if_pivot)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This function compute NEMO pivot point index from input file variable.
+   !> - F-point : 0
+   !> - T-point : 1
+   !>
+   !> @details
+   !> check north points symmetry of a 2D variable (indices jpj to jpj-3), depending on which grid point
+   !> (T,F,U,V) variable is defined.
+   !> 
+   !> @warning 
+   !> - do not work with ORCA2 grid (T-point)
+   !>
+   !> @author J.Paul
+   !> @date Ocotber, 2014 - Initial version
+   !> @date August, 2017
+   !> - if can't find latitude variable, assume there is a north fold
+   !> - do not use latitude variable to get pivot (to avoid mistake with regular
+   !> grid)
+   !>
+   !> @param[in] td_file file structure
+   !> @return pivot point index
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(IN) :: td_file
+
+      ! function
+      INTEGER(i4)             :: if_pivot
+
+      ! local variable
+      INTEGER(i4)                       :: il_varid
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
+
+      LOGICAL                           :: ll_north
+
+      TYPE(TVAR)                        :: tl_var
+      TYPE(TVAR)                        :: tl_lat
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! intitalise
+      if_pivot=-1
+
+      ! look for north fold
+      il_varid=var_get_index(td_file%t_var(:), 'latitude')
+      IF( il_varid == 0 )THEN
+         CALL logger_error("GRID GET PIVOT: no variable with name "//&
+            &  "or standard name latitude in file structure "//&
+            &  TRIM(td_file%c_name)//". Assume there is north fold and "//&
+            &  "try to get pivot point")
+
+         ll_north=.TRUE.
+      ELSE      
+         IF( ASSOCIATED(td_file%t_var(il_varid)%d_value) )THEN
+            tl_lat=var_copy(td_file%t_var(il_varid))
+         ELSE
+            tl_lat=iom_read_var(td_file, 'latitude')
+         ENDIF
+
+         ll_north=grid_is_north_fold(tl_lat)
+         ! clean
+         CALL var_clean(tl_lat)
+      ENDIF
+
+      IF( ll_north )THEN      
+         ! look for suitable variable
+         DO ji=1,td_file%i_nvar
+            IF( .NOT. ALL(td_file%t_var(ji)%t_dim(1:2)%l_use) ) CYCLE
+
+            IF( ASSOCIATED(td_file%t_var(ji)%d_value) )THEN
+               tl_var=var_copy(td_file%t_var(ji))
+            ELSE
+               il_dim(:)=td_file%t_var(ji)%t_dim(:)%i_len
+               tl_var=iom_read_var(td_file, &
+                  &                td_file%t_var(ji)%c_name, &
+                  &                id_start=(/1,il_dim(2)-3,1,1/), &
+                  &                id_count=(/il_dim(1),4,1,1/) )
+            ENDIF
+         ENDDO
+
+         IF( ASSOCIATED(tl_var%d_value) )THEN
+
+            if_pivot=grid_get_pivot(tl_var)
+
+         ENDIF
+
+         ! clean
+         CALL var_clean(tl_var)
+      ELSE
+         CALL logger_warn("GRID GET PIVOT: no north fold. force to use T-PIVOT")
+         if_pivot=1
+      ENDIF
+
+   END FUNCTION grid__get_pivot_file
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__get_pivot_mpp(td_mpp) &
+         & RESULT (if_pivot)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This function compute NEMO pivot point index from input mpp variable.
+   !> - F-point : 0
+   !> - T-point : 1
+   !>
+   !> @details
+   !> check north points symmetry of a 2D variable (indices jpj to jpj-3), depending 
+   !> on which grid point (T,F,U,V) variable is defined.
+   !> 
+   !> @warning 
+   !> - do not work with ORCA2 grid (T-point)
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial version
+   !> @date August, 2017
+   !> - if can't find latitude variable, assume there is a north fold
+   !> - do not use latitude variable to get pivot (to avoid mistake with regular
+   !> grid)
+   !>
+   !> @param[in] td_mpp   mpp file structure
+   !> @return pivot point index
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP), INTENT(IN) :: td_mpp
+
+      ! function
+      INTEGER(i4)            :: if_pivot
+
+      ! local variable
+      INTEGER(i4)                       :: il_varid
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
+
+      LOGICAL                           :: ll_north
+
+      TYPE(TVAR)                        :: tl_var
+      TYPE(TVAR)                        :: tl_lat
+ 
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! intitalise
+      if_pivot=-1
+
+      ! look for north fold
+      il_varid=var_get_index(td_mpp%t_proc(1)%t_var(:), 'latitude')
+      IF( il_varid == 0 )THEN
+         CALL logger_error("GRID GET PIVOT: no variable with name "//&
+            &  "or standard name latitude in mpp structure "//&
+            &  TRIM(td_mpp%c_name)//". Assume there is north fold and "//&
+            &  "try to get pivot point")
+
+         ll_north=.TRUE.
+      ELSE
+         IF( ASSOCIATED(td_mpp%t_proc(1)%t_var(il_varid)%d_value) )THEN
+            ! 
+            tl_lat=mpp_recombine_var(td_mpp, 'latitude')
+         ELSE
+            tl_lat=iom_mpp_read_var(td_mpp, 'latitude')
+         ENDIF      
+
+         ll_north=grid_is_north_fold(tl_lat)
+         ! clean
+         CALL var_clean(tl_lat)
+      ENDIF
+
+      IF( ll_north )THEN
+
+         ! look for suitable variable
+         DO ji=1,td_mpp%t_proc(1)%i_nvar
+            IF(.NOT. ALL(td_mpp%t_proc(1)%t_var(ji)%t_dim(1:2)%l_use)) CYCLE
+
+            IF( ASSOCIATED(td_mpp%t_proc(1)%t_var(ji)%d_value) )THEN
+               CALL logger_debug("GRID GET PIVOT: mpp_recombine_var"//&
+                  &              TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name))
+               tl_var=mpp_recombine_var(td_mpp, &
+                  &                     TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name))
+            ELSE
+               CALL logger_debug("GRID GET PIVOT: iom_mpp_read_var "//&
+               &        TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name))
+               il_dim(:)=td_mpp%t_dim(:)%i_len
+
+               ! read variable
+               tl_var=iom_mpp_read_var(td_mpp, &
+                  &                    td_mpp%t_proc(1)%t_var(ji)%c_name, &
+                  &                    id_start=(/1,il_dim(2)-3,1,1/), &
+                  &                    id_count=(/il_dim(1),4,1,1/) )
+            ENDIF
+            EXIT
+         ENDDO
+
+         IF( ASSOCIATED(tl_var%d_value) )THEN
+
+            if_pivot=grid_get_pivot(tl_var)
+
+         ELSE
+            CALL logger_warn("GRID GET PIVOT: force to use T-PIVOT")
+            if_pivot=1
+         ENDIF
+
+         ! clean
+         CALL var_clean(tl_var)
+      ELSE
+         CALL logger_warn("GRID GET PIVOT: no north fold. force to use T-PIVOT")
+         if_pivot=1
+      ENDIF
+
+   END FUNCTION grid__get_pivot_mpp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__get_perio_var(td_var, id_pivot) &
+         & RESULT (if_perio)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This subroutine search NEMO periodicity index given variable structure and
+   !> pivot point index.
+   !> @details
+   !> The variable must be on T point.
+   !>
+   !> 0: closed boundaries
+   !> 1: cyclic east-west boundary
+   !> 2: symmetric boundary condition across the equator
+   !> 3: North fold boundary (with a T-point pivot)
+   !> 4: North fold boundary (with a T-point pivot) and cyclic east-west boundary
+   !> 5: North fold boundary (with a F-point pivot)
+   !> 6: North fold boundary (with a F-point pivot) and cyclic east-west boundary
+   !>
+   !> @warning pivot point should have been computed before run this script. see grid_get_pivot.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !> @date October, 2014
+   !> - work on variable structure instead of file structure
+   !>
+   !> @param[in] td_var   variable structure
+   !> @param[in] id_pivot pivot point index
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR) , INTENT(IN) :: td_var
+      INTEGER(i4), INTENT(IN) :: id_pivot
+
+      ! function
+      INTEGER(i4)             :: if_perio
+
+      ! local variable
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
+
+      ! loop indices
+      !----------------------------------------------------------------
+      ! intitalise
+      if_perio=-1
+
+      IF( id_pivot < 0 .OR. id_pivot > 1 )THEN
+         CALL logger_error("GRID GET PERIO: invalid pivot point index. "//&
+         &  "you should use grid_get_pivot to compute it")
+      ENDIF
+
+      IF( .NOT. ASSOCIATED(td_var%d_value) .OR. &
+      &   .NOT. ALL(td_var%t_dim(1:2)%l_use) )THEN
+         CALL logger_error("GRID GET PERIO: can not compute periodicity"//&
+         &  " with variable "//TRIM(td_var%c_name)//"."//&
+         &  " no value associated or missing dimension.")
+      ELSE
+
+         il_dim(:)=td_var%t_dim(:)%i_len
+
+         CALL logger_debug("GRID GET PERIO: use variable "//TRIM(td_var%c_name))
+         CALL logger_debug("GRID GET PERIO: fill value "//TRIM(fct_str(td_var%d_fill)))
+         CALL logger_debug("GRID GET PERIO: first value "//TRIM(fct_str(td_var%d_value(1,1,1,1))))
+
+         IF(ALL(td_var%d_value(    1    ,    :    ,1,1)/=td_var%d_fill).AND.&
+         &  ALL(td_var%d_value(il_dim(1),    :    ,1,1)/=td_var%d_fill).AND.&
+         &  ALL(td_var%d_value(    :    ,    1    ,1,1)/=td_var%d_fill).AND.&
+         &  ALL(td_var%d_value(    :    ,il_dim(2),1,1)/=td_var%d_fill))THEN
+         ! no boundary closed
+            CALL logger_error("GRID GET PERIO: can't determined periodicity. "//&
+            &             "there is no boundary closed for variable "//&
+            &              TRIM(td_var%c_name) )
+            ! check pivot
+            SELECT CASE(id_pivot)
+               CASE(0)
+                  ! F pivot
+                  CALL logger_warn("GRID GET PERIO: assume domain is global")
+                  if_perio=6
+               CASE(1)
+                  ! T pivot
+                  CALL logger_warn("GRID GET PERIO: assume domain is global")
+                  if_perio=4
+            END SELECT
+         ELSE
+            if_perio=-1
+            ! check periodicity
+            IF(ANY(td_var%d_value(   1     ,:,1,1)/=td_var%d_fill).OR.&
+            &  ANY(td_var%d_value(il_dim(1),:,1,1)/=td_var%d_fill))THEN
+            ! East-West cyclic (1,4,6)
+
+               IF( ANY(td_var%d_value(:, 1, 1, 1) /= td_var%d_fill) )THEN
+                  ! South boundary not closed 
+
+                  CALL logger_debug("GRID GET PERIO: East_West cyclic")
+                  CALL logger_debug("GRID GET PERIO: South boundary not closed")
+                  CALL logger_error("GRID GET PERIO: should have been an "//&
+                  &              "impossible case")
+
+               ELSE
+                  ! South boundary closed (1,4,6)
+                  CALL logger_info("GRID GET PERIO: South boundary closed")
+
+                  IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill) )THEN
+                     ! North boundary not closed (4,6)
+                     CALL logger_info("GRID GET PERIO: North boundary not closed")
+                     ! check pivot
+                     SELECT CASE(id_pivot)
+                        CASE(0)
+                           ! F pivot
+                           if_perio=6
+                        CASE(1)
+                           ! T pivot
+                           if_perio=4
+                        CASE DEFAULT
+                           CALL logger_error("GRID GET PERIO: invalid pivot ")
+                     END SELECT
+                  ELSE
+                  ! North boundary closed
+                     CALL logger_info("GRID GET PERIO: North boundary closed")
+                     if_perio=1 ! North and South boundaries closed
+                  ENDIF
+
+               ENDIF
+
+            ELSE
+            ! East-West boundaries closed (0,2,3,5)
+               CALL logger_info("GRID GET PERIO: East West boundaries closed")
+
+               IF( ANY(td_var%d_value(:, 1, 1, 1) /= td_var%d_fill) )THEN
+               ! South boundary not closed (2)
+                  CALL logger_info("GRID GET PERIO: South boundary not closed")
+
+                  IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill))THEN
+                     ! North boundary not closed
+                     CALL logger_debug("GRID GET PERIO: East West boundaries "//&
+                        &              "closed")
+                     CALL logger_debug("GRID GET PERIO: South boundary not closed")
+                     CALL logger_debug("GRID GET PERIO: North boundary not closed")
+                     CALL logger_error("GRID GET PERIO: should have been "//&
+                        &              "an impossible case")
+                  ELSE
+                     ! North boundary closed
+                     if_perio=2   ! East-West and North boundaries closed 
+                  ENDIF
+
+               ELSE
+               ! South boundary closed (0,3,5)
+                  CALL logger_info("GRID GET PERIO: South boundary closed")
+
+                  IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill))THEN
+                     ! North boundary not closed (3,5)
+                     CALL logger_info("GRID GET PERIO: North boundary not closed")
+                     ! check pivot
+                     SELECT CASE(id_pivot)
+                        CASE(0)
+                           ! F pivot
+                           if_perio=5
+                        CASE(1)
+                           ! T pivot
+                           if_perio=3
+                        CASE DEFAULT
+                           CALL logger_error("GRID GET PERIO: invalid pivot")
+                     END SELECT
+                  ELSE
+                  ! North boundary closed   
+                     CALL logger_info("GRID GET PERIO: North boundary closed")
+                     if_perio=0   ! all boundary closed
+                  ENDIF
+
+               ENDIF
+
+            ENDIF
+
+         ENDIF
+
+      ENDIF
+
+   END FUNCTION grid__get_perio_var
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__get_perio_file(td_file, id_pivot) &
+         & RESULT (if_perio)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This subroutine search NEMO periodicity index given file structure, and
+   !> optionaly pivot point index.
+   !> @details
+   !> The variable used must be on T point.
+   !>
+   !> 0: closed boundaries
+   !> 1: cyclic east-west boundary
+   !> 2: symmetric boundary condition across the equator
+   !> 3: North fold boundary (with a F-point pivot)
+   !> 4: North fold boundary (with a F-point pivot) and cyclic east-west boundary
+   !> 5: North fold boundary (with a T-point pivot)
+   !> 6: North fold boundary (with a T-point pivot) and cyclic east-west boundary
+   !>
+   !> @warning pivot point should have been computed before run this script. see grid_get_pivot.
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial version
+   !> @date August, 2017
+   !> - read only grid boundaries to handle huge file 
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] id_pivot  pivot point index
+   !> @return NEMO periodicity index
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(IN) :: td_file
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_pivot
+
+      ! function
+      INTEGER(i4)             :: if_perio
+
+      ! local variable
+      INTEGER(i4)                       :: il_idx
+      INTEGER(i4)                       :: il_pivot
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
+
+      TYPE(TVAR)                        :: tl_var
+      TYPE(TVAR)                        :: tl_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      !initialise
+      if_perio=-1
+
+      IF(PRESENT(id_pivot) )THEN
+         il_pivot=id_pivot
+      ELSE
+         il_pivot=grid_get_pivot(td_file)
+      ENDIF
+
+      IF( il_pivot < 0 .OR. il_pivot > 1 )THEN
+         CALL logger_error("GRID GET PERIO: invalid pivot point index. "//&
+         &  "you should use grid_get_pivot to compute it")
+      ENDIF
+
+      ! look for suitable variable
+      il_idx=0
+      DO ji=1,td_file%i_nvar
+         IF( .NOT. ALL(td_file%t_var(ji)%t_dim(1:2)%l_use) ) CYCLE
+         SELECT CASE(TRIM(fct_lower(td_file%t_var(ji)%c_stdname)) )
+            CASE('longitude','latitude')
+            CASE DEFAULT
+               il_idx=ji
+               EXIT
+         END SELECT
+      ENDDO
+
+      IF( il_idx==0 )THEN
+ 
+         CALL logger_error("GRID GET PERIO: no suitable variable to compute "//&
+         &              " periodicity in file "//TRIM(td_file%c_name))
+
+      ELSE
+
+         DO ji=1,ip_maxdim
+            IF( td_file%t_var(il_idx)%t_dim(ji)%l_use )THEN
+               il_dim(ji)= td_file%t_var(il_idx)%t_dim(ji)%i_len
+            ELSE
+               il_dim(ji)=1
+            ENDIF
+         ENDDO
+
+         ! read variable (full array)
+         !tl_var=iom_read_var(td_file, &
+         !&                   td_file%t_var(il_idx)%c_name, &
+         !&                   id_start=(/1,1,1,1/), &
+         !&                   id_count=(/il_dim(1),il_dim(2),1,1/) )
+
+         ! read variable (only usefull part)
+         tl_tmp=iom_read_var(td_file, &
+            &                td_file%t_var(il_idx)%c_name, &
+            &                id_start=(/1,1,1,1/), &
+            &                id_count=(/il_dim(1),1,1,1/) )
+
+         ! copy variable struct here, to get change done inside read_var too.
+         tl_var=var_copy(tl_tmp,ld_value=.false.)
+         ! force dimension to be full domain dimension 
+         ! (instead of proc dimension)
+         tl_var%t_dim(:)%i_len=il_dim(:)
+         ALLOCATE(tl_var%d_value(il_dim(jp_I), &
+            &                    il_dim(jp_J), &
+            &                    il_dim(jp_K), &
+            &                    il_dim(jp_L)))
+
+         tl_var%d_value(:,1,1,1)=tl_tmp%d_value(:,1,1,1)
+         ! clean 
+         CALL var_clean(tl_tmp)
+         
+         ! read variable (only usefull part)
+         tl_tmp=iom_read_var(td_file, &
+            &                td_file%t_var(il_idx)%c_name, &
+            &                id_start=(/1,il_dim(2),1,1/), &
+            &                id_count=(/il_dim(1),1,1,1/) )
+
+         tl_var%d_value(:,il_dim(2),1,1)=tl_tmp%d_value(:,1,1,1)
+         ! clean 
+         CALL var_clean(tl_tmp)
+
+         ! read variable (only usefull part)
+         tl_tmp=iom_read_var(td_file, &
+            &                td_file%t_var(il_idx)%c_name, &
+            &                id_start=(/1,1,1,1/), &
+            &                id_count=(/1,il_dim(2),1,1/) )
+
+         tl_var%d_value(1,:,1,1)=tl_tmp%d_value(1,:,1,1)
+         ! clean 
+         CALL var_clean(tl_tmp)
+
+         ! read variable (only usefull part)
+         tl_tmp=iom_read_var(td_file, &
+            &                td_file%t_var(il_idx)%c_name, &
+            &                id_start=(/il_dim(1),1,1,1/), &
+            &                id_count=(/1,il_dim(2),1,1/) )
+
+         tl_var%d_value(il_dim(1),:,1,1)=tl_tmp%d_value(1,:,1,1)
+         ! clean 
+         CALL var_clean(tl_tmp)
+
+         if_perio=grid_get_perio(tl_var,il_pivot)
+ 
+         ! clean 
+         CALL var_clean(tl_var)
+
+      ENDIF
+
+   END FUNCTION grid__get_perio_file
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__get_perio_mpp(td_mpp, id_pivot) &
+         & RESULT (if_perio)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This subroutine search NEMO periodicity given mpp structure and optionaly
+   !> pivot point index.
+   !> @details
+   !> The variable used must be on T point.
+   !>
+   !> 0: closed boundaries
+   !> 1: cyclic east-west boundary
+   !> 2: symmetric boundary condition across the equator
+   !> 3: North fold boundary (with a T-point pivot)
+   !> 4: North fold boundary (with a T-point pivot) and cyclic east-west boundary
+   !> 5: North fold boundary (with a F-point pivot)
+   !> 6: North fold boundary (with a F-point pivot) and cyclic east-west boundary
+   !>
+   !> @warning pivot point should have been computed before run this script. see grid_get_pivot.
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial version
+   !> @date August, 2017
+   !> - read only grid boundaries to handle huge file 
+   !> @date January, 2019
+   !> - do not use silicalim, or silicamax to get pivot point
+   !>
+   !> @todo
+   !> do not check silicalim, or silicamax
+   !>
+   !> @param[in] td_mpp   mpp file structure
+   !> @param[in] id_pivot pivot point index
+   !> @return NEMO periodicity index
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP) , INTENT(IN) :: td_mpp
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_pivot
+
+      ! function
+      INTEGER(i4)             :: if_perio
+
+      ! local variable
+      INTEGER(i4)                       :: il_idx
+      INTEGER(i4)                       :: il_pivot
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
+
+      TYPE(TVAR)                        :: tl_var
+      TYPE(TVAR)                        :: tl_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! initialise
+      if_perio=-1
+
+      IF(PRESENT(id_pivot) )THEN
+         il_pivot=id_pivot
+      ELSE
+         il_pivot=grid_get_pivot(td_mpp)
+      ENDIF
+
+      IF( il_pivot < 0 .OR. il_pivot > 1 )THEN
+         CALL logger_error("GRID GET PERIO: invalid pivot point index. "//&
+            &  "you should use grid_get_pivot to compute it")
+      ENDIF
+
+      ! look for suitable variable
+      il_idx=0
+      DO ji=1,td_mpp%t_proc(1)%i_nvar
+         IF( .NOT. ALL(td_mpp%t_proc(1)%t_var(ji)%t_dim(1:2)%l_use) ) CYCLE
+         SELECT CASE(TRIM(fct_lower(td_mpp%t_proc(1)%t_var(ji)%c_stdname)) )
+            CASE('longitude','latitude')
+            CASE DEFAULT
+               SELECT CASE(TRIM(fct_lower(td_mpp%t_proc(1)%t_var(ji)%c_name)))
+                  CASE('silicalim','silicamax')
+                  CASE DEFAULT
+                     il_idx=ji
+                     EXIT
+               END SELECT
+         END SELECT
+      ENDDO
+
+      IF( il_idx==0 )THEN
+ 
+         CALL logger_error("GRID GET PERIO: no suitable variable to compute "//&
+         &              " periodicity in file "//TRIM(td_mpp%c_name))
+
+      ELSE
+ 
+         ! full domain dimension
+         DO ji=1,ip_maxdim
+            IF( td_mpp%t_proc(1)%t_var(il_idx)%t_dim(ji)%l_use )THEN
+               il_dim(ji)=td_mpp%t_dim(ji)%i_len
+            ELSE
+               il_dim(ji)=1
+            ENDIF
+         ENDDO
+
+         ! read variable (full array)
+         !tl_var=iom_mpp_read_var(td_mpp, td_mpp%t_proc(1)%t_var(il_idx)%c_name)
+
+         ! read variable (only usefull part)
+         tl_tmp=iom_mpp_read_var(td_mpp, &
+            &                    td_mpp%t_proc(1)%t_var(il_idx)%c_name, &
+            &                    id_start=(/1,1,1,1/), &
+            &                    id_count=(/il_dim(1),1,1,1/) )
+
+         ! copy variable struct here, to get change done inside read_var too.
+         tl_var=var_copy(tl_tmp,ld_value=.false.)
+         ! force dimension to be full domain dimension 
+         ! (instead of proc dimension)
+         tl_var%t_dim(:)%i_len=il_dim(:)
+         ALLOCATE(tl_var%d_value(il_dim(jp_I), &
+            &                    il_dim(jp_J), &
+            &                    il_dim(jp_K), &
+            &                    il_dim(jp_L)))
+
+         tl_var%d_value(:,1,1,1)=tl_tmp%d_value(:,1,1,1)
+         ! clean 
+         CALL var_clean(tl_tmp)
+ 
+         ! read variable (only usefull part)
+         tl_tmp=iom_mpp_read_var(td_mpp, &
+            &                    td_mpp%t_proc(1)%t_var(il_idx)%c_name, &
+            &                    id_start=(/1,il_dim(2),1,1/), &
+            &                    id_count=(/il_dim(1),1,1,1/) )
+
+         tl_var%d_value(:,il_dim(2),1,1)=tl_tmp%d_value(:,1,1,1)
+         ! clean 
+         CALL var_clean(tl_tmp)
+
+         ! read variable (only usefull part)
+         tl_tmp=iom_mpp_read_var(td_mpp, &
+            &                    td_mpp%t_proc(1)%t_var(il_idx)%c_name, &
+            &                    id_start=(/1,1,1,1/), &
+            &                    id_count=(/1,il_dim(2),1,1/) )
+
+         tl_var%d_value(1,:,1,1)=tl_tmp%d_value(1,:,1,1)
+         ! clean 
+         CALL var_clean(tl_tmp)
+
+         ! read variable (only usefull part)
+         tl_tmp=iom_mpp_read_var(td_mpp, &
+            &                    td_mpp%t_proc(1)%t_var(il_idx)%c_name, &
+            &                    id_start=(/il_dim(1),1,1,1/), &
+            &                    id_count=(/1,il_dim(2),1,1/) )
+
+         tl_var%d_value(il_dim(1),:,1,1)=tl_tmp%d_value(1,:,1,1)
+         ! clean 
+         CALL var_clean(tl_tmp)
+
+         if_perio=grid_get_perio(tl_var, il_pivot)
+
+         ! clean 
+         CALL var_clean(tl_var)
+      ENDIF
+
+   END FUNCTION grid__get_perio_mpp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__get_ew_overlap_var(td_var) &
+         & RESULT (if_overlap)
+   !-------------------------------------------------------------------
+   !> @brief This function get East-West overlap.
+   !>
+   !> @details
+   !> If no East-West wrap return -1, 
+   !> else return the size of the ovarlap band.
+   !> East-West overlap is computed comparing longitude value of the  
+   !> South part of the domain, to avoid  north fold boundary.
+   !>
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date October, 2014
+   !> - work on mpp file structure instead of file structure
+   !> @date October, 2016
+   !> - check longitude as longname
+   !>
+   !> @param[in] td_lon longitude variable structure 
+   !> @return East West overlap
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+
+      ! function
+      INTEGER(i4)               :: if_overlap
+
+      ! local variable
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_value
+      REAL(dp), DIMENSION(:)  , ALLOCATABLE :: dl_vare
+      REAL(dp), DIMENSION(:)  , ALLOCATABLE :: dl_varw
+
+      REAL(dp)    :: dl_delta
+      REAL(dp)    :: dl_varmax
+      REAL(dp)    :: dl_varmin
+
+      INTEGER(i4) :: il_east
+      INTEGER(i4) :: il_west
+      INTEGER(i4) :: il_jmin
+      INTEGER(i4) :: il_jmax
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! initialise
+      if_overlap=-1
+
+      IF( ASSOCIATED(td_var%d_value) )THEN
+
+         IF( td_var%t_dim(1)%i_len > 1 )THEN
+            il_west=1
+            il_east=td_var%t_dim(1)%i_len
+
+            ALLOCATE( dl_value(td_var%t_dim(1)%i_len, &
+               &               td_var%t_dim(2)%i_len) )
+
+            dl_value(:,:)=td_var%d_value(:,:,1,1)
+
+            ! we do not use jmax as dimension length due to north fold boundary
+            IF( td_var%t_dim(2)%i_len > 1 )THEN
+               il_jmin=1+ip_ghost
+               il_jmax=(td_var%t_dim(2)%i_len-ip_ghost)/2
+            ELSE
+               il_jmin=1
+               il_jmax=1
+            ENDIF
+
+            ALLOCATE( dl_vare(il_jmax-il_jmin+1) )
+            ALLOCATE( dl_varw(il_jmax-il_jmin+1) )
+
+            dl_vare(:)=dl_value(il_east,il_jmin:il_jmax)
+            dl_varw(:)=dl_value(il_west,il_jmin:il_jmax)
+
+            IF( .NOT.( ALL(dl_vare(:)==td_var%d_fill) .AND. &
+            &          ALL(dl_varw(:)==td_var%d_fill) ) )THEN
+
+               IF( TRIM(td_var%c_stdname) == 'longitude' .OR. &
+                 & SCAN( TRIM(td_var%c_longname), 'longitude') == 0 )THEN
+                  WHERE( dl_value(:,:) > 180._dp .AND. &
+                     &   dl_value(:,:) /= td_var%d_fill ) 
+                     dl_value(:,:)=360.-dl_value(:,:)
+                  END WHERE
+
+                  dl_varmax=MAXVAL(dl_value(:,il_jmin:il_jmax))
+                  dl_varmin=MINVAL(dl_value(:,il_jmin:il_jmax))
+
+                  dl_delta=(dl_varmax-dl_varmin)/td_var%t_dim(1)%i_len
+
+                  IF( ALL(ABS(dl_vare(:)) - ABS(dl_varw(:)) == dl_delta) )THEN
+                     if_overlap=0
+                  ENDIF
+               ENDIF
+
+               IF( if_overlap == -1 )THEN
+                  DO ji=0,im_max_overlap
+
+                     IF( il_east-ji == il_west )THEN
+                        ! case of small domain
+                        EXIT
+                     ELSE
+                        dl_vare(:)=dl_value(il_east-ji,il_jmin:il_jmax)
+
+                        IF( ALL( dl_varw(:) == dl_vare(:) ) )THEN
+                           if_overlap=ji+1
+                           EXIT
+                        ENDIF
+                     ENDIF
+
+                  ENDDO
+               ENDIF
+            ENDIF
+
+         ENDIF
+      ELSE
+         CALL logger_error("GRID GET EW OVERLAP: input variable standard name"//&
+         &  TRIM(td_var%c_stdname)//" can not be used to compute East West "//&
+         &  "overalp. no value associated. ")
+      ENDIF
+
+   END FUNCTION grid__get_ew_overlap_var
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__get_ew_overlap_file(td_file) &
+         & RESULT (if_overlap)
+   !-------------------------------------------------------------------
+   !> @brief This function get East-West overlap.
+   !>
+   !> @details
+   !> If no East-West wrap return -1, 
+   !> else return the size of the ovarlap band.
+   !> East-West overlap is computed comparing longitude value of the  
+   !> South part of the domain, to avoid  north fold boundary.
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !> @date October, 2016
+   !> - check varid for longitude_T
+   !> @date August, 2017
+   !> - read only grid boundaries to handle huge file 
+   !>
+   !> @param[in] td_file file structure 
+   !> @return East West overlap
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! function
+      INTEGER(i4)                :: if_overlap
+
+      ! local variable
+      INTEGER(i4)                       :: il_idx
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
+
+      TYPE(TVAR)                        :: tl_var
+      TYPE(TVAR)                        :: tl_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: i1
+      INTEGER(i4) :: i2
+      INTEGER(i4) :: j1
+      INTEGER(i4) :: j2
+      INTEGER(i4) :: ic
+      INTEGER(i4) :: jc
+      !----------------------------------------------------------------
+
+      ! look for suitable variable
+      il_idx=var_get_index(td_file%t_var(:), 'longitude', 'longitude_T')
+      IF( il_idx == 0 )THEN
+         DO jj=1,td_file%i_nvar
+            IF( ALL(td_file%t_var(jj)%t_dim(1:2)%l_use) )THEN
+               il_idx=jj
+               EXIT
+            ENDIF
+         ENDDO
+      ENDIF
+
+      IF( il_idx==0 )THEN
+ 
+         CALL logger_error("GRID GET EW OVERLAP: no suitable variable to compute "//&
+         &              " east west overlap in file "//TRIM(td_file%c_name))
+
+      ELSE
+         ! read variable (full array)
+         !tl_var=iom_read_var(td_file, td_file%t_var(il_idx)%c_name)
+
+         ! full domain dimension
+         DO ji=1,ip_maxdim
+            IF( td_file%t_var(il_idx)%t_dim(ji)%l_use )THEN
+               il_dim(ji)= td_file%t_var(il_idx)%t_dim(ji)%i_len
+            ELSE
+               il_dim(ji)=1
+            ENDIF
+         ENDDO
+
+         ! read variable (only usefull part)
+         i1=1                ; j1=1
+         i2=im_max_overlap   ; j2=il_dim(jp_J)
+         ic=i2-i1+1          ; jc=j2-j1+1
+         tl_tmp=iom_read_var(td_file, &
+            &                td_file%t_var(il_idx)%c_name, &
+            &                id_start=(/i1,j1,1,1/), &
+            &                id_count=(/ic,jc,1,1/) )
+
+         ! copy variable struct here, to get change done inside read_var too.
+         tl_var=var_copy(tl_tmp,ld_value=.false.)
+         ! force dimension to be full domain dimension 
+         ! (instead of proc dimension)
+         tl_var%t_dim(:)%i_len=il_dim(:)
+         ALLOCATE(tl_var%d_value(il_dim(jp_I), &
+            &                    il_dim(jp_J), &
+            &                    il_dim(jp_K), &
+            &                    il_dim(jp_L)))
+         ! init array
+         tl_var%d_value(:,:,:,:)=tl_var%d_fill
+
+         tl_var%d_value(i1:i2,:,1,1)=tl_tmp%d_value(:,:,1,1)
+         ! clean 
+         CALL var_clean(tl_tmp)
+         
+         ! read variable (only usefull part)
+         i1=il_dim(jp_I)-im_max_overlap ; j1=1
+         i2=il_dim(jp_I)                ; j2=il_dim(jp_J)
+         ic=i2-i1+1                     ; jc=j2-j1+1
+         tl_tmp=iom_read_var(td_file, &
+            &                td_file%t_var(il_idx)%c_name, &
+            &                id_start=(/i1,j1,1,1/), &
+            &                id_count=(/ic,jc,1,1/) )
+
+         tl_var%d_value(i1:i2,:,1,1)=tl_tmp%d_value(:,:,1,1)
+         ! clean 
+         CALL var_clean(tl_tmp)
+
+         if_overlap=grid_get_ew_overlap(tl_var)
+
+         ! clean
+         CALL var_clean(tl_var)
+
+      ENDIF
+
+   END FUNCTION grid__get_ew_overlap_file
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__get_ew_overlap_mpp(td_mpp) &
+         & RESULT (if_overlap)
+   !-------------------------------------------------------------------
+   !> @brief This function get East-West overlap.
+   !>
+   !> @details
+   !> If no East-West wrap return -1, 
+   !> else return the size of the ovarlap band.
+   !> East-West overlap is computed comparing longitude value of the  
+   !> South part of the domain, to avoid  north fold boundary.
+   !>
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date October, 2014
+   !> - work on mpp file structure instead of file structure
+   !> @date October, 2016
+   !> - check varid for longitude_T
+   !> @date August, 2017
+   !> - read only grid boundaries to handle huge file 
+   !>
+   !> @param[in] td_mpp mpp structure 
+   !> @return East West overlap
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+
+      ! function
+      INTEGER(i4)               :: if_overlap
+
+      ! local variable
+      INTEGER(i4)                       :: il_idx
+      INTEGER(i4)                       :: il_ew
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
+
+      TYPE(TVAR)                        :: tl_var
+      TYPE(TVAR)                        :: tl_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: i1
+      INTEGER(i4) :: i2
+      INTEGER(i4) :: j1
+      INTEGER(i4) :: j2
+      INTEGER(i4) :: ic
+      INTEGER(i4) :: jc
+      !----------------------------------------------------------------
+
+      ! initialise
+      if_overlap=td_mpp%i_ew
+
+      il_idx=var_get_index(td_mpp%t_proc(1)%t_var(:), 'longitude', 'longitude_T')
+      IF( il_idx == 0 )THEN
+         DO jj=1,td_mpp%t_proc(1)%i_nvar
+            IF( ALL(td_mpp%t_proc(1)%t_var(jj)%t_dim(1:2)%l_use) )THEN
+               il_idx=jj
+               EXIT
+            ENDIF
+         ENDDO
+      ENDIF
+
+      IF( il_idx==0 )THEN
+ 
+         CALL logger_error("GRID GET EW OVERLAP: no suitable variable to compute "//&
+         &              " east west overlap in mppfile "//TRIM(td_mpp%c_name))
+
+      ELSE
+         ! read variable (full array)
+         !tl_var=iom_mpp_read_var(td_mpp, il_idx)
+
+         ! full domain dimension
+         DO ji=1,ip_maxdim
+            IF( td_mpp%t_proc(1)%t_var(il_idx)%t_dim(ji)%l_use )THEN
+               !il_dim(ji)=td_mpp%t_proc(1)%t_var(il_idx)%t_dim(ji)%i_len
+               il_dim(ji)=td_mpp%t_dim(ji)%i_len
+            ELSE
+               il_dim(ji)=1
+            ENDIF
+         ENDDO
+
+         ! read variable (only usefull part)
+         i1=1                ; j1=1
+         i2=im_max_overlap   ; j2=il_dim(jp_J)
+         ic=i2-i1+1          ; jc=j2-j1+1
+         tl_tmp=iom_mpp_read_var(td_mpp, &
+         &                       td_mpp%t_proc(1)%t_var(il_idx)%c_name, &
+         &                       id_start=(/i1,j1,1,1/), &
+         &                       id_count=(/ic,jc,1,1/) )
+
+         ! copy variable struct here, to get change done inside read_var too.
+         tl_var=var_copy(tl_tmp,ld_value=.false.)
+         ! force dimension to be full domain dimension 
+         ! (instead of proc dimension)
+         tl_var%t_dim(:)%i_len=il_dim(:)
+         ALLOCATE(tl_var%d_value(il_dim(jp_I), &
+            &                    il_dim(jp_J), &
+            &                    il_dim(jp_K), &
+            &                    il_dim(jp_L)))
+         ! init array
+         tl_var%d_value(:,:,:,:)=tl_var%d_fill
+
+         tl_var%d_value(i1:i2,:,1,1)=tl_tmp%d_value(:,:,1,1)
+         ! clean 
+         CALL var_clean(tl_tmp)
+         
+         ! read variable (only usefull part)
+         i1=il_dim(jp_I)-im_max_overlap ; j1=1
+         i2=il_dim(jp_I)                ; j2=il_dim(jp_J)
+         ic=i2-i1+1                     ; jc=j2-j1+1
+         tl_tmp=iom_mpp_read_var(td_mpp, &
+         &                       td_mpp%t_proc(1)%t_var(il_idx)%c_name, &
+         &                       id_start=(/i1,j1,1,1/), &
+         &                       id_count=(/ic,jc,1,1/) )
+
+         tl_var%d_value(i1:i2,:,1,1)=tl_tmp%d_value(:,:,1,1)
+         ! clean 
+         CALL var_clean(tl_tmp)
+
+         il_ew=grid_get_ew_overlap(tl_var)
+         IF( il_ew >= 0 )THEN
+            if_overlap=il_ew
+         ENDIF
+
+         ! clean
+         CALL var_clean(tl_var)
+
+      ENDIF
+
+   END FUNCTION grid__get_ew_overlap_mpp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid_is_north_fold(td_lat) &
+         & RESULT (lf_north)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine check if there is north fold.
+   !>
+   !> @details
+   !> check if maximum latitude greater than 88°N 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_lat latitude variable structure 
+   !> @return true if there is north fold
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR), INTENT(IN) :: td_lat
+
+      ! function
+      LOGICAL                :: lf_north
+
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+   
+      ! init
+      lf_north=.FALSE.
+
+      IF( .NOT. ASSOCIATED(td_lat%d_value) )THEN
+         CALL logger_error("GRID IS NORTH FOLD: "//&
+         &                 " no value associated to latitude")
+      ELSE      
+         IF( MAXVAL(td_lat%d_value(:,:,:,:), &
+         &          td_lat%d_value(:,:,:,:)/= td_lat%d_fill) >= 88.0 )THEN
+
+            lf_north=.TRUE.
+            
+         ENDIF
+      ENDIF
+
+   END FUNCTION grid_is_north_fold
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_check_dom(td_coord, id_imin, id_imax, id_jmin, id_jmax)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine check domain validity.
+   !>
+   !> @details
+   !> If maximum latitude greater than 88°N, program will stop. 
+   !> @note Not able to manage north fold for now.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date October, 2014
+   !> - work on mpp file structure instead of file structure
+   !>
+   !> @param[in] cd_coord  coordinate file 
+   !> @param[in] id_imin   i-direction lower left  point indice  
+   !> @param[in] id_imax   i-direction upper right point indice 
+   !> @param[in] id_jmin   j-direction lower left  point indice 
+   !> @param[in] id_jmax   j-direction upper right point indice 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP) , INTENT(IN) :: td_coord
+      INTEGER(i4), INTENT(IN) :: id_imin
+      INTEGER(i4), INTENT(IN) :: id_imax
+      INTEGER(i4), INTENT(IN) :: id_jmin
+      INTEGER(i4), INTENT(IN) :: id_jmax
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_name
+
+      INTEGER(i4)       :: il_ind
+
+      TYPE(TVAR)        :: tl_var
+
+      TYPE(TMPP)        :: tl_coord
+
+      TYPE(TDOM)        :: tl_dom
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( id_jmin > id_jmax .OR. id_jmax == 0 )THEN
+
+         CALL logger_fatal("GRID CHECK DOM: invalid domain. "//&
+         &  "can not create configuration with north pole.")
+
+      ELSE
+
+            IF( id_imin == id_imax .AND. td_coord%i_ew < 0 )THEN
+               CALL logger_fatal("GRID CHECK DOM: invalid domain."//&
+               &  " can not create east-west cyclic fine grid"//&
+               &  " inside closed coarse grid")
+            ENDIF
+
+            ! copy structure
+            tl_coord=mpp_copy(td_coord)
+
+            ! compute domain
+            tl_dom=dom_init( tl_coord,        &
+            &                id_imin, id_imax,&
+            &                id_jmin, id_jmax )
+            
+            ! open mpp files to be used
+            CALL iom_dom_open(tl_coord, tl_dom)
+
+            ! read variable value on domain
+            WRITE(cl_name,*) 'latitude'
+            il_ind=var_get_id(tl_coord%t_proc(1)%t_var(:), cl_name)
+            IF( il_ind == 0 )THEN
+               CALL logger_warn("GRID CHECK DOM: no variable "//&
+               &  TRIM(cl_name)//" in file "//TRIM(tl_coord%c_name)//". &
+               &  try to use latitude_T.")
+               WRITE(cl_name,*) 'latitude_T'
+            ENDIF
+            tl_var=iom_dom_read_var(tl_coord,TRIM(cl_name),tl_dom)
+
+            ! close mpp files
+            CALL iom_dom_close(tl_coord)
+
+            ! clean structure
+            CALL mpp_clean(tl_coord)
+
+            IF( MAXVAL(tl_var%d_value(:,:,:,:), &
+            &          tl_var%d_value(:,:,:,:)/= tl_var%d_fill) >= 88.0 )THEN
+               
+               CALL logger_debug("GRID CHECK DOM: max latitude "//&
+               &  TRIM(fct_str(MAXVAL(tl_var%d_value(:,:,:,:)))) )
+               CALL logger_fatal("GRID CHECK DOM: invalid domain. "//&
+               &  "can not create configuration too close from north pole.")
+
+            ENDIF
+
+            ! clean
+            CALL dom_clean(tl_dom)
+            CALL var_clean(tl_var)
+
+      ENDIF
+
+   END SUBROUTINE grid_check_dom
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__get_coarse_index_ff(td_coord0, td_coord1, &
+         &                            id_rho, cd_point) &
+         & RESULT (if_idx)
+   !-------------------------------------------------------------------
+   !> @brief This function get closest coarse grid indices of fine grid domain.
+   !>
+   !> @details
+   !> it use coarse and fine grid coordinates files.
+   !> optionally, you could specify the array of refinment factor (default 1.)
+   !> optionally, you could specify on which Arakawa grid point you want to
+   !> work (default 'T')
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014
+   !> - use grid point to read coordinates variable. 
+   !> @date October, 2014
+   !> - work on mpp file structure instead of file structure
+   !> @date February, 2015
+   !> - use longitude or latitude as standard name, if can not find 
+   !> longitude_T, latitude_T...
+   !>
+   !> @param[in] td_coord0 coarse grid coordinate mpp structure
+   !> @param[in] td_coord1 fine grid coordinate mpp structure
+   !> @param[in] id_rho    array of refinment factor (default 1.)
+   !> @param[in] cd_point  Arakawa grid point (default 'T').
+   !> @return coarse grid indices(/(/imin0, imax0/), (/jmin0, jmax0/)/)
+   !>                                     
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP)                    , INTENT(IN) :: td_coord0
+      TYPE(TMPP)                    , INTENT(IN) :: td_coord1
+      INTEGER(i4)     , DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho
+      CHARACTER(LEN=*)              , INTENT(IN), OPTIONAL :: cd_point
+
+      ! function
+      INTEGER(i4)     , DIMENSION(2,2)           :: if_idx
+
+      ! local variable
+      CHARACTER(LEN= 1)                        :: cl_point
+      CHARACTER(LEN=lc)                        :: cl_name
+
+      INTEGER(i4)                              :: il_imin0
+      INTEGER(i4)                              :: il_imax0
+      INTEGER(i4)                              :: il_jmin0
+      INTEGER(i4)                              :: il_jmax0
+      INTEGER(i4)                              :: il_ind
+
+      INTEGER(i4), DIMENSION(2,2)              :: il_xghost0
+      INTEGER(i4), DIMENSION(2,2)              :: il_xghost1
+
+      INTEGER(i4), DIMENSION(:)  , ALLOCATABLE :: il_rho
+
+      TYPE(TVAR)                               :: tl_lon0
+      TYPE(TVAR)                               :: tl_lat0
+      TYPE(TVAR)                               :: tl_lon1
+      TYPE(TVAR)                               :: tl_lat1
+
+      TYPE(TMPP)                               :: tl_coord0
+      TYPE(TMPP)                               :: tl_coord1
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! init
+      if_idx(:,:)=0
+
+      ALLOCATE(il_rho(ip_maxdim))
+      il_rho(:)=1
+      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:)
+
+      cl_point='T'
+      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point))
+
+      ! copy structure
+      tl_coord0=mpp_copy(td_coord0)
+      tl_coord1=mpp_copy(td_coord1)
+
+      IF( .NOT. ASSOCIATED(tl_coord0%t_proc) .OR. &
+      &   .NOT. ASSOCIATED(tl_coord1%t_proc) )THEN
+         CALL logger_error("GRID GET COARSE INDEX: can not get coarse "//&
+         &  "grid indices. decompsition of mpp file "//TRIM(tl_coord0%c_name)//&
+         &  " and/or "//TRIM(tl_coord1%c_name)//" not defined." )
+      ELSE
+         ! Coarse grid
+         ! get ghost cell factor on coarse grid
+         il_xghost0(:,:)=grid_get_ghost( tl_coord0 )
+
+         ! open mpp files
+         CALL iom_mpp_open(tl_coord0)
+
+         ! read coarse longitue and latitude
+         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
+         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
+
+         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use latitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
+         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
+         
+         CALL grid_del_ghost(tl_lon0, il_xghost0(:,:))
+         CALL grid_del_ghost(tl_lat0, il_xghost0(:,:))
+
+         ! close mpp files
+         CALL iom_mpp_close(tl_coord0)
+
+         ! Fine grid
+
+         ! get ghost cell factor on fine grid
+         il_xghost1(:,:)=grid_get_ghost( tl_coord1 )
+
+         ! open mpp files
+         CALL iom_mpp_open(tl_coord1)
+
+         ! read fine longitue and latitude
+         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
+               &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
+               &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
+         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name)) 
+
+         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
+            &  try to use latitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
+         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
+ 
+         CALL grid_del_ghost(tl_lon1, il_xghost1(:,:))
+         CALL grid_del_ghost(tl_lat1, il_xghost1(:,:))
+
+         ! close mpp files
+         CALL iom_mpp_close(tl_coord1)
+
+         ! compute
+         if_idx(:,:)=grid_get_coarse_index(tl_lon0,tl_lat0,&
+            &                              tl_lon1,tl_lat1,&
+            &                              il_rho(:) )
+
+         ! add ghost cell to indices
+         il_imin0=if_idx(1,1)+il_xghost0(jp_I,1)*ip_ghost
+         il_imax0=if_idx(1,2)+il_xghost0(jp_I,1)*ip_ghost
+
+         il_jmin0=if_idx(2,1)+il_xghost0(jp_J,1)*ip_ghost
+         il_jmax0=if_idx(2,2)+il_xghost0(jp_J,1)*ip_ghost
+
+         if_idx(jp_I,1)=il_imin0
+         if_idx(jp_I,2)=il_imax0
+         if_idx(jp_J,1)=il_jmin0
+         if_idx(jp_J,2)=il_jmax0
+
+         CALL var_clean(tl_lon0)
+         CALL var_clean(tl_lat0)         
+         CALL var_clean(tl_lon1)
+         CALL var_clean(tl_lat1)         
+
+      ENDIF
+
+      ! clean
+      CALL mpp_clean(tl_coord0)
+      CALL mpp_clean(tl_coord1)
+      DEALLOCATE(il_rho)
+
+   END FUNCTION grid__get_coarse_index_ff
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__get_coarse_index_cf(td_lon0, td_lat0, td_coord1, &
+         &                            id_rho, cd_point) &
+         & RESULT (if_id)
+   !-------------------------------------------------------------------
+   !> @brief This function get closest coarse grid indices of fine grid domain.
+   !>
+   !> @details
+   !> it use coarse array of longitude and latitude and fine grid coordinates file.
+   !> optionaly, you could specify the array of refinment factor (default 1.)
+   !> optionally, you could specify on which Arakawa grid point you want to
+   !> work (default 'T')
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014
+   !> - use grid point to read coordinates variable.
+   !> @date October, 2014
+   !> - work on mpp file structure instead of file structure
+   !> @date February, 2015
+   !> - use longitude or latitude as standard name, if can not find 
+   !> longitude_T, latitude_T...
+   !>
+   !> @param[in] td_longitude0   coarse grid longitude
+   !> @param[in] td_latitude0    coarse grid latitude
+   !> @param[in] td_coord1       fine grid coordinate mpp structure
+   !> @param[in] id_rho          array of refinment factor
+   !> @param[in] cd_point        Arakawa grid point (default 'T')
+   !> @return coarse grid indices (/(/imin0, imax0/), (/jmin0, jmax0/)/)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR )                   , INTENT(IN) :: td_lon0
+      TYPE(TVAR )                   , INTENT(IN) :: td_lat0
+      TYPE(TMPP )                   , INTENT(IN) :: td_coord1
+      INTEGER(i4)     , DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho
+      CHARACTER(LEN=*)              , INTENT(IN), OPTIONAL :: cd_point
+
+      ! function
+      INTEGER(i4), DIMENSION(2,2) :: if_id
+
+      ! local variable
+      CHARACTER(LEN= 1)                        :: cl_point
+      CHARACTER(LEN=lc)                        :: cl_name
+
+      INTEGER(i4)                              :: il_ind
+
+      INTEGER(i4), DIMENSION(:)  , ALLOCATABLE :: il_rho
+
+      INTEGER(i4), DIMENSION(2,2)              :: il_xghost
+
+      TYPE(TVAR)                               :: tl_lon1
+      TYPE(TVAR)                               :: tl_lat1
+
+      TYPE(TMPP)                               :: tl_coord1
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! init
+      if_id(:,:)=0
+
+      ALLOCATE(il_rho(ip_maxdim) )
+      il_rho(:)=1
+      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:)
+
+      ! copy structure
+      tl_coord1=mpp_copy(td_coord1)
+      
+      cl_point='T'
+      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point))
+
+      IF( .NOT. ASSOCIATED(tl_coord1%t_proc) )THEN
+         CALL logger_error("GRID GET COARSE INDEX: decompsition of mpp "//&
+         &  "file "//TRIM(tl_coord1%c_name)//" not defined." )
+
+      ELSE IF( .NOT. ASSOCIATED(td_lon0%d_value) .OR. &
+      &        .NOT. ASSOCIATED(td_lat0%d_value) )THEN
+
+         CALL logger_error("GRID GET COARSE INDEX: some coarse grid"//&
+         &                 " coordinate value are not associated.")         
+
+      ELSE
+         
+         IF( TRIM(td_lon0%c_point)/='' )THEN
+            cl_point=TRIM(td_lon0%c_point)
+         ELSEIF( TRIM(td_lat0%c_point)/='' )THEN
+            cl_point=TRIM(td_lat0%c_point)
+         ENDIF
+
+         ! Fine grid
+         ! get ghost cell factor on fine grid
+         il_xghost(:,:)=grid_get_ghost( tl_coord1 )
+
+         ! open mpp files
+         CALL iom_mpp_open(tl_coord1)
+
+         ! read fine longitue and latitude
+         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
+               &  TRIM(cl_name)//"in file "//TRIM(tl_coord1%c_name)//". &
+               &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
+         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
+
+         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
+               &  TRIM(cl_name)//"in file "//TRIM(tl_coord1%c_name)//". &
+               &  try to use longitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
+         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
+         
+         CALL grid_del_ghost(tl_lon1, il_xghost(:,:))
+         CALL grid_del_ghost(tl_lat1, il_xghost(:,:))
+
+         ! close mpp files
+         CALL iom_mpp_close(tl_coord1)
+
+         ! compute
+         if_id(:,:)=grid_get_coarse_index(td_lon0,td_lat0,&
+            &                             tl_lon1,tl_lat1,&
+            &                             il_rho(:), cl_point )
+
+         CALL var_clean(tl_lon1)
+         CALL var_clean(tl_lat1)         
+
+      ENDIF
+
+      DEALLOCATE(il_rho)
+      CALL mpp_clean(tl_coord1)
+
+   END FUNCTION grid__get_coarse_index_cf
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__get_coarse_index_fc(td_coord0, td_lon1, td_lat1, &
+         &                            id_rho, cd_point) &
+         & RESULT (if_idx)
+   !-------------------------------------------------------------------
+   !> @brief This function get closest coarse grid indices of fine grid domain.
+   !>
+   !> @details
+   !> it use coarse grid coordinates file and fine grid array of longitude and latitude.
+   !> optionaly, you could specify the array of refinment factor (default 1.)
+   !> optionally, you could specify on which Arakawa grid point you want to
+   !> work (default 'T')
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014
+   !> - use grid point to read coordinates variable.
+   !> @date October, 2014
+   !> - work on mpp file structure instead of file structure
+   !> @date February, 2015
+   !> - use longitude or latitude as standard name, if can not find 
+   !> longitude_T, latitude_T...
+   !> 
+   !> @param[in] td_coord0 coarse grid coordinate mpp structure
+   !> @param[in] td_lon1   fine grid longitude
+   !> @param[in] td_lat1   fine grid latitude
+   !> @param[in] id_rho    array of refinment factor (default 1.)
+   !> @param[in] cd_point  Arakawa grid point (default 'T')
+   !> @return coarse grid indices (/(/imin0, imax0/), (/jmin0, jmax0/)/)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP )                   , INTENT(IN) :: td_coord0
+      TYPE(TVAR )                   , INTENT(IN) :: td_lon1
+      TYPE(TVAR )                   , INTENT(IN) :: td_lat1
+      INTEGER(i4)     , DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho
+      CHARACTER(LEN=*)              , INTENT(IN), OPTIONAL :: cd_point
+
+      ! function
+      INTEGER(i4)     , DIMENSION(2,2)           :: if_idx
+
+      ! local variable
+      CHARACTER(LEN= 1)                        :: cl_point
+      CHARACTER(LEN=lc)                        :: cl_name      
+
+      INTEGER(i4)                              :: il_imin0
+      INTEGER(i4)                              :: il_imax0
+      INTEGER(i4)                              :: il_jmin0
+      INTEGER(i4)                              :: il_jmax0
+      INTEGER(i4)                              :: il_ind
+
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho
+
+      INTEGER(i4), DIMENSION(2,2)              :: il_xghost
+
+      TYPE(TVAR)                               :: tl_lon0
+      TYPE(TVAR)                               :: tl_lat0
+
+      TYPE(TMPP)                               :: tl_coord0
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! init
+      if_idx(:,:)=0
+
+      ALLOCATE(il_rho(ip_maxdim))
+      il_rho(:)=1
+      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:)
+
+      cl_point='T'
+      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point))
+
+      ! copy structure
+      tl_coord0=mpp_copy(td_coord0)
+
+      IF( .NOT. ASSOCIATED(tl_coord0%t_proc) )THEN
+         CALL logger_error("GRID GET COARSE INDEX: decompsition of mpp "//&
+            &              "file "//TRIM(tl_coord0%c_name)//" not defined." )
+
+      ELSE IF( .NOT. ASSOCIATED(td_lon1%d_value) .OR. &
+      &        .NOT. ASSOCIATED(td_lat1%d_value) )THEN
+
+         CALL logger_error("GRID GET COARSE INDEX: some fine grid"//&
+            &              " coordinate value are not associated.")
+
+      ELSE
+
+         IF( TRIM(td_lon1%c_point)/='' )THEN
+            cl_point=TRIM(td_lon1%c_point)
+         ELSEIF( TRIM(td_lat1%c_point)/='' )THEN
+            cl_point=TRIM(td_lat1%c_point)
+         ENDIF
+
+         ! get ghost cell factor on coarse grid
+         il_xghost(:,:)=grid_get_ghost( tl_coord0 )
+
+         ! open mpp files
+         CALL iom_mpp_open(tl_coord0)
+
+         ! read coarse longitue and latitude
+         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
+               &  TRIM(cl_name)//"in file "//TRIM(tl_coord0%c_name)//". &
+               &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
+         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
+         
+         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET COARSE INDEX: no variable "//&
+               &  TRIM(cl_name)//"in file "//TRIM(tl_coord0%c_name)//". &
+               &  try to use latitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
+         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
+
+         CALL grid_del_ghost(tl_lon0, il_xghost(:,:))
+         CALL grid_del_ghost(tl_lat0, il_xghost(:,:))
+
+         ! close mpp files
+         CALL iom_mpp_close(tl_coord0)
+
+         if_idx(:,:)=grid_get_coarse_index(tl_lon0,tl_lat0,&
+            &                              td_lon1,td_lat1,&
+            &                              il_rho(:), cl_point )
+
+         ! remove ghost cell
+         il_imin0=if_idx(1,1)+il_xghost(jp_I,1)*ip_ghost
+         il_imax0=if_idx(1,2)+il_xghost(jp_I,1)*ip_ghost
+
+         il_jmin0=if_idx(2,1)+il_xghost(jp_J,1)*ip_ghost
+         il_jmax0=if_idx(2,2)+il_xghost(jp_J,1)*ip_ghost
+
+         if_idx(1,1)=il_imin0
+         if_idx(1,2)=il_imax0
+         if_idx(2,1)=il_jmin0
+         if_idx(2,2)=il_jmax0
+
+         CALL var_clean(tl_lon0)
+         CALL var_clean(tl_lat0)
+
+      ENDIF
+
+      CALL mpp_clean(tl_coord0)
+      DEALLOCATE(il_rho)
+
+   END FUNCTION grid__get_coarse_index_fc
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__get_coarse_index_cc(td_lon0, td_lat0, td_lon1, td_lat1, &
+         &                            id_rho, cd_point) &
+         & RESULT (if_idx)
+   !-------------------------------------------------------------------
+   !> @brief This function get closest coarse grid indices of fine grid domain.
+   !
+   !> @details
+   !> it use coarse and fine grid array of longitude and latitude.
+   !> optionaly, you could specify the array of refinment factor (default 1.)
+   !> optionally, you could specify on which Arakawa grid point you want to
+   !> work (default 'T')
+   !>
+   !> @note do not use ghost cell
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014
+   !> - check grid point
+   !> - take into account EW overlap
+   !> @date February, 2016
+   !> - use delta (lon or lat)
+   !> - manage cases for T,U,V or F point, with even or odd refinment
+   !>
+   !> @param[in] td_lon0   coarse grid longitude
+   !> @param[in] td_lat0   coarse grid latitude
+   !> @param[in] td_lon1   fine grid longitude
+   !> @param[in] td_lat1   fine grid latitude
+   !> @param[in] id_rho    array of refinment factor
+   !> @param[in] cd_point  Arakawa grid point ('T','U','V','F')
+   !> @return coarse grid indices (/(/imin0, imax0/), (/jmin0, jmax0/)/)
+   !>
+   !> @todo
+   !> -check case boundary domain on overlap band
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR)                    , INTENT(IN) :: td_lon0
+      TYPE(TVAR)                    , INTENT(IN) :: td_lat0
+      TYPE(TVAR)                    , INTENT(IN) :: td_lon1
+      TYPE(TVAR)                    , INTENT(IN) :: td_lat1
+      INTEGER(i4)     , DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho
+      CHARACTER(LEN=*)              , INTENT(IN), OPTIONAL :: cd_point
+
+      ! function
+      INTEGER(i4)     , DIMENSION(2,2)           :: if_idx
+
+      ! local variable
+      CHARACTER(LEN= 1)                      :: cl_point0
+      CHARACTER(LEN= 1)                      :: cl_point1
+
+      LOGICAL    , DIMENSION(2)              :: ll_even
+
+      REAL(dp)                               :: dl_lon1
+      REAL(dp)                               :: dl_dlon
+      REAL(dp)                               :: dl_lat1
+      REAL(dp)                               :: dl_dlat
+
+      INTEGER(i4)                            :: il_ew0 
+      INTEGER(i4)                            :: il_imin0
+      INTEGER(i4)                            :: il_imax0
+      INTEGER(i4)                            :: il_jmin0
+      INTEGER(i4)                            :: il_jmax0
+
+      INTEGER(i4)                            :: il_ew1 
+      INTEGER(i4)                            :: il_imin1
+      INTEGER(i4)                            :: il_imax1
+      INTEGER(i4)                            :: il_jmin1
+      INTEGER(i4)                            :: il_jmax1
+
+      INTEGER(i4)                            :: il_imin
+      INTEGER(i4)                            :: il_imax
+      INTEGER(i4)                            :: il_jmin
+      INTEGER(i4)                            :: il_jmax      
+
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_rho
+
+      INTEGER(i4), DIMENSION(2)              :: il_ill
+      INTEGER(i4), DIMENSION(2)              :: il_ilr
+      INTEGER(i4), DIMENSION(2)              :: il_iul
+      INTEGER(i4), DIMENSION(2)              :: il_iur
+
+      INTEGER(i4), DIMENSION(2,2)            :: il_xghost0
+      INTEGER(i4), DIMENSION(2,2)            :: il_yghost0
+      INTEGER(i4), DIMENSION(2,2)            :: il_xghost1
+      INTEGER(i4), DIMENSION(2,2)            :: il_yghost1
+
+      TYPE(TVAR)                             :: tl_lon0
+      TYPE(TVAR)                             :: tl_lat0
+      TYPE(TVAR)                             :: tl_lon1
+      TYPE(TVAR)                             :: tl_lat1
+
+      ! loop indices
+      !----------------------------------------------------------------
+      ! init
+      if_idx(:,:)=0
+
+      ALLOCATE( il_rho(ip_maxdim) )
+      il_rho(:)=1
+      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:)
+
+      ll_even(:)=(/ (MOD(id_rho(jp_I),2)==0), (MOD(id_rho(jp_J),2)==0) /)
+
+      cl_point0='T'
+      cl_point1='T'
+      IF( PRESENT(cd_point) )THEN
+         cl_point0=TRIM(fct_upper(cd_point))
+         cl_point1=TRIM(fct_upper(cd_point))
+      ENDIF
+      
+      IF( .NOT. ASSOCIATED(td_lon0%d_value) .OR. &
+      &   .NOT. ASSOCIATED(td_lat0%d_value) .OR. &
+      &   .NOT. ASSOCIATED(td_lon1%d_value) .OR. &
+      &   .NOT. ASSOCIATED(td_lat1%d_value) )THEN
+         CALL logger_error("GRID GET COARSE INDEX: some fine or coarse grid"//&
+         &                 " coordinate value not associated.")
+      ELSE
+
+         IF( TRIM(td_lon0%c_point)/='' )THEN
+            cl_point0=TRIM(td_lon0%c_point)
+         ELSEIF( TRIM(td_lat0%c_point)/='' )THEN
+            cl_point0=TRIM(td_lat0%c_point)
+         ENDIF
+         IF( TRIM(td_lon1%c_point)/='' )THEN
+            cl_point1=TRIM(td_lon1%c_point)
+         ELSEIF( TRIM(td_lat1%c_point)/='' )THEN
+            cl_point1=TRIM(td_lat1%c_point)
+         ENDIF
+         IF( cl_point0 /= cl_point1 )THEN
+            CALL logger_error("GRID GET COARSE INDEX: fine and coarse grid"//&
+         &                 " coordinate not on same grid point.")
+         ENDIF
+
+         IF( grid_is_global(td_lon1, td_lat1) )THEN
+
+            IF( grid_is_global(td_lon0, td_lat0) )THEN
+               CALL logger_trace("GRID GET COARSE INDEX: fine grid is global ")
+               if_idx(:,:) = 1
+               if_idx(:,:) = 0
+            ELSE
+               CALL logger_error("GRID GET COARSE INDEX: fine grid is "//&
+               &                 "global, coarse grid not.")
+            ENDIF
+
+         ELSE
+
+            il_xghost0(:,:)=grid_get_ghost( td_lon0 )
+            il_yghost0(:,:)=grid_get_ghost( td_lat0 )
+            IF( ANY(il_xghost0(:,:) /= il_yghost0(:,:)) )THEN
+               CALL logger_error("GRID GET COARSE INDEX: coarse grid "//&
+               &        "coordinate do not share same ghost cell")
+            ENDIF
+
+            tl_lon0=var_copy(td_lon0)
+            tl_lat0=var_copy(td_lat0)
+            CALL grid_del_ghost(tl_lon0, il_xghost0(:,:))
+            CALL grid_del_ghost(tl_lat0, il_xghost0(:,:))
+ 
+            ! "global" coarse grid indice
+            il_imin0=1
+            il_jmin0=1
+
+            il_imax0=tl_lon0%t_dim(1)%i_len
+            il_jmax0=tl_lon0%t_dim(2)%i_len
+
+            ! get east west overlap for coarse grid
+            il_ew0=tl_lon0%i_ew
+            IF( il_ew0 >= 0 )THEN
+               ! last point before overlap
+               il_imax0=il_imax0-il_ew0
+            ENDIF
+
+            il_xghost1(:,:)=grid_get_ghost( td_lon1 )
+            il_yghost1(:,:)=grid_get_ghost( td_lat1 )
+            IF( ANY(il_xghost1(:,:) /= il_yghost1(:,:)) )THEN
+               CALL logger_error("GRID GET COARSE INDEX: fine grid "//&
+               &        "coordinate do not share same ghost cell")
+            ENDIF
+
+            tl_lon1=var_copy(td_lon1)
+            tl_lat1=var_copy(td_lat1)
+            CALL grid_del_ghost(tl_lon1, il_xghost1(:,:))
+            CALL grid_del_ghost(tl_lat1, il_xghost1(:,:))
+            
+            ! "global" fine grid indice
+            il_imin1=1
+            il_jmin1=1
+
+            il_imax1=tl_lon1%t_dim(1)%i_len
+            il_jmax1=tl_lon1%t_dim(2)%i_len
+
+            ! get east west overlap for fine grid
+            il_ew1=tl_lon1%i_ew
+            IF( il_ew1 >= 0 )THEN
+               ! last point before overlap
+               il_imax1=il_imax1-il_ew1
+            ENDIF
+
+            ! get indices for each corner
+            !1- search lower left corner indices
+            dl_lon1=tl_lon1%d_value( il_imin1, il_jmin1, 1, 1 )
+            dl_lat1=tl_lat1%d_value( il_imin1, il_jmin1, 1, 1 )
+
+            IF( dl_lon1 == tl_lon1%d_fill .OR. &
+            &   dl_lat1 == tl_lat1%d_fill )THEN
+               CALL logger_error("GRID GET COARSE INDEX: lower left corner "//&
+                  &                 "point is FillValue. remove ghost cell "//&
+                  &                 "before running grid_get_coarse_index.")
+            ENDIF
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point1))
+                  CASE('F','U')
+                     dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmin1,1,1) -   &
+                        &       tl_lon1%d_value(il_imin1  ,il_jmin1,1,1) ) / &
+                        &     2.
+                  CASE DEFAULT
+                     dl_dlon=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmin1,1,1) -   &
+                  &       tl_lon1%d_value(il_imin1  ,il_jmin1,1,1) ) / &
+                  &     2.
+            ENDIF
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point1))
+                  CASE('F','V')
+                     dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmin1+1,1,1) -   &
+                        &       tl_lat1%d_value(il_imin1,il_jmin1  ,1,1) ) / &
+                        &     2.
+                  CASE DEFAULT
+                     dl_dlat=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmin1+1,1,1) -   &
+                  &       tl_lat1%d_value(il_imin1,il_jmin1  ,1,1) ) / &
+                  &     2.
+            ENDIF
+
+            dl_lon1 = dl_lon1 + dl_dlon
+            dl_lat1 = dl_lat1 + dl_dlat
+
+            ! look for closest point on coarse grid
+            il_ill(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, &
+               &                                        il_jmin0:il_jmax0, &
+               &                                        1,1), &
+               &                        tl_lat0%d_value(il_imin0:il_imax0, &
+               &                                        il_jmin0:il_jmax0, &
+               &                                        1,1), &
+               &                        dl_lon1, dl_lat1, 'll'   )
+
+
+            !2- search upper left corner indices
+            dl_lon1=tl_lon1%d_value( il_imin1, il_jmax1, 1, 1 )
+            dl_lat1=tl_lat1%d_value( il_imin1, il_jmax1, 1, 1 )
+
+            IF( dl_lon1 == tl_lon1%d_fill .OR. &
+            &   dl_lat1 == tl_lat1%d_fill )THEN
+               CALL logger_error("GRID GET COARSE INDEX: upper left corner "//&
+               &                 "point is FillValue. remove ghost cell "//&
+               &                 "running grid_get_coarse_index.")
+            ENDIF            
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point1))
+                  CASE('F','U')
+                     dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmax1,1,1) -   &
+                        &       tl_lon1%d_value(il_imin1  ,il_jmax1,1,1) ) / &
+                        &     2.
+                  CASE DEFAULT
+                     dl_dlon=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlon= ( tl_lon1%d_value(il_imin1+1,il_jmax1,1,1) -   &
+                  &       tl_lon1%d_value(il_imin1  ,il_jmax1,1,1) ) / &
+                  &     2.
+            ENDIF
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point1))
+                  CASE('F','V')
+                     dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmax1  ,1,1) -   &
+                        &       tl_lat1%d_value(il_imin1,il_jmax1-1,1,1) ) / &
+                        &     2.
+                  CASE DEFAULT
+                     dl_dlat=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlat= ( tl_lat1%d_value(il_imin1,il_jmax1  ,1,1) -   &
+                  &       tl_lat1%d_value(il_imin1,il_jmax1-1,1,1) ) / &
+                  &     2.
+            ENDIF
+
+            dl_lon1 = dl_lon1 + dl_dlon
+            dl_lat1 = dl_lat1 - dl_dlat
+
+            ! look for closest point on coarse grid
+            il_iul(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, &
+               &                                        il_jmin0:il_jmax0, &
+               &                                        1,1), &
+               &                        tl_lat0%d_value(il_imin0:il_imax0, &
+               &                                        il_jmin0:il_jmax0, &
+               &                                        1,1), &
+               &                        dl_lon1, dl_lat1, 'ul' )
+
+            !3- search lower right corner indices
+            dl_lon1=tl_lon1%d_value( il_imax1, il_jmin1, 1, 1 )
+            dl_lat1=tl_lat1%d_value( il_imax1, il_jmin1, 1, 1 )
+
+            IF( dl_lon1 == tl_lon1%d_fill .OR. &
+            &   dl_lat1 == tl_lat1%d_fill )THEN
+               CALL logger_error("GRID GET COARSE INDEX: lower right corner "//&
+                  &                 "point is FillValue. remove ghost cell "//&
+                  &                 "running grid_get_coarse_index.")
+            ENDIF            
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point1))
+                  CASE('F','U')
+                     dl_dlon= ( tl_lon1%d_value(il_imax1  ,il_jmin1,1,1) -   &
+                        &       tl_lon1%d_value(il_imax1-1,il_jmin1,1,1) ) / &
+                        &     2.
+                  CASE DEFAULT
+                     dl_dlon=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlon= ( tl_lon1%d_value(il_imax1  ,il_jmin1,1,1) -   &
+                  &       tl_lon1%d_value(il_imax1-1,il_jmin1,1,1) ) / &
+                  &     2.
+            ENDIF
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point1))
+                  CASE('F','V')
+                     dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmin1+1,1,1) -   &
+                        &       tl_lat1%d_value(il_imax1,il_jmin1  ,1,1) ) / &
+                        &     2.
+                  CASE DEFAULT
+                     dl_dlat=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmin1+1,1,1) -   &
+                  &       tl_lat1%d_value(il_imax1,il_jmin1  ,1,1) ) / &
+                  &     2.
+            ENDIF
+
+            dl_lon1 = dl_lon1 - dl_dlon
+            dl_lat1 = dl_lat1 + dl_dlat
+
+            ! look for closest point on coarse grid
+            il_ilr(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, &
+               &                                        il_jmin0:il_jmax0, &
+               &                                        1,1), &
+               &                        tl_lat0%d_value(il_imin0:il_imax0, &
+               &                                        il_jmin0:il_jmax0, &
+               &                                        1,1), &
+               &                        dl_lon1, dl_lat1, 'lr' )
+
+            !4- search upper right corner indices
+            dl_lon1=tl_lon1%d_value( il_imax1, il_jmax1, 1, 1 )
+            dl_lat1=tl_lat1%d_value( il_imax1, il_jmax1, 1, 1 )
+
+            IF( dl_lon1 == tl_lon1%d_fill .OR. &
+            &   dl_lat1 == tl_lat1%d_fill )THEN
+               CALL logger_error("GRID GET COARSE INDEX: upper right corner "//&
+                  &                 "point is FillValue. remove ghost cell "//&
+                  &                 "before running grid_get_coarse_index.")
+            ENDIF            
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point1))
+                  CASE('F','U')
+                     dl_dlon= ( tl_lon1%d_value(il_imax1  ,il_jmax1,1,1) -   &
+                        &       tl_lon1%d_value(il_imax1-1,il_jmax1,1,1) ) / &
+                        &     2.
+                  CASE DEFAULT
+                     dl_dlon=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlon= ( tl_lon1%d_value(il_imax1  ,il_jmax1,1,1) -   &
+                  &       tl_lon1%d_value(il_imax1-1,il_jmax1,1,1) ) / &
+                  &     2.
+            ENDIF
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point1))
+                  CASE('F','V')
+                     dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmax1  ,1,1) -   &
+                        &       tl_lat1%d_value(il_imax1,il_jmax1-1,1,1) ) / &
+                        &     2.
+                  CASE DEFAULT
+                     dl_dlat=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlat= ( tl_lat1%d_value(il_imax1,il_jmax1  ,1,1) -   &
+                  &       tl_lat1%d_value(il_imax1,il_jmax1-1,1,1) ) / &
+                  &     2.
+            ENDIF
+
+            dl_lon1 = dl_lon1 - dl_dlon
+            dl_lat1 = dl_lat1 - dl_dlat
+
+            ! look for closest point on coarse grid
+            il_iur(:)= grid_get_closest(tl_lon0%d_value(il_imin0:il_imax0, &
+               &                                        il_jmin0:il_jmax0, &
+               &                                        1,1), &
+               &                        tl_lat0%d_value(il_imin0:il_imax0, &
+               &                                        il_jmin0:il_jmax0, &
+               &                                        1,1), &
+               &                        dl_lon1, dl_lat1, 'ur' )
+
+            ! coarse grid indices
+            il_imin = il_imin0-1+MIN(il_ill(1), il_iul(1))
+            il_imax = il_imin0-1+MAX(il_ilr(1), il_iur(1))
+
+            IF( il_imax <= il_ew0 )THEN
+               !il_imin = 1
+               il_imax = tl_lon0%t_dim(1)%i_len - il_ew0 + il_imax 
+            ENDIF
+
+            il_jmin = il_jmin0-1+MIN(il_ill(2), il_ilr(2))
+            il_jmax = il_jmin0-1+MAX(il_iul(2), il_iur(2))
+
+            ! special case if east west overlap
+            IF( il_ew1 >= 0 )THEN
+               CALL logger_debug("GRID GET COARSE INDEX: East-West overlap "//&
+               &                 "found for fine grid " )
+
+               il_imin = 1
+               il_imax = tl_lon0%t_dim(1)%i_len
+
+            ENDIF
+         ENDIF
+
+         if_idx(1,1) = il_imin
+         if_idx(1,2) = il_imax
+
+         if_idx(2,1) = il_jmin
+         if_idx(2,2) = il_jmax
+ 
+         ! clean 
+         CALL var_clean(tl_lon1)
+         CALL var_clean(tl_lat1)
+         CALL var_clean(tl_lon0)
+         CALL var_clean(tl_lat0)
+      ENDIF
+
+      DEALLOCATE( il_rho )
+
+   END FUNCTION grid__get_coarse_index_cc
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid_is_global(td_lon, td_lat) &
+         & RESULT (lf_global)
+   !-------------------------------------------------------------------
+   !> @brief This function check if grid is global or not
+   !>
+   !> @details
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_lon longitude structure 
+   !> @param[in] td_lat latitude structure 
+   !> @return true if grid is global
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR), INTENT(IN) :: td_lon
+      TYPE(TVAR), INTENT(IN) :: td_lat
+
+      ! function
+      LOGICAL                :: lf_global
+      
+      ! local variable
+      INTEGER(i4)               :: il_ew
+      INTEGER(i4)               :: il_south
+      INTEGER(i4)               :: il_north
+
+      REAL(dp)                  :: dl_lat_min
+      REAL(dp)                  :: dl_lat_max
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! init
+      lf_global=.FALSE.
+
+      IF( ANY( td_lon%t_dim(:)%i_len /= td_lat%t_dim(:)%i_len )  )THEN
+         CALL logger_fatal("GRID IS GLOBAL: dimension of longitude and "//&
+         &              " latitude differ")
+      ENDIF
+
+      IF( .NOT. ASSOCIATED(td_lon%d_value) .OR. &
+      &   .NOT. ASSOCIATED(td_lat%d_value) )THEN
+         CALL logger_error("GRID IS GLOBAL: no value associated to "//&
+         &              " longitude or latitude strucutre")      
+      ELSE
+
+         il_south=1
+         il_north=td_lon%t_dim(2)%i_len
+
+         dl_lat_min=MINVAL(td_lat%d_value(:,il_south,1,1))
+         dl_lat_max=MAXVAL(td_lat%d_value(:,il_north,1,1))
+
+         IF( dl_lat_min < -77.0 .AND. dl_lat_max > 89.0 )THEN
+
+            il_ew=td_lon%i_ew
+            IF( il_ew >= 0 )THEN
+
+               lf_global=.TRUE.
+
+            ENDIF
+
+         ENDIF
+      ENDIF
+
+   END FUNCTION grid_is_global
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__get_closest_str( td_coord0, dd_lon1, dd_lat1, cd_pos, dd_fill ) &
+         &  RESULT(if_idx)
+   !-------------------------------------------------------------------
+   !> @brief This function return grid indices of the closest point
+   !> from point (lon1,lat1) 
+   !> 
+   !> @details
+   !>
+   !> @note overlap band should have been already removed from coarse grid array 
+   !> of longitude and latitude, before running this function
+   !>
+   !> if you add cd_pos argument, you could choice to return closest point at
+   !> - lower left  (ll) of the point
+   !> - lower right (lr) of the point
+   !> - upper left  (ul) of the point
+   !> - upper right (ur) of the point
+   !> - lower       (lo) of the point
+   !> - upper       (up) of the point
+   !> -       left  (le) of the point
+   !> -       right (ri) of the point
+   !>
+   !> @author J.Paul
+   !> @date April, 2016 - Initial Version
+   !> @date October, 2016
+   !> - use max of zero and east-west overlap instead of east-west overlap
+   !>
+   !> @param[in] td_coord0 coarse grid coordinate mpp structure
+   !> @param[in] dd_lon1   fine   grid longitude
+   !> @param[in] dd_lat1   fine   grid latitude
+   !> @param[in] cd_pos    relative position of grid point from point 
+   !> @param[in] dd_fill   fill value
+   !> @return coarse grid indices of closest point of fine grid point
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP )     , INTENT(IN) :: td_coord0
+      REAL(dp),         INTENT(IN) :: dd_lon1
+      REAL(dp),         INTENT(IN) :: dd_lat1
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_pos
+      REAL(dp),         INTENT(IN), OPTIONAL :: dd_fill
+
+      ! function
+      INTEGER(i4), DIMENSION(2)    :: if_idx
+
+      ! local variable
+      CHARACTER(LEN=lc)                        :: cl_point
+      CHARACTER(LEN=lc)                        :: cl_name
+
+      INTEGER(i4)                              :: il_ind
+      INTEGER(i4)                              :: il_ew
+
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat0
+
+      TYPE(TVAR)                               :: tl_lon0
+      TYPE(TVAR)                               :: tl_lat0
+      TYPE(TMPP)                               :: tl_coord0
+      !----------------------------------------------------------------
+
+      if_idx(:)=-1
+      cl_point='T'
+
+      ! copy structure
+      tl_coord0=mpp_copy(td_coord0)
+
+      IF( .NOT. ASSOCIATED(tl_coord0%t_proc) )THEN
+
+         CALL logger_error("GRID GET CLOSEST: decompsition of mpp "//&
+         &  "file "//TRIM(tl_coord0%c_name)//" not defined." )
+
+      ELSE
+
+         ! open mpp files
+         CALL iom_mpp_open(tl_coord0)
+ 
+         ! read coarse longitue and latitude
+         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET CLOSEST: no variable "//&
+            &  TRIM(cl_name)//"in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
+         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
+ 
+         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET CLOSEST: no variable "//&
+            &  TRIM(cl_name)//"in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use latitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
+         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
+
+         ! close mpp files
+         CALL iom_mpp_close(tl_coord0)
+
+         il_ew=MAX(0,tl_coord0%i_ew)
+         ALLOCATE(dl_lon0(tl_coord0%t_dim(jp_I)%i_len-il_ew, &
+            &             tl_coord0%t_dim(jp_J)%i_len) )             
+         ALLOCATE(dl_lat0(tl_coord0%t_dim(jp_I)%i_len-il_ew, &
+            &             tl_coord0%t_dim(jp_J)%i_len) )
+
+         dl_lon0(:,:)=tl_lon0%d_value(il_ew+1:,:,1,1)
+         dl_lat0(:,:)=tl_lat0%d_value(il_ew+1:,:,1,1)
+
+         if_idx(:)=grid_get_closest( dl_lon0, dl_lat0, dd_lon1, dd_lat1, cd_pos, dd_fill )
+
+         DEALLOCATE(dl_lon0, dl_lat0)
+         CALL var_clean(tl_lon0)
+         CALL var_clean(tl_lat0)
+         CALL mpp_clean(tl_coord0)
+
+      ENDIF
+
+   END FUNCTION  grid__get_closest_str
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__get_closest_arr(dd_lon0, dd_lat0, dd_lon1, dd_lat1, cd_pos, dd_fill) &
+         & RESULT (if_idx)
+   !-------------------------------------------------------------------
+   !> @brief This function return grid indices of the closest point
+   !> from point (lon1,lat1) 
+   !> 
+   !> @details
+   !>
+   !> @note overlap band should have been already removed from coarse grid array 
+   !> of longitude and latitude, before running this function
+   !>
+   !> if you add cd_pos argument, you could choice to return closest point at
+   !> - lower left  (ll) of the point
+   !> - lower right (lr) of the point
+   !> - upper left  (ul) of the point
+   !> - upper right (ur) of the point
+   !> - lower       (lo) of the point
+   !> - upper       (up) of the point
+   !> -       left  (le) of the point
+   !> -       right (ri) of the point
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015
+   !> - change dichotomy method to manage ORCA grid
+   !> @date February, 2016
+   !> - add optional use of relative position
+   !>
+   !> @param[in] dd_lon0   coarse grid array of longitude
+   !> @param[in] dd_lat0   coarse grid array of latitude
+   !> @param[in] dd_lon1   fine   grid longitude
+   !> @param[in] dd_lat1   fine   grid latitude
+   !> @param[in] cd_pos    relative position of grid point from point 
+   !> @param[in] dd_fill   fill value
+   !> @return coarse grid indices of closest point of fine grid point
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_lon0
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_lat0
+      REAL(dp),                 INTENT(IN) :: dd_lon1
+      REAL(dp),                 INTENT(IN) :: dd_lat1
+      CHARACTER(LEN=*),         INTENT(IN), OPTIONAL :: cd_pos
+      REAL(dp),                 INTENT(IN), OPTIONAL :: dd_fill
+
+      ! function
+      INTEGER(i4), DIMENSION(2)            :: if_idx
+
+      ! local variable
+      INTEGER(i4)                              :: il_iinf
+      INTEGER(i4)                              :: il_imid
+      INTEGER(i4)                              :: il_isup
+      INTEGER(i4)                              :: il_jinf
+      INTEGER(i4)                              :: il_jmid
+      INTEGER(i4)                              :: il_jsup
+      INTEGER(i4), DIMENSION(2)                :: il_shape
+      INTEGER(i4), DIMENSION(1)                :: il_ind
+    
+      LOGICAL                                  :: ll_north
+      LOGICAL                                  :: ll_continue
+
+      REAL(dp)                                 :: dl_lon1
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_dist
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( ANY( SHAPE(dd_lon0(:,:)) /= SHAPE(dd_lat0(:,:)) ) )THEN
+         CALL logger_fatal("GRID GET CLOSEST: dimension of longitude and "//&
+         &              " latitude differ")
+      ENDIF
+
+      il_shape(:)=SHAPE(dd_lon0(:,:))
+      
+      ALLOCATE( dl_lon0(il_shape(1),il_shape(2)) ) 
+      
+      dl_lon0(:,:) = dd_lon0(:,:)
+      WHERE(dd_lon0(:,:) < 0 ) dl_lon0(:,:) = dd_lon0(:,:) + 360.
+
+      dl_lon1 = dd_lon1
+      IF( dd_lon1 < 0 ) dl_lon1 = dd_lon1 + 360.
+
+      ! first, use dichotomy to reduce domain
+      il_iinf = 1              ; il_jinf = 1
+      il_isup = il_shape(1)    ; il_jsup = il_shape(2)
+
+      il_shape(1)= il_isup - il_iinf + 1
+      il_shape(2)= il_jsup - il_jinf + 1
+
+      ll_north=.FALSE.
+      ll_continue=.FALSE.
+
+      ! avoid to use fillvalue for reduce domain on first time
+      IF( PRESENT(dd_fill) )THEN
+         DO WHILE( ALL(dl_lon0(il_isup,:) == dd_fill) )
+            il_isup=il_isup-1
+         ENDDO
+         DO WHILE( ALL(dl_lon0(il_iinf,:) == dd_fill) )
+            il_iinf=il_iinf+1
+         ENDDO
+         DO WHILE( ALL(dd_lat0(:,il_jsup) == dd_fill) )
+            il_jsup=il_jsup-1
+         ENDDO
+         DO WHILE( ALL(dd_lat0(:,il_jinf) == dd_fill) )
+            il_jinf=il_jinf+1
+         ENDDO
+
+         il_shape(1)= il_isup - il_iinf + 1
+         il_shape(2)= il_jsup - il_jinf + 1
+
+      ENDIF
+
+      ! special case for north ORCA grid
+      IF( dd_lat1 > 19. .AND. dl_lon1 < 74.  )THEN
+         ll_north=.TRUE.
+      ENDIF
+
+      IF( .NOT. ll_north )THEN
+         ! look for meridian 0°/360°
+         il_jmid = il_jinf + INT(il_shape(2)/2)
+         il_ind(:) = MAXLOC( dl_lon0(il_iinf:il_isup,il_jmid), &
+         &                   dl_lon0(il_iinf:il_isup,il_jmid) <= 360._dp )
+
+         il_imid=il_ind(1)
+
+         IF( dl_lon1 == dl_lon0(il_imid,il_jmid) .AND. &
+         &   dd_lat1 == dd_lat0(il_imid,il_jmid) )THEN
+
+            il_iinf = il_imid ;  il_isup = il_imid
+            il_jinf = il_jmid ;  il_jsup = il_jmid
+
+         ELSE
+            IF( ALL(dl_lon0(il_isup,il_jinf:il_jsup) >  dl_lon1 ) .AND. &
+            &   il_imid /= il_isup )THEN
+               ! 0 < lon1 < lon0(isup)
+               ! point east
+               il_iinf = il_imid+1
+               ll_continue=.TRUE.
+         
+            ELSE IF( ALL(dl_lon0(il_iinf,il_jinf:il_jsup) <  dl_lon1 ) .AND. &
+            &        il_imid /= il_iinf )THEN
+               ! lon0(iinf) < lon1 < 360
+               ! point west
+               il_isup = il_imid
+               ll_continue=.TRUE.
+
+            ENDIF
+
+            il_shape(1)= il_isup - il_iinf + 1
+            il_shape(2)= il_jsup - il_jinf + 1
+
+            il_imid = il_iinf + INT(il_shape(1)/2) 
+            il_jmid = il_jinf + INT(il_shape(2)/2)
+
+            ! exit when close enough of point
+            IF( ANY(il_shape(:) < 10 ) ) ll_continue=.FALSE.
+         ENDIF
+      ENDIF
+
+      !
+      DO WHILE( ll_continue .AND. .NOT. ll_north )
+
+         ll_continue=.FALSE.
+         IF( dl_lon1 == dl_lon0(il_imid,il_jmid) .AND. &
+         &   dd_lat1 == dd_lat0(il_imid,il_jmid) )THEN
+
+            il_iinf = il_imid ;  il_isup = il_imid
+            il_jinf = il_jmid ;  il_jsup = il_jmid
+
+         ELSE
+            IF( ALL(dl_lon0(il_imid,il_jinf:il_jsup) <  dl_lon1) )THEN    
+
+               ! point east
+               il_iinf = il_imid
+               ll_continue=.TRUE.
+        
+            ELSE IF( ALL(dl_lon0(il_imid,il_jinf:il_jsup) >  dl_lon1) )THEN    
+
+               ! point west
+               il_isup = il_imid
+               ll_continue=.TRUE.
+
+            ENDIF
+
+            IF( ALL(dd_lat0(il_iinf:il_isup,il_jmid) <  dd_lat1) )THEN    
+               
+               ! point north
+               il_jinf = il_jmid
+               ll_continue=.TRUE.
+
+            ELSE IF( ALL(dd_lat0(il_iinf:il_isup,il_jmid) > dd_lat1) )THEN    
+
+               ! point south
+               il_jsup = il_jmid
+               ll_continue=.TRUE.
+            
+            ENDIF
+
+            il_shape(1)= il_isup - il_iinf + 1
+            il_shape(2)= il_jsup - il_jinf + 1
+
+            il_imid = il_iinf + INT(il_shape(1)/2) 
+            il_jmid = il_jinf + INT(il_shape(2)/2)
+
+            ! exit when close enough of point
+            IF( ANY(il_shape(:) < 10 ) ) ll_continue=.FALSE.
+         ENDIF
+         
+      ENDDO
+
+      ! then find closest point by computing distances
+      il_shape(1)= il_isup - il_iinf + 1
+      il_shape(2)= il_jsup - il_jinf + 1
+
+      ALLOCATE( dl_dist(il_shape(1), il_shape(2)) )
+
+      dl_dist(:,:)=grid_distance(dl_lon0(il_iinf:il_isup,il_jinf:il_jsup), &
+         &                       dd_lat0(il_iinf:il_isup,il_jinf:il_jsup), &
+         &                       dl_lon1, dd_lat1 )
+
+      IF( PRESENT(cd_pos) )THEN
+         ! 
+         SELECT CASE(TRIM(cd_pos))
+            CASE('le')
+               WHERE( dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) > dd_lat1 )
+                  dl_dist(:,:)=NF90_FILL_DOUBLE
+               END WHERE
+            CASE('ri')
+               WHERE( dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) < dd_lat1 )
+                  dl_dist(:,:)=NF90_FILL_DOUBLE
+               END WHERE
+            CASE('up')
+               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) < dl_lon1 )
+                  dl_dist(:,:)=NF90_FILL_DOUBLE
+               END WHERE
+            CASE('lo')
+               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) > dl_lon1 )
+                  dl_dist(:,:)=NF90_FILL_DOUBLE
+               END WHERE
+            CASE('ll')
+               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) > dl_lon1 .OR. &
+                    & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) > dd_lat1 )
+                  dl_dist(:,:)=NF90_FILL_DOUBLE
+               END WHERE
+            CASE('lr')
+               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) < dl_lon1 .OR. &
+                    & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) > dd_lat1 )
+                  dl_dist(:,:)=NF90_FILL_DOUBLE
+               END WHERE               
+            CASE('ul')
+               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) > dl_lon1 .OR. &
+                    & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) < dd_lat1 )
+                  dl_dist(:,:)=NF90_FILL_DOUBLE
+               END WHERE               
+            CASE('ur')
+               WHERE( dl_lon0(il_iinf:il_isup,il_jinf:il_jsup) < dl_lon1 .OR. &
+                    & dd_lat0(il_iinf:il_isup,il_jinf:il_jsup) < dd_lat1 )
+                  dl_dist(:,:)=NF90_FILL_DOUBLE
+               END WHERE
+         END SELECT
+      ENDIF
+      if_idx(:)=MINLOC(dl_dist(:,:),dl_dist(:,:)/=NF90_FILL_DOUBLE)
+
+      if_idx(1)=if_idx(1)+il_iinf-1
+      if_idx(2)=if_idx(2)+il_jinf-1
+
+      DEALLOCATE( dl_dist )
+      DEALLOCATE( dl_lon0 )
+
+   END FUNCTION grid__get_closest_arr
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid_distance(dd_lon, dd_lat, dd_lonA, dd_latA) &
+         & RESULT (df_dist)
+   !-------------------------------------------------------------------
+   !> @brief This function compute the distance between a point A and grid points.  
+   !>
+   !> @details
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] dd_lon    grid longitude array
+   !> @param[in] dd_lat    grid latitude  array
+   !> @param[in] dd_lonA   longitude of point A
+   !> @param[in] dd_latA   latitude  of point A
+   !> @param[in] dd_fill
+   !> @return array of distance between point A and grid points.
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_lon
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_lat
+      REAL(dp),                 INTENT(IN) :: dd_lonA
+      REAL(dp),                 INTENT(IN) :: dd_latA
+
+      ! function
+      REAL(dp), DIMENSION(SIZE(dd_lon(:,:),DIM=1),&
+      &                   SIZE(dd_lon(:,:),DIM=2)) :: df_dist
+
+      ! local variable
+      INTEGER(i4), DIMENSION(2) :: il_shape
+
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat
+      REAL(dp)                                 :: dl_lonA
+      REAL(dp)                                 :: dl_latA
+
+      REAL(dp)                                 :: dl_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      IF( ANY( SHAPE(dd_lon(:,:)) /= SHAPE(dd_lat(:,:)) ) )THEN
+         CALL logger_fatal("GRID DISTANCE: dimension of longitude and "//&
+         &              " latitude differ")
+      ENDIF
+      il_shape(:)=SHAPE(dd_lon(:,:))
+      
+      ALLOCATE(dl_lon(il_shape(1),il_shape(2)))
+      ALLOCATE(dl_lat(il_shape(1),il_shape(2)))
+
+      dl_lon(:,:) = dd_lon(:,:)
+      dl_lonA     = dd_lonA
+
+      WHERE(dd_lon(:,:) < 0 ) dl_lon(:,:) = dd_lon(:,:) + 360.
+      IF(   dd_lonA     < 0 ) dl_lonA     = dd_lonA     + 360.
+      
+      dl_lonA = dd_lonA * dp_deg2rad
+      dl_latA = dd_latA * dp_deg2rad
+
+      dl_lon(:,:) = dl_lon(:,:) * dp_deg2rad
+      dl_lat(:,:) = dd_lat(:,:) * dp_deg2rad
+
+      df_dist(:,:)=NF90_FILL_DOUBLE
+
+      DO jj=1,il_shape(2)
+         DO ji=1,il_shape(1)
+            IF( dl_lon(ji,jj) == dl_lonA .AND. &
+            &   dl_lat(ji,jj) == dl_latA )THEN
+               df_dist(ji,jj)=0.0
+            ELSE
+               dl_tmp= SIN(dl_latA)*SIN(dl_lat(ji,jj)) + &
+               &       COS(dl_latA)*COS(dl_lat(ji,jj)) * &
+               &       COS(dl_lon(ji,jj)-dl_lonA)
+               ! check to avoid mistake with ACOS
+               IF( dl_tmp < -1.0 ) dl_tmp = -1.0
+               IF( dl_tmp >  1.0 ) dl_tmp =  1.0
+               df_dist(ji,jj)=ACOS(dl_tmp)*dp_rearth
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DEALLOCATE(dl_lon)
+      DEALLOCATE(dl_lat)
+
+   END FUNCTION grid_distance
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__get_fine_offset_ff(td_coord0, &
+         &                           id_imin0, id_jmin0, id_imax0, id_jmax0, &
+         &                           td_coord1, id_rho, cd_point) &
+         & RESULT (if_offset)
+   !-------------------------------------------------------------------
+   !> @brief This function get offset between fine grid and coarse grid.
+   !>
+   !> @details
+   !> optionally, you could specify on which Arakawa grid point you want to
+   !> work (default 'T')
+   !> offset value could be 0,1,..,rho-1
+   !>
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !> @date October, 2014
+   !> - work on mpp file structure instead of file structure
+   !>
+   !> @param[in] td_coord0 coarse grid coordinate 
+   !> @param[in] id_imin0  coarse grid lower left corner i-indice of fine grid domain
+   !> @param[in] id_jmin0  coarse grid lower left corner j-indice of fine grid domain
+   !> @param[in] id_imax0  coarse grid upper right corner i-indice of fine grid domain
+   !> @param[in] id_jmax0  coarse grid upper right corner j-indice of fine grid domain
+   !> @param[in] td_coord1 fine   grid coordinate 
+   !> @param[in] id_rho    array of refinement factor
+   !> @param[in] cd_point  Arakawa grid point
+   !> @return offset array (/ (/i_offset_left,i_offset_right/),(/j_offset_lower,j_offset_upper/) /)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP)                    , INTENT(IN) :: td_coord0
+      TYPE(TMPP)                    , INTENT(IN) :: td_coord1
+
+      INTEGER(i4)                   , INTENT(IN) :: id_imin0
+      INTEGER(i4)                   , INTENT(IN) :: id_jmin0
+      INTEGER(i4)                   , INTENT(IN) :: id_imax0
+      INTEGER(i4)                   , INTENT(IN) :: id_jmax0
+
+      INTEGER(i4)     , DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho
+      CHARACTER(LEN=*)              , INTENT(IN), OPTIONAL :: cd_point
+
+      ! function
+      INTEGER(i4)     , DIMENSION(2,2)           :: if_offset
+
+      ! local variable
+      INTEGER(i4)                              :: il_imin0
+      INTEGER(i4)                              :: il_jmin0
+      INTEGER(i4)                              :: il_imax0
+      INTEGER(i4)                              :: il_jmax0
+      INTEGER(i4)                              :: il_ind
+      
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho
+      
+      INTEGER(i4), DIMENSION(2,2)              :: il_xghost0
+      INTEGER(i4), DIMENSION(2,2)              :: il_xghost1
+
+      CHARACTER(LEN= 1)                        :: cl_point
+      CHARACTER(LEN=lc)                        :: cl_name
+
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat0
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon1
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat1
+
+      TYPE(TVAR)                               :: tl_lon0
+      TYPE(TVAR)                               :: tl_lat0
+      TYPE(TVAR)                               :: tl_lon1
+      TYPE(TVAR)                               :: tl_lat1
+
+      TYPE(TMPP)                               :: tl_coord0
+      TYPE(TMPP)                               :: tl_coord1
+      
+      ! loop indices
+      !----------------------------------------------------------------
+      ! init
+      if_offset(:,:)=-1
+
+      ALLOCATE(il_rho(ip_maxdim))
+      il_rho(:)=1
+      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:)
+
+      cl_point='T'
+      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point))
+
+      ! copy structure
+      tl_coord0=mpp_copy(td_coord0)
+      tl_coord1=mpp_copy(td_coord1)
+
+      IF( .NOT. ASSOCIATED(tl_coord0%t_proc) .OR. &
+      &   .NOT. ASSOCIATED(tl_coord1%t_proc) )THEN
+         CALL logger_error("GRID GET FINE OFFSET: can not get coarse "//&
+         &  "grid indices. decompsition of mpp file "//TRIM(tl_coord0%c_name)//&
+         &  " and/or "//TRIM(tl_coord1%c_name)//" not defined." )
+      ELSE      
+         !1- Coarse grid
+         ! get ghost cell factor on coarse grid
+         il_xghost0(:,:)=grid_get_ghost( tl_coord0 )
+
+         ! open mpp files
+         CALL iom_mpp_open(tl_coord0)
+
+         ! read coarse longitue and latitude
+         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
+         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
+
+         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use latitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
+         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
+
+         ! close mpp files
+         CALL iom_mpp_close(tl_coord0)
+
+         CALL grid_del_ghost(tl_lon0, il_xghost0(:,:))
+         CALL grid_del_ghost(tl_lat0, il_xghost0(:,:))
+
+         ALLOCATE(dl_lon0(tl_lon0%t_dim(jp_I)%i_len, &
+         &                tl_lon0%t_dim(jp_J)%i_len ))
+
+         dl_lon0(:,:)=tl_lon0%d_value(:,:,1,1)
+
+         ALLOCATE(dl_lat0(tl_lat0%t_dim(jp_I)%i_len, &
+         &                tl_lat0%t_dim(jp_J)%i_len ))
+
+         dl_lat0(:,:)=tl_lat0%d_value(:,:,1,1)
+
+         ! clean
+         CALL var_clean(tl_lon0)
+         CALL var_clean(tl_lat0)
+
+         ! adjust coarse grid indices
+         il_imin0=id_imin0-il_xghost0(jp_I,1)
+         il_imax0=id_imax0-il_xghost0(jp_I,1)
+
+         il_jmin0=id_jmin0-il_xghost0(jp_J,1)
+         il_jmax0=id_jmax0-il_xghost0(jp_J,1)
+
+         !2- Fine grid
+         ! get ghost cell factor on fine grid
+         il_xghost1(:,:)=grid_get_ghost( tl_coord1 )
+
+         ! open mpp files
+         CALL iom_mpp_open(tl_coord1)
+
+         ! read fine longitue and latitude
+         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
+            &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
+         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
+
+         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
+            &  try to use latitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
+         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
+ 
+         ! close mpp files
+         CALL iom_mpp_close(tl_coord1)
+
+         CALL grid_del_ghost(tl_lon1, il_xghost1(:,:))
+         CALL grid_del_ghost(tl_lat1, il_xghost1(:,:))
+
+         ALLOCATE(dl_lon1(tl_lon1%t_dim(jp_I)%i_len, &
+         &                tl_lon1%t_dim(jp_J)%i_len ))
+
+         dl_lon1(:,:)=tl_lon1%d_value(:,:,1,1)
+
+         ALLOCATE(dl_lat1(tl_lat1%t_dim(jp_I)%i_len, &
+         &                tl_lat1%t_dim(jp_J)%i_len ))
+
+         dl_lat1(:,:)=tl_lat1%d_value(:,:,1,1)
+
+         ! clean
+         CALL var_clean(tl_lon1)
+         CALL var_clean(tl_lat1)
+ 
+         !3- compute
+         if_offset(:,:)=grid_get_fine_offset( dl_lon0(:,:), dl_lat0(:,:),&
+            &                                 il_imin0, il_jmin0, &
+            &                                 il_imax0, il_jmax0, &
+            &                                 dl_lon1(:,:), dl_lat1(:,:),&
+            &                                 id_rho(:), cl_point )
+ 
+         DEALLOCATE(dl_lon0, dl_lat0)
+         DEALLOCATE(dl_lon1, dl_lat1)
+      ENDIF
+
+      ! clean 
+      CALL mpp_clean(tl_coord0)
+      CALL mpp_clean(tl_coord1)
+      DEALLOCATE(il_rho)
+
+   END FUNCTION grid__get_fine_offset_ff
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__get_fine_offset_cf(dd_lon0, dd_lat0, &
+         &                           id_imin0, id_jmin0, id_imax0, id_jmax0, &
+         &                           td_coord1, id_rho, cd_point) &
+         & RESULT (if_offset)
+   !-------------------------------------------------------------------
+   !> @brief This function get offset between fine grid and coarse grid.
+   !>
+   !> @details
+   !> optionally, you could specify on which Arakawa grid point you want to
+   !> work (default 'T')
+   !> offset value could be 0,1,..,rho-1
+   !>
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !> @date October, 2014
+   !> - work on mpp file structure instead of file structure
+   !>
+   !> @param[in] dd_lon0   coarse grid longitude array 
+   !> @param[in] dd_lat0   coarse grid latitude  array
+   !> @param[in] id_imin0  coarse grid lower left corner i-indice of fine grid domain
+   !> @param[in] id_jmin0  coarse grid lower left corner j-indice of fine grid domain
+   !> @param[in] id_imax0  coarse grid upper right corner i-indice of fine grid domain
+   !> @param[in] id_jmax0  coarse grid upper right corner j-indice of fine grid domain
+   !> @param[in] td_coord1 fine   grid coordinate 
+   !> @param[in] id_rho    array of refinement factor
+   !> @param[in] cd_point  Arakawa grid point
+   !> @return offset array (/ (/i_offset_left,i_offset_right/),(/j_offset_lower,j_offset_upper/) /)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)       , DIMENSION(:,:), INTENT(IN) :: dd_lon0
+      REAL(dp)       , DIMENSION(:,:), INTENT(IN) :: dd_lat0
+      TYPE(TMPP)                     , INTENT(IN) :: td_coord1
+
+      INTEGER(i4)                    , INTENT(IN) :: id_imin0
+      INTEGER(i4)                    , INTENT(IN) :: id_jmin0
+      INTEGER(i4)                    , INTENT(IN) :: id_imax0
+      INTEGER(i4)                    , INTENT(IN) :: id_jmax0
+
+      INTEGER(i4)     , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_rho
+      CHARACTER(LEN=*)               , INTENT(IN), OPTIONAL :: cd_point
+
+      ! function
+      INTEGER(i4)     , DIMENSION(2,2)            :: if_offset
+
+      ! local variable
+      INTEGER(i4)                              :: il_ind
+      INTEGER(i4), DIMENSION(2,2)              :: il_xghost1
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho
+      
+      CHARACTER(LEN= 1)                        :: cl_point
+      CHARACTER(LEN=lc)                        :: cl_name
+
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon1
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat1
+
+      TYPE(TVAR)                               :: tl_lon1
+      TYPE(TVAR)                               :: tl_lat1
+
+      TYPE(TMPP)                               :: tl_coord1
+      ! loop indices
+      !----------------------------------------------------------------
+      ! init
+      if_offset(:,:)=-1
+
+      ALLOCATE(il_rho(ip_maxdim))
+      il_rho(:)=1
+      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:)
+
+      cl_point='T'
+      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point))
+
+      ! copy structure
+      tl_coord1=mpp_copy(td_coord1)
+
+      IF( .NOT. ASSOCIATED(tl_coord1%t_proc) )THEN
+         CALL logger_error("GRID GET FINE OFFSET: decompsition of mpp "//&
+         &  "file "//TRIM(tl_coord1%c_name)//" not defined." )
+      ELSE      
+
+         ! Fine grid
+         ! get ghost cell factor on fine grid
+         il_xghost1(:,:)=grid_get_ghost( tl_coord1 )
+
+         ! open mpp files
+         CALL iom_mpp_open(tl_coord1)
+
+         ! read fine longitue and latitude
+         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
+            &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
+         tl_lon1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
+
+         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord1%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord1%c_name)//". &
+            &  try to use latitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
+         tl_lat1=iom_mpp_read_var(tl_coord1, TRIM(cl_name))
+ 
+         ! close mpp files
+         CALL iom_mpp_close(tl_coord1)
+
+         CALL grid_del_ghost(tl_lon1, il_xghost1(:,:))
+         CALL grid_del_ghost(tl_lat1, il_xghost1(:,:))
+
+         ALLOCATE(dl_lon1(tl_lon1%t_dim(jp_I)%i_len, &
+         &                tl_lon1%t_dim(jp_J)%i_len ))
+
+         dl_lon1(:,:)=tl_lon1%d_value(:,:,1,1)
+
+         ALLOCATE(dl_lat1(tl_lat1%t_dim(jp_I)%i_len, &
+         &                tl_lat1%t_dim(jp_J)%i_len ))
+
+         dl_lat1(:,:)=tl_lat1%d_value(:,:,1,1)
+
+         ! clean
+         CALL var_clean(tl_lon1)
+         CALL var_clean(tl_lat1)
+      
+         ! compute
+         if_offset(:,:)=grid_get_fine_offset( dd_lon0(:,:), dd_lat0(:,:),&
+            &                                 id_imin0, id_jmin0, &
+            &                                 id_imax0, id_jmax0, &
+            &                                 dl_lon1(:,:), dl_lat1(:,:),&
+            &                                 id_rho(:), cl_point )
+         
+         DEALLOCATE(dl_lon1, dl_lat1)
+      ENDIF
+
+      ! clean 
+      CALL mpp_clean(tl_coord1)
+      DEALLOCATE(il_rho)
+
+   END FUNCTION grid__get_fine_offset_cf
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__get_fine_offset_fc(td_coord0, &
+         &                           id_imin0, id_jmin0, id_imax0, id_jmax0, &
+         &                           dd_lon1, dd_lat1, &
+         &                           id_rho, cd_point) &
+         & RESULT (if_offset)
+   !-------------------------------------------------------------------
+   !> @brief This function get offset between fine grid and coarse grid.
+   !>
+   !> @details
+   !> optionally, you could specify on which Arakawa grid point you want to
+   !> work (default 'T')
+   !> offset value could be 0,1,..,rho-1
+   !>
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !> @date October, 2014
+   !> - work on mpp file structure instead of file structure
+   !>
+   !> @param[in] td_coord0 coarse grid coordinate 
+   !> @param[in] id_imin0  coarse grid lower left corner i-indice of fine grid domain
+   !> @param[in] id_jmin0  coarse grid lower left corner j-indice of fine grid domain
+   !> @param[in] id_imax0  coarse grid upper right corner i-indice of fine grid domain
+   !> @param[in] id_jmax0  coarse grid upper right corner j-indice of fine grid domain
+   !> @param[in] dd_lon1   fine   grid longitude array 
+   !> @param[in] dd_lat1   fine   grid latitude  array
+   !> @param[in] id_rho    array of refinement factor
+   !> @param[in] cd_point  Arakawa grid point
+   !> @return offset array (/ (/i_offset_left,i_offset_right/),(/j_offset_lower,j_offset_upper/) /)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP)                      , INTENT(IN) :: td_coord0
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lon1
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lat1
+
+      INTEGER(i4)                     , INTENT(IN) :: id_imin0
+      INTEGER(i4)                     , INTENT(IN) :: id_jmin0
+      INTEGER(i4)                     , INTENT(IN) :: id_imax0
+      INTEGER(i4)                     , INTENT(IN) :: id_jmax0
+
+      INTEGER(i4)     , DIMENSION(:)  , INTENT(IN), OPTIONAL :: id_rho
+      CHARACTER(LEN=*)                , INTENT(IN), OPTIONAL :: cd_point
+
+      ! function
+      INTEGER(i4)     , DIMENSION(2,2)             :: if_offset
+
+      ! local variable
+      INTEGER(i4)                              :: il_imin0
+      INTEGER(i4)                              :: il_jmin0
+      INTEGER(i4)                              :: il_imax0
+      INTEGER(i4)                              :: il_jmax0
+      INTEGER(i4)                              :: il_ind
+      
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE   :: il_rho
+      
+      INTEGER(i4), DIMENSION(2,2)              :: il_xghost0
+
+      CHARACTER(LEN= 1)                        :: cl_point
+      CHARACTER(LEN=lc)                        :: cl_name
+
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lat0
+
+      TYPE(TVAR)                               :: tl_lon0
+      TYPE(TVAR)                               :: tl_lat0
+
+      TYPE(TMPP)                               :: tl_coord0
+      ! loop indices
+      !----------------------------------------------------------------
+      ! init
+      if_offset(:,:)=-1
+      ALLOCATE(il_rho(ip_maxdim))
+      il_rho(:)=1
+      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:)
+
+      cl_point='T'
+      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point))
+
+      ! copy structure
+      tl_coord0=mpp_copy(td_coord0)
+
+      IF( .NOT. ASSOCIATED(tl_coord0%t_proc) )THEN
+         CALL logger_error("GRID GET FINE OFFSET: decompsition of mpp "//&
+         &  "file "//TRIM(tl_coord0%c_name)//" not defined." )
+      ELSE      
+         !1- Coarse grid
+         ! get ghost cell factor on coarse grid
+         il_xghost0(:,:)=grid_get_ghost( tl_coord0 )
+
+         ! open mpp files
+         CALL iom_mpp_open(tl_coord0)
+
+         ! read coarse longitude and latitude
+         WRITE(cl_name,*) 'longitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use longitude.")
+            WRITE(cl_name,*) 'longitude'
+         ENDIF
+         tl_lon0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
+
+         WRITE(cl_name,*) 'latitude_'//TRIM(cl_point)
+         il_ind=var_get_id(tl_coord0%t_proc(1)%t_var(:), cl_name)
+         IF( il_ind == 0 )THEN
+            CALL logger_warn("GRID GET FINE OFFSET: no variable "//&
+            &  TRIM(cl_name)//" in file "//TRIM(tl_coord0%c_name)//". &
+            &  try to use latitude.")
+            WRITE(cl_name,*) 'latitude'
+         ENDIF
+         tl_lat0=iom_mpp_read_var(tl_coord0, TRIM(cl_name))
+ 
+         ! close mpp files
+         CALL iom_mpp_close(tl_coord0)
+
+         CALL grid_del_ghost(tl_lon0, il_xghost0(:,:))
+         CALL grid_del_ghost(tl_lat0, il_xghost0(:,:))
+
+
+         ALLOCATE(dl_lon0(tl_lon0%t_dim(jp_I)%i_len, &
+         &                tl_lon0%t_dim(jp_J)%i_len ))
+
+         dl_lon0(:,:)=tl_lon0%d_value(:,:,1,1)
+
+         ALLOCATE(dl_lat0(tl_lat0%t_dim(jp_I)%i_len, &
+         &                tl_lat0%t_dim(jp_J)%i_len ))
+
+         dl_lat0(:,:)=tl_lat0%d_value(:,:,1,1)
+
+         ! clean
+         CALL var_clean(tl_lon0)
+         CALL var_clean(tl_lat0)
+
+         ! adjust coarse grid indices
+         il_imin0=id_imin0-il_xghost0(jp_I,1)
+         il_imax0=id_imax0-il_xghost0(jp_I,1)
+
+         il_jmin0=id_jmin0-il_xghost0(jp_J,1)
+         il_jmax0=id_jmax0-il_xghost0(jp_J,1)
+
+         !3- compute
+         if_offset(:,:)=grid_get_fine_offset( dl_lon0(:,:), dl_lat0(:,:),&
+            &                                 il_imin0, il_jmin0, &
+            &                                 il_imax0, il_jmax0, &
+            &                                 dd_lon1(:,:), dd_lat1(:,:),&
+            &                                 id_rho(:), cl_point )
+         
+         DEALLOCATE(dl_lon0, dl_lat0)
+      ENDIF
+
+      ! clean
+      CALL mpp_clean(tl_coord0)
+      DEALLOCATE(il_rho)
+
+   END FUNCTION grid__get_fine_offset_fc
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__get_fine_offset_cc(dd_lon0, dd_lat0, &
+         &                           id_imin0, id_jmin0, id_imax0, id_jmax0, &
+         &                           dd_lon1, dd_lat1, id_rho, cd_point) &
+         & RESULT (if_offset)
+   !-------------------------------------------------------------------
+   !> @brief This function get offset between fine grid and coarse grid.
+   !>
+   !> @details
+   !> offset value could be 0,1,..,rho-1
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014 
+   !> - rename from grid_get_fine_offset
+   !> @date May, 2015 
+   !> - improve way to find offset
+   !> @date July, 2015
+   !> - manage case close to greenwich meridian
+   !> @date February, 2016
+   !> - use grid_get_closest to assess offset
+   !> - use delta (lon or lat)
+   !> - manage cases for T,U,V or F point, with even or odd refinment
+   !> - check lower left(upper right) fine grid point inside lower left(upper
+   !> right) coarse grid cell.
+   !> 
+   !> @todo check case close from North fold.
+   !>
+   !> @param[in] dd_lon0   coarse grid longitude array 
+   !> @param[in] dd_lat0   coarse grid latitude  array
+   !> @param[in] id_imin0  coarse grid lower left corner i-indice of fine grid domain
+   !> @param[in] id_jmin0  coarse grid lower left corner j-indice of fine grid domain
+   !> @param[in] id_imax0  coarse grid upper right corner i-indice of fine grid domain
+   !> @param[in] id_jmax0  coarse grid upper right corner j-indice of fine grid domain
+   !> @param[in] dd_lon1   fine   grid longitude array 
+   !> @param[in] dd_lat1   fine   grid latitude  array
+   !> @param[in] id_rho    array of refinement factor
+   !> @param[in] cd_point  Arakawa grid point
+   !> @return offset array (/ (/i_offset_left,i_offset_right/),(/j_offset_lower,j_offset_upper/) /)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lon0
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lat0
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lon1
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN) :: dd_lat1
+
+      INTEGER(i4)     ,                 INTENT(IN) :: id_imin0
+      INTEGER(i4)     ,                 INTENT(IN) :: id_jmin0
+      INTEGER(i4)     ,                 INTENT(IN) :: id_imax0
+      INTEGER(i4)     ,                 INTENT(IN) :: id_jmax0
+
+      INTEGER(i4)     , DIMENSION(:)  , INTENT(IN) :: id_rho
+      CHARACTER(LEN=*)                , INTENT(IN), OPTIONAL :: cd_point
+
+      ! function
+      INTEGER(i4)     , DIMENSION(2,2)             :: if_offset
+
+      ! local variable
+      CHARACTER(LEN= 1)                        :: cl_point
+
+      INTEGER(i4)                              :: i1
+      INTEGER(i4)                              :: i2
+      INTEGER(i4)                              :: j1
+      INTEGER(i4)                              :: j2
+
+      INTEGER(i4), DIMENSION(2)                :: il_shape0
+      INTEGER(i4), DIMENSION(2)                :: il_shape1
+
+      INTEGER(i4), DIMENSION(2)                :: il_ind
+
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon0
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_lon1
+
+      REAL(dp)                                 :: dl_lonmax0
+      REAL(dp)                                 :: dl_latmax0
+      REAL(dp)                                 :: dl_lonmin0
+      REAL(dp)                                 :: dl_latmin0
+
+      REAL(dp)                                 :: dl_lon0F
+      REAL(dp)                                 :: dl_lat0F
+      REAL(dp)                                 :: dl_dlon
+      REAL(dp)                                 :: dl_dlat
+
+      LOGICAL    , DIMENSION(2)                :: ll_even
+      LOGICAL                                  :: ll_greenwich
+      
+      ! loop indices
+      INTEGER(i4) :: ii
+      INTEGER(i4) :: ij
+      !----------------------------------------------------------------
+      IF( ANY( SHAPE(dd_lon0(:,:)) /= SHAPE(dd_lat0(:,:)) ) )THEN
+         CALL logger_fatal("GRID GET FINE OFFSET: dimension of coarse "//&
+         &              "longitude and latitude differ")
+      ENDIF
+
+      IF( ANY( SHAPE(dd_lon1(:,:)) /= SHAPE(dd_lat1(:,:)) ) )THEN
+         CALL logger_fatal("GRID GET FINE OFFSET: dimension of fine "//&
+         &              "longitude and latitude differ")
+      ENDIF
+
+      ll_even(:)=(/ (MOD(id_rho(jp_I),2)==0), (MOD(id_rho(jp_J),2)==0) /)
+
+      cl_point='T'
+      IF( PRESENT(cd_point) ) cl_point=TRIM(fct_upper(cd_point))
+
+      il_shape0(:)=SHAPE(dd_lon0(:,:))
+      ALLOCATE( dl_lon0(il_shape0(1),il_shape0(2)) )
+
+      il_shape1(:)=SHAPE(dd_lon1(:,:))
+      ALLOCATE( dl_lon1(il_shape1(1),il_shape1(2)) )
+
+      dl_lon0(:,:)=dd_lon0(:,:)
+      WHERE( dd_lon0(:,:) < 0 ) dl_lon0(:,:)=dd_lon0(:,:)+360.
+
+      dl_lon1(:,:)=dd_lon1(:,:)
+      WHERE( dd_lon1(:,:) < 0 ) dl_lon1(:,:)=dd_lon1(:,:)+360.
+
+      ! init
+      if_offset(:,:)=-1
+      ll_greenwich=.FALSE.
+
+      IF( il_shape1(jp_J) == 1 )THEN
+ 
+         if_offset(jp_J,:)=((id_rho(jp_J)-1)/2)
+
+         !!! work on i-direction
+         !!! look for i-direction left offset
+         i1=1 ; i2=MIN((id_rho(jp_I)+2),il_shape1(jp_I))
+         j1=1 ; j2=1
+
+         ! check if cross greenwich meridien
+         IF( minval(dl_lon0(id_imin0:id_imin0+1,id_jmin0))<5. .OR. &
+           & maxval(dl_lon0(id_imin0:id_imin0+1,id_jmin0))>355. )THEN
+            ! close to greenwich meridien
+            ll_greenwich=.TRUE.
+            ! 0:360 => -180:180
+            WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0) > 180. )
+               dl_lon0(id_imin0:id_imin0+1,id_jmin0) = &
+                  & dl_lon0(id_imin0:id_imin0+1,id_jmin0)-360.
+            END WHERE
+
+            WHERE( dl_lon1(i1:i2,j1:j2) > 180. )
+               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360.
+            END WHERE
+         ENDIF
+
+         ! max lognitude of the left cell
+         dl_lonmax0=dl_lon0(id_imin0+1,id_jmin0)
+         IF( dl_lon1(1,1) < dl_lonmax0 )THEN
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('F','U')
+                     dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0) -   &
+                        &       dl_lon0(id_imin0  ,id_jmin0) ) / &
+                        &     ( 2.*id_rho(jp_I) )
+                  CASE DEFAULT
+                     dl_dlon=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0) -   &
+                  &       dl_lon0(id_imin0  ,id_jmin0) ) / &
+                  &     ( 2.*id_rho(jp_I) )
+            ENDIF
+
+            dl_lon0F= dl_lon0(id_imin0+1,id_jmin0) + dl_dlon
+            dl_lat0F= dd_lat0(id_imin0+1,id_jmin0)
+
+            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), &
+            &                           dl_lon0F, dl_lat0F, 'le' )
+      
+            ii=il_ind(1)
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('T','V')
+                     if_offset(jp_I,1)=id_rho(jp_I)-ii
+                  CASE DEFAULT !'F','U' 
+                     if_offset(jp_I,1)=(id_rho(jp_I)+1)-ii
+               END SELECT
+            ELSE
+               ! odd
+               if_offset(jp_I,1)=(id_rho(jp_I)+1)-ii
+            ENDIF
+
+         ELSE
+            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//&
+            &                 " not match fine grid left corner.")
+         ENDIF
+
+         IF( ll_greenwich )THEN
+            ! close to greenwich meridien
+            ll_greenwich=.FALSE.
+            ! -180:180 => 0:360
+            WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0) < 0. )
+               dl_lon0(id_imin0:id_imin0+1,id_jmin0) = &
+                  & dl_lon0(id_imin0:id_imin0+1,id_jmin0)+360.
+            END WHERE
+
+            WHERE( dl_lon1(i1:i2,j1:j2) < 0. )
+               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360.
+            END WHERE
+         ENDIF
+
+         !!!!!! look for i-direction right offset !!!!!!
+         i1=MAX(1,il_shape1(jp_I)-(id_rho(jp_I)+2)+1) ; i2=il_shape1(jp_I)
+         j1=1                                         ; j2=1
+
+         ! check if cross greenwich meridien
+         IF( minval(dl_lon0(id_imax0-1:id_imax0,id_jmin0))<5. .OR. &
+           & maxval(dl_lon0(id_imax0-1:id_imax0,id_jmin0))>355. )THEN
+            ! close to greenwich meridien
+            ll_greenwich=.TRUE.
+            ! 0:360 => -180:180
+            WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmin0) > 180. )
+               dl_lon0(id_imax0-1:id_imax0,id_jmin0) = &
+                  & dl_lon0(id_imax0-1:id_imax0,id_jmin0)-360.
+            END WHERE
+
+            WHERE( dl_lon1(i1:i2,j1:j2) > 180. )
+               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360.
+            END WHERE
+         ENDIF
+
+         ! min lognitude of the right cell
+         dl_lonmin0=dl_lon0(id_imax0-1,id_jmin0)
+         IF( dl_lon1(il_shape1(jp_I),il_shape1(jp_J)) > dl_lonmin0 )THEN
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('F','U')
+                     dl_dlon= ( dl_lon0(id_imax0  ,id_jmin0) -   &
+                        &       dl_lon0(id_imax0-1,id_jmin0) ) / &
+                        &     ( 2.*id_rho(jp_I) )
+                  CASE DEFAULT
+                     dl_dlon=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlon= ( dl_lon0(id_imax0  ,id_jmin0) -   &
+                  &       dl_lon0(id_imax0-1,id_jmin0) ) / &
+                  &     ( 2.*id_rho(jp_I) )
+            ENDIF
+
+            dl_lon0F= dl_lon0(id_imax0-1,id_jmin0) - dl_dlon
+            dl_lat0F= dd_lat0(id_imax0-1,id_jmin0)
+
+            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), &
+            &                           dl_lon0F, dl_lat0F, 'ri' )
+
+            ii=(MIN(il_shape1(jp_I),(id_rho(jp_I)+2))-il_ind(1)+1)
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('T','V')
+                     if_offset(jp_I,2)=id_rho(jp_I)-ii
+                  CASE DEFAULT !'F','U' 
+                     if_offset(jp_I,2)=(id_rho(jp_I)+1)-ii
+               END SELECT
+            ELSE
+               ! odd
+               if_offset(jp_I,2)=(id_rho(jp_I)+1)-ii
+            ENDIF
+
+         ELSE
+            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//&
+            &                 " not match fine grid right corner.")
+         ENDIF
+
+         IF( ll_greenwich )THEN
+            ! close to greenwich meridien
+            ll_greenwich=.FALSE.
+            ! -180:180 => 0:360
+            WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmin0) < 0. )
+               dl_lon0(id_imax0-1:id_imax0,id_jmin0) = &
+                  & dl_lon0(id_imax0-1:id_imax0,id_jmin0)+360.
+            END WHERE
+
+            WHERE( dl_lon1(i1:i2,j1:j2) < 0. )
+               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360.
+            END WHERE
+         ENDIF
+
+      ELSEIF( il_shape1(jp_I) == 1 )THEN
+         
+         if_offset(jp_I,:)=((id_rho(jp_I)-1)/2)
+         
+         !!! work on j-direction
+         !!! look for j-direction lower offset 
+         i1=1 ; i2=1
+         j1=1 ; j2=MIN((id_rho(jp_J)+2),il_shape1(jp_J))
+
+
+         ! max latitude of the lower cell
+         dl_latmax0=dd_lat0(id_imin0,id_jmin0+1)
+         IF( dd_lat1(1,1) < dl_latmax0 )THEN
+
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('F','V')
+                     dl_dlat= ( dd_lat0(id_imin0,id_jmin0+1) -   &
+                        &       dd_lat0(id_imin0,id_jmin0  ) ) / &
+                        &     ( 2.*id_rho(jp_J) )
+                  CASE DEFAULT
+                     dl_dlat=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlat= ( dd_lat0(id_imin0,id_jmin0+1) -   &
+                  &       dd_lat0(id_imin0,id_jmin0  ) ) / &
+                  &     ( 2.*id_rho(jp_J) )
+            ENDIF
+
+            dl_lon0F= dl_lon0(id_imin0,id_jmin0+1)
+            dl_lat0F= dd_lat0(id_imin0,id_jmin0+1) + dl_dlat 
+            
+            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), &
+            &                           dl_lon0F, dl_lat0F, 'lo' )
+
+            ij=il_ind(2)
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('T','V')
+                     if_offset(jp_J,1)=id_rho(jp_J)-ij
+                  CASE DEFAULT !'F','U' 
+                     if_offset(jp_J,1)=(id_rho(jp_J)+1)-ij
+               END SELECT
+            ELSE
+               ! odd
+               if_offset(jp_J,1)=(id_rho(jp_J)+1)-ij
+            ENDIF
+
+         ELSE
+            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//&
+            &                 " not match fine grid lower corner.")
+         ENDIF
+
+         !!! look for j-direction upper offset 
+         i1=1                                         ; i2=1
+         j1=MAX(1,il_shape1(jp_J)-(id_rho(jp_J)+2)+1) ; j2=il_shape1(jp_J)
+
+         ! min latitude of the upper cell
+         dl_latmin0=dd_lat0(id_imin0,id_jmax0-1)
+         IF( dd_lat1(il_shape1(jp_I),il_shape1(jp_J)) > dl_latmin0 )THEN
+
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('F','V')
+                     dl_dlat= ( dd_lat0(id_imin0,id_jmax0  ) -   &
+                        &       dd_lat0(id_imin0,id_jmax0-1) ) / &
+                        &     ( 2.*id_rho(jp_J) )
+                  CASE DEFAULT
+                     dl_dlat=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlat= ( dd_lat0(id_imin0,id_jmax0  ) -   &
+                  &       dd_lat0(id_imin0,id_jmax0-1) ) / &
+                  &     ( 2*id_rho(jp_J) )
+            ENDIF
+
+            dl_lon0F= dl_lon0(id_imin0,id_jmax0-1) 
+            dl_lat0F= dd_lat0(id_imin0,id_jmax0-1) - dl_dlat
+            
+            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), &
+            &                           dl_lon0F, dl_lat0F, 'up' )
+
+            ij=(MIN(il_shape1(jp_J),(id_rho(jp_J)+2))-il_ind(2)+1)
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('T','U')
+                     if_offset(jp_J,2)=id_rho(jp_J)-ij
+                  CASE DEFAULT !'F','V'
+                     if_offset(jp_J,2)=(id_rho(jp_J)+1)-ij
+               END SELECT
+            ELSE
+               ! odd
+               if_offset(jp_J,2)=(id_rho(jp_J)+1)-ij
+            ENDIF
+
+         ELSE
+            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do "//&
+            &                 " not match fine grid upper corner.")
+         ENDIF
+
+      ELSE ! il_shape1(1) > 1 .AND. il_shape1(2) > 1 
+
+         !!!!!! look for lower left offset !!!!!!
+         i1=1 ; i2=MIN((id_rho(jp_I)+2),il_shape1(jp_I))
+         j1=1 ; j2=MIN((id_rho(jp_J)+2),il_shape1(jp_J))
+
+         ! check if cross greenwich meridien
+         IF( minval(dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1))<5. .OR. &
+           & maxval(dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1))>355. )THEN
+            ! close to greenwich meridien
+            ll_greenwich=.TRUE.
+            ! 0:360 => -180:180
+            WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) > 180. )
+               dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) = &
+                  & dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1)-360.
+            END WHERE
+
+            WHERE( dl_lon1(i1:i2,j1:j2) > 180. )
+               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360.
+            END WHERE
+         ENDIF
+
+         ! max longitude of the lower left cell
+         dl_lonmax0=MAX(dl_lon0(id_imin0+1,id_jmin0),dl_lon0(id_imin0+1,id_jmin0+1))
+         ! max latitude of the lower left cell
+         dl_latmax0=MAX(dd_lat0(id_imin0,id_jmin0+1),dd_lat0(id_imin0+1,id_jmin0+1))
+         IF( dl_lon1(1,1) < dl_lonmax0 .AND. &
+           & dd_lat1(1,1) < dl_latmax0 )THEN
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('F','U')
+                     dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0+1) -   &
+                        &       dl_lon0(id_imin0  ,id_jmin0+1) ) / &
+                        &     ( 2.*id_rho(jp_I) )
+                  CASE DEFAULT
+                     dl_dlon=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlon= ( dl_lon0(id_imin0+1,id_jmin0+1) -   &
+                  &       dl_lon0(id_imin0  ,id_jmin0+1) ) / &
+                  &     ( 2.*id_rho(jp_I) )
+            ENDIF
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('F','V')
+                     dl_dlat= ( dd_lat0(id_imin0+1,id_jmin0+1) -   &
+                        &       dd_lat0(id_imin0+1,id_jmin0  ) ) / &
+                        &     ( 2.*id_rho(jp_J) )
+                  CASE DEFAULT
+                     dl_dlat=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlat= ( dd_lat0(id_imin0+1,id_jmin0+1) -   &
+                  &       dd_lat0(id_imin0+1,id_jmin0  ) ) / &
+                  &     ( 2.*id_rho(jp_J) )
+            ENDIF
+
+            dl_lon0F= dl_lon0(id_imin0+1,id_jmin0+1) + dl_dlon
+            dl_lat0F= dd_lat0(id_imin0+1,id_jmin0+1) + dl_dlat
+
+            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), &
+            &                           dl_lon0F, dl_lat0F, 'll' )
+
+            ii=il_ind(1)
+            ij=il_ind(2)
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('T','V')
+                     if_offset(jp_I,1)=id_rho(jp_I)-ii
+                  CASE DEFAULT !'F','U' 
+                     if_offset(jp_I,1)=(id_rho(jp_I)+1)-ii
+               END SELECT
+            ELSE
+               ! odd
+               if_offset(jp_I,1)=(id_rho(jp_I)+1)-ii
+            ENDIF
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('T','U')
+                     if_offset(jp_J,1)=id_rho(jp_J)-ij
+                  CASE DEFAULT !'F','V'
+                     if_offset(jp_J,1)=(id_rho(jp_J)+1)-ij
+               END SELECT
+            ELSE
+               ! odd
+               if_offset(jp_J,1)=(id_rho(jp_J)+1)-ij
+            ENDIF
+
+         ELSE
+            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do"//&
+            &                 " not match fine grid lower left corner.")
+         ENDIF
+
+         IF( ll_greenwich )THEN
+            ! close to greenwich meridien
+            ll_greenwich=.FALSE.
+            ! -180:180 => 0:360 
+            WHERE( dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) < 0. )
+               dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1) = &
+                  & dl_lon0(id_imin0:id_imin0+1,id_jmin0:id_jmin0+1)+360.
+            END WHERE
+
+            WHERE( dl_lon1(i1:i2,j1:j2) < 0. )
+               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360.
+            END WHERE
+         ENDIF
+
+         !!!!!! look for upper right offset !!!!!!
+         i1=MAX(1,il_shape1(jp_I)-(id_rho(jp_I)+2)+1) ; i2=il_shape1(jp_I)
+         j1=MAX(1,il_shape1(jp_J)-(id_rho(jp_J)+2)+1) ; j2=il_shape1(jp_J)
+
+         ! check if cross greenwich meridien
+         IF( minval(dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0))<5. .OR. &
+           & maxval(dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0))>355. )THEN
+            ! close to greenwich meridien
+            ll_greenwich=.TRUE.
+            ! 0:360 => -180:180
+            WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) > 180. )
+               dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) = &
+                  & dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0)-360.
+            END WHERE
+
+            WHERE( dl_lon1(i1:i2,j1:j2) > 180. )
+               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)-360.
+            END WHERE
+         ENDIF
+
+         ! min latitude of the upper right cell
+         dl_lonmin0=MIN(dl_lon0(id_imax0-1,id_jmax0-1),dl_lon0(id_imax0-1,id_jmax0))
+         ! min latitude of the upper right cell
+         dl_latmin0=MIN(dd_lat0(id_imax0-1,id_jmax0-1),dd_lat0(id_imax0,id_jmax0-1))
+         IF( dl_lon1(il_shape1(jp_I),il_shape1(jp_J)) > dl_lonmin0 .AND. &
+           & dd_lat1(il_shape1(jp_I),il_shape1(jp_J)) > dl_latmin0 )THEN
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('F','U')
+                     dl_dlon= ( dl_lon0(id_imax0  ,id_jmax0-1) -   &
+                        &       dl_lon0(id_imax0-1,id_jmax0-1) ) / &
+                        &     ( 2.*id_rho(jp_I) )
+                  CASE DEFAULT
+                     dl_dlon=0
+               END SELECT               
+            ELSE
+               ! odd
+               dl_dlon= ( dl_lon0(id_imax0  ,id_jmax0-1) -   &
+                  &       dl_lon0(id_imax0-1,id_jmax0-1) ) / &
+                  &     ( 2*id_rho(jp_I) )
+            ENDIF
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('F','V')
+                     dl_dlat= ( dd_lat0(id_imax0-1,id_jmax0  ) -   &
+                        &       dd_lat0(id_imax0-1,id_jmax0-1) ) / &
+                        &     ( 2.*id_rho(jp_J) )
+                  CASE DEFAULT
+                     dl_dlat=0
+               END SELECT
+            ELSE
+               ! odd
+               dl_dlat= ( dd_lat0(id_imax0-1,id_jmax0  ) -   &
+                  &       dd_lat0(id_imax0-1,id_jmax0-1) ) / &
+                  &     ( 2*id_rho(jp_J) )
+            ENDIF
+
+            dl_lon0F= dl_lon0(id_imax0-1,id_jmax0-1) - dl_dlon
+            dl_lat0F= dd_lat0(id_imax0-1,id_jmax0-1) - dl_dlat
+
+            il_ind(:)=grid_get_closest( dl_lon1(i1:i2,j1:j2), dd_lat1(i1:i2,j1:j2), &
+               &                        dl_lon0F, dl_lat0F, 'ur' )
+
+            ii=(MIN(il_shape1(jp_I),(id_rho(jp_I)+2))-il_ind(1)+1)
+            ij=(MIN(il_shape1(jp_J),(id_rho(jp_J)+2))-il_ind(2)+1)
+
+            !!!!! i-direction !!!!!
+            IF( ll_even(jp_I) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('T','V')
+                     if_offset(jp_I,2)=id_rho(jp_I)-ii
+                  CASE DEFAULT !'F','U' 
+                     if_offset(jp_I,2)=(id_rho(jp_I)+1)-ii
+               END SELECT
+            ELSE
+               ! odd
+               if_offset(jp_I,2)=(id_rho(jp_I)+1)-ii
+            ENDIF
+
+            !!!!! j-direction !!!!!
+            IF( ll_even(jp_J) )THEN
+               ! even
+               SELECT CASE(TRIM(cl_point))
+                  CASE('T','U')
+                     if_offset(jp_J,2)=id_rho(jp_J)-ij
+                  CASE DEFAULT !'F','V'
+                     if_offset(jp_J,2)=(id_rho(jp_J)+1)-ij
+               END SELECT
+            ELSE
+               ! odd
+               if_offset(jp_J,2)=(id_rho(jp_J)+1)-ij
+            ENDIF
+
+         ELSE
+            CALL logger_error("GRID GET FINE OFFSET: coarse grid indices do"//&
+            &                 " not match fine grid upper right corner.")
+         ENDIF
+
+         IF( ll_greenwich )THEN
+            ! close to greenwich meridien
+            ll_greenwich=.FALSE.
+            ! -180:180 => 0:360
+            WHERE( dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) < 0. )
+               dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0) = &
+                  & dl_lon0(id_imax0-1:id_imax0,id_jmax0-1:id_jmax0)+360.
+            END WHERE
+
+            WHERE( dl_lon1(i1:i2,j1:j2) < 0. )
+               dl_lon1(i1:i2,j1:j2)=dl_lon1(i1:i2,j1:j2)+360.
+            END WHERE
+         ENDIF
+
+      ENDIF
+
+      DEALLOCATE( dl_lon0 )
+      DEALLOCATE( dl_lon1 )
+
+      IF( ANY(if_offset(:,:)==-1) )THEN
+         CALL logger_fatal("GRID GET FINE OFFSET: can not found "//&
+         &                 " offset between coarse and fine grid.")
+      ENDIF
+
+   END FUNCTION grid__get_fine_offset_cc
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_check_coincidence(td_coord0, td_coord1, &
+         &                           id_imin0, id_imax0, &
+         &                           id_jmin0, id_jmax0, &
+         &                           id_rho)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine check fine and coarse grid coincidence.
+   !>
+   !> @details
+   !>
+   !> @author J.Paul
+   !> @date November, 2013- Initial Version
+   !> @date October, 2014
+   !> - work on mpp file structure instead of file structure
+   !> @date February, 2016
+   !> - use F-point to check coincidence for even refinment
+   !> - use F-point estimation, if can not read it.
+   !>
+   !> @param[in] td_coord0 coarse grid coordinate file structure 
+   !> @param[in] td_coord1 fine   grid coordinate file structure 
+   !> @param[in] id_imin0  coarse grid lower left  corner i-indice of fine grid domain 
+   !> @param[in] id_imax0  coarse grid upper right corner i-indice of fine grid domain
+   !> @param[in] id_jmin0  coarse grid lower left  corner j-indice of fine grid domain 
+   !> @param[in] id_jmax0  coarse grid upper right corner j-indice of fine grid domain  
+   !> @param[in] id_rho    array of refinement factor 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+      
+      ! Argument      
+      TYPE(TMPP)               , INTENT(IN) :: td_coord0
+      TYPE(TMPP)               , INTENT(IN) :: td_coord1
+      INTEGER(i4)              , INTENT(IN) :: id_imin0
+      INTEGER(i4)              , INTENT(IN) :: id_imax0
+      INTEGER(i4)              , INTENT(IN) :: id_jmin0
+      INTEGER(i4)              , INTENT(IN) :: id_jmax0
+      INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_rho
+
+      ! local variable
+      INTEGER(i4)               :: il_imid1
+      INTEGER(i4)               :: il_jmid1
+      
+      INTEGER(i4)               :: il_ew0
+      INTEGER(i4)               :: il_ew1
+
+      INTEGER(i4)               :: il_ind
+
+      INTEGER(i4)               :: il_imin1
+      INTEGER(i4)               :: il_imax1
+      INTEGER(i4)               :: il_jmin1
+      INTEGER(i4)               :: il_jmax1
+
+      INTEGER(i4), DIMENSION(2) :: il_ind0
+      INTEGER(i4), DIMENSION(2) :: il_ind1
+
+      INTEGER(i4), DIMENSION(2) :: il_ill1
+      INTEGER(i4), DIMENSION(2) :: il_ilr1
+      INTEGER(i4), DIMENSION(2) :: il_iul1
+      INTEGER(i4), DIMENSION(2) :: il_iur1
+
+      REAL(dp)                  :: dl_lon0F
+      REAL(dp)                  :: dl_lat0F
+      REAL(dp)                  :: dl_lon0
+      REAL(dp)                  :: dl_lat0
+      REAL(dp)                  :: dl_lon1F
+      REAL(dp)                  :: dl_lat1F
+      REAL(dp)                  :: dl_lon1
+      REAL(dp)                  :: dl_lat1
+
+      REAL(dp)                  :: dl_delta
+
+      LOGICAL                   :: ll_coincidence
+      LOGICAL                   :: ll_even
+      LOGICAL                   :: ll_grid0F
+      LOGICAL                   :: ll_grid1F
+
+      TYPE(TVAR)                :: tl_lon0
+      TYPE(TVAR)                :: tl_lat0
+      TYPE(TVAR)                :: tl_lon0F
+      TYPE(TVAR)                :: tl_lat0F
+      TYPE(TVAR)                :: tl_lon1
+      TYPE(TVAR)                :: tl_lat1
+      TYPE(TVAR)                :: tl_lon1F
+      TYPE(TVAR)                :: tl_lat1F
+
+      TYPE(TMPP)                :: tl_coord0
+      TYPE(TMPP)                :: tl_coord1
+
+      TYPE(TDOM)                :: tl_dom0
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      ll_coincidence=.TRUE.
+
+      ll_even=.FALSE.
+      IF( MOD(id_rho(jp_I)*id_rho(jp_J),2) == 0 )THEN
+         ll_even=.TRUE.
+      ENDIF
+
+      ! copy structure
+      tl_coord0=mpp_copy(td_coord0)
+
+      ! compute domain
+      tl_dom0=dom_init( tl_coord0,         &
+      &                 id_imin0, id_imax0,&
+      &                 id_jmin0, id_jmax0 )
+
+      ! open mpp files
+      CALL iom_dom_open(tl_coord0, tl_dom0)
+
+      ! read variable value on domain
+      il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'longitude_T')
+      IF( il_ind /= 0 )THEN
+         tl_lon0=iom_dom_read_var(tl_coord0,'longitude_T',tl_dom0)
+      ELSE
+         tl_lon0=iom_dom_read_var(tl_coord0,'longitude',tl_dom0)
+      ENDIF
+
+      il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'latitude_T')
+      IF( il_ind /= 0 )THEN
+         tl_lat0=iom_dom_read_var(tl_coord0,'latitude_T' ,tl_dom0)
+      ELSE
+         tl_lat0=iom_dom_read_var(tl_coord0,'latitude' ,tl_dom0)
+      ENDIF
+
+      IF( ll_even )THEN
+
+         ! look for variable value on domain for F point
+         il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'longitude_F')
+         IF( il_ind /= 0 )THEN
+            tl_lon0F=iom_dom_read_var(tl_coord0,'longitude_F',tl_dom0)
+         ENDIF
+
+         il_ind=var_get_index(tl_coord0%t_proc(1)%t_var(:), 'latitude_F')
+         IF( il_ind /= 0 )THEN
+            tl_lat0F=iom_dom_read_var(tl_coord0,'latitude_F' ,tl_dom0)
+         ENDIF
+
+         ll_grid0F=.FALSE.
+         IF( ASSOCIATED(tl_lon0F%d_value) .AND. &
+         &   ASSOCIATED(tl_lat0F%d_value) )THEN
+            ll_grid0F=.TRUE.
+         ENDIF
+
+      ENDIF
+
+      ! close mpp files
+      CALL iom_dom_close(tl_coord0)
+
+      ! clean structure
+      CALL mpp_clean(tl_coord0)
+      CALL dom_clean(tl_dom0)
+
+      ! copy structure
+      tl_coord1=mpp_copy(td_coord1)
+
+      ! open mpp files
+      CALL iom_mpp_open(tl_coord1)
+
+      ! read fine longitue and latitude
+      il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), TRIM(tl_lon0%c_longname))
+      IF( il_ind /= 0 )THEN
+         tl_lon1=iom_mpp_read_var(tl_coord1,TRIM(tl_lon0%c_longname))
+      ELSE
+         tl_lon1=iom_mpp_read_var(tl_coord1,'longitude')
+      ENDIF
+      il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), TRIM(tl_lat0%c_longname))
+      IF( il_ind /= 0 )THEN
+         tl_lat1=iom_mpp_read_var(tl_coord1,TRIM(tl_lat0%c_longname))
+      ELSE
+         tl_lat1=iom_mpp_read_var(tl_coord1,'latitude')
+      ENDIF
+      
+      IF( ll_even )THEN
+
+         ! look for variable value on domain for F point
+         il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), 'longitude_F')
+         IF( il_ind /= 0 )THEN
+            tl_lon1F=iom_mpp_read_var(tl_coord1,'longitude_F')
+         ENDIF
+
+         il_ind=var_get_index(tl_coord1%t_proc(1)%t_var(:), 'latitude_F')
+         IF( il_ind /= 0 )THEN
+            tl_lat1F=iom_mpp_read_var(tl_coord1,'latitude_F')
+         ENDIF
+
+         ll_grid1F=.FALSE.
+         IF( ASSOCIATED(tl_lon1F%d_value) .AND. &
+         &   ASSOCIATED(tl_lat1F%d_value) )THEN
+            ll_grid1F=.TRUE.
+         ENDIF
+
+      ENDIF
+
+      ! close mpp files
+      CALL iom_mpp_close(tl_coord1)
+      ! clean structure
+      CALL mpp_clean(tl_coord1)
+
+      CALL logger_debug("GRID CHECK COINCIDENCE:"//&
+      &        " fine   grid "//TRIM(td_coord1%c_name) )
+      CALL logger_debug("GRID CHECK COINCIDENCE:"//&
+      &        " coarse grid "//TRIM(td_coord0%c_name) )
+
+      ! check domain
+      ! check global grid
+      IF( .NOT. grid_is_global(tl_lon0, tl_lat0) )THEN
+         IF( grid_is_global(tl_lon1, tl_lat1) )THEN
+
+            ll_coincidence=.FALSE.
+            CALL logger_fatal("GRID CHECK COINCIDENCE:"//&
+            &        " fine   grid is global,"//&
+            &        " coarse grid is not ")
+
+         ELSE
+            il_ew1=tl_lon1%i_ew
+            IF( il_ew1 >= 0 )THEN
+               ! ew overlap
+
+               il_ew0=tl_lon0%i_ew
+               IF( il_ew0 < 0 )THEN
+                  CALL logger_fatal("GRID CHECK COINCIDENCE: "//&
+                  &        "fine grid has east west overlap,"//&
+                  &        " coarse grid not ")
+               ENDIF
+
+               il_jmin1=1+ip_ghost
+               il_jmax1=tl_lon1%t_dim(2)%i_len-ip_ghost
+
+               ll_coincidence=grid__check_lat(&
+               &                     tl_lat0%d_value(1,:,1,1),&
+               &                     tl_lat1%d_value(1,il_jmin1:il_jmax1,1,1))
+
+            ELSE
+               ! other case
+               il_imin1=1+ip_ghost
+               il_jmin1=1+ip_ghost
+
+               il_imax1=tl_lon1%t_dim(1)%i_len-ip_ghost
+               il_jmax1=tl_lon1%t_dim(2)%i_len-ip_ghost
+
+               ll_coincidence=grid__check_corner(&
+                  &                   tl_lon0%d_value(:,:,1,1),&
+                  &                   tl_lat0%d_value(:,:,1,1),&
+                  &                   tl_lon1%d_value(il_imin1:il_imax1, &
+                  &                                   il_jmin1:il_jmax1, &
+                  &                                   1,1),&
+                  &                   tl_lat1%d_value(il_imin1:il_imax1, &
+                  &                                   il_jmin1:il_jmax1, &
+                  &                                   1,1) )
+
+            ENDIF
+ 
+         ENDIF
+
+         IF( .NOT. ll_coincidence )THEN
+            CALL logger_fatal("GRID CHECK COINCIDENCE: no coincidence "//&
+            &              "between fine grid and coarse grid: invalid domain." )
+         ENDIF
+
+      ENDIF
+ 
+      ! check refinement factor
+      ! select point in middle of fine grid
+      il_imid1=INT(tl_lon1%t_dim(1)%i_len*0.5)
+      il_jmid1=INT(tl_lon1%t_dim(2)%i_len*0.5)
+ 
+      dl_lon1=tl_lon1%d_value(il_imid1, il_jmid1,1,1)
+      dl_lat1=tl_lat1%d_value(il_imid1, il_jmid1,1,1)
+
+      ! select closest point on coarse grid
+      il_ind0(:)=grid_get_closest(tl_lon0%d_value(:,:,1,1),&
+      &                           tl_lat0%d_value(:,:,1,1),&
+      &                           dl_lon1, dl_lat1   )
+
+      IF( ANY(il_ind0(:)==0) )THEN
+         CALL logger_fatal("GRID CHECK COINCIDENCE: can not find valid "//&
+         &              "coarse grid indices: invalid domain." )
+      ENDIF
+
+      IF( .NOT. ll_even )THEN
+         ! case odd refinment in both direction
+         ! work on T-point
+
+         dl_lon0=tl_lon0%d_value(il_ind0(1),il_ind0(2),1,1)
+         dl_lat0=tl_lat0%d_value(il_ind0(1),il_ind0(2),1,1)
+
+         il_ind1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),&
+            &                        tl_lat1%d_value(:,:,1,1),&
+            &                        dl_lon0, dl_lat0 )
+
+         ! check i-direction refinement factor
+         DO ji=0,MIN(3,il_imid1)
+
+            IF( il_ind1(1)+ji*id_rho(jp_I)+1 > tl_lon1%t_dim(1)%i_len )THEN
+               CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//&
+               &  " to check i-direction refinement factor ")
+               EXIT
+            ELSE
+               dl_lon0=tl_lon0%d_value(il_ind0(1)+ji             ,il_ind0(2),1,1)
+               dl_lon1=tl_lon1%d_value(il_ind1(1)+ji*id_rho(jp_I),il_ind1(2),1,1)
+
+               ! assume there could be little difference due to interpolation
+               IF( ABS(dl_lon1 - dl_lon0) > dp_delta )THEN
+                  ll_coincidence=.FALSE.
+                  CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//&
+                  &  "i-direction refinement factor ("//&
+                  &   TRIM(fct_str(id_rho(jp_I)))//&
+                  &  ") between fine grid and coarse grid ")
+               ENDIF
+            ENDIF
+
+         ENDDO
+
+         ! check j-direction refinement factor
+         DO jj=0,MIN(3,il_jmid1)
+
+            IF( il_ind1(2)+jj*id_rho(jp_J)+1 > tl_lat1%t_dim(2)%i_len )THEN
+               CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//&
+                  &  " to check j-direction refinement factor ")
+               EXIT
+            ELSE      
+               dl_lat0=tl_lat0%d_value(il_ind0(1),il_ind0(2)+jj             ,1,1)
+               dl_lat1=tl_lat1%d_value(il_ind1(1),il_ind1(2)+jj*id_rho(jp_J),1,1)
+
+               ! assume there could be little difference due to interpolation
+               IF( ABS(dl_lat1-dl_lat0) > dp_delta )THEN
+                  ll_coincidence=.FALSE.
+                  CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//&
+                     &  "j-direction refinement factor ("//&
+                     &   TRIM(fct_str(id_rho(jp_J)))//&
+                     &  ") between fine grid and coarse grid ")
+               ENDIF
+            ENDIF
+
+         ENDDO
+
+      ELSE
+         ! case even refinment at least in one direction
+         ! work on F-point
+
+         dl_delta=dp_delta
+         ! look for lower left fine point in coarse cell.
+         IF( ll_grid0F )THEN
+      
+            ! lower left corner of coarse cell
+            dl_lon0F=tl_lon0F%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1)
+            dl_lat0F=tl_lat0F%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1)
+
+         ELSE
+
+            ! approximate lower left corner of coarse cell (with T point)
+            dl_lon0F=( tl_lon0%d_value(il_ind0(1)  ,il_ind0(2)  ,1,1) + &
+               &       tl_lon0%d_value(il_ind0(1)  ,il_ind0(2)-1,1,1) + &
+               &       tl_lon0%d_value(il_ind0(1)-1,il_ind0(2)  ,1,1) + &
+               &       tl_lon0%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1) ) * 0.25
+
+            dl_lat0F=( tl_lat0%d_value(il_ind0(1)  ,il_ind0(2)  ,1,1) + &
+               &       tl_lat0%d_value(il_ind0(1)  ,il_ind0(2)-1,1,1) + &
+               &       tl_lat0%d_value(il_ind0(1)-1,il_ind0(2)  ,1,1) + &
+               &       tl_lat0%d_value(il_ind0(1)-1,il_ind0(2)-1,1,1) ) * 0.25
+
+            ! as we use approximation of F-point we relax condition
+            dl_delta=100*dp_delta
+
+         ENDIF
+
+         IF( ll_grid1F )THEN
+      
+            il_ind1(:)=grid_get_closest(tl_lon1F%d_value(:,:,1,1),&
+               &                        tl_lat1F%d_value(:,:,1,1),&
+               &                        dl_lon0F, dl_lat0F )
+
+         ELSE
+
+            il_ill1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),&
+               &                        tl_lat1%d_value(:,:,1,1),&
+               &                        dl_lon0F, dl_lat0F, 'll' )
+
+            il_ilr1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),&
+               &                        tl_lat1%d_value(:,:,1,1),&
+               &                        dl_lon0F, dl_lat0F, 'lr' )
+
+            il_iul1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),&
+               &                        tl_lat1%d_value(:,:,1,1),&
+               &                        dl_lon0F, dl_lat0F, 'ul' )
+
+            il_iur1(:)=grid_get_closest(tl_lon1%d_value(:,:,1,1),&
+               &                        tl_lat1%d_value(:,:,1,1),&
+               &                        dl_lon0F, dl_lat0F, 'ur' )
+
+            ! as we use approximation of F-point we relax condition
+            dl_delta=100*dp_delta
+
+         ENDIF
+
+         ! check i-direction refinement factor
+         DO ji=0,MIN(3,il_imid1)
+
+            IF( il_ind1(1)+ji*id_rho(jp_I)+1 > tl_lon1%t_dim(1)%i_len )THEN
+               CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//&
+               &  " to check i-direction refinement factor ")
+               EXIT
+            ELSE
+               IF( ll_grid0F )THEN
+                  dl_lon0F=tl_lon0F%d_value(il_ind0(1)+ji-1, il_ind0(2)-1,1,1)
+               ELSE
+                  dl_lon0F= 0.25 * &
+                     & ( tl_lon0%d_value(il_ind0(1)+ji  , il_ind0(2)  ,1,1) + &
+                     &   tl_lon0%d_value(il_ind0(1)+ji-1, il_ind0(2)  ,1,1) + &
+                     &   tl_lon0%d_value(il_ind0(1)+ji  , il_ind0(2)-1,1,1) + &
+                     &   tl_lon0%d_value(il_ind0(1)+ji-1, il_ind0(2)-1,1,1) )
+               ENDIF
+
+               IF( ll_grid1F )THEN
+                  dl_lon1F= tl_lon1F%d_value( il_ind1(1)+ji*id_rho(jp_I), &
+                                            & il_ind1(2),1,1)
+               ELSE
+                  dl_lon1F= 0.25 * &
+                     & ( tl_lon1%d_value( il_ill1(1)+ji*id_rho(jp_I), &
+                                        & il_ill1(2),1,1) + &
+                     &   tl_lon1%d_value( il_ilr1(1)+ji*id_rho(jp_I), &
+                                        & il_ilr1(2),1,1) + &
+                     &   tl_lon1%d_value( il_iul1(1)+ji*id_rho(jp_I), &
+                                        & il_iul1(2),1,1) + &
+                     &   tl_lon1%d_value( il_iur1(1)+ji*id_rho(jp_I), &
+                                        & il_iur1(2),1,1) )
+                  
+               ENDIF
+
+               ! assume there could be little difference due to interpolation
+               IF( ABS(dl_lon1F - dl_lon0F) > dl_delta )THEN
+                  ll_coincidence=.FALSE.
+                  CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//&
+                  &  "i-direction refinement factor ("//&
+                  &   TRIM(fct_str(id_rho(jp_I)))//&
+                  &  ") between fine grid and coarse grid ")
+               ENDIF
+            ENDIF
+
+         ENDDO
+
+         ! check j-direction refinement factor
+         DO jj=0,MIN(3,il_jmid1)
+
+            IF( il_ind1(2)+jj*id_rho(jp_J)+1 > tl_lat1%t_dim(2)%i_len )THEN
+               CALL logger_warn("GRID CHECK COINCIDENCE: domain to small "//&
+               &  " to check j-direction refinement factor ")
+               EXIT
+            ELSE      
+               IF( ll_grid0F )THEN
+                  dl_lat0F=tl_lat0F%d_value(il_ind0(1)-1, il_ind0(2)+jj-1,1,1)
+               ELSE
+                  dl_lat0F= 0.25 * &
+                  & ( tl_lat0%d_value(il_ind0(1)  , il_ind0(2)+jj  ,1,1) + &
+                  &   tl_lat0%d_value(il_ind0(1)-1, il_ind0(2)+jj  ,1,1) + &
+                  &   tl_lat0%d_value(il_ind0(1)  , il_ind0(2)+jj-1,1,1) + &
+                  &   tl_lat0%d_value(il_ind0(1)-1, il_ind0(2)+jj-1,1,1) )
+               ENDIF
+
+               IF( ll_grid1F )THEN
+                  dl_lat1F= tl_lat1F%d_value( il_ind1(1), &
+                                            & il_ind1(2)+jj*id_rho(jp_J),1,1)
+               ELSE
+                  dl_lat1F= 0.25 * &
+                     & ( tl_lat1%d_value( il_ill1(1), &
+                                        & il_ill1(2)+jj*id_rho(jp_J),1,1) + &
+                     &   tl_lat1%d_value( il_ilr1(1), &
+                                        & il_ilr1(2)+jj*id_rho(jp_J),1,1) + &
+                     &   tl_lat1%d_value( il_iul1(1), &
+                                        & il_iul1(2)+jj*id_rho(jp_J),1,1) + &
+                     &   tl_lat1%d_value( il_iur1(1), &
+                                        & il_iur1(2)+jj*id_rho(jp_J),1,1) )
+                  
+               ENDIF
+
+               ! assume there could be little difference due to interpolation
+               IF( ABS(dl_lat1F - dl_lat0F) > dl_delta )THEN
+                  ll_coincidence=.FALSE.
+                  CALL logger_debug("GRID CHECK COINCIDENCE: invalid "//&
+                     &  "i-direction refinement factor ("//&
+                     &   TRIM(fct_str(id_rho(jp_I)))//&
+                     &  ") between fine grid and coarse grid ")
+               ENDIF
+            ENDIF
+
+         ENDDO
+      ENDIF
+
+      ! clean 
+      CALL var_clean(tl_lon1)
+      CALL var_clean(tl_lat1)
+      CALL var_clean(tl_lon0)
+      CALL var_clean(tl_lat0)
+
+      IF( .NOT. ll_coincidence )THEN
+         CALL logger_fatal("GRID CHECK COINCIDENCE: no coincidence "//&
+         &              "between fine and coarse grid: "//&
+         &              "invalid refinement factor" )
+      ENDIF
+
+   END SUBROUTINE grid_check_coincidence
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__check_corner(dd_lon0, dd_lat0, &
+         &                     dd_lon1, dd_lat1) &
+         & RESULT (lf_inside)
+   !-------------------------------------------------------------------
+   !> @brief This function check that fine grid is 
+   !> inside coarse grid 
+   !>
+   !> @details
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] dd_lon0   array of coarse grid longitude
+   !> @param[in] dd_lat0   array of coarse grid latitude
+   !> @param[in] dd_lon1   array of fine   grid longitude 
+   !> @param[in] dd_lat1   array of fine   grid latitude
+   !> @return true if fine grid is inside coarse grid
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_lon0
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_lat0
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_lon1
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_lat1
+
+      ! function
+      LOGICAL                              :: lf_inside
+
+      ! local variable
+      INTEGER(i4), DIMENSION(2) :: il_shape0
+      INTEGER(i4), DIMENSION(2) :: il_shape1
+
+      INTEGER(i4) :: il_imin0
+      INTEGER(i4) :: il_jmin0
+      INTEGER(i4) :: il_imax0
+      INTEGER(i4) :: il_jmax0
+
+      INTEGER(i4) :: il_imin1
+      INTEGER(i4) :: il_jmin1
+      INTEGER(i4) :: il_imax1
+      INTEGER(i4) :: il_jmax1
+
+      REAL(dp)    :: dl_lon0
+      REAL(dp)    :: dl_lat0
+
+      REAL(dp)    :: dl_lon1
+      REAL(dp)    :: dl_lat1
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! init
+      lf_inside=.TRUE.
+
+      il_shape0=SHAPE(dd_lon0(:,:))
+      il_shape1=SHAPE(dd_lon1(:,:))
+
+      !1- check if fine grid inside coarse grid domain
+      il_imin0=1 ; il_imax0=il_shape0(1)
+      il_jmin0=1 ; il_jmax0=il_shape0(2)
+
+      il_imin1=1 ; il_imax1=il_shape1(1)
+      il_jmin1=1 ; il_jmax1=il_shape1(2)
+
+      ! check lower left corner
+      dl_lon0 = dd_lon0(il_imin0, il_jmin0)
+      dl_lat0 = dd_lat0(il_imin0, il_jmin0)
+
+      dl_lon1 = dd_lon1(il_imin1, il_jmin1)
+      dl_lat1 = dd_lat1(il_imin1, il_jmin1)
+
+      IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 < dl_lon0 ) .OR. & 
+         &(ABS(dl_lat1-dl_lat0)>dp_delta) .AND. (dl_lat1 < dl_lat0 ) )THEN
+
+         CALL logger_error("GRID CHECK COINCIDENCE: fine grid lower left "//&
+            &     "corner  not north east of coarse grid (imin,jmin) ")
+         CALL logger_debug(" fine   grid lower left ( "//&
+            &              TRIM(fct_str(dl_lon1))//","//&
+            &              TRIM(fct_str(dl_lat1))//")" )
+         CALL logger_debug(" coarse grid lower left ( "//&
+            &              TRIM(fct_str(dl_lon0))//","//&
+            &              TRIM(fct_str(dl_lat0))//")" )
+         lf_inside=.FALSE.
+
+      ENDIF
+
+      ! check upper left corner
+      dl_lon0 = dd_lon0(il_imin0, il_jmax0)
+      dl_lat0 = dd_lat0(il_imin0, il_jmax0)
+
+      dl_lon1 = dd_lon1(il_imin1, il_jmax1)
+      dl_lat1 = dd_lat1(il_imin1, il_jmax1)
+
+      IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 < dl_lon0) .OR. &
+      &   (ABS(dl_lat1-dl_lat0)>dp_delta) .AND. (dl_lat1 > dl_lat0) )THEN
+
+         CALL logger_error("GRID CHECK COINCIDENCE: fine grid upper left "//&
+            &     "corner not south east of coarse grid (imin,jmax) ")
+         CALL logger_debug(" fine   grid upper left ("//&
+            &              TRIM(fct_str(dl_lon1))//","//&
+            &              TRIM(fct_str(dl_lat1))//")")
+         CALL logger_debug(" coasre grid upper left ("//&
+            &              TRIM(fct_str(dl_lon0))//","//&
+            &              TRIM(fct_str(dl_lat0))//")")
+         lf_inside=.FALSE.
+
+      ENDIF
+
+      ! check lower right corner
+      dl_lon0 = dd_lon0(il_imax0, il_jmin0)
+      dl_lat0 = dd_lat0(il_imax0, il_jmin0)
+
+      dl_lon1 = dd_lon1(il_imax1, il_jmin1)
+      dl_lat1 = dd_lat1(il_imax1, il_jmin1)
+
+
+      IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 > dl_lon0) .OR. &
+         &(ABS(dl_lat1-dl_lat0)>dp_delta) .AND. (dl_lat1 < dl_lat0) )THEN
+
+         CALL logger_error("GRID CHECK COINCIDENCE: fine grid lower right "//&
+            &     "corner not north west of coarse grid (imax,jmin) ")
+         CALL logger_debug(" fine   grid lower right ( "//&
+            &              TRIM(fct_str(dl_lon1))//","//&
+            &              TRIM(fct_str(dl_lat1))//")" )
+         CALL logger_debug(" coarse grid lower right ( "//&
+            &              TRIM(fct_str(dl_lon0))//","//&
+            &              TRIM(fct_str(dl_lat0))//")" )   
+         lf_inside=.FALSE.
+
+      ENDIF
+
+      ! check upper right corner
+      dl_lon0 = dd_lon0(il_imax0, il_jmax0)
+      dl_lat0 = dd_lat0(il_imax0, il_jmax0)
+
+      dl_lon1 = dd_lon1(il_imax1, il_jmax1)
+      dl_lat1 = dd_lat1(il_imax1, il_jmax1)
+
+      IF( (ABS(dl_lon1-dl_lon0)>dp_delta) .AND. (dl_lon1 > dl_lon0) .OR. &
+      &   (ABS(dl_lat1-dl_lat0)>dp_delta) .AND. (dl_lat1 > dl_lat0) )THEN
+
+         CALL logger_error("GRID CHECK COINCIDENCE: fine grid upper right "//&
+            &     "corner not south west of coarse grid (imax,jmax) ")
+         CALL logger_debug(" fine   grid upper right ( "//&
+            &              TRIM(fct_str(dl_lon1))//","//&
+            &              TRIM(fct_str(dl_lat1))//")" )
+         CALL logger_debug(" fine   imax1 jmax1 ( "//&
+            &              TRIM(fct_str(il_imax1))//","//&
+            &              TRIM(fct_str(il_jmax1))//")" )
+         CALL logger_debug(" coarse grid upper right ( "//&
+            &              TRIM(fct_str(dl_lon0))//","//&
+            &              TRIM(fct_str(dl_lat0))//")" )    
+         CALL logger_debug(" fine   imax0 jmax0 ( "//&
+            &              TRIM(fct_str(il_imax0))//","//&
+            &              TRIM(fct_str(il_jmax0))//")" )
+         lf_inside=.FALSE.
+
+      ENDIF      
+
+   END FUNCTION grid__check_corner
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__check_lat(dd_lat0, dd_lat1) &
+         & RESULT (lf_inside)
+   !-------------------------------------------------------------------
+   !> @brief This function check that fine grid latitude are 
+   !> inside coarse grid latitude
+   !>
+   !> @details
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] dd_lat0   array of coarse grid latitude 
+   !> @param[in] dd_lat1   array of fine grid latitude
+   !> @return true if fine grid is inside coarse grid
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument 
+      REAL(dp), DIMENSION(:), INTENT(IN) :: dd_lat0
+      REAL(dp), DIMENSION(:), INTENT(IN) :: dd_lat1
+
+      ! function
+      LOGICAL                            :: lf_inside
+
+      ! local variable
+      INTEGER(i4), DIMENSION(1) :: il_shape0
+      INTEGER(i4), DIMENSION(1) :: il_shape1
+
+      INTEGER(i4) :: il_jmin0
+      INTEGER(i4) :: il_jmax0
+
+      INTEGER(i4) :: il_jmin1
+      INTEGER(i4) :: il_jmax1
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! init
+      lf_inside=.TRUE.
+
+      il_shape0(:)=SHAPE(dd_lat0(:))
+      il_shape1(:)=SHAPE(dd_lat1(:))
+
+      !1- check if fine grid inside coarse grid domain
+      il_jmin0=1 ; il_jmax0=il_shape0(1)
+      il_jmin1=1 ; il_jmax1=il_shape1(1)
+
+      ! check lower left fine grid
+      IF( ABS(dd_lat1(il_jmin1)-dd_lat0(il_jmin0)) > dp_delta .AND. &
+         &dd_lat1(il_jmin1) < dd_lat0(il_jmin0) )THEN
+
+         CALL logger_error("GRID CHECK COINCIDENCE: fine grid lower point"//&
+            &     " not north of coarse grid (jmin) ")
+         CALL logger_debug(" fine grid lower point ( "//&
+            &              TRIM(fct_str(dd_lat1(il_jmin1)))//")" )
+         CALL logger_debug(" coarse grid lower point ( "//&
+            &              TRIM(fct_str(dd_lat0(il_jmin0)))//")" )
+         lf_inside=.FALSE.
+
+      ENDIF
+
+      ! check upper left fine grid
+      IF( ABS(dd_lat1(il_jmax1)-dd_lat0(il_jmax0)) > dp_delta .AND. &
+         &dd_lat1(il_jmax1) > dd_lat0(il_jmax0) )THEN
+
+         CALL logger_error("GRID CHECK COINCIDENCE: fine grid upper point"//&
+            &     " not south of coarse grid (jmax) ")
+         CALL logger_debug(" fine grid upper point ("//&
+            &              TRIM(fct_str(dd_lat1(il_jmax1)))//")")
+         CALL logger_debug(" coasre grid upper point ("//&
+            &              TRIM(fct_str(dd_lat0(il_jmax0)))//")")
+         lf_inside=.FALSE.
+
+      ENDIF
+      
+   END FUNCTION grid__check_lat
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_add_ghost(td_var, id_ghost)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine add ghost cell at boundaries.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_var array of variable structure 
+   !> @param[in] id_ghost  array of ghost cell factor 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
+      INTEGER(i4), DIMENSION(2,2), INTENT(IN   ) :: id_ghost
+
+      ! local variable
+      INTEGER(i4) :: il_imin
+      INTEGER(i4) :: il_jmin
+      INTEGER(i4) :: il_imax
+      INTEGER(i4) :: il_jmax
+
+      REAL(dp), DIMENSION(:,:,:,:) , ALLOCATABLE :: dl_value
+      
+      TYPE(TVAR) :: tl_var
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( ALL(td_var%t_dim(1:2)%l_use) )THEN
+
+         CALL logger_warn( "ADD GHOST: dimension change in variable "//&
+         &              TRIM(td_var%c_name) )
+
+         ! copy variable
+         tl_var=var_copy(td_var)
+
+         CALL var_del_value(td_var)
+
+         ! compute indice to fill center
+         il_imin=1+id_ghost(jp_I,1)*ip_ghost
+         il_jmin=1+id_ghost(jp_J,1)*ip_ghost
+
+         il_imax=tl_var%t_dim(1)%i_len+id_ghost(jp_I,1)*ip_ghost
+         il_jmax=tl_var%t_dim(2)%i_len+id_ghost(jp_J,1)*ip_ghost
+
+         ! compute new dimension
+         td_var%t_dim(1)%i_len = tl_var%t_dim(1)%i_len + &
+         &                             SUM(id_ghost(jp_I,:))*ip_ghost
+         td_var%t_dim(2)%i_len = tl_var%t_dim(2)%i_len + &
+         &                             SUM(id_ghost(jp_J,:))*ip_ghost
+
+         ALLOCATE(dl_value(td_var%t_dim(1)%i_len, &
+         &                 td_var%t_dim(2)%i_len, &
+         &                 td_var%t_dim(3)%i_len, &
+         &                 td_var%t_dim(4)%i_len) )
+
+         dl_value(:,:,:,:)=tl_var%d_fill
+
+         dl_value(il_imin:il_imax, &
+         &        il_jmin:il_jmax, &
+         &              :,:)  =  tl_var%d_value(:,:,:,:)
+
+         ! add variable value
+         CALL var_add_value(td_var,dl_value(:,:,:,:))
+
+         ! save variable type
+         td_var%i_type=tl_var%i_type
+         
+         DEALLOCATE( dl_value )
+
+         CALL var_clean(tl_var)
+
+      ENDIF
+
+   END SUBROUTINE grid_add_ghost
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_del_ghost(td_var, id_ghost)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine delete ghost cell at boundaries.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_var array of variable structure 
+   !> @param[in] id_ghost  array of ghost cell factor 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
+      INTEGER(i4), DIMENSION(2,2), INTENT(IN   ) :: id_ghost
+
+      ! local variable
+      INTEGER(i4) :: il_imin
+      INTEGER(i4) :: il_jmin
+      INTEGER(i4) :: il_imax
+      INTEGER(i4) :: il_jmax
+
+      REAL(dp), DIMENSION(:,:,:,:) , ALLOCATABLE :: dl_value
+      
+      TYPE(TVAR) :: tl_var
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( ALL(td_var%t_dim(1:2)%l_use) )THEN
+
+         IF( ANY(id_ghost(:,:)/=0) )THEN
+            CALL logger_warn( "GRID DEL GHOST: dimension change in variable "//&
+            &              TRIM(td_var%c_name) )
+         ENDIF
+
+         ! copy variable
+         tl_var=var_copy(td_var)
+
+         CALL var_del_value(td_var)
+
+         ! compute indice to get center
+         il_imin=1+id_ghost(jp_I,1)*ip_ghost
+         il_jmin=1+id_ghost(jp_J,1)*ip_ghost
+
+         il_imax=tl_var%t_dim(1)%i_len-id_ghost(jp_I,2)*ip_ghost
+         il_jmax=tl_var%t_dim(2)%i_len-id_ghost(jp_J,2)*ip_ghost
+
+         ! compute new dimension
+         td_var%t_dim(1)%i_len = il_imax - il_imin +1 
+         td_var%t_dim(2)%i_len = il_jmax - il_jmin +1 
+
+         ALLOCATE(dl_value(td_var%t_dim(1)%i_len, &
+            &              td_var%t_dim(2)%i_len, &
+            &              td_var%t_dim(3)%i_len, &
+            &              td_var%t_dim(4)%i_len) )
+
+         dl_value(:,:,:,:)=tl_var%d_fill
+
+         dl_value(:,:,:,:)  =  tl_var%d_value(il_imin:il_imax, &
+            &                                 il_jmin:il_jmax, &
+            &                                 :,:)
+
+         ! add variable value
+         CALL var_add_value(td_var,dl_value(:,:,:,:))
+
+         ! save variable type
+         td_var%i_type=tl_var%i_type
+         
+         DEALLOCATE( dl_value )
+
+         CALL var_clean(tl_var)
+
+      ENDIF
+
+   END SUBROUTINE grid_del_ghost
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__get_ghost_var(td_var) &
+         & RESULT (if_ghost)
+   !-------------------------------------------------------------------
+   !> @brief This function check if ghost cell are used or not, and return ghost
+   !> cell factor (0,1) in horizontal plan.
+   !>
+   !> @details
+   !> check if domain is global, and if there is an East-West overlap.
+   !>
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[in] td_var variable sturcture 
+   !> @return array of ghost cell factor
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR), INTENT(IN) :: td_var
+
+      ! function
+      INTEGER(i4), DIMENSION(2,2) :: if_ghost
+
+      ! local variable
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dim
+
+      ! loop indices
+      !----------------------------------------------------------------
+      ! init
+      if_ghost(:,:)=0
+
+      IF( .NOT. ALL(td_var%t_dim(1:2)%l_use) )THEN
+         CALL logger_error("GRID GET GHOST: "//TRIM(td_var%c_name)//" is not a suitable"//&
+            &              " variable to look for ghost cell (not 2D).")
+      ELSE
+         IF( .NOT. ASSOCIATED(td_var%d_value) )THEN
+            CALL logger_error("GRID GET GHOST: no value associated to "//TRIM(td_var%c_name)//&
+               &              ". can't look for ghost cell.")
+         ELSE
+            il_dim(:)=td_var%t_dim(:)%i_len
+
+            IF(ALL(td_var%d_value(    1    ,    :    ,1,1)/=td_var%d_fill).AND.&
+            &  ALL(td_var%d_value(il_dim(1),    :    ,1,1)/=td_var%d_fill).AND.&
+            &  ALL(td_var%d_value(    :    ,    1    ,1,1)/=td_var%d_fill).AND.&
+            &  ALL(td_var%d_value(    :    ,il_dim(2),1,1)/=td_var%d_fill))THEN
+            ! no boundary closed
+               CALL logger_warn("GRID GET GHOST: can't determined ghost cell. "//&
+                  &             "there is no boundary closed for variable "//&
+                  &              TRIM(td_var%c_name))
+
+            ELSE
+               ! check periodicity
+               IF(ANY(td_var%d_value(   1     ,:,1,1)/=td_var%d_fill).OR.&
+               &  ANY(td_var%d_value(il_dim(1),:,1,1)/=td_var%d_fill))THEN
+               ! East-West cyclic (1,4,6)
+                  CALL logger_info("GRID GET GHOST: East West cyclic")
+                  if_ghost(jp_I,:)=0
+
+                  IF( ANY(td_var%d_value(:, 1, 1, 1) /= td_var%d_fill) )THEN
+                  ! South boundary not closed 
+
+                     CALL logger_debug("GRID GET GHOST: East_West cyclic")
+                     CALL logger_debug("GRID GET GHOST: South boundary not closed")
+                     CALL logger_error("GRID GET GHOST: should have been an "//&
+                        &              "impossible case")
+
+                  ELSE
+                  ! South boundary closed (1,4,6)
+                     CALL logger_info("GRID GET GHOST: South boundary closed")
+                     if_ghost(jp_J,1)=1
+
+                     IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill) )THEN
+                     ! North boundary not closed (4,6)
+                        CALL logger_info("GRID GET GHOST: North boundary not closed")
+                        if_ghost(jp_J,2)=0
+                     ELSE
+                     ! North boundary closed
+                        CALL logger_info("GRID GET GHOST: North boundary closed")
+                        if_ghost(jp_J,2)=1
+                     ENDIF
+
+                  ENDIF
+
+               ELSE
+               ! East-West boundaries closed (0,2,3,5)
+                  CALL logger_info("GRID GET GHOST: East West boundaries closed")
+                  if_ghost(jp_I,:)=1
+
+                  IF( ANY(td_var%d_value(:, 1, 1, 1) /= td_var%d_fill) )THEN
+                  ! South boundary not closed (2)
+                     CALL logger_info("GRID GET GHOST: South boundary not closed")
+                     if_ghost(jp_J,1)=0
+
+                     IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill))THEN
+                     ! North boundary not closed
+                        CALL logger_debug("GRID GET GHOST: East West boundaries "//&
+                           &              "closed")
+                        CALL logger_debug("GRID GET GHOST: South boundary not closed")
+                        CALL logger_debug("GRID GET GHOST: North boundary not closed")
+                        CALL logger_error("GRID GET GHOST: should have been "//&
+                        &              "an impossible case")
+                     ELSE
+                     ! North boundary closed
+                        if_ghost(jp_J,2)=1
+                     ENDIF
+
+                  ELSE
+                  ! South boundary closed (0,3,5)
+                     CALL logger_info("GRID GET GHOST: South boundary closed")
+                     if_ghost(jp_J,1)=1
+
+                     IF(ANY(td_var%d_value(:,il_dim(2),1,1)/=td_var%d_fill))THEN
+                     ! North boundary not closed (3,5)
+                        CALL logger_info("GRID GET GHOST: North boundary not closed")
+                        if_ghost(jp_J,2)=0
+                     ELSE
+                     ! North boundary closed   
+                        CALL logger_info("GRID GET GHOST: North boundary closed")
+                        if_ghost(jp_J,2)=1
+                     ENDIF
+
+                  ENDIF
+
+               ENDIF
+
+            ENDIF
+
+         ENDIF
+      ENDIF
+
+   END FUNCTION grid__get_ghost_var
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid__get_ghost_mpp(td_mpp) &
+         & RESULT (if_ghost)
+   !-------------------------------------------------------------------
+   !> @brief This function check if ghost cell are used or not, and return ghost
+   !> cell factor (0,1) in i- and j-direction.
+   !>
+   !> @details
+   !> get longitude an latitude array, then
+   !> check if domain is global, and if there is an East-West overlap
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !> @date October, 2014
+   !> - work on mpp file structure instead of file structure
+   !>
+   !> @param[in] td_file   file sturcture
+   !> @return array of ghost cell factor
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP), INTENT(IN) :: td_mpp
+
+      ! function
+      INTEGER(i4), DIMENSION(2,2) :: if_ghost
+
+      ! local variable
+      !TYPE(TVAR)  :: tl_lon
+      !TYPE(TVAR)  :: tl_lat
+
+      TYPE(TMPP) :: tl_mpp
+
+      !INTEGER(i4) :: il_lonid
+      !INTEGER(i4) :: il_latid
+      ! loop indices
+      !----------------------------------------------------------------
+      ! init
+      if_ghost(:,:)=0
+
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+         CALL logger_error("GRID GET GHOST: decomposition of mpp file "//&
+         &                 TRIM(td_mpp%c_name)//" not defined." )
+
+      ELSE
+
+         ! copy structure
+         tl_mpp=mpp_copy(td_mpp)
+
+         CALL logger_info("GRID GET FINE GHOST perio"//TRIM(fct_str(tl_mpp%i_perio)))
+         IF( tl_mpp%i_perio < 0 )THEN
+            ! compute NEMO periodicity index
+            CALL grid_get_info(tl_mpp)
+         ENDIF
+
+         SELECT CASE(tl_mpp%i_perio)
+            CASE(0)
+               if_ghost(:,:)=1
+            CASE(1)
+               if_ghost(jp_J,:)=1
+            CASE(2)
+               if_ghost(jp_I,:)=1
+               if_ghost(jp_J,2)=1
+            CASE(3,5)
+               if_ghost(jp_I,:)=1
+               if_ghost(jp_J,1)=1
+            CASE(4,6)
+               if_ghost(jp_J,1)=1
+            CASE DEFAULT
+         END SELECT
+
+         ! clean 
+         CALL mpp_clean(tl_mpp)
+
+      ENDIF
+
+   END FUNCTION grid__get_ghost_mpp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid_split_domain(td_var, id_level) &
+         & RESULT (if_mask)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute closed sea domain.
+   !>
+   !> @details
+   !> to each domain is associated a negative value id (from -1 to ...)<br/>
+   !> optionaly you could specify which level use (default 1)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_var    variable strucutre 
+   !> @param[in] id_level  level
+   !> @return domain mask  
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) , INTENT(IN) :: td_var
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_level
+
+      ! function
+      INTEGER(i4), DIMENSION(td_var%t_dim(1)%i_len, &
+      &                      td_var%t_dim(2)%i_len ) :: if_mask
+
+      ! local variable
+      INTEGER(i4)                              :: il_domid
+      INTEGER(i4)                              :: il_level
+      INTEGER(i4), DIMENSION(2)                :: il_shape
+      INTEGER(i4), DIMENSION(2)                :: il_ind
+      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_tmp
+
+      LOGICAL                                  :: ll_full
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jim
+      INTEGER(i4) :: jip
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jjm
+      INTEGER(i4) :: jjp
+      !----------------------------------------------------------------
+      il_level=1
+      IF( PRESENT(id_level) ) il_level=id_level
+
+      ! init
+      il_domid=-1
+
+      il_shape(:)=td_var%t_dim(1:2)%i_len
+      if_mask(:,:)=0
+      WHERE( td_var%d_value(:,:,il_level,1)/=td_var%d_fill ) if_mask(:,:)=1
+
+      il_ind(:)=MAXLOC( if_mask(:,:) )
+      DO WHILE( if_mask(il_ind(1), il_ind(2)) == 1 )
+
+         if_mask(il_ind(1),il_ind(2))=il_domid
+         ll_full=.FALSE.
+
+         ALLOCATE( il_tmp(il_shape(1),il_shape(2)) )
+
+         DO WHILE( .NOT. ll_full )
+            il_tmp(:,:)=0
+
+            ll_full=.TRUE.
+            DO jj=1,il_shape(2)
+               DO ji=1,il_shape(1)
+                  IF( if_mask(ji,jj)==il_domid )THEN
+                     jim=MAX(1,ji-1)   ;  jip=MIN(il_shape(1),ji+1)
+                     jjm=MAX(1,jj-1)   ;  jjp=MIN(il_shape(2),jj+1)
+                     
+                     WHERE( if_mask(jim:jip,jjm:jjp)==1 )
+                        if_mask(jim:jip,jjm:jjp)=il_domid
+                        il_tmp(jim:jip,jjm:jjp)=1
+                     END WHERE
+
+                  ENDIF
+               ENDDO
+            ENDDO
+            IF( SUM(il_tmp(:,:))/=0 ) ll_full=.FALSE.
+
+         ENDDO
+         DEALLOCATE( il_tmp )
+
+         il_ind(:)=MAXLOC( if_mask(:,:) )
+         il_domid=il_domid-1
+
+      ENDDO
+
+      CALL logger_info("GRID SPLIT DOMAIN: "//TRIM( fct_str(ABS(il_domid+1)) )//&
+      &             " domain found" ) 
+
+   END FUNCTION grid_split_domain
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_fill_small_dom(td_var, id_mask, id_minsize)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill small closed sea with fill value. 
+   !>
+   !> @details
+   !> the minimum size (number of point) of closed sea to be kept could be
+   !> sepcify with id_minsize.
+   !> By default only the biggest sea is preserve.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var    variable structure
+   !> @param[in] id_mask      domain mask (from grid_split_domain)
+   !> @param[in] id_minsize   minimum size of sea to be kept
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
+      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ) :: id_mask
+      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_minsize
+
+      ! local variable
+      INTEGER(i4)                              :: il_ndom
+      INTEGER(i4)                              :: il_minsize
+      INTEGER(i4), DIMENSION(2)                :: il_shape
+      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      il_shape(:)=SHAPE(id_mask(:,:))
+      IF( ANY(il_shape(:) /= td_var%t_dim(1:2)%i_len) )THEN
+         CALL logger_error("GRID FILL SMALL DOM: variable and mask "//&
+            &              "dimension differ")
+      ELSE
+
+         il_ndom=MINVAL(id_mask(:,:))
+
+         ALLOCATE( il_tmp(il_shape(1),il_shape(2)) )
+         il_tmp(:,:)=0
+         DO ji=-1,il_ndom,-1
+            WHERE( id_mask(:,:)==ji ) 
+               il_tmp(:,:)=SUM(id_mask(:,:),id_mask(:,:)==ji)/ji
+            END WHERE
+         ENDDO
+
+         il_minsize=MAXVAL(il_tmp(:,:))
+         IF( PRESENT(id_minsize) ) il_minsize=id_minsize
+
+         DO jl=1,td_var%t_dim(4)%i_len
+            DO jk=1,td_var%t_dim(3)%i_len
+               WHERE( il_tmp(:,:) < il_minsize ) 
+                  td_var%d_value(:,:,jk,jl)=td_var%d_fill
+               END WHERE
+            ENDDO
+         ENDDO
+
+         DEALLOCATE( il_tmp )
+
+      ENDIF
+
+   END SUBROUTINE grid_fill_small_dom
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_fill_small_msk(id_mask, id_minsize)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill small domain inside bigger one. 
+   !>
+   !> @details
+   !> the minimum size (number of point) of domain sea to be kept 
+   !> is specified by id_minsize.
+   !> smaller domain are included in the one they are embedded.
+   !>
+   !> @author J.Paul
+   !> @date Ferbruay, 2015 - Initial Version
+   !>
+   !> @param[inout] id_mask   domain mask (from grid_split_domain)
+   !> @param[in] id_minsize   minimum size of sea to be kept
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      INTEGER(i4), DIMENSION(:,:), INTENT(INOUT) :: id_mask
+      INTEGER(i4),                 INTENT(IN   ) :: id_minsize
+
+      ! local variable
+      INTEGER(i4)                              :: il_ndom
+      INTEGER(i4)                              :: il_minsize
+      INTEGER(i4)                              :: il_msk
+      
+      INTEGER(i4)                              :: jim
+      INTEGER(i4)                              :: jjm
+      INTEGER(i4)                              :: jip
+      INTEGER(i4)                              :: jjp
+
+      INTEGER(i4), DIMENSION(2)                :: il_shape
+      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ii
+      INTEGER(i4) :: ij
+
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      il_shape(:)=SHAPE(id_mask(:,:))
+      il_ndom=MINVAL(id_mask(:,:))
+
+      ALLOCATE( il_tmp(il_shape(1),il_shape(2)) )
+      il_tmp(:,:)=0
+      DO ji=-1,il_ndom,-1
+         WHERE( id_mask(:,:)==ji ) 
+            il_tmp(:,:)=SUM(id_mask(:,:),id_mask(:,:)==ji)/ji
+         END WHERE
+      ENDDO
+
+      DO WHILE( id_minsize > MINVAL(il_tmp(:,:)) )
+
+         DO jj=1,il_shape(2)
+            DO ji=1,il_shape(1)
+
+               IF( il_tmp(ji,jj) < id_minsize )THEN
+                  jim=MAX(1,ji-1)   ;  jip=MIN(il_shape(1),ji+1)
+                  jjm=MAX(1,jj-1)   ;  jjp=MIN(il_shape(2),jj+1)
+                  
+                  il_msk=0
+                  DO ij=jjm,jjp
+                     DO ii=jim,jip
+                        IF( id_mask(ii,ij) /= id_mask(ji,jj) )THEN
+                           IF( il_msk == 0 )THEN
+                              il_msk=id_mask(ii,ij)
+                           ELSEIF( il_msk /= id_mask(ii,ij) )THEN
+                              CALL logger_error("GRID FILL SMALL MSK:"//&
+                                 &  " small domain not embedded in bigger one."//&
+                                 &  " point should be between two different"//&
+                                 &  " domain.")
+                           ENDIF
+                        ENDIF
+                     ENDDO
+                  ENDDO
+                  IF( il_msk /= 0 ) id_mask(ji,jj)=il_msk
+
+               ENDIF
+
+            ENDDO
+         ENDDO
+
+
+         il_tmp(:,:)=0
+         DO ji=-1,il_ndom,-1
+            WHERE( id_mask(:,:)==ji ) 
+               il_tmp(:,:)=SUM(id_mask(:,:),id_mask(:,:)==ji)/ji
+            END WHERE
+         ENDDO            
+
+      ENDDO
+
+      DEALLOCATE( il_tmp )
+
+   END SUBROUTINE grid_fill_small_msk
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE grid
+
Index: /utils/tools_ticket2413/SIREN/src/grid_hgr.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/grid_hgr.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/grid_hgr.f90	(revision 12863)
@@ -0,0 +1,1445 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief This module manage Horizontal grid.
+!>
+!> @details
+!> ** Purpose :   Compute the geographical position (in degre) of the 
+!>      model grid-points,  the horizontal scale factors (in meters) and 
+!>      the Coriolis factor (in s-1).
+!>
+!> ** Method  :   The geographical position of the model grid-points is
+!>    defined from analytical functions, fslam and fsphi, the derivatives of which gives the horizontal scale factors e1,e2.
+!>    Defining two function fslam and fsphi and their derivatives in the two horizontal directions (fse1 and fse2), 
+!>    the model grid-point position and scale factors are given by:
+!>    - t-point:
+!>       - glamt(i,j) = fslam(i    ,j    )   e1t(i,j) = fse1(i    ,j    )
+!>       - gphit(i,j) = fsphi(i    ,j    )   e2t(i,j) = fse2(i    ,j    )
+!>    - u-point:
+!>       - glamu(i,j) = fslam(i+1/2,j    )   e1u(i,j) = fse1(i+1/2,j    )
+!>       - gphiu(i,j) = fsphi(i+1/2,j    )   e2u(i,j) = fse2(i+1/2,j    )
+!>    - v-point:
+!>       - glamv(i,j) = fslam(i    ,j+1/2)   e1v(i,j) = fse1(i    ,j+1/2)
+!>       - gphiv(i,j) = fsphi(i    ,j+1/2)   e2v(i,j) = fse2(i    ,j+1/2)
+!>    - f-point:
+!>       - glamf(i,j) = fslam(i+1/2,j+1/2)   e1f(i,j) = fse1(i+1/2,j+1/2)
+!>       - gphif(i,j) = fsphi(i+1/2,j+1/2)   e2f(i,j) = fse2(i+1/2,j+1/2)
+!>
+!>    Where fse1 and fse2 are defined by:
+!>       - fse1(i,j) = ra * rad * SQRT( (cos(phi) di(fslam))**2
+!>                                     +          di(fsphi) **2 )(i,j)
+!>       - fse2(i,j) = ra * rad * SQRT( (cos(phi) dj(fslam))**2
+!>                                     +          dj(fsphi) **2 )(i,j)
+!>
+!>    The coriolis factor is given at z-point by:
+!>        - ff = 2.*omega*sin(gphif)      (in s-1)<br/>
+!>
+!>        This routine is given as an example, it must be modified
+!>      following the user s desiderata. nevertheless, the output as
+!>      well as the way to compute the model grid-point position and
+!>      horizontal scale factors must be respected in order to insure
+!>      second order accuracy schemes.
+!>
+!> @note If the domain is periodic, verify that scale factors are also
+!>      periodic, and the coriolis term again.
+!>
+!> ** Action  : 
+!>    - define  glamt, glamu, glamv, glamf: longitude of t-, u-, v- and f-points (in degre)
+!>    - define  gphit, gphiu, gphiv, gphit: latitude  of t-, u-, v-  and f-points (in degre)
+!>    - define e1t, e2t, e1u, e2u, e1v, e2v, e1f, e2f: horizontal
+!>    - scale factors (in meters) at t-, u-, v-, and f-points.
+!>    - define ff: coriolis factor at f-point
+!>
+!> References :   Marti, Madec and Delecluse, 1992, JGR
+!>                Madec, Imbard, 1996, Clim. Dyn.
+!>
+!> @author
+!> G, Madec
+!>
+!> @date March, 1988 - Original code
+!> @date January, 1996 
+!> - terrain following coordinates
+!> @date February, 1997 
+!> - print mesh informations
+!> @date November, 1999
+!> - M. Imbard : NetCDF format with IO-IPSL
+!> @date Augustr, 2000
+!> - D. Ludicone : Reduced section at Bab el Mandeb
+!> @date September, 2001
+!> - M. Levy : eel config: grid in km, beta-plane
+!> @date August, 2002
+!> - G. Madec :  F90: Free form and module, namelist
+!> @date January, 2004
+!> - A.M. Treguier, J.M. Molines : Case 4 (Mercator mesh)
+!> use of parameters in par_CONFIG-Rxx.h90, not in namelist
+!> @date May, 2004
+!> - A. Koch-Larrouy : Add Gyre configuration 
+!> @date February, 2011
+!> - G. Madec : add cell surface (e1e2t)
+!> @date September, 2015 
+!> - J, Paul : rewrite to SIREN format from $Id: domhgr.F90 5506 2015-06-29 15:19:38Z clevy $
+!> @date October, 2016
+!> - J, Paul : update from trunk (revision 6961): add wetting and drying, ice sheet coupling..
+!> - J, Paul : compute coriolis factor at f-point and at t-point 
+!> - J, Paul : do not use anymore special case for ORCA grid
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE grid_hgr
+
+   USE netcdf                          ! nf90 library
+   USE kind                            ! F90 kind parameter
+   USE fct                             ! basic usefull function
+   USE global                          ! global parameter
+   USE phycst                          ! physical constant
+   USE logger                          ! log file manager
+   USE file                            ! file manager
+   USE var                             ! variable manager
+   USE dim                             ! dimension manager
+   USE dom                             ! domain manager
+   USE grid                            ! grid manager
+   USE iom                             ! I/O manager
+   USE mpp                             ! MPP manager
+   USE iom_mpp                         ! I/O MPP manager
+   USE lbc                             ! lateral boundary conditions
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   PUBLIC :: TNAMH
+
+   PUBLIC :: tg_tmask
+   PUBLIC :: tg_umask
+   PUBLIC :: tg_vmask
+   PUBLIC :: tg_fmask
+
+!   PUBLIC :: tg_wmask
+!   PUBLIC :: tg_wumask
+!   PUBLIC :: tg_wvmask
+
+   PUBLIC :: tg_ssmask
+!   PUBLIC :: tg_ssumask
+!   PUBLIC :: tg_ssvmask
+!   PUBLIC :: tg_ssfmask
+
+   PUBLIC :: tg_glamt
+   PUBLIC :: tg_glamu
+   PUBLIC :: tg_glamv
+   PUBLIC :: tg_glamf
+
+   PUBLIC :: tg_gphit
+   PUBLIC :: tg_gphiu
+   PUBLIC :: tg_gphiv
+   PUBLIC :: tg_gphif
+   
+   PUBLIC :: tg_e1t
+   PUBLIC :: tg_e1u
+   PUBLIC :: tg_e1v
+   PUBLIC :: tg_e1f
+   
+   PUBLIC :: tg_e2t
+   PUBLIC :: tg_e2u
+   PUBLIC :: tg_e2v
+   PUBLIC :: tg_e2f
+   
+   PUBLIC :: tg_ff_t
+   PUBLIC :: tg_ff_f
+
+   PUBLIC :: tg_gcost
+   PUBLIC :: tg_gcosu
+   PUBLIC :: tg_gcosv
+   PUBLIC :: tg_gcosf
+
+   PUBLIC :: tg_gsint
+   PUBLIC :: tg_gsinu
+   PUBLIC :: tg_gsinv
+   PUBLIC :: tg_gsinf
+
+   ! function and subroutine
+   PUBLIC :: grid_hgr_init 
+   PUBLIC :: grid_hgr_fill
+   PUBLIC :: grid_hgr_clean
+   PUBLIC :: grid_hgr_nam 
+
+   PRIVATE :: grid_hgr__fill_curv
+   PRIVATE :: grid_hgr__fill_reg
+   PRIVATE :: grid_hgr__fill_plan
+   PRIVATE :: grid_hgr__fill_merc
+   PRIVATE :: grid_hgr__fill_gyre
+   PRIVATE :: grid_hgr__fill_coriolis
+   PRIVATE :: grid_hgr__angle
+
+   TYPE TNAMH
+
+      CHARACTER(LEN=lc) :: c_coord   
+      INTEGER(i4)       :: i_perio   
+                
+      INTEGER(i4)       :: i_mshhgr  
+      REAL(dp)          :: d_ppglam0 
+      REAL(dp)          :: d_ppgphi0 
+                
+      REAL(dp)          :: d_ppe1_deg
+      REAL(dp)          :: d_ppe2_deg
+!      REAL(dp)          :: d_ppe1_m  
+!      REAL(dp)          :: d_ppe2_m     
+
+!      INTEGER(i4)       :: i_cla     
+                
+!      CHARACTER(LEN=lc) :: c_cfg     
+      INTEGER(i4)       :: i_cfg     
+      LOGICAL           :: l_bench   
+                
+   END TYPE
+
+   TYPE(TVAR), SAVE :: tg_tmask   
+   TYPE(TVAR), SAVE :: tg_umask
+   TYPE(TVAR), SAVE :: tg_vmask
+   TYPE(TVAR), SAVE :: tg_fmask
+!   TYPE(TVAR), SAVE :: tg_wmask
+!   TYPE(TVAR), SAVE :: tg_wumask
+!   TYPE(TVAR), SAVE :: tg_wvmask
+
+   TYPE(TVAR), SAVE :: tg_ssmask 
+!   TYPE(TVAR), SAVE :: tg_ssumask
+!   TYPE(TVAR), SAVE :: tg_ssvmask
+!   TYPE(TVAR), SAVE :: tg_ssfmask
+
+   TYPE(TVAR), SAVE :: tg_glamt
+   TYPE(TVAR), SAVE :: tg_glamu
+   TYPE(TVAR), SAVE :: tg_glamv
+   TYPE(TVAR), SAVE :: tg_glamf
+
+   TYPE(TVAR), SAVE :: tg_gphit
+   TYPE(TVAR), SAVE :: tg_gphiu
+   TYPE(TVAR), SAVE :: tg_gphiv
+   TYPE(TVAR), SAVE :: tg_gphif
+
+   TYPE(TVAR), SAVE :: tg_e1t
+   TYPE(TVAR), SAVE :: tg_e1u
+   TYPE(TVAR), SAVE :: tg_e1v
+   TYPE(TVAR), SAVE :: tg_e1f
+
+   TYPE(TVAR), SAVE :: tg_e2t
+   TYPE(TVAR), SAVE :: tg_e2u
+   TYPE(TVAR), SAVE :: tg_e2v
+   TYPE(TVAR), SAVE :: tg_e2f
+
+   TYPE(TVAR), SAVE :: tg_ff_t
+   TYPE(TVAR), SAVE :: tg_ff_f
+
+   TYPE(TVAR), SAVE :: tg_gcost
+   TYPE(TVAR), SAVE :: tg_gcosu
+   TYPE(TVAR), SAVE :: tg_gcosv
+   TYPE(TVAR), SAVE :: tg_gcosf
+
+   TYPE(TVAR), SAVE :: tg_gsint
+   TYPE(TVAR), SAVE :: tg_gsinu
+   TYPE(TVAR), SAVE :: tg_gsinv
+   TYPE(TVAR), SAVE :: tg_gsinf
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_hgr_init(jpi, jpj, jpk, ld_domcfg) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine initialise hgr structure
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      INTEGER(i4), INTENT(IN) :: jpi
+      INTEGER(i4), INTENT(IN) :: jpj
+      INTEGER(i4), INTENT(IN) :: jpk
+      LOGICAL    , INTENT(IN) :: ld_domcfg
+
+      REAL(dp), DIMENSION(jpi,jpj)     :: dl_tmp2D
+      REAL(dp), DIMENSION(jpi,jpj,jpk) :: dl_tmp3D
+      ! loop indices
+      !----------------------------------------------------------------
+      ! variable 2D
+      dl_tmp2D(:,:)  =dp_fill_i1
+
+      tg_ssmask   = var_init('ssmask' ,dl_tmp2D(:,:)  , dd_fill=dp_fill_i1, id_type=NF90_BYTE)
+!      tg_ssumask  = var_init('ssumask',dl_tmp2D(:,:)  , dd_fill=dp_fill_i1, id_type=NF90_BYTE)
+!      tg_ssvmask  = var_init('ssvmask',dl_tmp2D(:,:)  , dd_fill=dp_fill_i1, id_type=NF90_BYTE)
+!      tg_ssfmask  = var_init('ssfmask',dl_tmp2D(:,:)  , dd_fill=dp_fill_i1, id_type=NF90_BYTE)
+
+      dl_tmp2D(:,:)=dp_fill
+
+      tg_glamt    = var_init('glamt',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_glamu    = var_init('glamu',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_glamv    = var_init('glamv',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_glamf    = var_init('glamf',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+
+      tg_gphit    = var_init('gphit',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_gphiu    = var_init('gphiu',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_gphiv    = var_init('gphiv',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_gphif    = var_init('gphif',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+
+      tg_e1t      = var_init('e1t'  ,dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e1u      = var_init('e1u'  ,dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e1v      = var_init('e1v'  ,dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e1f      = var_init('e1f'  ,dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+
+      tg_e2t      = var_init('e2t'  ,dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e2u      = var_init('e2u'  ,dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e2v      = var_init('e2v'  ,dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e2f      = var_init('e2f'  ,dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+
+      tg_ff_t     = var_init('ff_t' ,dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_ff_f     = var_init('ff_f' ,dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+
+      IF( .NOT. ld_domcfg )THEN
+         tg_gcost     =var_init('gcost',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+         tg_gcosu     =var_init('gcosu',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+         tg_gcosv     =var_init('gcosv',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+         tg_gcosf     =var_init('gcosf',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+
+         tg_gsint     =var_init('gsint',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+         tg_gsinu     =var_init('gsinu',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+         tg_gsinv     =var_init('gsinv',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+         tg_gsinf     =var_init('gsinf',dl_tmp2D(:,:)   , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      ENDIF
+
+      ! variable 3D
+      dl_tmp3D(:,:,:)=dp_fill_i1
+
+      tg_tmask   = var_init('tmask'  ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE)
+      tg_umask   = var_init('umask'  ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE)
+      tg_vmask   = var_init('vmask'  ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE)
+      IF( .NOT. ld_domcfg )THEN
+         tg_fmask   = var_init('fmask'  ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE)
+      ENDIF
+      
+!      tg_wmask   = var_init('wmask'  ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE)
+!      tg_wumask  = var_init('wumask' ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE)
+!      tg_wvmask  = var_init('wvmask' ,dl_tmp3D(:,:,:), dd_fill=dp_fill_i1, id_type=NF90_BYTE)
+
+   END SUBROUTINE grid_hgr_init
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_hgr_clean(ld_domcfg) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine clean hgr structure
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      LOGICAL    , INTENT(IN) :: ld_domcfg
+
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+      CALL var_clean(tg_ssmask  )
+
+      CALL var_clean(tg_glamt)
+      CALL var_clean(tg_glamu)
+      CALL var_clean(tg_glamv)
+      CALL var_clean(tg_glamf)
+
+      CALL var_clean(tg_gphit)
+      CALL var_clean(tg_gphiu)
+      CALL var_clean(tg_gphiv)
+      CALL var_clean(tg_gphif)
+
+      CALL var_clean(tg_e1t  )
+      CALL var_clean(tg_e1u  )
+      CALL var_clean(tg_e1v  )
+      CALL var_clean(tg_e1f  )
+
+      CALL var_clean(tg_e2t  )
+      CALL var_clean(tg_e2u  )
+      CALL var_clean(tg_e2v  )
+      CALL var_clean(tg_e2f  )
+
+      CALL var_clean(tg_ff_t )
+      CALL var_clean(tg_ff_f )
+
+      IF( .NOT. ld_domcfg )THEN
+         CALL var_clean(tg_gcost )
+         CALL var_clean(tg_gcosu )
+         CALL var_clean(tg_gcosv )
+         CALL var_clean(tg_gcosf )
+
+         CALL var_clean(tg_gsint )
+         CALL var_clean(tg_gsinu )
+         CALL var_clean(tg_gsinv )
+         CALL var_clean(tg_gsinf )
+      ENDIF
+
+      CALL var_clean(tg_tmask   )
+      CALL var_clean(tg_umask   )
+      CALL var_clean(tg_vmask   )
+      IF( .NOT. ld_domcfg )THEN
+         CALL var_clean(tg_fmask   )
+      ENDIF
+   END SUBROUTINE grid_hgr_clean
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid_hgr_nam(cd_coord, id_perio, cd_namelist) &
+         & RESULT (tf_namh)
+   !-------------------------------------------------------------------
+   !> @brief This function initialise hgr namelist structure
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !> @param[in] cd_coord   
+   !> @param[in] id_perio  
+   !> @param[in] cd_namelist
+   !> @return hgr namelist structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_coord
+      INTEGER(i4)     , INTENT(IN) :: id_perio   
+      CHARACTER(LEN=*), INTENT(IN) :: cd_namelist
+      
+      ! function
+      TYPE(TNAMH)                  :: tf_namh
+
+      ! local variable
+      INTEGER(i4)        :: il_status
+      INTEGER(i4)        :: il_fileid
+
+      LOGICAL            :: ll_exist
+
+      ! loop indices
+      ! namelist
+
+      ! namhgr
+      INTEGER(i4)       :: in_mshhgr   = 0 
+      REAL(dp)          :: dn_ppglam0  = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_ppgphi0  = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_ppe1_deg = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_ppe2_deg = NF90_FILL_DOUBLE
+!      REAL(dp)          :: dn_ppe1_m   = NF90_FILL_DOUBLE
+!      REAL(dp)          :: dn_ppe2_m   = NF90_FILL_DOUBLE
+
+!      ! namcla
+!      INTEGER(i4)       :: in_cla      = 0
+
+      ! namgrd
+!      CHARACTER(LEN=lc) :: cn_cfg      = ''
+      INTEGER(i4)       :: in_cfg      = 0
+      LOGICAL           :: ln_bench    = .FALSE.
+
+      !----------------------------------------------------------------
+      NAMELIST /namhgr/ &  
+      &  in_mshhgr,     &  !< type of horizontal mesh 
+                           !< 0: curvilinear coordinate on the sphere read in coordinate.nc
+                           !< 1: geographical mesh on the sphere with regular grid-spacing
+                           !< 2: f-plane with regular grid-spacing
+                           !< 3: beta-plane with regular grid-spacing
+                           !< 4: Mercator grid with T/U point at the equator
+                           !< 5: beta-plane with regular grid-spacing and rotated domain (GYRE configuration)
+      &  dn_ppglam0,    &  !< longitude of first raw and column T-point (in_mshhgr = 1 or 4)
+      &  dn_ppgphi0,    &  !< latitude  of first raw and column T-point (in_mshhgr = 1 or 4)
+      &  dn_ppe1_deg,   &  !< zonal      grid-spacing (degrees)         (in_mshhgr = 1,2,3 or 4)
+      &  dn_ppe2_deg       !< meridional grid-spacing (degrees)         (in_mshhgr = 1,2,3 or 4)
+!      &  dn_ppe1_m,     &  !< zonal      grid-spacing (degrees)
+!      &  dn_ppe2_m         !< meridional grid-spacing (degrees)
+
+!      NAMELIST /namcla/ &
+!      &  in_cla            !< =1 cross land advection for exchanges through some straits (ORCA2)
+
+      NAMELIST/namgrd/  &  !< orca grid namelist
+!      &  cn_cfg,        &  !< name of the configuration (orca)
+      &  in_cfg,        &  !< resolution of the configuration (2,1,025..)
+      &  ln_bench          !< benchmark parameter (in_mshhgr = 5 ). 
+
+      !----------------------------------------------------------------
+      ! read namelist
+      INQUIRE(FILE=TRIM(cd_namelist), EXIST=ll_exist)
+      IF( ll_exist )THEN
+         
+         il_fileid=fct_getunit()
+
+         OPEN( il_fileid, FILE=TRIM(cd_namelist), &
+            &             FORM='FORMATTED',       &
+            &             ACCESS='SEQUENTIAL',    &
+            &             STATUS='OLD',           &
+            &             ACTION='READ',          &
+            &             IOSTAT=il_status)
+         CALL fct_err(il_status)
+         IF( il_status /= 0 )THEN
+            CALL logger_fatal("GRID HGR NAM: error opening "//&
+               &  TRIM(cd_namelist))
+         ENDIF
+
+         READ( il_fileid, NML = namhgr  )
+!         READ( il_fileid, NML = namcla  )
+!         READ( il_fileid, NML = namgrd  )
+
+         CLOSE( il_fileid, IOSTAT=il_status )
+         CALL fct_err(il_status)
+         IF( il_status /= 0 )THEN
+            CALL logger_error("GRID HGR NAM: closing "//TRIM(cd_namelist))
+         ENDIF
+        
+         tf_namh%c_coord   = TRIM(cd_coord)
+         tf_namh%i_perio   = id_perio
+
+         tf_namh%i_mshhgr  = in_mshhgr
+         tf_namh%d_ppglam0 = dn_ppglam0
+         tf_namh%d_ppgphi0 = dn_ppgphi0
+
+         tf_namh%d_ppe1_deg= dn_ppe1_deg
+         tf_namh%d_ppe2_deg= dn_ppe2_deg
+!         tf_namh%d_ppe1_m  = dn_ppe1_m
+!         tf_namh%d_ppe2_m  = dn_ppe2_m
+
+!         tf_namh%i_cla     = in_cla
+
+!         tf_namh%c_cfg     = TRIM(cn_cfg)
+         tf_namh%i_cfg     = in_cfg
+         tf_namh%l_bench   = ln_bench
+
+      ELSE
+
+         CALL logger_fatal(" GRID HGR NAM: can't find "//TRIM(cd_namelist))
+
+      ENDIF
+
+   END FUNCTION grid_hgr_nam
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_hgr_fill(td_nam, jpi, jpj, ld_domcfg) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill horizontal mesh (hgr structure)
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TNAMH), INTENT(IN) :: td_nam
+      INTEGER(i4), INTENT(IN) :: jpi
+      INTEGER(i4), INTENT(IN) :: jpj
+      LOGICAL    , INTENT(IN) :: ld_domcfg
+
+      ! local variable
+      REAL(dp)    :: znorme
+      ! loop indices
+      !----------------------------------------------------------------
+      CALL logger_info('GRID HGR FILL : define the horizontal mesh from the'//&
+      &  ' type of horizontal mesh mshhgr = '//TRIM(fct_str(td_nam%i_mshhgr)))
+      IF( td_nam%i_mshhgr == 1 )THEN
+         CALL logger_info('   position of the first row and     ppglam0  = '//&
+            &  TRIM(fct_str(td_nam%d_ppglam0  )) )
+         CALL logger_info('   column grid-point (degrees)       ppgphi0  = '//&
+            &  TRIM(fct_str(td_nam%d_ppgphi0  )) )
+      ELSEIF( td_nam%i_mshhgr == 2 .OR. td_nam%i_mshhgr == 3  )THEN
+         CALL logger_info('   zonal      grid-spacing (degrees) ppe1_deg = '//&
+            &  TRIM(fct_str(td_nam%d_ppe1_deg )) )
+         CALL logger_info('   meridional grid-spacing (degrees) ppe2_deg = '//&
+            &  TRIM(fct_str(td_nam%d_ppe2_deg )) )
+!         CALL logger_info('   zonal      grid-spacing (meters)  ppe1_m   = '//&
+!            &  TRIM(fct_str(td_nam%d_ppe1_m   )) ) 
+!         CALL logger_info('   meridional grid-spacing (meters)  ppe2_m   = '//&
+!            &  TRIM(fct_str(td_nam%d_ppe2_m   )) ) 
+      ENDIF
+
+      SELECT CASE( td_nam%i_mshhgr ) ! type of horizontal mesh
+
+         CASE(0)   !  curvilinear coordinate on the sphere read in coordinate.nc file
+
+            CALL grid_hgr__fill_curv(td_nam)!,jpi,jpj)
+
+         CASE(1)   ! geographical mesh on the sphere with regular grid-spacing
+
+            CALL grid_hgr__fill_reg(td_nam,jpi,jpj)
+
+         CASE(2:3) ! f- or beta-plane with regular grid-spacing
+
+            CALL grid_hgr__fill_plan(td_nam,jpi,jpj)
+
+         CASE(4)   ! geographical mesh on the sphere, isotropic MERCATOR type
+
+            CALL grid_hgr__fill_merc(td_nam,jpi,jpj)
+
+         CASE(5)   ! beta-plane with regular grid-spacing and rotated domain (GYRE configuration)
+
+            CALL grid_hgr__fill_gyre(td_nam,jpi,jpj)
+
+         CASE DEFAULT
+
+            CALL logger_fatal('GRID HGR FILL : bad flag value for mshhgr = '//&
+               &  TRIM(fct_str(td_nam%i_mshhgr)))
+
+      END SELECT
+
+      ! No Useful associated horizontal metrics
+      ! ---------------------------------------
+
+      ! create coriolis factor
+      CALL grid_hgr__fill_coriolis(td_nam,jpi)!,jpj)
+     
+      ! Control of domain for symetrical condition
+      ! ------------------------------------------
+      ! The equator line must be the latitude coordinate axe
+
+      IF( td_nam%i_perio == 2 ) THEN
+         znorme = SQRT( SUM(tg_gphiu%d_value(:,2,1,1)*tg_gphiu%d_value(:,2,1,1)) ) / FLOAT( jpi )
+         IF( znorme > 1.e-13 )THEN
+            CALL logger_fatal( ' ===>>>> : symmetrical condition: rerun with good equator line' )
+         ENDIF
+      ENDIF
+
+      ! compute angles between model grid lines and the North direction
+      ! ---------------------------------------------------------------
+      IF( .NOT. ld_domcfg )THEN
+         CALL grid_hgr__angle(td_nam,jpi,jpj) 
+      ENDIF
+
+   END SUBROUTINE grid_hgr_fill
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_hgr__fill_curv(td_nam)!,jpi,jpj) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill horizontal mesh (hgr structure)
+   !> for case of curvilinear coordinate on the sphere read in coordinate.nc file
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !> @date October, 2016
+   !> - do not use anymore special case for ORCA grid
+   !>
+   !> @param[in] td_nam
+   ! @param[in] jpi
+   ! @param[in] jpj   
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TNAMH), INTENT(IN) :: td_nam
+!      INTEGER(i4), INTENT(IN) :: jpi
+!      INTEGER(i4), INTENT(IN) :: jpj
+
+      ! local variable
+!      INTEGER(i4) :: ii0, ii1, ij0, ij1   ! temporary integers
+!      INTEGER(i4) :: isrow                ! index for ORCA1 starting row
+
+      TYPE(TMPP)  :: tl_coord
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! read coordinates
+      ! open file
+      IF( td_nam%c_coord /= '' )THEN
+         tl_coord=mpp_init( file_init(TRIM(td_nam%c_coord)), id_perio=td_nam%i_perio)
+         CALL grid_get_info(tl_coord)
+      ELSE
+         CALL logger_fatal("GRID HGR FILL: no input coordinates file found. "//&
+         &     "check namelist")      
+      ENDIF
+
+      CALL iom_mpp_open( tl_coord )
+
+      ! read variable in coordinates
+      tg_glamt=iom_mpp_read_var(tl_coord, 'glamt')
+      tg_glamu=iom_mpp_read_var(tl_coord, 'glamu')
+      tg_glamv=iom_mpp_read_var(tl_coord, 'glamv')
+      tg_glamf=iom_mpp_read_var(tl_coord, 'glamf')
+
+      tg_gphit=iom_mpp_read_var(tl_coord, 'gphit')
+      tg_gphiu=iom_mpp_read_var(tl_coord, 'gphiu')
+      tg_gphiv=iom_mpp_read_var(tl_coord, 'gphiv')
+      tg_gphif=iom_mpp_read_var(tl_coord, 'gphif')
+
+      ! force output type
+      tg_glamt%i_type=NF90_DOUBLE
+      tg_glamu%i_type=NF90_DOUBLE
+      tg_glamv%i_type=NF90_DOUBLE
+      tg_glamf%i_type=NF90_DOUBLE
+
+      tg_gphit%i_type=NF90_DOUBLE
+      tg_gphiu%i_type=NF90_DOUBLE
+      tg_gphiv%i_type=NF90_DOUBLE
+      tg_gphif%i_type=NF90_DOUBLE
+
+      tg_e1t  =iom_mpp_read_var(tl_coord, 'e1t')
+      tg_e1u  =iom_mpp_read_var(tl_coord, 'e1u')
+      tg_e1v  =iom_mpp_read_var(tl_coord, 'e1v')
+      tg_e1f  =iom_mpp_read_var(tl_coord, 'e1f')
+
+      tg_e2t  =iom_mpp_read_var(tl_coord, 'e2t')
+      tg_e2u  =iom_mpp_read_var(tl_coord, 'e2u')
+      tg_e2v  =iom_mpp_read_var(tl_coord, 'e2v')
+      tg_e2f  =iom_mpp_read_var(tl_coord, 'e2f')
+
+      CALL iom_mpp_close( tl_coord )
+      ! clean
+      CALL mpp_clean(tl_coord)
+
+      !! WARNING extended grid have to be correctly fill
+
+!      !! special case for ORCA grid
+!      ! ORCA R2 configuration
+!      IF( TRIM(td_nam%c_cfg) == "orca" .AND. td_nam%i_cfg == 2 ) THEN
+!            IF( td_nam%i_cla == 0 ) THEN
+!               !
+!               ! Gibraltar Strait (e2u = 20 km)
+!               ii0 = 139   ;   ii1 = 140
+!               ij0 = 102   ;   ij1 = 102   
+!               ! e2u = 20 km
+!               tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) =  20.e3
+!               CALL logger_info('orca_r2: Gibraltar    : e2u reduced to 20 km')
+!               !
+!               ! Bab el Mandeb (e2u = 18 km)
+!               ii0 = 160   ;   ii1 = 160 
+!               ij0 =  88   ;   ij1 =  88   
+!               ! e1v = 18 km
+!               tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) =  18.e3
+!               ! e2u = 30 km
+!               tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) =  30.e3
+!
+!               CALL logger_info('orca_r2: Bab el Mandeb: e2u reduced to 30 km')
+!               CALL logger_info('e1v reduced to 18 km')
+!            ENDIF
+!            ! Danish Straits
+!            ii0 = 145   ;   ii1 = 146
+!            ij0 = 116   ;   ij1 = 116   
+!            ! e2u = 10 km
+!            tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) =  10.e3
+!            CALL logger_info('orca_r2: Danish Straits : e2u reduced to 10 km')
+!      ENDIF
+!
+!      ! ORCA R1 configuration
+!      IF( TRIM(td_nam%c_cfg) == "orca" .AND. td_nam%i_cfg == 1 ) THEN
+!         ! This dirty section will be suppressed by simplification process: all this will come back in input files
+!         ! Currently these hard-wired indices relate to configuration with
+!         ! extend grid (jpjglo=332)
+!         ! which had a grid-size of 362x292.
+!
+!         isrow = 332 - jpj
+!
+!         ! Gibraltar Strait (e2u = 20 km)
+!         ii0 = 282           ;   ii1 = 283
+!         ij0 = 201 + isrow   ;   ij1 = 241 - isrow 
+!         ! e2u = 20 km
+!         tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) =  20.e3
+!         CALL logger_info('orca_r1: Gibraltar : e2u reduced to 20 km')
+!
+!         ! Bhosporus Strait (e2u = 10 km)
+!         ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait (e2u = 10 km)
+!         ij0 = 208 + isrow   ;   ij1 = 248 - isrow
+!         ! Bhosporus Strait (e2u = 10 km)
+!         tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) =  10.e3
+!         CALL logger_info('orca_r1: Bhosporus : e2u reduced to 10 km')
+!
+!         ! Lombok Strait (e1v = 13 km)
+!         ii0 =  44           ;   ii1 =  44        ! Lombok Strait (e1v = 13 km)
+!         ij0 = 124 + isrow   ;   ij1 = 165 - isrow
+!         ! Lombok Strait (e1v = 13 km)
+!         tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) =  13.e3
+!         CALL logger_info('orca_r1: Lombok : e1v reduced to 10 km')
+!
+!         ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on]
+!         ii0 =  48           ;   ii1 =  48        ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on]
+!         ij0 = 124 + isrow   ;   ij1 = 165 - isrow
+!         ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on]
+!         tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) =  8.e3
+!         CALL logger_info('orca_r1: Sumba : e1v reduced to 8 km')
+!
+!         ! Ombai Strait (e1v = 13 km)
+!         ii0 =  53           ;   ii1 =  53        ! Ombai Strait (e1v = 13 km)
+!         ij0 = 124 + isrow   ;   ij1 = 165 - isrow
+!         ! Ombai Strait (e1v = 13 km)
+!         tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 13.e3
+!         CALL logger_info('orca_r1: Ombai : e1v reduced to 13 km')
+!
+!         ! Timor Passage (e1v = 20 km)
+!         ii0 =  56           ;   ii1 =  56        ! Timor Passage (e1v = 20 km)
+!         ij0 = 124 + isrow   ;   ij1 = 145 - isrow
+!         ! Timor Passage (e1v = 20 km)
+!         tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 20.e3
+!         CALL logger_info('orca_r1: Timor Passage : e1v reduced to 20 km')
+!
+!          ! West Halmahera Strait (e1v = 30 km)
+!         ii0 =  55           ;   ii1 =  55        ! West Halmahera Strait (e1v = 30 km)
+!         ij0 = 141 + isrow   ;   ij1 = 182 - isrow
+!         ! West Halmahera Strait (e1v = 30 km)
+!         tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 30.e3
+!         CALL logger_info('orca_r1: W Halmahera : e1v reduced to 30 km')
+!
+!         ! East Halmahera Strait (e1v = 50 km)
+!         ii0 =  58           ;   ii1 =  58        ! East Halmahera Strait (e1v = 50 km)
+!         ij0 = 141 + isrow   ;   ij1 = 182 - isrow
+!         ! East Halmahera Strait (e1v = 50 km)
+!         tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) = 50.e3
+!         CALL logger_info('orca_r1: E Halmahera : e1v reduced to 50 km')
+!
+!      ENDIF
+!
+!      ! ORCA R05 configuration
+!      IF( TRIM(td_nam%c_cfg) == "orca" .AND. td_nam%i_cfg == 05 ) THEN
+!
+!         ! Gibraltar Strait (e2u = 20 km)
+!         ii0 = 563   ;   ii1 = 564        ! Gibraltar Strait (e2u = 20 km)
+!         ij0 = 327   ;   ij1 = 327
+!         ! Gibraltar Strait (e2u = 20 km)
+!         tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) =  20.e3
+!         CALL logger_info('orca_r05: Reduced e2u at the Gibraltar Strait')
+!         !
+!         ! Bosphore Strait (e2u = 10 km)
+!         ii0 = 627   ;   ii1 = 628        ! Bosphore Strait (e2u = 10 km)
+!         ij0 = 343   ;   ij1 = 343
+!         ! Bosphore Strait (e2u = 10 km)
+!         tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) =  10.e3
+!         CALL logger_info('orca_r05: Reduced e2u at the Bosphore Strait')
+!         !
+!         ! Sumba Strait (e2u = 40 km)
+!         ii0 =  93   ;   ii1 =  94        ! Sumba Strait (e2u = 40 km)
+!         ij0 = 232   ;   ij1 = 232
+!         ! Sumba Strait (e2u = 40 km)
+!         tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) =  40.e3
+!         CALL logger_info('orca_r05: Reduced e2u at the Sumba Strait')
+!         !
+!         ! Ombai Strait (e2u = 15 km)
+!         ii0 = 103   ;   ii1 = 103        ! Ombai Strait (e2u = 15 km)
+!         ij0 = 232   ;   ij1 = 232
+!         ! Ombai Strait (e2u = 15 km)
+!         tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) =  15.e3
+!         CALL logger_info('orca_r05: Reduced e2u at the Ombai Strait')
+!         !
+!         ! Palk Strait (e2u = 10 km)
+!         ii0 =  15   ;   ii1 =  15        ! Palk Strait (e2u = 10 km)
+!         ij0 = 270   ;   ij1 = 270
+!         ! Palk Strait (e2u = 10 km)
+!         tg_e2u%d_value(ii0:ii1,ij0:ij1,1,1) =  10.e3
+!         CALL logger_info('orca_r05: Reduced e2u at the Palk Strait')
+!         !
+!         ! Lombok Strait (e1v = 10 km)
+!         ii0 =  87   ;   ii1 =  87        ! Lombok Strait (e1v = 10 km)
+!         ij0 = 232   ;   ij1 = 233
+!         ! Lombok Strait (e1v = 10 km)
+!         tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) =  10.e3
+!         CALL logger_info('orca_r05: Reduced e1v at the Lombok Strait')
+!         !
+!         !
+!         ! Bab el Mandeb (e1v = 25 km)
+!         ii0 = 662   ;   ii1 = 662        ! Bab el Mandeb (e1v = 25 km)
+!         ij0 = 276   ;   ij1 = 276
+!         ! Bab el Mandeb (e1v = 25 km)
+!         tg_e1v%d_value(ii0:ii1,ij0:ij1,1,1) =  25.e3
+!         CALL logger_info('orca_r05: Reduced e1v at the Bab el Mandeb')
+!
+!      ENDIF
+
+   END SUBROUTINE grid_hgr__fill_curv
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_hgr__fill_reg(td_nam, jpi, jpj) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill horizontal mesh (hgr structure)
+   !> for case of geographical mesh on the sphere with regular grid-spacing
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj   
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TNAMH), INTENT(IN) :: td_nam
+      INTEGER(i4), INTENT(IN) :: jpi
+      INTEGER(i4), INTENT(IN) :: jpj
+
+      ! local variable
+      REAL(dp)   ::   zti, zui, zvi, zfi   ! local scalars
+      REAL(dp)   ::   ztj, zuj, zvj, zfj   !
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      CALL logger_info('GRID HGR FILL : geographical mesh on the sphere with'//&
+         &  ' regular grid-spacing given by ppe1_deg and ppe2_deg')
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zti = FLOAT( ji - 1 )         ;   ztj = FLOAT( jj - 1 )
+            zui = FLOAT( ji - 1 ) + 0.5   ;   zuj = FLOAT( jj - 1 )
+            zvi = FLOAT( ji - 1 )         ;   zvj = FLOAT( jj - 1 ) + 0.5
+            zfi = FLOAT( ji - 1 ) + 0.5   ;   zfj = FLOAT( jj - 1 ) + 0.5
+      ! Longitude
+            tg_glamt%d_value(ji,jj,1,1) = td_nam%d_ppglam0 + td_nam%d_ppe1_deg * zti
+            tg_glamu%d_value(ji,jj,1,1) = td_nam%d_ppglam0 + td_nam%d_ppe1_deg * zui
+            tg_glamv%d_value(ji,jj,1,1) = td_nam%d_ppglam0 + td_nam%d_ppe1_deg * zvi
+            tg_glamf%d_value(ji,jj,1,1) = td_nam%d_ppglam0 + td_nam%d_ppe1_deg * zfi
+      ! Latitude
+            tg_gphit%d_value(ji,jj,1,1) = td_nam%d_ppgphi0 + td_nam%d_ppe2_deg * ztj
+            tg_gphiu%d_value(ji,jj,1,1) = td_nam%d_ppgphi0 + td_nam%d_ppe2_deg * zuj
+            tg_gphiv%d_value(ji,jj,1,1) = td_nam%d_ppgphi0 + td_nam%d_ppe2_deg * zvj
+            tg_gphif%d_value(ji,jj,1,1) = td_nam%d_ppgphi0 + td_nam%d_ppe2_deg * zfj
+      ! e1
+            tg_e1t%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * COS( dp_deg2rad * tg_gphit%d_value(ji,jj,1,1) ) * td_nam%d_ppe1_deg
+            tg_e1u%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * COS( dp_deg2rad * tg_gphiu%d_value(ji,jj,1,1) ) * td_nam%d_ppe1_deg
+            tg_e1v%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * COS( dp_deg2rad * tg_gphiv%d_value(ji,jj,1,1) ) * td_nam%d_ppe1_deg
+            tg_e1f%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * COS( dp_deg2rad * tg_gphif%d_value(ji,jj,1,1) ) * td_nam%d_ppe1_deg
+      ! e2
+            tg_e2t%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * td_nam%d_ppe2_deg
+            tg_e2u%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * td_nam%d_ppe2_deg
+            tg_e2v%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * td_nam%d_ppe2_deg
+            tg_e2f%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * td_nam%d_ppe2_deg
+         END DO
+      END DO
+
+   END SUBROUTINE grid_hgr__fill_reg
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_hgr__fill_plan(td_nam, jpi, jpj) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill horizontal mesh (hgr structure)
+   !> for case of f- or beta-plane with regular grid-spacing
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj   
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TNAMH), INTENT(IN) :: td_nam
+      INTEGER(i4), INTENT(IN) :: jpi
+      INTEGER(i4), INTENT(IN) :: jpj
+
+      ! local variable
+      REAL(dp)    :: dl_glam0
+      REAL(dp)    :: dl_gphi0
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      CALL logger_info('GRID HGR FILL : f- or beta-plane with regular'//&
+         &  ' grid-spacing given by ppe1_deg and ppe2_deg')
+!         &  ' grid-spacing given by ppe1_m and ppe2_m')
+
+      ! Position coordinates (in kilometers)
+      !                          ==========
+      dl_glam0 = 0.e0
+      dl_gphi0 = - td_nam%d_ppe2_deg * 1.e-3
+!      dl_gphi0 = - td_nam%d_ppe2_m * 1.e-3
+
+         !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+!            tg_glamt%d_value(ji,jj,1,1) = dl_glam0 + td_nam%d_ppe1_m * 1.e-3 * ( FLOAT( ji - 1 )       )
+!            tg_glamu%d_value(ji,jj,1,1) = dl_glam0 + td_nam%d_ppe1_m * 1.e-3 * ( FLOAT( ji - 1 ) + 0.5 )
+            tg_glamt%d_value(ji,jj,1,1) = dl_glam0 + td_nam%d_ppe1_deg * 1.e-3 * ( FLOAT( ji - 1 )       )
+            tg_glamu%d_value(ji,jj,1,1) = dl_glam0 + td_nam%d_ppe1_deg * 1.e-3 * ( FLOAT( ji - 1 ) + 0.5 )
+            tg_glamv%d_value(ji,jj,1,1) = tg_glamt%d_value(ji,jj,1,1)
+            tg_glamf%d_value(ji,jj,1,1) = tg_glamu%d_value(ji,jj,1,1)
+   
+            !tg_gphit%d_value(ji,jj,1,1) = dl_gphi0 + td_nam%d_ppe2_m * 1.e-3 * ( FLOAT( jj - 1 )       )
+            tg_gphit%d_value(ji,jj,1,1) = dl_gphi0 + td_nam%d_ppe2_deg * 1.e-3 * ( FLOAT( jj - 1 )       )
+            tg_gphiu%d_value(ji,jj,1,1) = tg_gphit%d_value(ji,jj,1,1)
+            !tg_gphiv%d_value(ji,jj,1,1) = dl_gphi0 + td_nam%d_ppe2_m * 1.e-3 * ( FLOAT( jj - 1 ) + 0.5 )
+            tg_gphiv%d_value(ji,jj,1,1) = dl_gphi0 + td_nam%d_ppe2_deg * 1.e-3 * ( FLOAT( jj - 1 ) + 0.5 )
+            tg_gphif%d_value(ji,jj,1,1) = tg_gphiv%d_value(ji,jj,1,1)
+         END DO
+      END DO
+
+      ! Horizontal scale factors (in meters)
+      !                              ======
+!      tg_e1t%d_value(:,:,1,1) = td_nam%d_ppe1_m      
+!      tg_e1u%d_value(:,:,1,1) = td_nam%d_ppe1_m      
+!      tg_e1v%d_value(:,:,1,1) = td_nam%d_ppe1_m      
+!      tg_e1f%d_value(:,:,1,1) = td_nam%d_ppe1_m      
+      tg_e1t%d_value(:,:,1,1) = td_nam%d_ppe1_deg      
+      tg_e1u%d_value(:,:,1,1) = td_nam%d_ppe1_deg      
+      tg_e1v%d_value(:,:,1,1) = td_nam%d_ppe1_deg      
+      tg_e1f%d_value(:,:,1,1) = td_nam%d_ppe1_deg      
+
+!      tg_e2t%d_value(:,:,1,1) = td_nam%d_ppe2_m
+!      tg_e2u%d_value(:,:,1,1) = td_nam%d_ppe2_m
+!      tg_e2v%d_value(:,:,1,1) = td_nam%d_ppe2_m
+!      tg_e2f%d_value(:,:,1,1) = td_nam%d_ppe2_m
+      tg_e2t%d_value(:,:,1,1) = td_nam%d_ppe2_deg
+      tg_e2u%d_value(:,:,1,1) = td_nam%d_ppe2_deg
+      tg_e2v%d_value(:,:,1,1) = td_nam%d_ppe2_deg
+      tg_e2f%d_value(:,:,1,1) = td_nam%d_ppe2_deg
+
+   END SUBROUTINE grid_hgr__fill_plan
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_hgr__fill_merc(td_nam, jpi, jpj) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill horizontal mesh (hgr structure)
+   !> for case of geographical mesh on the sphere, isotropic MERCATOR type
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj   
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TNAMH), INTENT(IN) :: td_nam
+      INTEGER(i4), INTENT(IN) :: jpi
+      INTEGER(i4), INTENT(IN) :: jpj
+
+      ! local variable
+      INTEGER  ::   ijeq                 ! index of equator T point (used in case 4)
+
+      REAL(dp) ::   zti, zui, zvi, zfi   ! local scalars
+      REAL(dp) ::   ztj, zuj, zvj, zfj   !
+      REAL(dp) ::   zarg
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      CALL logger_info('GRID HGR FILL : geographical mesh on the sphere, '//&
+        &  'MERCATOR type longitudinal/latitudinal spacing given by ppe1_deg')
+
+      IF( td_nam%d_ppgphi0 == -90 )THEN
+         CALL logger_fatal(' Mercator grid cannot start at south pole !!!! ' )
+      ENDIF
+
+      !  Find index corresponding to the equator, given the grid spacing e1_deg
+      !  and the (approximate) southern latitude ppgphi0.
+      !  This way we ensure that the equator is at a "T / U" point, when in the domain.
+      !  The formula should work even if the equator is outside the domain.
+      zarg = dp_pi / 4. - dp_pi / 180. * td_nam%d_ppgphi0 / 2.
+      ijeq = ABS( 180./dp_pi * LOG( COS( zarg ) / SIN( zarg ) ) / td_nam%d_ppe1_deg )
+      IF( td_nam%d_ppgphi0 > 0 )  ijeq = -ijeq
+
+      CALL logger_info('Index of the equator on the MERCATOR grid: '//TRIM(fct_str(ijeq)))
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zti = FLOAT( ji - 1 )         ;   ztj = FLOAT( jj - ijeq )
+            zui = FLOAT( ji - 1 ) + 0.5   ;   zuj = FLOAT( jj - ijeq )
+            zvi = FLOAT( ji - 1 )         ;   zvj = FLOAT( jj - ijeq ) + 0.5
+            zfi = FLOAT( ji - 1 ) + 0.5   ;   zfj = FLOAT( jj - ijeq ) + 0.5
+         ! Longitude
+            tg_glamt%d_value(ji,jj,1,1) = td_nam%d_ppglam0 + td_nam%d_ppe1_deg * zti
+            tg_glamu%d_value(ji,jj,1,1) = td_nam%d_ppglam0 + td_nam%d_ppe1_deg * zui
+            tg_glamv%d_value(ji,jj,1,1) = td_nam%d_ppglam0 + td_nam%d_ppe1_deg * zvi
+            tg_glamf%d_value(ji,jj,1,1) = td_nam%d_ppglam0 + td_nam%d_ppe1_deg * zfi
+         ! Latitude
+            tg_gphit%d_value(ji,jj,1,1) = 1./dp_deg2rad * ASIN ( TANH( td_nam%d_ppe1_deg *dp_deg2rad* ztj ) )
+            tg_gphiu%d_value(ji,jj,1,1) = 1./dp_deg2rad * ASIN ( TANH( td_nam%d_ppe1_deg *dp_deg2rad* zuj ) )
+            tg_gphiv%d_value(ji,jj,1,1) = 1./dp_deg2rad * ASIN ( TANH( td_nam%d_ppe1_deg *dp_deg2rad* zvj ) )
+            tg_gphif%d_value(ji,jj,1,1) = 1./dp_deg2rad * ASIN ( TANH( td_nam%d_ppe1_deg *dp_deg2rad* zfj ) )
+         ! e1
+            tg_e1t%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * COS( dp_deg2rad * tg_gphit%d_value(ji,jj,1,1) ) * td_nam%d_ppe1_deg
+            tg_e1u%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * COS( dp_deg2rad * tg_gphiu%d_value(ji,jj,1,1) ) * td_nam%d_ppe1_deg
+            tg_e1v%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * COS( dp_deg2rad * tg_gphiv%d_value(ji,jj,1,1) ) * td_nam%d_ppe1_deg
+            tg_e1f%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * COS( dp_deg2rad * tg_gphif%d_value(ji,jj,1,1) ) * td_nam%d_ppe1_deg
+         ! e2
+            tg_e2t%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * COS( dp_deg2rad * tg_gphit%d_value(ji,jj,1,1) ) * td_nam%d_ppe1_deg
+            tg_e2u%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * COS( dp_deg2rad * tg_gphiu%d_value(ji,jj,1,1) ) * td_nam%d_ppe1_deg
+            tg_e2v%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * COS( dp_deg2rad * tg_gphiv%d_value(ji,jj,1,1) ) * td_nam%d_ppe1_deg
+            tg_e2f%d_value(ji,jj,1,1) = dp_rearth * dp_deg2rad * COS( dp_deg2rad * tg_gphif%d_value(ji,jj,1,1) ) * td_nam%d_ppe1_deg
+         END DO
+      END DO
+
+   END SUBROUTINE grid_hgr__fill_merc
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_hgr__fill_gyre(td_nam, jpi, jpj) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill horizontal mesh (hgr structure)
+   !> for case of beta-plane with regular grid-spacing and rotated domain (GYRE configuration)
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TNAMH), INTENT(IN) :: td_nam
+      INTEGER(i4), INTENT(IN) :: jpi
+      INTEGER(i4), INTENT(IN) :: jpj
+
+      ! local variable
+      REAL(dp) ::   zlam1, zcos_alpha, zim1 , zjm1 , ze1, ze1deg
+      REAL(dp) ::   zphi1, zsin_alpha, zim05, zjm05
+
+      REAL(dp) ::   dl_glam0
+      REAL(dp) ::   dl_gphi0
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      CALL logger_info('GRID HGR FILL : beta-plane with regular grid-spacing '//&
+         &  'and rotated domain (GYRE configuration)')
+
+      ! Position coordinates (in kilometers)
+      !
+      ! angle 45deg and ze1=106.e+3 / jp_cfg forced -> zlam1 = -85deg, zphi1 = 29degN
+      zlam1 = -85
+      zphi1 = 29
+      ! resolution in meters
+      ze1 = 106000. / FLOAT(td_nam%i_cfg)            
+      ! benchmark: forced the resolution to be about 100 km
+      IF( td_nam%l_bench )   ze1 = 106000.e0     
+      zsin_alpha = - SQRT( 2. ) / 2.
+      zcos_alpha =   SQRT( 2. ) / 2.
+      ze1deg = ze1 / (dp_rearth * dp_deg2rad)
+      dl_glam0 = zlam1 + zcos_alpha * ze1deg * FLOAT( jpj-2 )
+      dl_gphi0 = zphi1 + zsin_alpha * ze1deg * FLOAT( jpj-2 )
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zim1 = FLOAT( ji - 1 )   ;   zim05 = FLOAT( ji ) - 1.5
+            zjm1 = FLOAT( jj - 1 )   ;   zjm05 = FLOAT( jj ) - 1.5
+
+            tg_glamf%d_value(ji,jj,1,1) = dl_glam0 &
+                                        &  + zim1  * ze1deg * zcos_alpha &
+                                        &  + zjm1  * ze1deg * zsin_alpha
+            tg_gphif%d_value(ji,jj,1,1) = dl_gphi0 &
+                                        & - zim1  * ze1deg * zsin_alpha &
+                                        & + zjm1  * ze1deg * zcos_alpha
+
+            tg_glamt%d_value(ji,jj,1,1) = dl_glam0 &
+                                        & + zim05 * ze1deg * zcos_alpha &
+                                        & + zjm05 * ze1deg * zsin_alpha
+            tg_gphit%d_value(ji,jj,1,1) = dl_gphi0 &
+                                        & - zim05 * ze1deg * zsin_alpha &
+                                        & + zjm05 * ze1deg * zcos_alpha
+
+            tg_glamu%d_value(ji,jj,1,1) = dl_glam0 &
+                                        & + zim1  * ze1deg * zcos_alpha &
+                                        & + zjm05 * ze1deg * zsin_alpha
+            tg_gphiu%d_value(ji,jj,1,1) = dl_gphi0 & 
+                                        & - zim1  * ze1deg * zsin_alpha &
+                                        & + zjm05 * ze1deg * zcos_alpha
+
+            tg_glamv%d_value(ji,jj,1,1) = dl_glam0 &
+                                        & + zim05 * ze1deg * zcos_alpha &
+                                        & + zjm1  * ze1deg * zsin_alpha
+            tg_gphiv%d_value(ji,jj,1,1) = dl_gphi0 &
+                                        & - zim05 * ze1deg * zsin_alpha &
+                                        & + zjm1  * ze1deg * zcos_alpha
+
+         END DO
+      END DO
+
+      ! Horizontal scale factors (in meters)
+      !                              ======
+      tg_e1t%d_value(:,:,1,1) = ze1      
+      tg_e1u%d_value(:,:,1,1) = ze1      
+      tg_e1v%d_value(:,:,1,1) = ze1      
+      tg_e1f%d_value(:,:,1,1) = ze1      
+
+      tg_e2t%d_value(:,:,1,1) = ze1
+      tg_e2u%d_value(:,:,1,1) = ze1
+      tg_e2v%d_value(:,:,1,1) = ze1
+      tg_e2f%d_value(:,:,1,1) = ze1
+
+   END SUBROUTINE grid_hgr__fill_gyre
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_hgr__fill_coriolis(td_nam, jpi)!,jpj) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill coriolis factor
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !> @date October, 2016
+   !> - compute coriolis factor at f-point and at t-point
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   ! @param[in] jpj
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TNAMH), INTENT(IN) :: td_nam
+      INTEGER(i4), INTENT(IN) :: jpi
+!      INTEGER(i4), INTENT(IN) :: jpj
+
+      ! local variable
+      REAL(dp) :: zbeta
+      REAL(dp) :: zphi0  
+      REAL(dp) :: zf0
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      !  Coriolis factor
+      SELECT CASE( td_nam%i_mshhgr )   ! type of horizontal mesh
+
+         CASE ( 0, 1, 4 ) ! mesh on the sphere
+
+            tg_ff_f%d_value(:,:,1,1) = 2. * dp_omega * SIN(dp_deg2rad * tg_gphif%d_value(:,:,1,1))
+            tg_ff_t%d_value(:,:,1,1) = 2. * dp_omega * SIN(dp_deg2rad * tg_gphit%d_value(:,:,1,1)) ! at t-point
+
+         CASE ( 2 )  ! f-plane at ppgphi0 
+
+            tg_ff_f%d_value(:,:,1,1) = 2. * dp_omega * SIN( dp_deg2rad * td_nam%d_ppgphi0 )
+            tg_ff_t%d_value(:,:,1,1) = 2. * dp_omega * SIN( dp_deg2rad * td_nam%d_ppgphi0 )
+            CALL logger_info('f-plane: Coriolis parameter = constant = '//&
+               &  TRIM(fct_str(tg_ff_f%d_value(1,1,1,1))) )
+
+         CASE ( 3 )  ! beta-plane
+
+            ! beta at latitude ppgphi0
+            zbeta = 2. * dp_omega * COS( dp_deg2rad * td_nam%d_ppgphi0 ) / dp_rearth
+            ! latitude of the first row F-points
+!            zphi0 = td_nam%d_ppgphi0 - FLOAT( jpi/2 ) * td_nam%d_ppe2_m / ( dp_rearth * dp_deg2rad )
+            zphi0 = td_nam%d_ppgphi0 - FLOAT( jpi/2 ) * td_nam%d_ppe2_deg / ( dp_rearth * dp_deg2rad )
+
+            ! compute f0 1st point south
+            zf0 = 2. * dp_omega * SIN( dp_deg2rad * zphi0 )
+            ! f = f0 +beta* y ( y=0 at south)
+            tg_ff_f%d_value(:,:,1,1) = zf0 + zbeta * tg_gphif%d_value(:,:,1,1) * 1.e3
+            tg_ff_t%d_value(:,:,1,1) = zf0 + zbeta * tg_gphit%d_value(:,:,1,1) * 1.e3
+
+         CASE ( 5 )  ! beta-plane and rotated domain (gyre configuration)
+
+            ! beta at latitude ppgphi0
+            zbeta = 2. * dp_omega * COS( dp_deg2rad * td_nam%d_ppgphi0 ) / dp_rearth
+            ! latitude of the first row F-points
+            zphi0 = 15.e0
+            ! compute f0 1st point south
+            zf0   = 2. * dp_omega * SIN( dp_deg2rad * zphi0 )
+
+            ! f = f0 +beta* y ( y=0 at south)
+            tg_ff_f%d_value(:,:,1,1) = ( zf0 + zbeta * ABS( tg_gphif%d_value(:,:,1,1) - zphi0 ) &
+                                     & * dp_deg2rad * dp_rearth )
+            tg_ff_t%d_value(:,:,1,1) = ( zf0 + zbeta * ABS( tg_gphit%d_value(:,:,1,1) - zphi0 ) &
+                                     & * dp_deg2rad * dp_rearth )
+
+      END SELECT
+
+   END SUBROUTINE grid_hgr__fill_coriolis
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_hgr__angle(td_nam, jpi, jpj)
+   !!----------------------------------------------------------------------
+   !> @brief This subroutine compute angles between model grid lines and the North direction
+   !>
+   !> @details
+   !> ** Method  :
+   !>
+   !> ** Action  :   Compute (gsint, gcost, gsinu, gcosu, gsinv, gcosv, gsinf, gcosf) arrays:
+   !>      sinus and cosinus of the angle between the north-south axe and the 
+   !>      j-direction at t, u, v and f-points
+   !>
+   !> History :
+   !>   7.0  !  96-07  (O. Marti )  Original code
+   !>   8.0  !  98-06  (G. Madec )
+   !>   8.5  !  98-06  (G. Madec )  Free form, F90 + opt.
+   !>   9.2  !  07-04  (S. Masson)  Add T, F points and bugfix in cos lateral boundary
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from geo2ocean
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !!----------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TNAMH), INTENT(IN) :: td_nam
+      INTEGER(i4), INTENT(IN) :: jpi
+      INTEGER(i4), INTENT(IN) :: jpj
+
+      ! local variable
+      REAL(dp) :: zlam, zphi          
+      REAL(dp) :: zlan, zphh          
+      REAL(dp) :: zxnpt, zynpt, znnpt ! x,y components and norm of the vector: T point to North Pole
+      REAL(dp) :: zxnpu, zynpu, znnpu ! x,y components and norm of the vector: U point to North Pole
+      REAL(dp) :: zxnpv, zynpv, znnpv ! x,y components and norm of the vector: V point to North Pole
+      REAL(dp) :: zxnpf, zynpf, znnpf ! x,y components and norm of the vector: F point to North Pole
+      REAL(dp) :: zxvvt, zyvvt, znvvt ! x,y components and norm of the vector: between V points below and above a T point
+      REAL(dp) :: zxffu, zyffu, znffu ! x,y components and norm of the vector: between F points below and above a U point
+      REAL(dp) :: zxffv, zyffv, znffv ! x,y components and norm of the vector: between F points left  and right a V point
+      REAL(dp) :: zxuuf, zyuuf, znuuf ! x,y components and norm of the vector: between U points below and above a F point
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !!----------------------------------------------------------------------
+
+      ! ============================= !
+      ! Compute the cosinus and sinus !
+      ! ============================= !
+      ! (computation done on the north stereographic polar plane)
+
+      DO jj = 2, jpj-1
+!CDIR NOVERRCHK
+         DO ji = 2, jpi   ! vector opt.
+
+            ! north pole direction & modulous (at t-point)
+            zlam = tg_glamt%d_value(ji,jj,1,1)
+            zphi = tg_gphit%d_value(ji,jj,1,1)
+            zxnpt = 0._dp - 2._dp * COS( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )
+            zynpt = 0._dp - 2._dp * SIN( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )
+            znnpt = zxnpt*zxnpt + zynpt*zynpt
+
+            ! north pole direction & modulous (at u-point)
+            zlam = tg_glamu%d_value(ji,jj,1,1)
+            zphi = tg_gphiu%d_value(ji,jj,1,1)
+            zxnpu = 0._dp - 2._dp * COS( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )
+            zynpu = 0._dp - 2._dp * SIN( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )
+            znnpu = zxnpu*zxnpu + zynpu*zynpu
+
+            ! north pole direction & modulous (at v-point)
+            zlam = tg_glamv%d_value(ji,jj,1,1)
+            zphi = tg_gphiv%d_value(ji,jj,1,1)
+            zxnpv = 0._dp - 2._dp * COS( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )
+            zynpv = 0._dp - 2._dp * SIN( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )
+            znnpv = zxnpv*zxnpv + zynpv*zynpv
+
+            ! north pole direction & modulous (at f-point)
+            zlam = tg_glamf%d_value(ji,jj,1,1)
+            zphi = tg_gphif%d_value(ji,jj,1,1)
+            zxnpf = 0._dp - 2._dp * COS( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )
+            zynpf = 0._dp - 2._dp * SIN( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )
+            znnpf = zxnpf*zxnpf + zynpf*zynpf
+
+            ! j-direction: v-point segment direction (around t-point)
+            zlam = tg_glamv%d_value(ji,jj  ,1,1)
+            zphi = tg_gphiv%d_value(ji,jj  ,1,1)
+            zlan = tg_glamv%d_value(ji,jj-1,1,1)
+            zphh = tg_gphiv%d_value(ji,jj-1,1,1)
+            zxvvt =  2._dp * COS( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )   &
+               &  -  2._dp * COS( dp_deg2rad*zlan ) * TAN( dp_pi/4._dp - dp_deg2rad*zphh/2._dp )
+            zyvvt =  2._dp * SIN( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )   &
+               &  -  2._dp * SIN( dp_deg2rad*zlan ) * TAN( dp_pi/4._dp - dp_deg2rad*zphh/2._dp )
+            znvvt = SQRT( znnpt * ( zxvvt*zxvvt + zyvvt*zyvvt )  )
+            znvvt = MAX( znvvt, dp_eps )
+
+            ! j-direction: f-point segment direction (around u-point)
+            zlam = tg_glamf%d_value(ji,jj  ,1,1)
+            zphi = tg_gphif%d_value(ji,jj  ,1,1)
+            zlan = tg_glamf%d_value(ji,jj-1,1,1)
+            zphh = tg_gphif%d_value(ji,jj-1,1,1)
+            zxffu =  2._dp * COS( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )   &
+               &  -  2._dp * COS( dp_deg2rad*zlan ) * TAN( dp_pi/4._dp - dp_deg2rad*zphh/2._dp )
+            zyffu =  2._dp * SIN( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )   &
+               &  -  2._dp * SIN( dp_deg2rad*zlan ) * TAN( dp_pi/4._dp - dp_deg2rad*zphh/2._dp )
+            znffu = SQRT( znnpu * ( zxffu*zxffu + zyffu*zyffu )  )
+            znffu = MAX( znffu, dp_eps )
+
+            ! i-direction: f-point segment direction (around v-point)
+            zlam = tg_glamf%d_value(ji  ,jj,1,1)
+            zphi = tg_gphif%d_value(ji  ,jj,1,1)
+            zlan = tg_glamf%d_value(ji-1,jj,1,1)
+            zphh = tg_gphif%d_value(ji-1,jj,1,1)
+            zxffv =  2._dp * COS( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )   &
+               &  -  2._dp * COS( dp_deg2rad*zlan ) * TAN( dp_pi/4._dp - dp_deg2rad*zphh/2._dp )
+            zyffv =  2._dp * SIN( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )   &
+               &  -  2._dp * SIN( dp_deg2rad*zlan ) * TAN( dp_pi/4._dp - dp_deg2rad*zphh/2._dp )
+            znffv = SQRT( znnpv * ( zxffv*zxffv + zyffv*zyffv )  )
+            znffv = MAX( znffv, dp_eps )
+
+            ! j-direction: u-point segment direction (around f-point)
+            zlam = tg_glamu%d_value(ji,jj+1,1,1)
+            zphi = tg_gphiu%d_value(ji,jj+1,1,1)
+            zlan = tg_glamu%d_value(ji,jj  ,1,1)
+            zphh = tg_gphiu%d_value(ji,jj  ,1,1)
+            zxuuf =  2._dp * COS( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )   &
+               &  -  2._dp * COS( dp_deg2rad*zlan ) * TAN( dp_pi/4._dp - dp_deg2rad*zphh/2._dp )
+            zyuuf =  2._dp * SIN( dp_deg2rad*zlam ) * TAN( dp_pi/4._dp - dp_deg2rad*zphi/2._dp )   &
+               &  -  2._dp * SIN( dp_deg2rad*zlan ) * TAN( dp_pi/4._dp - dp_deg2rad*zphh/2._dp )
+            znuuf = SQRT( znnpf * ( zxuuf*zxuuf + zyuuf*zyuuf )  )
+            znuuf = MAX( znuuf, dp_eps )
+
+            ! cosinus and sinus using scalar and vectorial products
+            tg_gsint%d_value(ji,jj,1,1) = ( zxnpt*zyvvt - zynpt*zxvvt ) / znvvt
+            tg_gcost%d_value(ji,jj,1,1) = ( zxnpt*zxvvt + zynpt*zyvvt ) / znvvt
+
+            tg_gsinu%d_value(ji,jj,1,1) = ( zxnpu*zyffu - zynpu*zxffu ) / znffu
+            tg_gcosu%d_value(ji,jj,1,1) = ( zxnpu*zxffu + zynpu*zyffu ) / znffu
+
+            tg_gsinf%d_value(ji,jj,1,1) = ( zxnpf*zyuuf - zynpf*zxuuf ) / znuuf
+            tg_gcosf%d_value(ji,jj,1,1) = ( zxnpf*zxuuf + zynpf*zyuuf ) / znuuf
+
+            ! (caution, rotation of 90 degres)
+            tg_gsinv%d_value(ji,jj,1,1) = ( zxnpv*zxffv + zynpv*zyffv ) / znffv
+            tg_gcosv%d_value(ji,jj,1,1) =-( zxnpv*zyffv - zynpv*zxffv ) / znffv
+
+         END DO
+      END DO
+
+      ! =============== !
+      ! Geographic mesh !
+      ! =============== !
+
+      DO jj = 2, jpj-1
+         DO ji = 2, jpi   ! vector opt.
+            IF( MOD( ABS( tg_glamv%d_value(ji,jj,1,1) - tg_glamv%d_value(ji,jj-1,1,1) ), 360._dp ) < 1.e-8 ) THEN
+               tg_gsint%d_value(ji,jj,1,1) = 0._dp
+               tg_gcost%d_value(ji,jj,1,1) = 1._dp
+            ENDIF
+            IF( MOD( ABS( tg_glamf%d_value(ji,jj,1,1) - tg_glamf%d_value(ji,jj-1,1,1) ), 360._dp ) < 1.e-8 ) THEN
+               tg_gsinu%d_value(ji,jj,1,1) = 0._dp
+               tg_gcosu%d_value(ji,jj,1,1) = 1._dp
+            ENDIF
+            IF(      ABS( tg_gphif%d_value(ji,jj,1,1) - tg_gphif%d_value(ji-1,jj,1,1) )            < 1.e-8 ) THEN
+               tg_gsinv%d_value(ji,jj,1,1) = 0._dp
+               tg_gcosv%d_value(ji,jj,1,1) = 1._dp
+            ENDIF
+            IF( MOD( ABS( tg_glamu%d_value(ji,jj,1,1) - tg_glamu%d_value(ji,jj+1,1,1) ), 360._dp ) < 1.e-8 ) THEN
+               tg_gsinf%d_value(ji,jj,1,1) = 0._dp
+               tg_gcosf%d_value(ji,jj,1,1) = 1._dp
+            ENDIF
+         END DO
+      END DO
+
+      ! =========================== !
+      ! Lateral boundary conditions !
+      ! =========================== !
+
+      ! lateral boundary cond.: T-, U-, V-, F-pts, sgn
+      CALL lbc_lnk( tg_gcost%d_value(:,:,1,1), 'T', td_nam%i_perio, -1._dp )   
+      CALL lbc_lnk( tg_gcosu%d_value(:,:,1,1), 'U', td_nam%i_perio, -1._dp )   
+      CALL lbc_lnk( tg_gcosv%d_value(:,:,1,1), 'V', td_nam%i_perio, -1._dp )   
+      CALL lbc_lnk( tg_gcosf%d_value(:,:,1,1), 'F', td_nam%i_perio, -1._dp )   
+
+      CALL lbc_lnk( tg_gsint%d_value(:,:,1,1), 'T', td_nam%i_perio, -1._dp )
+      CALL lbc_lnk( tg_gsinu%d_value(:,:,1,1), 'U', td_nam%i_perio, -1._dp )
+      CALL lbc_lnk( tg_gsinv%d_value(:,:,1,1), 'V', td_nam%i_perio, -1._dp )
+      CALL lbc_lnk( tg_gsinf%d_value(:,:,1,1), 'F', td_nam%i_perio, -1._dp )
+
+   END SUBROUTINE grid_hgr__angle
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE grid_hgr
Index: /utils/tools_ticket2413/SIREN/src/grid_zgr.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/grid_zgr.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/grid_zgr.f90	(revision 12863)
@@ -0,0 +1,4459 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief This module manage Vertical grid.
+!>
+!> @details
+!> ** Purpose :   set the depth of model levels and the resulting 
+!>              vertical scale factors.
+!>
+!> ** Method  : 
+!>    - reference 1D vertical coordinate (gdep._1d, e3._1d)
+!>    - read/set ocean depth and ocean levels (bathy, mbathy)
+!>    - vertical coordinate (gdep., e3.) depending on the coordinate chosen :
+!>       - ln_zco=T   z-coordinate   
+!>       - ln_zps=T   z-coordinate with partial steps
+!>       - ln_zco=T   s-coordinate 
+!>
+!> ** Action  :   define gdep., e3., mbathy and bathy
+!>
+!> @author
+!> G, Madec
+!>
+!> @date December, 1995 - Original code : s vertical coordinate
+!> @date July, 1997
+!> - lbc_lnk call
+!> @date September, 2002
+!> - A. Bozec, G. Madec : F90: Free form and module
+!> @date September, 2002
+!> - A. de Miranda : rigid-lid + islands
+!> @date August, 2003
+!> - G. Madec : Free form and module
+!> @date October, 2005
+!> - A. Beckmann : modifications for hybrid s-ccordinates & new stretching function
+!> @date April, 2006
+!> - R. Benshila, G. Madec : add zgr_zco
+!> @date June, 2008
+!> - G. Madec : insertion of domzgr_zps.h90 & conding style
+!> @date July, 2009
+!> - R. Benshila : Suppression of rigid-lid option
+!> @date November, 2011
+!> - G. Madec : add mbk. arrays associated to the deepest ocean level
+!> @date August, 2012
+!> - J. Siddorn : added Siddorn and Furner stretching function
+!> @date December, 2012
+!> - R. Bourdalle-Badie and G. Reffray : modify C1D case
+!> @date November, 2014
+!> - P. Mathiot and C. Harris : add ice shelf capabilitye
+!> @date November, 2015
+!> - H. Liu : Modifications for Wetting/Drying
+!> @date October, 2016
+!> - J, Paul : update from trunk (revision 6961): add wetting and drying, ice sheet coupling..
+!> - J, Paul : do not use anymore special case for ORCA grid.
+!> @date November, 2016
+!> - J, Paul : vertical scale factors e3. = dk[gdep] or old definition
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE grid_zgr
+
+   USE netcdf                          ! nf90 library
+   USE kind                            ! F90 kind parameter
+   USE fct                             ! basic usefull function
+   USE global                          ! global parameter
+   USE phycst                          ! physical constant
+   USE logger                          ! log file manager
+   USE file                            ! file manager
+   USE var                             ! variable manager
+   USE dim                             ! dimension manager
+   USE dom                             ! domain manager
+   USE grid                            ! grid manager
+   USE iom                             ! I/O manager
+   USE mpp                             ! MPP manager
+   USE iom_mpp                         ! I/O MPP manager
+   USE lbc                             ! lateral boundary conditions
+   USE grid_hgr                        ! Horizontal mesh
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+   ! type and variable
+   PUBLIC :: TNAMZ
+
+   PUBLIC :: tg_gdepw_1d
+   PUBLIC :: tg_gdept_1d
+   PUBLIC :: tg_e3w_1d
+   PUBLIC :: tg_e3t_1d
+   PUBLIC :: tg_e3tp 
+   PUBLIC :: tg_e3wp 
+
+   PUBLIC :: tg_rx1 
+   
+   PUBLIC :: tg_mbathy
+   PUBLIC :: tg_misfdep
+
+   PUBLIC :: tg_gdept_0 
+   PUBLIC :: tg_gdepw_0
+!   PUBLIC :: tg_gdep3w_0  !useless to create meshmask
+   PUBLIC :: tg_e3t_0
+   PUBLIC :: tg_e3u_0
+   PUBLIC :: tg_e3v_0
+   PUBLIC :: tg_e3w_0
+   PUBLIC :: tg_e3f_0     !useless to create meshmask
+   PUBLIC :: tg_e3uw_0    !useless to create meshmask
+   PUBLIC :: tg_e3vw_0    !useless to create meshmask
+   
+   PUBLIC :: tg_mbkt
+!   PUBLIC :: tg_mbku      !useless to create meshmask
+!   PUBLIC :: tg_mbkv      !useless to create meshmask
+   PUBLIC :: tg_mikt
+!   PUBLIC :: tg_miku      !useless to create meshmask
+!   PUBLIC :: tg_mikv      !useless to create meshmask
+!   PUBLIC :: tg_mikf      !useless to create meshmask
+
+   PUBLIC :: tg_hbatt     !            sco
+   PUBLIC :: tg_hbatu     !            sco
+   PUBLIC :: tg_hbatv     !            sco
+   PUBLIC :: tg_hbatf     !            sco
+
+   PUBLIC :: tg_gsigt     !            sco(tanh)
+   PUBLIC :: tg_gsigw     !            sco(tanh)
+   PUBLIC :: tg_gsi3w     !            sco(tanh)
+   PUBLIC :: tg_esigt     !            sco(tanh)
+   PUBLIC :: tg_esigw     !            sco(tanh)
+
+   ! function and subroutine
+   PUBLIC :: grid_zgr_init 
+   PUBLIC :: grid_zgr_nam
+   PUBLIC :: grid_zgr_fill
+   PUBLIC :: grid_zgr_clean
+
+   PUBLIC :: grid_zgr_zps_init 
+   PUBLIC :: grid_zgr_zps_clean
+   PUBLIC :: grid_zgr_sco_init
+   PUBLIC :: grid_zgr_sco_clean
+   PUBLIC :: grid_zgr_sco_stiff 
+
+   PRIVATE :: grid_zgr__z
+   PRIVATE :: grid_zgr__bat 
+   PRIVATE :: grid_zgr__zco 
+!   PRIVATE :: grid_zgr__bat_zoom
+   PRIVATE :: grid_zgr__bat_ctl
+   PRIVATE :: grid_zgr__bot_level
+   PRIVATE :: grid_zgr__top_level
+   PRIVATE :: grid_zgr__zps_fill
+   PRIVATE :: grid_zgr__isf_fill
+!   PRIVATE :: grid_zgr__isf_fill_e3x
+   PRIVATE :: grid_zgr__isf_fill_e3uw
+!   PRIVATE :: grid_zgr__isf_fill_gdep3w_0
+   PRIVATE :: grid_zgr__sco_fill
+   PRIVATE :: grid_zgr__sco_s_sh94 
+   PRIVATE :: grid_zgr__sco_s_sf12
+   PRIVATE :: grid_zgr__sco_s_tanh
+   PRIVATE :: grid_zgr__sco_fssig      !: tanh stretch function
+   PRIVATE :: grid_zgr__sco_fssig1     !: Song and Haidvogel 1994 stretch function
+   PRIVATE :: grid_zgr__sco_fgamma     !: Siddorn and Furner 2012 stretching function 
+
+   TYPE TNAMZ
+
+      CHARACTER(LEN=lc) :: c_coord   
+      INTEGER(i4)       :: i_perio   
+                
+      LOGICAL           :: l_zco               
+      LOGICAL           :: l_zps      
+      LOGICAL           :: l_sco      
+      LOGICAL           :: l_isfcav   
+      LOGICAL           :: l_iscpl   
+      LOGICAL           :: l_wd   
+      INTEGER(i4)       :: i_nlevel   
+                  
+      REAL(dp)          :: d_ppsur    
+      REAL(dp)          :: d_ppa0     
+      REAL(dp)          :: d_ppa1     
+      REAL(dp)          :: d_ppkth    
+      REAL(dp)          :: d_ppacr    
+      REAL(dp)          :: d_ppdzmin  
+      REAL(dp)          :: d_pphmax   
+      LOGICAL           :: l_dbletanh 
+      REAL(dp)          :: d_ppa2     
+      REAL(dp)          :: d_ppkth2   
+      REAL(dp)          :: d_ppacr2   
+                  
+      REAL(dp)          :: d_hmin     
+      REAL(dp)          :: d_isfhmin
+
+      REAL(dp)          :: d_e3zps_min
+      REAL(dp)          :: d_e3zps_rat
+!      INTEGER(i4)       :: i_msh      
+                  
+      LOGICAL           :: l_s_sh94   
+      LOGICAL           :: l_s_sf12   
+      REAL(dp)          :: d_sbot_min 
+      REAL(dp)          :: d_sbot_max 
+      ! Song and Haidvogel 1994 stretching additional parameters
+      REAL(dp)          :: d_rmax     
+      REAL(dp)          :: d_hc       
+      REAL(dp)          :: d_theta    
+      REAL(dp)          :: d_thetb    
+      REAL(dp)          :: d_bb       
+      ! Siddorn and Furner stretching additional parameters 
+      LOGICAL           :: l_sigcrit  
+      REAL(dp)          :: d_alpha    
+      REAL(dp)          :: d_efold    
+      REAL(dp)          :: d_zs       
+      REAL(dp)          :: d_zb_a     
+      REAL(dp)          :: d_zb_b     
+                  
+      INTEGER(i4)       :: i_cla     
+
+      REAL(dp)          :: d_wdmin1 
+      REAL(dp)          :: d_wdmin2 
+      REAL(dp)          :: d_wdld 
+
+!      CHARACTER(LEN=lc) :: c_cfg     
+!      INTEGER(i4)       :: i_cfg     
+!      INTEGER(i4)       :: i_bench   
+!      LOGICAL           :: l_zoom
+      LOGICAL           :: l_c1d
+      LOGICAL           :: l_e3_dep
+                
+!      CHARACTER(LEN=lc) :: c_cfz      
+!      INTEGER(i4)       :: i_izoom    
+!      INTEGER(i4)       :: i_jzoom    
+!      LOGICAL           :: l_zoom_s   
+!      LOGICAL           :: l_zoom_e   
+!      LOGICAL           :: l_zoom_w   
+!      LOGICAL           :: l_zoom_n
+
+   END TYPE
+
+   TYPE(TVAR), SAVE :: tg_gdepw_1d  !zco & zps & sco
+   TYPE(TVAR), SAVE :: tg_gdept_1d  !zco & zps & sco
+   TYPE(TVAR), SAVE :: tg_e3w_1d    !zco & zps
+   TYPE(TVAR), SAVE :: tg_e3t_1d    !zco & zps
+   TYPE(TVAR), SAVE :: tg_e3tp      !      zps
+   TYPE(TVAR), SAVE :: tg_e3wp      !      zps
+   
+   TYPE(TVAR), SAVE :: tg_rx1       !            sco
+   
+   TYPE(TVAR), SAVE :: tg_mbathy    !zco & zps & sco
+   TYPE(TVAR), SAVE :: tg_misfdep
+
+   TYPE(TVAR), SAVE :: tg_gdept_0   !      zps & sco
+   TYPE(TVAR), SAVE :: tg_gdepw_0   !      zps & sco
+   !TYPE(TVAR), SAVE :: tg_gdep3w_0
+   TYPE(TVAR), SAVE :: tg_e3t_0     !      zps & sco
+   TYPE(TVAR), SAVE :: tg_e3u_0     !      zps & sco
+   TYPE(TVAR), SAVE :: tg_e3v_0     !      zps & sco
+   TYPE(TVAR), SAVE :: tg_e3w_0     !      zps & sco
+   TYPE(TVAR), SAVE :: tg_e3f_0
+   TYPE(TVAR), SAVE :: tg_e3uw_0
+   TYPE(TVAR), SAVE :: tg_e3vw_0
+   
+   TYPE(TVAR), SAVE :: tg_mbkt      !zco & zps & sco
+   !TYPE(TVAR), SAVE :: tg_mbku
+   !TYPE(TVAR), SAVE :: tg_mbkv
+   TYPE(TVAR), SAVE :: tg_mikt      !zco & zps & sco
+   !TYPE(TVAR), SAVE :: tg_miku
+   !TYPE(TVAR), SAVE :: tg_mikv
+   !TYPE(TVAR), SAVE :: tg_mikf
+
+   TYPE(TVAR), SAVE :: tg_hbatt     !            sco
+   TYPE(TVAR), SAVE :: tg_hbatu     !            sco
+   TYPE(TVAR), SAVE :: tg_hbatv     !            sco
+   TYPE(TVAR), SAVE :: tg_hbatf     !            sco
+
+   TYPE(TVAR), SAVE :: tg_gsigt     !            sco(tanh)
+   TYPE(TVAR), SAVE :: tg_gsigw     !            sco(tanh)
+   TYPE(TVAR), SAVE :: tg_gsi3w     !            sco(tanh)
+   TYPE(TVAR), SAVE :: tg_esigt     !            sco(tanh)
+   TYPE(TVAR), SAVE :: tg_esigw     !            sco(tanh)
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_zgr_init(jpi, jpj, jpk, ld_sco) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine initialise global variable needed to compute vertical
+   !>        mesh
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !> @param[in] jpk
+   !> @param[in] ld_sco
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      INTEGER(i4), INTENT(IN) :: jpi
+      INTEGER(i4), INTENT(IN) :: jpj
+      INTEGER(i4), INTENT(IN) :: jpk
+      LOGICAL    , INTENT(IN) :: ld_sco
+
+      ! local variable
+      REAL(dp), DIMENSION(jpk)         :: dl_tmp1D
+      REAL(dp), DIMENSION(jpi,jpj)     :: dl_tmp2D
+      REAL(dp), DIMENSION(jpi,jpj,jpk) :: dl_tmp3D
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! variable 1D
+      dl_tmp1D(:)    =dp_fill
+
+      tg_gdepw_1d=var_init('gdepw_1d',dl_tmp1D(:)    , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_gdept_1d=var_init('gdept_1d',dl_tmp1D(:)    , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e3w_1d  =var_init('e3w_1d  ',dl_tmp1D(:)    , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e3t_1d  =var_init('e3t_1d  ',dl_tmp1D(:)    , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+
+      !only sco
+      IF( ld_sco )THEN
+         tg_gsigt   =var_init('gsigt   ',dl_tmp1D(:)    , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+         tg_gsigw   =var_init('gsigw   ',dl_tmp1D(:)    , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+         tg_gsi3w   =var_init('gsi3w   ',dl_tmp1D(:)    , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+         tg_esigt   =var_init('esigt   ',dl_tmp1D(:)    , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+         tg_esigw   =var_init('esigw   ',dl_tmp1D(:)    , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      ENDIF
+
+      ! variable 2D
+      dl_tmp2D(:,:)  =dp_fill_i2
+
+      tg_mbkt    =var_init('mbkt    ',dl_tmp2D(:,:)  , dd_fill=dp_fill_i2, id_type=NF90_SHORT)
+      !tg_mbku    =var_init('mbku    ',dl_tmp2D(:,:)  , dd_fill=dp_fill_i2, id_type=NF90_SHORT)
+      !tg_mbkv    =var_init('mbkv    ',dl_tmp2D(:,:)  , dd_fill=dp_fill_i2, id_type=NF90_SHORT)
+      tg_mikt    =var_init('mikt    ',dl_tmp2D(:,:)  , dd_fill=dp_fill_i2, id_type=NF90_SHORT)
+      !tg_miku    =var_init('miku    ',dl_tmp2D(:,:)  , dd_fill=dp_fill_i2, id_type=NF90_SHORT)
+      !tg_mikv    =var_init('mikv    ',dl_tmp2D(:,:)  , dd_fill=dp_fill_i2, id_type=NF90_SHORT)
+      !tg_mikf    =var_init('mikf    ',dl_tmp2D(:,:)  , dd_fill=dp_fill_i2, id_type=NF90_SHORT)
+
+      dl_tmp2D(:,:)  =dp_fill_i4
+
+      tg_mbathy  =var_init('mbathy  ',dl_tmp2D(:,:)  , dd_fill=dp_fill_i4, id_type=NF90_INT)
+      tg_misfdep =var_init('misfdep ',dl_tmp2D(:,:)  , dd_fill=dp_fill_i4, id_type=NF90_INT)
+
+      dl_tmp2D(:,:)  =dp_fill
+
+      ! only sco
+      IF( ld_sco )THEN
+         tg_hbatt   =var_init('hbatt   ',dl_tmp2D(:,:)  , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+         tg_hbatu   =var_init('hbatu   ',dl_tmp2D(:,:)  , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+         tg_hbatv   =var_init('hbatv   ',dl_tmp2D(:,:)  , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+         tg_hbatf   =var_init('hbatf   ',dl_tmp2D(:,:)  , dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      ENDIF
+
+      ! variable 3D
+      dl_tmp3D(:,:,:)=dp_fill
+
+      tg_gdept_0 =var_init('gdept_0 ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_gdepw_0 =var_init('gdepw_0 ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      !tg_gdep3w_0=var_init('gdep3w_0',dl_tmp3D(:,:,:), dd_fill=dp_fill_sp, id_type=NF90_FLOAT)
+
+      tg_e3t_0   =var_init('e3t_0   ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e3u_0   =var_init('e3u_0   ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e3v_0   =var_init('e3v_0   ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e3w_0   =var_init('e3w_0   ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e3f_0   =var_init('e3f_0   ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e3uw_0  =var_init('e3uw_0  ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e3vw_0  =var_init('e3vw_0  ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)
+
+   END SUBROUTINE grid_zgr_init
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_zgr_clean(ld_sco) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine clean hgr structure
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !> @param[in] ld_sco
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      LOGICAL    , INTENT(IN) :: ld_sco
+
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+
+      CALL var_clean(tg_gdepw_1d)
+      CALL var_clean(tg_gdept_1d)
+      CALL var_clean(tg_e3w_1d  )
+      CALL var_clean(tg_e3t_1d  )
+
+      IF( ld_sco )THEN
+         CALL var_clean(tg_gsigt   )
+         CALL var_clean(tg_gsigw   )
+         CALL var_clean(tg_gsi3w   )
+         CALL var_clean(tg_esigt   )
+         CALL var_clean(tg_esigw   )
+      ENDIF
+      
+      CALL var_clean(tg_mbathy  )
+      CALL var_clean(tg_misfdep )
+
+      CALL var_clean(tg_mbkt    )
+      !CALL var_clean(tg_mbku    )
+      !CALL var_clean(tg_mbkv    )
+      CALL var_clean(tg_mikt    )
+      !CALL var_clean(tg_miku    )
+      !CALL var_clean(tg_mikv    )
+      !CALL var_clean(tg_mikf    )
+
+      IF( ld_sco )THEN
+         CALL var_clean(tg_hbatt   )
+         CALL var_clean(tg_hbatu   )
+         CALL var_clean(tg_hbatv   )
+         CALL var_clean(tg_hbatf   )
+      ENDIF
+
+      CALL var_clean(tg_gdept_0 )
+      CALL var_clean(tg_gdepw_0 )
+      !CALL var_clean(tg_gdep3w_0)
+
+      CALL var_clean(tg_e3t_0   )
+      CALL var_clean(tg_e3u_0   )
+      CALL var_clean(tg_e3v_0   )
+      CALL var_clean(tg_e3f_0   )
+      CALL var_clean(tg_e3uw_0  )
+      CALL var_clean(tg_e3vw_0  )
+      
+   END SUBROUTINE grid_zgr_clean
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid_zgr_nam(cd_coord, id_perio, cd_namelist) &
+         & RESULT (tf_namz)
+   !-------------------------------------------------------------------
+   !> @brief This function initialise zgr namelist structure
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !> @param[in] cd_coord   
+   !> @param[in] id_perio  
+   !> @param[in] cd_namelist
+   !> @return hgr namelist structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_coord
+      INTEGER(i4)     , INTENT(IN) :: id_perio   
+
+      CHARACTER(LEN=*), INTENT(IN) :: cd_namelist
+      
+      ! function
+      TYPE(TNAMZ)                  :: tf_namz
+
+      ! local variable
+      INTEGER(i4)        :: il_status
+      INTEGER(i4)        :: il_fileid
+
+      LOGICAL            :: ll_exist
+
+      ! namelist
+      ! namzgr
+      LOGICAL           :: ln_zco      = .FALSE.
+      LOGICAL           :: ln_zps      = .FALSE.
+      LOGICAL           :: ln_sco      = .FALSE.
+      LOGICAL           :: ln_isfcav   = .FALSE.
+      LOGICAL           :: ln_iscpl    = .FALSE.
+      LOGICAL           :: ln_wd       = .FALSE.
+      INTEGER(i4)       :: in_nlevel   = 75
+
+      ! namdmin
+      REAL(dp)          :: dn_hmin     = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_isfhmin  = NF90_FILL_DOUBLE
+
+      ! namzco
+      REAL(dp)          :: dn_ppsur    = -3958.951371276829 !NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_ppa0     = 103.953009600000   !NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_ppa1     = 2.415951269000     !NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_ppkth    = 15.351013700000    !NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_ppacr    = 7.000000000000     !NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_ppdzmin  = 6.                 !NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_pphmax   = 5750.              !NF90_FILL_DOUBLE
+      LOGICAL           :: ln_dbletanh = .TRUE.
+      REAL(dp)          :: dn_ppa2     = 100.760928500000   !NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_ppkth2   = 48.029893720000    !NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_ppacr2   = 13.000000000000    !NF90_FILL_DOUBLE
+
+      ! namzps
+      REAL(dp)          :: dn_e3zps_min= NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_e3zps_rat= NF90_FILL_DOUBLE
+!      INTEGER(i4)       :: in_msh      = NF90_FILL_INT
+
+      ! namsco
+      LOGICAL           :: ln_s_sh94   = .FALSE.
+      LOGICAL           :: ln_s_sf12   = .FALSE.
+      REAL(dp)          :: dn_sbot_min = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_sbot_max = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_rmax     = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_hc       = NF90_FILL_DOUBLE
+      !
+      REAL(dp)          :: dn_theta    = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_thetb    = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_bb       = NF90_FILL_DOUBLE
+      !                               
+      LOGICAL           :: ln_sigcrit  = .FALSE.
+      REAL(dp)          :: dn_alpha    = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_efold    = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_zs       = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_zb_a     = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_zb_b     = NF90_FILL_DOUBLE
+
+!      ! namcla
+!      INTEGER(i4)       :: in_cla      = 0
+
+      ! namwd
+      REAL(dp)          :: dn_wdmin1   = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_wdmin2   = NF90_FILL_DOUBLE
+      REAL(dp)          :: dn_wdld     = NF90_FILL_DOUBLE
+
+      ! namgrd
+!      CHARACTER(LEN=lc) :: cn_cfg      = ''
+!      INTEGER(i4)       :: in_cfg      = 0
+!      INTEGER(i4)       :: in_bench    = 0
+!      LOGICAL           :: ln_zoom     = .FALSE.
+      LOGICAL           :: ln_c1d      = .FALSE.
+      LOGICAL           :: ln_e3_dep   = .FALSE.
+
+!      ! namzoom
+!      CHARACTER(LEN=lc) :: cn_cfz      =''
+!      INTEGER(i4)       :: in_izoom    = NF90_FILL_INT
+!      INTEGER(i4)       :: in_jzoom    = NF90_FILL_INT
+!      LOGICAL           :: ln_zoom_s   = .FALSE.
+!      LOGICAL           :: ln_zoom_e   = .FALSE.
+!      LOGICAL           :: ln_zoom_w   = .FALSE.
+!      LOGICAL           :: ln_zoom_n   = .FALSE.
+      !----------------------------------------------------------------
+      NAMELIST /namzgr/ &
+      &  ln_zco,        &  !< z-coordinate
+      &  ln_zps,        &  !< z-coordinate with partial steps
+      &  ln_sco,        &  !< s-coordinate
+      &  ln_isfcav,     &  !< presence of ISF 
+      &  ln_iscpl,      &  !< coupling with ice sheet
+      &  ln_wd,         &  !< Wetting/drying activation      
+      &  in_nlevel         !< number of vertical level
+
+      NAMELIST /namdmin/ &
+      &  dn_hmin,       &  !< minimum ocean depth (>0) or minimum number of ocean levels (<0)
+      &  dn_isfhmin        !< threshold to discriminate grounded ice to floating ice
+
+      NAMELIST /namzco/ &
+      &  dn_ppsur,      &
+      &  dn_ppa0,       &
+      &  dn_ppa1,       &
+      &  dn_ppkth,      &
+      &  dn_ppacr,      &
+      &  dn_ppdzmin,    &
+      &  dn_pphmax,     &
+      &  ln_dbletanh,   &
+      &  dn_ppa2,       &
+      &  dn_ppkth2,     &
+      &  dn_ppacr2
+
+      NAMELIST /namzps/ &
+      &  dn_e3zps_min,  &
+      &  dn_e3zps_rat!,  &
+!      &  in_msh          
+
+      NAMELIST /namsco/ &
+      &   ln_s_sh94,    & !< use hybrid s-sig Song and Haidvogel 1994 stretching function fssig1
+      &   ln_s_sf12,    & !< use hybrid s-z-sig Siddorn and Furner 2012 stretching function fgamma
+      &   dn_sbot_min,  & !< minimum depth of s-bottom surface (>0) (m)
+      &   dn_sbot_max,  & !< maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+      &   dn_hc,        & !< Critical depth for transition from sigma to stretched coordinates
+      ! Song and Haidvogel 1994 stretching parameters
+      &   dn_rmax,      & !< maximum cut-off r-value allowed (0<dn_rmax<1)
+      &   dn_theta,     & !< surface control parameter (0<=dn_theta<=20)
+      &   dn_thetb,     & !< bottom control parameter  (0<=dn_thetb<= 1)
+      &   dn_bb,        & !< stretching parameter ( dn_bb=0; top only, dn_bb =1; top and bottom)
+      ! Siddorn and Furner stretching parameters
+      &   ln_sigcrit,   & !< use sigma coordinates below critical depth (T) or Z coordinates (F) for Siddorn & Furner stretch
+      &   dn_alpha,     & !< control parameter ( > 1 stretch towards surface, < 1 towards seabed)
+      &   dn_efold,     & !<  efold length scale for transition to stretched coord
+      &   dn_zs,        & !<  depth of surface grid box
+                          !<  bottom cell depth (Zb) is a linear function of water depth Zb = H*rn_zb_a + rn_zb_b'
+      &   dn_zb_a,      & !<  bathymetry scaling factor for calculating Zb
+      &   dn_zb_b         !<  offset for calculating Zb
+
+!      NAMELIST /namcla/ &
+!      &  in_cla            !< =1 cross land advection for exchanges through some straits (ORCA2)
+
+      NAMELIST /namwd/ &  !< wetting and drying
+      &  dn_wdmin1, &     !< minimum water depth on dried cells
+      &  dn_wdmin2, &     !< tolerrance of minimum water depth on dried cells
+      &  dn_wdld          !< land elevation below which wetting/drying
+
+      NAMELIST/namgrd/  &  !< orca grid namelist
+!      &  cn_cfg,        &  !< name of the configuration (orca)
+!      &  in_cfg,        &  !< resolution of the configuration (2,1,025..)
+!      &  in_bench,      &  !< benchmark parameter (in_mshhgr = 5 )
+!      &  ln_zoom,       &  !< use zoom
+      &  ln_c1d,         &  !< use configuration 1D
+      &  ln_e3_dep          !< new vertical scale factors [T, F:old definition]
+
+!      NAMELIST /namzoom/&
+!      &  cn_cfz,        &  !< name of the zoom of configuration
+!      &  in_izoom,      &  !< left bottom i-indices of the zoom in data domain indices
+!      &  in_jzoom,      &  !< left bottom j-indices of the zoom in data domain indices
+!      &  ln_zoom_s,     &  !< South zoom type flag
+!      &  ln_zoom_e,     &  !< East  zoom type flag
+!      &  ln_zoom_w,     &  !< West  zoom type flag
+!      &  ln_zoom_n         !< North zoom type flag
+      !----------------------------------------------------------------
+   !1-2 read namelist
+   INQUIRE(FILE=TRIM(cd_namelist), EXIST=ll_exist)
+   IF( ll_exist )THEN
+      
+      il_fileid=fct_getunit()
+
+      OPEN( il_fileid, FILE=TRIM(cd_namelist), &
+      &                FORM='FORMATTED',       &
+      &                ACCESS='SEQUENTIAL',    &
+      &                STATUS='OLD',           &
+      &                ACTION='READ',          &
+      &                IOSTAT=il_status)
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         CALL logger_fatal("GRID ZGR NAM: error opening "//&
+            &  TRIM(cd_namelist))
+      ENDIF
+
+      READ( il_fileid, NML = namzgr  )
+      READ( il_fileid, NML = namdmin )
+      READ( il_fileid, NML = namzco  )
+
+      IF( ln_zps    ) READ( il_fileid, NML = namzps  )
+      IF( ln_sco    ) READ( il_fileid, NML = namsco  )
+!      READ( il_fileid, NML = namcla  )
+      READ( il_fileid, NML = namwd   )
+      READ( il_fileid, NML = namgrd  )
+!      IF( ln_zoom   ) READ( il_fileid, NML = namzoom )
+
+      CLOSE( il_fileid, IOSTAT=il_status )
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         CALL logger_error("GRID ZGR NAM: closing "//TRIM(cd_namelist))
+      ENDIF
+     
+      tf_namz%c_coord    = TRIM(cd_coord)
+      tf_namz%i_perio    = id_perio
+
+      tf_namz%l_zco      = ln_zco    
+      tf_namz%l_zps      = ln_zps    
+      tf_namz%l_sco      = ln_sco    
+      tf_namz%l_isfcav   = ln_isfcav 
+      tf_namz%l_iscpl    = ln_iscpl 
+      tf_namz%l_wd       = ln_wd 
+      tf_namz%i_nlevel   = in_nlevel
+
+      tf_namz%d_hmin     = dn_hmin  
+      tf_namz%d_isfhmin  = dn_isfhmin  
+
+      tf_namz%d_ppsur    = dn_ppsur  
+      tf_namz%d_ppa0     = dn_ppa0   
+      tf_namz%d_ppa1     = dn_ppa1   
+      tf_namz%d_ppkth    = dn_ppkth  
+      tf_namz%d_ppacr    = dn_ppacr  
+      tf_namz%d_ppdzmin  = dn_ppdzmin
+      tf_namz%d_pphmax   = dn_pphmax 
+                             
+      tf_namz%l_dbletanh = ln_dbletanh
+      tf_namz%d_ppa2     = dn_ppa2    
+      tf_namz%d_ppkth2   = dn_ppkth2  
+      tf_namz%d_ppacr2   = dn_ppacr2  
+
+      tf_namz%d_e3zps_min= dn_e3zps_min
+      tf_namz%d_e3zps_rat= dn_e3zps_rat
+!      tf_namz%i_msh      = in_msh      
+
+      tf_namz%l_s_sh94   = ln_s_sh94  
+      tf_namz%l_s_sf12   = ln_s_sf12  
+      tf_namz%d_sbot_min = dn_sbot_min
+      tf_namz%d_sbot_max = dn_sbot_max
+      tf_namz%d_rmax     = dn_rmax    
+      tf_namz%d_hc       = dn_hc      
+      !
+      tf_namz%d_theta    = dn_theta   
+      tf_namz%d_thetb    = dn_thetb   
+      tf_namz%d_bb       = dn_bb      
+      !
+      tf_namz%l_sigcrit  = ln_sigcrit
+      tf_namz%d_alpha    = dn_alpha  
+      tf_namz%d_efold    = dn_efold  
+      tf_namz%d_zs       = dn_zs     
+      tf_namz%d_zb_a     = dn_zb_a
+      tf_namz%d_zb_b     = dn_zb_b
+
+!      tf_namz%i_cla      = in_cla
+
+      tf_namz%d_wdmin1   = dn_wdmin1  
+      tf_namz%d_wdmin2   = dn_wdmin2  
+      tf_namz%d_wdld     = dn_wdld  
+
+!      tf_namz%c_cfg      = TRIM(cn_cfg)
+!      tf_namz%i_cfg      = in_cfg
+!      tf_namz%i_bench    = in_bench
+!      tf_namz%l_zoom     = ln_zoom
+      tf_namz%l_c1d      = ln_c1d
+      tf_namz%l_e3_dep   = ln_e3_dep
+
+!      tf_namz%c_cfz      = cn_cfz   
+!      tf_namz%i_izoom    = in_izoom 
+!      tf_namz%i_jzoom    = in_jzoom 
+!      tf_namz%l_zoom_s   = ln_zoom_s
+!      tf_namz%l_zoom_e   = ln_zoom_e
+!      tf_namz%l_zoom_w   = ln_zoom_w
+!      tf_namz%l_zoom_n   = ln_zoom_n
+
+   ELSE
+
+      CALL logger_fatal(" GRID ZGR NAM: can't find "//TRIM(cd_namelist))
+
+   ENDIF
+
+   END FUNCTION grid_zgr_nam
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_zgr_fill(td_nam, jpi, jpj, jpk, td_bathy, td_risfdep) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill vertical mesh
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !> @date October, 2016
+   !> - ice shelf cavity
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !> @param[in] jpk
+   !> @param[in] td_bathy
+   !> @param[in] td_risfdep
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+      INTEGER(i4), INTENT(IN   ) :: jpi
+      INTEGER(i4), INTENT(IN   ) :: jpj
+      INTEGER(i4), INTENT(IN   ) :: jpk
+      TYPE(TVAR) , INTENT(INOUT) :: td_bathy
+      TYPE(TVAR) , INTENT(INOUT) :: td_risfdep
+
+      ! local variable
+      INTEGER(i4) :: il_count
+
+      REAL(dp)    :: dl_bat
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      CALL logger_info('GRID ZGR : vertical coordinate')
+      CALL logger_info('~~~~~~~')
+      CALL logger_info(' Namelist namzgr : set vertical coordinate')
+      CALL logger_info(' z-coordinate - full steps      ln_zco    = '//TRIM(fct_str(td_nam%l_zco)))
+      CALL logger_info(' z-coordinate - partial steps   ln_zps    = '//TRIM(fct_str(td_nam%l_zps)))
+      CALL logger_info(' s- or hybrid z-s-coordinate    ln_sco    = '//TRIM(fct_str(td_nam%l_sco)))
+      CALL logger_info(' ice shelf cavities             ln_isfcav = '//TRIM(fct_str(td_nam%l_isfcav)))
+      CALL logger_info(' vertical scale factors         ln_e3_dep = '//TRIM(fct_str(td_nam%l_e3_dep)))
+
+      il_count=0
+      IF( td_nam%l_zco      )   il_count = il_count + 1
+      IF( td_nam%l_zps      )   il_count = il_count + 1
+      IF( td_nam%l_sco      )   il_count = il_count + 1
+      IF( il_count /= 1 )THEN
+         CALL logger_fatal(' GRID ZGR : none or several vertical coordinate options used' )
+      ENDIF
+      !
+      il_count=0
+      IF ( td_nam%l_zco .AND. td_nam%l_isfcav ) il_count = il_count + 1
+      IF ( td_nam%l_sco .AND. td_nam%l_isfcav ) il_count = il_count + 1
+      IF( il_count > 0 )THEN
+         CALL logger_fatal(' GRID ZGR : Cavity not tested/compatible with full step (zco) and sigma (ln_sco)' )
+      ENDIF
+
+      IF(.NOT. td_nam%l_e3_dep )THEN
+         CALL logger_info("Obsolescent definition of e3 scale factors is used")
+      ENDIF
+      ! Build the vertical coordinate system
+      ! ------------------------------------
+
+      ! Reference z-coordinate system (always called)
+      CALL grid_zgr__z( td_nam,jpk )
+
+      ! Bathymetry fields (levels and meters)
+      CALL grid_zgr__bat( td_nam,td_bathy,td_risfdep ) !jpi,jpj,td_bathy,td_risfdep )
+
+      ! 1D config.: same bathy value over the 3x3 domain
+      IF( td_nam%l_c1d ) CALL lbc_lnk( td_bathy%d_value(:,:,1,1),'T',td_nam%i_perio,1._dp )
+
+      ! z-coordinate
+      IF( td_nam%l_zco ) CALL grid_zgr__zco(jpk)
+
+      ! Partial step z-coordinate
+      IF( td_nam%l_zps ) CALL grid_zgr__zps_fill( td_nam,jpi,jpj,jpk,td_bathy,td_risfdep )
+
+      ! s-coordinate or hybrid z-s coordinate
+      IF( td_nam%l_sco ) CALL grid_zgr__sco_fill( td_nam,jpi,jpj,jpk,td_bathy )
+
+      ! final adjustment of mbathy & check 
+      ! ----------------------------------
+
+!      ! correct mbathy in case of zoom subdomain
+!      IF( td_nam%l_zoom )   CALL grid_zgr__bat_zoom( td_nam,jpi,jpj )
+
+      ! check bathymetry (mbathy) and suppress isolated ocean points
+      IF( .NOT. td_nam%l_c1d )   CALL grid_zgr__bat_ctl( td_nam,jpi,jpj,jpk )
+
+      ! deepest ocean level for t-, u- and v-points
+      CALL grid_zgr__bot_level( ) !td_nam,jpi,jpj )
+
+      ! shallowest ocean level for T-, U-, V- points
+      CALL grid_zgr__top_level( ) !td_nam,jpi,jpj )
+
+      ! 1D config.: same mbathy value over the 3x3 domain
+      IF( td_nam%l_c1d ) THEN
+         dl_bat = tg_mbathy%d_value(2,2,1,1)
+         tg_mbathy%d_value(:,:,1,1) = dl_bat
+      END IF      
+
+      CALL logger_info(' MIN val mbathy '//TRIM(fct_str(MINVAL( tg_mbathy%d_value(:,:,1,1) )))//&
+         &   ' MAX '//TRIM(fct_str(MAXVAL( tg_mbathy%d_value(:,:,1,1) ))) )
+      CALL logger_info(' MIN val depth  t '//TRIM(fct_str(MINVAL( tg_gdept_0%d_value(:,:,:,1) )))//&
+         &   ' w '//TRIM(fct_str(MINVAL( tg_gdepw_0%d_value(:,:,:,1) )))//&
+         !&   ' 3w '//TRIM(fct_str(MINVAL( tg_gdep3w_0%d_value(:,:,:,1) )))//&
+         &   '  t '//TRIM(fct_str(MINVAL( tg_e3t_0%d_value(:,:,:,1) )))//&
+         &   '  f '//TRIM(fct_str(MINVAL( tg_e3f_0%d_value(:,:,:,1) )))//&
+         &   '  u '//TRIM(fct_str(MINVAL( tg_e3u_0%d_value(:,:,:,1) )))//&
+         &   '  v '//TRIM(fct_str(MINVAL( tg_e3v_0%d_value(:,:,:,1) )))//&
+         &   ' uw '//TRIM(fct_str(MINVAL( tg_e3uw_0%d_value(:,:,:,1) )))//&
+         &   ' vw '//TRIM(fct_str(MINVAL( tg_e3vw_0%d_value(:,:,:,1) )))//&
+         &   '  w '//TRIM(fct_str(MINVAL( tg_e3w_0%d_value(:,:,:,1) ))) )
+      CALL logger_info(' MAX val depth t '//TRIM(fct_str(MAXVAL( tg_gdept_0%d_value(:,:,:,1) )))//&
+         &   ' w '//TRIM(fct_str(MAXVAL( tg_gdepw_0%d_value(:,:,:,1) ))) )!//&
+         !&   ' 3w '//TRIM(fct_str(MAXVAL( tg_gdep3w_0%d_value(:,:,:,1) ))) )
+      CALL logger_info(' MAX val e3    t '//TRIM(fct_str(MAXVAL( tg_e3t_0%d_value(:,:,:,1) )))//&
+         &   ' f '//TRIM(fct_str(MAXVAL( tg_e3f_0%d_value(:,:,:,1) )))//&
+         &   ' u '//TRIM(fct_str(MAXVAL( tg_e3u_0%d_value(:,:,:,1) )))//&
+         &   ' v '//TRIM(fct_str(MAXVAL( tg_e3v_0%d_value(:,:,:,1) )))//&
+         &   ' uw '//TRIM(fct_str(MAXVAL( tg_e3uw_0%d_value(:,:,:,1) )))//&
+         &   ' vw '//TRIM(fct_str(MAXVAL( tg_e3vw_0%d_value(:,:,:,1) )))//&
+         &   ' w '//TRIM(fct_str(MAXVAL( tg_e3w_0%d_value(:,:,:,1) ))) )
+
+   END SUBROUTINE grid_zgr_fill
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_zgr__z(td_nam, jpk) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine set the depth of model levels and the resulting 
+   !>        vertical scale factors.
+   !>
+   !> @details
+   !>
+   !> ** Method  :   z-coordinate system (use in all type of coordinate)
+   !>        The depth of model levels is defined from an analytical
+   !>      function the derivative of which gives the scale factors.
+   !>        both depth and scale factors only depend on k (1d arrays).<br/>
+   !>              w-level: 
+   !>                       - gdepw_1d  = gdep(k)<br/>
+   !>                       - e3w_1d(k) = dk(gdep)(k)     = e3(k)<br/>
+   !>              t-level: 
+   !>                       - gdept_1d  = gdep(k+0.5)<br/>
+   !>                       - e3t_1d(k) = dk(gdep)(k+0.5) = e3(k+0.5)<br/>
+   !>
+   !>
+   !> ** Action  : - gdept_1d, gdepw_1d : depth of T- and W-point (m)
+   !>              - e3t_1d  , e3w_1d   : scale factors at T- and W-levels (m)
+   !>
+   !> !! Reference : Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766.
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from zgr_z
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpk
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+      INTEGER(i4), INTENT(IN   ) :: jpk
+
+      ! local variable
+      CHARACTER(LEN=lc)          :: cl_tmp
+
+      REAL(dp)                   :: zsur, za0, za1, zkth   ! Values set from parameters in
+      REAL(dp)                   :: zacr, zdzmin, zhmax    ! par_CONFIG_Rxx.h90
+!      REAL(dp)                   :: zrefdep                ! depth of the reference level (~10m)
+      REAL(dp)                   :: za2, zkth2, zacr2      ! Values for optional double tanh function set from parameters
+      REAL(dp)                   :: zt, zw                 ! temporary scalars
+      REAL(dp), PARAMETER        :: dp_pp_to_be_computed = NF90_FILL_DOUBLE
+
+      ! loop indices
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      ! Set variables from parameters
+      ! ------------------------------
+      zkth   = td_nam%d_ppkth       
+      zacr   = td_nam%d_ppacr
+      zdzmin = td_nam%d_ppdzmin   
+      zhmax  = td_nam%d_pphmax
+      zkth2  = td_nam%d_ppkth2     
+      zacr2  = td_nam%d_ppacr2
+
+      ! If ppa1 and ppa0 and ppsur are set to pp_to_be_computed
+      !  za0, za1, zsur are computed from ppdzmin , pphmax, ppkth, ppacr
+      IF(   td_nam%d_ppa1  == dp_pp_to_be_computed  .AND.  &
+         &  td_nam%d_ppa0  == dp_pp_to_be_computed  .AND.  &
+         &  td_nam%d_ppsur == dp_pp_to_be_computed           ) THEN
+         !
+         za1  = (  zdzmin - zhmax / REAL(jpk-1,dp)  )                                               &
+            & / ( TANH((1-zkth)/zacr) - zacr/REAL(jpk-1,dp) * ( LOG( COSH( (jpk - zkth) / zacr) )   &
+            &                                               - LOG( COSH( ( 1  - zkth) / zacr) ) ) )
+         za0  = zdzmin  - za1 *             TANH( (1-zkth) / zacr )
+         zsur =   - za0 - za1 * zacr * LOG( COSH( (1-zkth) / zacr )  )
+         ! za2 ???
+      ELSE
+         za1  = td_nam%d_ppa1 
+         za0  = td_nam%d_ppa0
+         zsur = td_nam%d_ppsur
+         za2  = td_nam%d_ppa2                            ! optional (ldbletanh=T) double tanh parameter
+      ENDIF      
+
+      CALL logger_info(' GRID ZGR Z : Reference vertical z-coordinates')
+      CALL logger_info('~~~~~~~~~~~')
+      IF( zkth == 0._dp ) THEN 
+         CALL logger_info('Uniform grid with '//TRIM(fct_str(jpk-1))//' layers')
+         CALL logger_info('Total depth    :'//TRIM(fct_str(zhmax)))
+         CALL logger_info('Layer thickness:'//TRIM(fct_str(zhmax/(jpk-1))))         
+      ELSE
+         IF( za1 == 0._dp .AND. za0 == 0._dp .AND. zsur == 0._dp ) THEN
+            CALL logger_info('zsur, za0, za1 computed from ')
+            CALL logger_info('        zdzmin = '//TRIM(fct_str(zdzmin)))
+            CALL logger_info('        zhmax  = '//TRIM(fct_str(zhmax)))            
+         ENDIF
+            CALL logger_info('Value of coefficients for vertical mesh:')
+            CALL logger_info('      zsur = '//TRIM(fct_str(zsur)))
+            CALL logger_info('      za0  = '//TRIM(fct_str(za0)))
+            CALL logger_info('      za1  = '//TRIM(fct_str(za1)))
+            CALL logger_info('      zkth = '//TRIM(fct_str(zkth)))
+            CALL logger_info('      zacr = '//TRIM(fct_str(zacr)))
+         IF( td_nam%l_dbletanh ) THEN
+            CALL logger_info(' (Double tanh    za2  = '//TRIM(fct_str(za2)))
+            CALL logger_info('  parameters)    zkth2= '//TRIM(fct_str(zkth2)))
+            CALL logger_info('                 zacr2= '//TRIM(fct_str(zacr2)))
+         ENDIF
+      ENDIF
+
+      ! Reference z-coordinate (depth - scale factor at T- and W-points)
+      ! ======================
+      ! init
+      IF( zkth == 0._dp ) THEN            !  uniform vertical grid       
+         za1 = zhmax / REAL(jpk-1,dp) 
+         DO jk = 1, jpk
+            zw = REAL( jk, dp )
+            zt = REAL( jk, dp ) + 0.5_dp
+            tg_gdepw_1d%d_value(1,1,jk,1) = ( zw - 1 ) * za1
+            tg_gdept_1d%d_value(1,1,jk,1) = ( zt - 1 ) * za1
+            tg_e3w_1d%d_value  (1,1,jk,1) =  za1
+            tg_e3t_1d%d_value  (1,1,jk,1) =  za1
+         END DO
+      ELSE                                ! Madec & Imbard 1996 function
+         IF( .NOT. td_nam%l_dbletanh ) THEN
+            DO jk = 1, jpk
+               zw = REAL( jk , dp )
+               zt = REAL( jk , dp ) + 0.5_dp
+               tg_gdepw_1d%d_value(1,1,jk,1) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth) / zacr ) )  )
+               tg_gdept_1d%d_value(1,1,jk,1) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth) / zacr ) )  )
+               tg_e3w_1d%d_value  (1,1,jk,1) =          za0      + za1        * TANH(       (zw-zkth) / zacr   )
+               tg_e3t_1d%d_value  (1,1,jk,1) =          za0      + za1        * TANH(       (zt-zkth) / zacr   )
+            END DO
+         ELSE
+            DO jk = 1, jpk
+               zw = REAL( jk, dp )
+               zt = REAL( jk, dp ) + 0.5_dp
+               ! Double tanh function
+               tg_gdepw_1d%d_value(1,1,jk,1) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth ) / zacr  ) )    &
+                           &                                     + za2 * zacr2* LOG ( COSH( (zw-zkth2) / zacr2 ) )  )
+               tg_gdept_1d%d_value(1,1,jk,1) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth ) / zacr  ) )    &
+                           &                                     + za2 * zacr2* LOG ( COSH( (zt-zkth2) / zacr2 ) )  )
+               tg_e3w_1d  %d_value(1,1,jk,1) =          za0      + za1        * TANH(       (zw-zkth ) / zacr  )      &
+                           &                                     + za2        * TANH(       (zw-zkth2) / zacr2 )
+               tg_e3t_1d  %d_value(1,1,jk,1) =          za0      + za1        * TANH(       (zt-zkth ) / zacr  )      &
+                  &                                              + za2        * TANH(       (zt-zkth2) / zacr2 )
+            END DO
+         ENDIF
+         tg_gdepw_1d%d_value(1,1,1,1) = 0._dp                    ! force first w-level to be exactly at zero
+      ENDIF      
+
+      IF ( td_nam%l_isfcav .OR. td_nam%l_e3_dep ) THEN
+         ! need to be like this to compute the pressure gradient with ISF. 
+         ! If not, level beneath the ISF are not aligned (sum(e3t) /= depth)
+         ! define e3t_0 and e3w_0 as the differences between gdept and gdepw respectively
+         DO jk = 1, jpk-1
+            tg_e3t_1d%d_value(1,1,jk,1) = tg_gdepw_1d%d_value(1,1,jk+1,1)-tg_gdepw_1d%d_value(1,1,jk,1) 
+         END DO
+         ! we don't care because this level is masked in NEMO
+         tg_e3t_1d%d_value(1,1,jpk,1) = tg_e3t_1d%d_value(1,1,jpk-1,1)
+
+         DO jk = 2, jpk
+            tg_e3w_1d%d_value(1,1,jk,1) = tg_gdept_1d%d_value(1,1,jk,1) - tg_gdept_1d%d_value(1,1,jk-1,1) 
+         END DO
+         tg_e3w_1d%d_value(1,1,1,1) = 2._dp * (tg_gdept_1d%d_value(1,1,1,1) - tg_gdepw_1d%d_value(1,1,1,1)) 
+      END IF 
+
+! unused ?
+!!!!gm BUG in s-coordinate this does not work!
+!      ! deepest/shallowest W level Above/Below ~10m
+!      
+!      ! ref. depth with tolerance (10% of minimum layer thickness)
+!      zrefdep = 10._dp - 0.1_dp * MINVAL( tg_e3w_1d%d_value(1,1,:,1) )
+!      
+!      ! shallowest W level Below ~10m
+!      nlb10 = MINLOC( tg_gdepw_1d%d_value(1,1,:,1), mask = tg_gdepw_1d%d_value(1,1,:,1) > zrefdep, dim = 1 )
+!      
+!      ! deepest    W level Above ~10m
+!      nla10 = nlb10 - 1
+!!!!gm end bug
+
+      ! control print
+      CALL logger_info(' GRID ZGR Z : Reference z-coordinate depth and scale factors:')
+      CALL logger_info('~~~~~~~~~~~')
+      WRITE(cl_tmp, "(9x,' level  gdept_1d  gdepw_1d  e3t_1d   e3w_1d  ')" )
+      CALL logger_info(cl_tmp)
+      DO jk=1,jpk
+         WRITE(cl_tmp, "(10x, i4, 4f9.2)" ) jk, tg_gdept_1d%d_value(1,1,jk,1), tg_gdepw_1d%d_value(1,1,jk,1), &
+            &                                   tg_e3t_1d%d_value  (1,1,jk,1), tg_e3w_1d%d_value  (1,1,jk,1)
+         CALL logger_info(cl_tmp)
+      ENDDO
+
+      ! control positivity
+      DO jk = 1, jpk                      
+         IF( tg_e3w_1d%d_value  (1,1,jk,1) <= 0._dp .OR. tg_e3t_1d%d_value  (1,1,jk,1) <= 0._dp )THEN
+            CALL logger_fatal( 'GRID ZGR Z: e3w_1d or e3t_1d =< 0 '    )
+         ENDIF
+         IF( tg_gdepw_1d%d_value(1,1,jk,1) <  0._dp .OR. tg_gdept_1d%d_value(1,1,jk,1) <  0._dp )THEN
+            CALL logger_fatal( 'GRID ZGR Z: gdepw_1d or gdept_1d < 0 ' )
+         ENDIF
+      END DO
+
+   END SUBROUTINE grid_zgr__z
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_zgr__bat(td_nam, td_bathy, td_risfdep) !jpi,jpj,td_bathy,td_risfdep ) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine set bathymetry both in levels and meters
+   !>
+   !> @details
+   !>
+   !> ** Method  :   read or define mbathy and bathy arrays
+   !>       * level bathymetry:
+   !>      The ocean basin geometry is given by a two-dimensional array,
+   !>      mbathy, which is defined as follow :
+   !>            mbathy(ji,jj) = 1, ..., jpk-1, the number of ocean level
+   !>                              at t-point (ji,jj).
+   !>                          = 0  over the continental t-point.
+   !>      The array mbathy is checked to verified its consistency with
+   !>      model option. in particular:
+   !>            mbathy must have at least 1 land grid-points (mbathy<=0)
+   !>                  along closed boundary.
+   !>            mbathy must be cyclic IF jperio=1.
+   !>            mbathy must be lower or equal to jpk-1.
+   !>            isolated ocean grid points are suppressed from mbathy
+   !>                  since they are only connected to remaining
+   !>                  ocean through vertical diffusion.
+   !>      ntopo=-1 :   rectangular channel or bassin with a bump 
+   !>      ntopo= 0 :   flat rectangular channel or basin 
+   !>      ntopo= 1 :   mbathy is read in 'bathy_level.nc' NetCDF file
+   !>                   bathy  is read in 'bathy_meter.nc' NetCDF file
+   !>
+   !> ** Action  : - mbathy: level bathymetry (in level index)
+   !>              - bathy : meter bathymetry (in meters)   
+   !>
+   !> @warning do not manage case ntopo=-1 or 0
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from zgr_bat
+   !> @date October, 2016
+   !> - do not use anymore special case for ORCA grid.
+   !>
+   !> @param[in] td_nam
+   ! @param[in] jpi
+   ! @param[in] jpj
+   !> @param[in] td_bathy
+   !> @param[in] td_risfdep
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+!      INTEGER(i4), INTENT(IN   ) :: jpi
+!      INTEGER(i4), INTENT(IN   ) :: jpj
+      TYPE(TVAR) , INTENT(INOUT) :: td_bathy
+      TYPE(TVAR) , INTENT(INOUT) :: td_risfdep
+
+      ! local variable
+!      INTEGER(i4) :: ii0, ii1
+!      INTEGER(i4) :: ij0, ij1
+
+      REAL(dp)                                  :: zhmin
+
+      ! loop indices
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      CALL logger_info(' GRID ZGR BAT : defines level and meter bathymetry')
+      CALL logger_info(' ~~~~~~~~~~~~~')
+      CALL logger_info(' GRID ZGR BAT : bathymetry read in file')
+
+      IF( td_nam%l_zco )THEN
+         ! zco : read level bathymetry
+
+         ! read variable in bathymetry file
+         tg_mbathy%d_value(:,:,1,1) = INT(td_bathy%d_value(:,:,1,1),i4)
+         tg_misfdep%d_value(:,:,1,1)=1
+         !                                                ! =====================
+!         IF( TRIM(td_nam%c_cfg) == "orca" .AND. td_nam%i_cfg == 2 ) THEN    ! ORCA R2 configuration
+!            !                                             ! =====================
+!            IF( td_nam%i_cla == 0 ) THEN
+!               ii0 = 140   ;   ii1 = 140                  ! Gibraltar Strait open 
+!               ij0 = 102   ;   ij1 = 102                  ! (Thomson, Ocean Modelling, 1995)
+!               tg_mbathy%d_value(ii0:ii1,ij0:ij1,1,1) = 15
+!               CALL logger_info('orca_r2: Gibraltar strait open at i='//&
+!                  &  TRIM(fct_str(ii0))//' j='//TRIM(fct_str(ij0)) )
+!               !
+!               ii0 = 160   ;   ii1 = 160                  ! Bab el mandeb Strait open
+!               ij0 = 88    ;   ij1 = 88                   ! (Thomson, Ocean Modelling, 1995)
+!               tg_mbathy%d_value(ii0:ii1,ij0:ij1,1,1) = 12
+!               CALL logger_info('orca_r2: Bab el Mandeb strait open at i='//&
+!                  &  TRIM(fct_str(ii0))//' j='//TRIM(fct_str(ij0)) )
+!            ENDIF
+!            !
+!         ENDIF
+
+      ENDIF
+
+      IF( td_nam%l_zps .OR. td_nam%l_sco )THEN
+         ! zps or sco : read meter bathymetry
+
+         tg_misfdep%d_value(:,:,:,:)=1
+
+         IF ( td_nam%l_isfcav ) THEN
+            WHERE( td_bathy%d_value(:,:,1,1) <= 0._dp )
+               td_risfdep%d_value(:,:,1,1) = 0._dp
+            END WHERE
+
+            ! set grounded point to 0
+            ! (a treshold could be set here if needed, or set it offline based on the grounded fraction)
+            WHERE ( td_bathy%d_value(:,:,1,1) <= td_risfdep%d_value(:,:,1,1) + td_nam%d_isfhmin )
+               tg_misfdep%d_value(:,:,1,1) = 0
+               td_risfdep%d_value(:,:,1,1) = 0._dp
+               tg_mbathy%d_value (:,:,1,1) = 0
+               td_bathy%d_value  (:,:,1,1) = 0._dp
+            END WHERE
+         END IF
+         !       
+!         IF( TRIM(td_nam%c_cfg) == "orca" .AND. td_nam%i_cfg == 2 ) THEN    ! ORCA R2 configuration
+!            !
+!           IF( td_nam%i_cla == 0 ) THEN
+!              ii0 = 140   ;   ii1 = 140                   ! Gibraltar Strait open 
+!              ij0 = 102   ;   ij1 = 102                   ! (Thomson, Ocean Modelling, 1995)
+!              td_bathy%d_value(ii0:ii1,ij0:ij1,1,1) = 284._dp 
+!              CALL logger_info('orca_r2: Gibraltar strait open at i='//&
+!                 &   TRIM(fct_str(ii0))//' j='//TRIM(fct_str(ij0)) )
+!              !
+!              ii0 = 160   ;   ii1 = 160                   ! Bab el mandeb Strait open
+!              ij0 = 88    ;   ij1 = 88                    ! (Thomson, Ocean Modelling, 1995)
+!              td_bathy%d_value(ii0:ii1,ij0:ij1,1,1) = 137._dp
+!              CALL logger_info('orca_r2: Bab el Mandeb strait open at i='//&
+!                 &   TRIM(fct_str(ii0))//' j='//TRIM(fct_str(ij0)) )
+!           ENDIF
+!           !
+!        ENDIF
+         !
+      ENDIF      
+
+      !==  NO closed seas or lakes  ==!
+      ! already done
+
+      IF ( .NOT. td_nam%l_sco ) THEN
+         !==  set a minimum depth  ==!
+         
+         IF( td_nam%d_hmin < 0._dp ) THEN
+            ! from a nb of level
+            jk = - INT(td_nam%d_hmin, i4)
+         ELSE
+            ! from a depth
+            jk = MINLOC( tg_gdepw_1d%d_value(1,1,:,1), &
+               &  MASK = tg_gdepw_1d%d_value(1,1,:,1) > td_nam%d_hmin, &
+               &  DIM  = 1)
+         ENDIF
+
+         ! minimum depth = ik+1 w-levels
+         zhmin = tg_gdepw_1d%d_value(1,1,jk+1,1)
+         WHERE( td_bathy%d_value(:,:,1,1) <= 0._dp )
+            ! min=0     over the lands
+            td_bathy%d_value(:,:,1,1) = 0._dp
+         ELSE WHERE
+            ! min=zhmin over the oceans
+            td_bathy%d_value(:,:,1,1) = MAX(zhmin, td_bathy%d_value(:,:,1,1))
+         END WHERE
+         CALL logger_info('GRID ZGR BAT: Minimum ocean depth: '//&
+            &   TRIM(fct_str(zhmin))//' minimum number of ocean'//&
+            &   ' levels : '//TRIM(fct_str(jk)))
+      ENDIF
+
+   END SUBROUTINE grid_zgr__bat
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_zgr__zco(jpk) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine define the z-coordinate system
+   !>
+   !> @details
+   !> set 3D coord. arrays to reference 1D array
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from zgr_zco
+   !>
+   !> @param[in] jpk
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      INTEGER(i4), INTENT(IN   ) :: jpk
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      DO jk = 1, jpk
+         tg_gdept_0%d_value (:,:,jk,1) = tg_gdept_1d%d_value(1,1,jk,1)
+         tg_gdepw_0%d_value (:,:,jk,1) = tg_gdepw_1d%d_value(1,1,jk,1)
+         !tg_gdep3w_0%d_value(:,:,jk,1) = tg_gdepw_1d%d_value(1,1,jk,1)
+         tg_e3t_0%d_value   (:,:,jk,1) = tg_e3t_1d%d_value  (1,1,jk,1)
+         tg_e3u_0%d_value   (:,:,jk,1) = tg_e3t_1d%d_value  (1,1,jk,1)
+         tg_e3v_0%d_value   (:,:,jk,1) = tg_e3t_1d%d_value  (1,1,jk,1)
+         tg_e3f_0%d_value   (:,:,jk,1) = tg_e3t_1d%d_value  (1,1,jk,1)
+         tg_e3w_0%d_value   (:,:,jk,1) = tg_e3w_1d%d_value  (1,1,jk,1)
+         tg_e3uw_0%d_value  (:,:,jk,1) = tg_e3w_1d%d_value  (1,1,jk,1)
+         tg_e3vw_0%d_value  (:,:,jk,1) = tg_e3w_1d%d_value  (1,1,jk,1)
+      END DO
+
+   END SUBROUTINE grid_zgr__zco
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!   SUBROUTINE grid_zgr__bat_zoom(td_nam,jpi,jpj) 
+!   !-------------------------------------------------------------------
+!   !> @brief This subroutine : 
+!   !> - close zoom domain boundary if necessary
+!   !> - suppress Med Sea from ORCA R2 and R05 arctic zoom
+!   !> 
+!   !> @author J.Paul
+!   !> @date September, 2015 - Initial version
+!   !>
+!   !> @param[in] td_nam
+!   !> @param[in] jpi
+!   !> @param[in] jpj
+!   !-------------------------------------------------------------------
+!
+!      IMPLICIT NONE
+!
+!      ! Argument      
+!      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+!      INTEGER(i4), INTENT(IN   ) :: jpi
+!      INTEGER(i4), INTENT(IN   ) :: jpj
+!
+!      ! local variable
+!      INTEGER(i4) :: jpizoom
+!      INTEGER(i4) :: jpjzoom
+!
+!      INTEGER(i4) :: ii0, ii1
+!      INTEGER(i4) :: ij0, ij1
+!      ! loop indices
+!      !----------------------------------------------------------------
+!
+!      CALL logger_info('GRID ZGR BAT ZOOM : modify the level bathymetry for zoom domain')
+!      CALL logger_info('~~~~~~~~~~~~')
+!
+!      jpizoom=td_nam%i_izoom
+!      jpjzoom=td_nam%i_jzoom
+!
+!      ! Forced closed boundary if required
+!      IF( td_nam%l_zoom_s ) tg_mbathy%d_value(    :         ,    jpjzoom  ,1,1) = 0
+!      IF( td_nam%l_zoom_w ) tg_mbathy%d_value(     jpizoom  ,   :         ,1,1) = 0
+!      IF( td_nam%l_zoom_e ) tg_mbathy%d_value( jpi+jpizoom-1,   :         ,1,1) = 0
+!      IF( td_nam%l_zoom_n ) tg_mbathy%d_value(    :         ,jpj+jpjzoom-1,1,1) = 0
+!
+!      ! Configuration specific domain modifications
+!      ! (here, ORCA arctic configuration: suppress Med Sea)
+!      IF( TRIM(td_nam%c_cfg) == "orca" .AND. &
+!        & TRIM(td_nam%c_cfz) == "arctic" ) THEN
+!         SELECT CASE ( td_nam%i_cfg )
+!         !                                        ! =======================
+!         CASE ( 2 )                               !  ORCA_R2 configuration
+!            !                                     ! =======================
+!            CALL logger_info('ORCA R2 arctic zoom: suppress the Med Sea')
+!            ii0 = 141   ;   ii1 = 162      ! Sea box i,j indices
+!            ij0 =  98   ;   ij1 = 110
+!            !                                     ! =======================
+!         CASE ( 05 )                              !  ORCA_R05 configuration
+!            !                                     ! =======================
+!            CALL logger_info('ORCA R05 arctic zoom: suppress the Med Sea')
+!            ii0 = 563   ;   ii1 = 642      ! zero over the Med Sea boxe
+!            ij0 = 314   ;   ij1 = 370 
+!         END SELECT
+!         !
+!         tg_mbathy%d_value( ii0:ii1, ij0:ij1, 1, 1) = 0   ! zero over the Med Sea boxe
+!         !
+!      ENDIF
+!
+!   END SUBROUTINE grid_zgr__bat_zoom
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_zgr__bat_ctl(td_nam, jpi, jpj, jpk) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine check the bathymetry in levels
+   !>
+   !> @details
+   !>
+   !> 
+   !> ** Method  :   The array mbathy is checked to verified its consistency
+   !>      with the model options. in particular:
+   !>            mbathy must have at least 1 land grid-points (mbathy<=0)
+   !>                  along closed boundary.
+   !>            mbathy must be cyclic IF jperio=1.
+   !>            mbathy must be lower or equal to jpk-1.
+   !>            isolated ocean grid points are suppressed from mbathy
+   !>                  since they are only connected to remaining
+   !>                  ocean through vertical diffusion.
+   !>      C A U T I O N : mbathy will be modified during the initializa-
+   !>      tion phase to become the number of non-zero w-levels of a water
+   !>      column, with a minimum value of 1.
+   !>
+   !> ** Action  : - update mbathy: level bathymetry (in level index)
+   !>              - update bathy : meter bathymetry (in meters)
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !> @param[in] jpk
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+      INTEGER(i4), INTENT(IN   ) :: jpi
+      INTEGER(i4), INTENT(IN   ) :: jpj
+      INTEGER(i4), INTENT(IN   ) :: jpk
+
+      ! local variable
+      INTEGER(i4) :: icompt, ibtest, ikmax         ! temporary integers
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      CALL logger_info('GRID ZGR BAT CTL: check the bathymetry')
+      CALL logger_info('~~~~~~~~~~~~~~~')
+      CALL logger_info('                   suppress isolated ocean grid points')
+      CALL logger_info('                   -----------------------------------')
+
+      icompt = 0
+      DO jl = 1, 2
+         IF( td_nam%i_perio == 1 .OR. &
+           & td_nam%i_perio == 4 .OR. &
+           & td_nam%i_perio == 6 ) THEN
+            tg_mbathy%d_value( 1 ,:,1,1) = tg_mbathy%d_value(jpi-1,:,1,1)           ! local domain is cyclic east-west
+            tg_mbathy%d_value(jpi,:,1,1) = tg_mbathy%d_value(  2  ,:,1,1)
+         ENDIF
+         DO jj = 2, jpj-1
+            DO ji = 2, jpi-1
+               ibtest = MAX(  tg_mbathy%d_value(ji-1,jj  ,1,1), &
+                  &           tg_mbathy%d_value(ji+1,jj  ,1,1), &
+                  &           tg_mbathy%d_value(ji  ,jj-1,1,1), &
+                  &           tg_mbathy%d_value(ji  ,jj+1,1,1)  )
+               IF( ibtest < tg_mbathy%d_value(ji,jj,1,1) ) THEN
+                  CALL logger_info(' the number of ocean level at '//&
+                     &             'grid-point (i,j) =  ('//TRIM(fct_str(ji))//&
+                     &             ','//TRIM(fct_str(jj))//') is changed from '//&
+                     &             TRIM(fct_str(tg_mbathy%d_value(ji,jj,1,1)))//' to '//&
+                     &             TRIM(fct_str(ibtest)) )
+                  tg_mbathy%d_value(ji,jj,1,1) = ibtest
+                  icompt = icompt + 1
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      !! lk_mpp not used
+
+      IF( icompt == 0 ) THEN
+         CALL logger_info('     no isolated ocean grid points')
+      ELSE
+         CALL logger_info(TRIM(fct_str(icompt))//' ocean grid points suppressed')
+      ENDIF
+
+      !! lk_mpp not used
+
+      !                                          ! East-west cyclic boundary conditions
+      IF( td_nam%i_perio == 0 ) THEN
+         CALL logger_info(' mbathy set to 0 along east and west boundary:'//&
+            &  ' nperio = '//TRIM(fct_str(td_nam%i_perio)) )
+         !! lk_mpp not used
+         IF( td_nam%l_zco .OR. td_nam%l_zps ) THEN
+            tg_mbathy%d_value( 1 ,:,1,1) = 0
+            tg_mbathy%d_value(jpi,:,1,1) = 0
+         ELSE
+            tg_mbathy%d_value( 1 ,:,1,1) = jpk-1
+            tg_mbathy%d_value(jpi,:,1,1) = jpk-1
+         ENDIF
+      ELSEIF( td_nam%i_perio == 1 .OR. &
+            & td_nam%i_perio == 4 .OR. &
+            & td_nam%i_perio == 6 ) THEN
+         CALL logger_info(' east-west cyclic boundary conditions on mbathy:'//&
+            &  ' nperio = '//TRIM(fct_str(td_nam%i_perio)) )
+         tg_mbathy%d_value( 1 ,:,1,1) = tg_mbathy%d_value(jpi-1,:,1,1)
+         tg_mbathy%d_value(jpi,:,1,1) = tg_mbathy%d_value(  2  ,:,1,1)
+      ELSEIF( td_nam%i_perio == 2 ) THEN
+         CALL logger_info('   equatorial boundary conditions on mbathy:'//&
+            ' nperio = '//TRIM(fct_str(td_nam%i_perio)) )
+      ELSE
+         CALL logger_info('    e r r o r')
+         CALL logger_info('    parameter , nperio = '//TRIM(fct_str(td_nam%i_perio)) )
+         !         STOP 'dom_mba'
+      ENDIF
+
+      !  Boundary condition on mbathy
+!!gm  !!bug ???  think about it !
+      !   ... mono- or macro-tasking: T-point, >0, 2D array, no slab
+      CALL lbc_lnk( tg_mbathy%d_value(:,:,1,1), 'T', td_nam%i_perio, 1._dp )
+
+
+      ! Number of ocean level inferior or equal to jpkm1
+      ikmax = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ikmax = MAX( ikmax, INT(tg_mbathy%d_value(ji,jj,1,1),i4) )
+         END DO
+      END DO      
+!!gm  !!! test to do:   ikmax = MAX( mbathy(:,:) )   ???
+      IF( ikmax > jpk-1 ) THEN
+         CALL logger_info(' maximum number of ocean level = '//TRIM(fct_str(ikmax))//' >  jpk-1')
+         CALL logger_info(' change jpk to '//TRIM(fct_str(ikmax+1))//' to use the exact ead bathymetry')
+      ELSE IF( ikmax < jpk-1 ) THEN
+         CALL logger_info(' maximum number of ocean level = '//TRIM(fct_str(ikmax))//' < jpk-1')
+         CALL logger_info(' you can decrease jpk to '//TRIM(fct_str(ikmax+1)))
+      ENDIF      
+
+   END SUBROUTINE grid_zgr__bat_ctl
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_zgr__bot_level()!td_nam,jpi,jpj) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine defines the vertical index of ocean bottom (mbk. arrays)
+   !>
+   !> @details
+   !>
+   !> ** Method  :   computes from mbathy with a minimum value of 1 over land
+   !>
+   !> ** Action  :   mbkt, mbku, mbkv :   vertical indices of the deeptest 
+   !>                                     ocean level at t-, u- & v-points
+   !>                                     (min value = 1 over land)
+   !> 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from zgr_bot_level
+   !>
+   ! @param[in] td_nam
+   ! @param[in] jpi
+   ! @param[in] jpj
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+!      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+!      INTEGER(i4), INTENT(IN   ) :: jpi
+!      INTEGER(i4), INTENT(IN   ) :: jpj
+
+      ! local variable
+
+      ! loop indices
+!      INTEGER(i4) :: ji
+!      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      CALL logger_info('GRID ZGR BOT LEVEL: ocean bottom k-index of T-, U-, V- and W-levels ')
+      CALL logger_info('    ~~~~~~~~~~~~~')
+
+      ! bottom k-index of T-level (=1 over land)
+      tg_mbkt%d_value(:,:,1,1) = MAX( tg_mbathy%d_value(:,:,1,1) , 1._dp )
+
+!      ! bottom k-index of W-level = mbkt+1
+!      ! bottom k-index of u- (v-) level
+!      DO jj = 1, jpj-1                      ! bottom k-index of u- (v-) level
+!         DO ji = 1, jpi-1
+!            tg_mbku%d_value(ji,jj,1,1) = MIN(  tg_mbkt%d_value(ji+1,jj  ,1,1) , &
+!               &                               tg_mbkt%d_value(ji  ,jj  ,1,1)  )
+!
+!            tg_mbkv%d_value(ji,jj,1,1) = MIN(  tg_mbkt%d_value(ji  ,jj+1,1,1) , &
+!               &                               tg_mbkt%d_value(ji  ,jj  ,1,1)  )
+!         END DO
+!      END DO
+!
+!      CALL lbc_lnk(tg_mbku%d_value(:,:,1,1),'U', td_nam%i_perio, 1._dp)
+!      CALL lbc_lnk(tg_mbkv%d_value(:,:,1,1),'U', td_nam%i_perio, 1._dp)
+
+   END SUBROUTINE grid_zgr__bot_level
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_zgr__top_level()!td_nam,jpi,jpj) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine defines the vertical index of ocean top (mik. arrays)
+   !>
+   !> @details
+   !>
+   !> ** Method  :   computes from misfdep with a minimum value of 1
+   !>
+   !> ** Action  :   mikt, miku, mikv :   vertical indices of the shallowest 
+   !>                                     ocean level at t-, u- & v-points
+   !>                                     (min value = 1)
+   !> 
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from zgr_top_level
+   !>
+   ! @param[in] td_nam
+   ! @param[in] jpi
+   ! @param[in] jpj
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+!      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+!      INTEGER(i4), INTENT(IN   ) :: jpi
+!      INTEGER(i4), INTENT(IN   ) :: jpj
+      ! local variable
+
+      ! loop indices
+!      INTEGER(i4) :: ji
+!      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      CALL logger_info('    GRID ZGR TOP LEVEL : ocean top k-index of T-, U-, V- and W-levels ')
+      CALL logger_info('    ~~~~~~~~~~~~~')
+
+      ! top k-index of T-level (=1)
+      tg_mikt%d_value(:,:,1,1) = MAX( tg_misfdep%d_value(:,:,1,1) , 1._dp )
+
+!      ! top k-index of W-level (=mikt)
+!      ! top k-index of U- (U-) level
+!      DO jj = 1, jpj-1                       ! top k-index of U- (U-) level
+!         DO ji = 1, jpi-1
+!            tg_miku%d_value(ji,jj,1,1) = MAX(  tg_mikt%d_value(ji+1,jj  ,1,1), &
+!               &                               tg_mikt%d_value(ji  ,jj  ,1,1)  )
+!
+!            tg_mikv%d_value(ji,jj,1,1) = MAX(  tg_mikt%d_value(ji  ,jj+1,1,1), &
+!               &                               tg_mikt%d_value(ji  ,jj  ,1,1)  )
+!
+!            tg_mikf%d_value(ji,jj,1,1) = MAX(  tg_mikt%d_value(ji  ,jj+1,1,1), &
+!               &                               tg_mikt%d_value(ji  ,jj  ,1,1), &
+!               &                               tg_mikt%d_value(ji+1,jj  ,1,1), &
+!               &                               tg_mikt%d_value(ji+1,jj+1,1,1)  )
+!         END DO
+!      END DO
+!
+!      CALL lbc_lnk(tg_miku%d_value(:,:,1,1),'U',td_nam%i_perio,1._dp)
+!      CALL lbc_lnk(tg_mikv%d_value(:,:,1,1),'V',td_nam%i_perio,1._dp)
+!      CALL lbc_lnk(tg_mikf%d_value(:,:,1,1),'F',td_nam%i_perio,1._dp)
+
+   END SUBROUTINE grid_zgr__top_level
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_zgr_zps_init(jpi, jpj) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine initialise global variable needed to compute vertical
+   !>        mesh
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      INTEGER(i4), INTENT(IN) :: jpi
+      INTEGER(i4), INTENT(IN) :: jpj
+
+      ! local variable
+      REAL(dp), DIMENSION(jpi,jpj) :: dl_tmp
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      dl_tmp(:,:)=dp_fill
+
+      tg_e3tp    =var_init('e3t_ps   ',dl_tmp(:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)
+      tg_e3wp    =var_init('e3w_ps   ',dl_tmp(:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)
+
+   END SUBROUTINE grid_zgr_zps_init
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_zgr_zps_clean() 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine clean hgr structure
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+
+      CALL var_clean(tg_e3tp     )
+      CALL var_clean(tg_e3wp     )
+      
+   END SUBROUTINE grid_zgr_zps_clean
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_zgr__zps_fill(td_nam, jpi, jpj, jpk, td_bathy, td_risfdep) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine define the depth and vertical scale factor in partial step
+   !>      z-coordinate case
+   !>
+   !> @details
+   !> ** Method  :   Partial steps : computes the 3D vertical scale factors
+   !>      of T-, U-, V-, W-, UW-, VW and F-points that are associated with
+   !>      a partial step representation of bottom topography.
+   !>
+   !>        The reference depth of model levels is defined from an analytical
+   !>      function the derivative of which gives the reference vertical
+   !>      scale factors.
+   !>        From  depth and scale factors reference, we compute there new value
+   !>      with partial steps  on 3d arrays ( i, j, k ).
+   !>
+   !>              w-level: gdepw_0(i,j,k)  = gdep(k)
+   !>                       e3w_0(i,j,k) = dk(gdep)(k)     = e3(i,j,k)
+   !>              t-level: gdept_0(i,j,k)  = gdep(k+0.5)
+   !>                       e3t_0(i,j,k) = dk(gdep)(k+0.5) = e3(i,j,k+0.5)
+   !>
+   !>        With the help of the bathymetric file ( bathymetry_depth_ORCA_R2.nc),
+   !>      we find the mbathy index of the depth at each grid point.
+   !>      This leads us to three cases:
+   !>
+   !>              - bathy = 0 => mbathy = 0
+   !>              - 1 < mbathy < jpkm1    
+   !>              - bathy > gdepw_0(jpk) => mbathy = jpkm1  
+   !>
+   !>        Then, for each case, we find the new depth at t- and w- levels
+   !>      and the new vertical scale factors at t-, u-, v-, w-, uw-, vw- 
+   !>      and f-points.
+   !> 
+   !>        This routine is given as an example, it must be modified
+   !>      following the user s desiderata. nevertheless, the output as
+   !>      well as the way to compute the model levels and scale factors
+   !>      must be respected in order to insure second order accuracy
+   !>      schemes.
+   !>
+   !>  @warrning gdept_1d, gdepw_1d and e3._1d are positives
+   !>            gdept_0, gdepw_0 and e3. are positives
+   !>      
+   !>  Reference :   Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270.
+   !> set 3D coord. arrays to reference 1D array
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from zgr_zps
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !> @param[in] jpk
+   !> @param[inout] td_bathy
+   !> @param[inout] td_risfdep
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+      INTEGER(i4), INTENT(IN   ) :: jpi
+      INTEGER(i4), INTENT(IN   ) :: jpj
+      INTEGER(i4), INTENT(IN   ) :: jpk
+      TYPE(TVAR) , INTENT(INOUT) :: td_bathy
+      TYPE(TVAR) , INTENT(INOUT) :: td_risfdep
+
+      ! local variable
+      REAL(dp)    :: zmax             ! Maximum depth
+      REAL(dp)    :: zdepwp, zdepth   ! Ajusted ocean depth to avoid too small e3t
+      REAL(dp)    :: ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points
+      REAL(dp)    :: zdiff            ! temporary scalar
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+
+      INTEGER(i4) :: ik
+      INTEGER(i4) :: it
+      !----------------------------------------------------------------
+
+      CALL logger_info('GRID ZGR ZPS : z-coordinate with partial steps')
+      CALL logger_info('mbathy is recomputed : bathy_level file is NOT used')
+
+      ! bathymetry in level (from bathy_meter)
+
+      ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_1d(jpkm1) )
+      zmax = tg_gdepw_1d%d_value(1,1,jpk,1) + tg_e3t_1d%d_value(1,1,jpk,1)
+
+      ! bounded value of bathy (min already set at the end of zgr_bat)
+      td_bathy%d_value(:,:,1,1) = MIN(zmax, td_bathy%d_value(:,:,1,1))
+
+      WHERE( td_bathy%d_value(:,:,1,1) == 0._dp )
+         ! land  : set mbathy to 0
+         tg_mbathy%d_value(:,:,1,1) = 0
+      ELSE WHERE
+         ! ocean : initialize mbathy to the max ocean level
+         tg_mbathy%d_value(:,:,1,1) = jpk-1
+      END WHERE
+
+      ! Compute mbathy for ocean points (i.e. the number of ocean levels)
+      ! find the number of ocean levels such that the last level thickness
+      ! is larger than the minimum of e3zps_min and e3zps_rat * e3t_1d (where
+      ! e3t_1d is the reference level thickness
+      DO jk = jpk-1, 1, -1
+         zdepth = tg_gdepw_1d%d_value(1,1,jk,1) +  MIN( td_nam%d_e3zps_min, &
+            &                                           td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,jk,1))
+
+         WHERE( 0._dp < td_bathy%d_value(:,:,1,1) .AND. &
+            &           td_bathy%d_value(:,:,1,1) <= zdepth )
+            tg_mbathy%d_value(:,:,1,1) = jk-1
+         END WHERE
+      END DO
+
+      ! Scale factors and depth at T- and W-points
+      DO jk = 1, jpk                        
+         ! intitialization to the reference z-coordinate
+         tg_gdept_0%d_value(:,:,jk,1) = tg_gdept_1d%d_value(1,1,jk,1)
+         tg_gdepw_0%d_value(:,:,jk,1) = tg_gdepw_1d%d_value(1,1,jk,1)
+         tg_e3t_0%d_value  (:,:,jk,1) = tg_e3t_1d%d_value  (1,1,jk,1)
+         tg_e3w_0%d_value  (:,:,jk,1) = tg_e3w_1d%d_value  (1,1,jk,1)
+      END DO
+
+      IF ( td_nam%l_isfcav )THEN
+         ! Bathy, iceshelf draft, scale factor and depth at T- and W- points in case of isf
+         CALL grid_zgr__isf_fill( td_nam, jpi,jpj,jpk, td_bathy, td_risfdep )
+
+      ELSE ! .NOT. td_nam%l_isfcav
+         !
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ik = tg_mbathy%d_value(ji,jj,1,1)
+               IF( ik > 0 ) THEN               
+                  ! ocean point only
+                  IF( ik == jpk-1 ) THEN
+                     ! max ocean level case
+                     zdepwp = td_bathy%d_value(ji,jj,1,1)
+                     ze3tp  = td_bathy%d_value(ji,jj,1,1) - tg_gdepw_1d%d_value(1,1,ik,1)
+                     ze3wp  = 0.5_dp * tg_e3w_1d%d_value(1,1,ik,1) &
+                        &            * ( 1._dp + ( ze3tp/tg_e3t_1d%d_value(1,1,ik,1) ) )
+                     tg_e3t_0%d_value  (ji,jj,ik  ,1) = ze3tp
+                     tg_e3t_0%d_value  (ji,jj,ik+1,1) = ze3tp
+                     tg_e3w_0%d_value  (ji,jj,ik  ,1) = ze3wp
+                     tg_e3w_0%d_value  (ji,jj,ik+1,1) = ze3tp
+
+                     tg_gdepw_0%d_value(ji,jj,ik+1,1) = zdepwp
+                     tg_gdept_0%d_value(ji,jj,ik  ,1) = tg_gdept_1d%d_value( 1, 1,ik-1,1) + ze3wp
+                     tg_gdept_0%d_value(ji,jj,ik+1,1) = tg_gdept_0%d_value (ji,jj,ik  ,1) + ze3tp
+                     !
+                  ELSE
+                     ! standard case
+                     IF( td_bathy%d_value(ji,jj,1,1) <= tg_gdepw_1d%d_value(1,1,ik+1,1) ) THEN
+                        tg_gdepw_0%d_value(ji,jj,ik+1,1) = td_bathy%d_value(ji,jj,1,1)
+                     ELSE
+                        tg_gdepw_0%d_value(ji,jj,ik+1,1) = tg_gdepw_1d%d_value(1,1,ik+1,1)
+                     ENDIF
+                     !gm Bug?  check the gdepw_1d
+                     !       ... on ik
+                     tg_gdept_0%d_value(ji,jj,ik,1) = tg_gdepw_1d%d_value( 1, 1,ik  ,1) + &
+                     &        ( tg_gdepw_0%d_value(ji,jj,ik+1,1) - tg_gdepw_1d%d_value(1,1,ik,1) )  &
+                     &    * ( (tg_gdept_1d%d_value( 1, 1,ik  ,1) - tg_gdepw_1d%d_value(1,1,ik,1) )  &
+                     &      / (tg_gdepw_1d%d_value( 1, 1,ik+1,1) - tg_gdepw_1d%d_value(1,1,ik,1) ) )
+
+                     tg_e3t_0%d_value  (ji,jj,ik,1) = tg_e3t_1d%d_value  ( 1, 1,ik  ,1)            &
+                     &     * ( tg_gdepw_0%d_value (ji,jj,ik+1,1) - tg_gdepw_1d%d_value(1,1,ik,1) ) &
+                     &     / ( tg_gdepw_1d%d_value( 1, 1,ik+1,1) - tg_gdepw_1d%d_value(1,1,ik,1) ) 
+
+                     tg_e3w_0%d_value  (ji,jj,ik,1) = 0.5_dp   &
+                     &                               * ( tg_gdepw_0%d_value(ji,jj,ik+1,1) &
+                     &                                 + tg_gdepw_1d%d_value(1,1 ,ik+1,1) &
+                     &                                 - tg_gdepw_1d%d_value(1,1 ,ik  ,1) * 2._dp ) &
+                     &                               * ( tg_e3w_1d%d_value (1 ,1 ,ik  ,1) &
+                     &                                 / (tg_gdepw_1d%d_value(1,1,ik+1,1) - tg_gdepw_1d%d_value(1,1,ik,1)) )
+
+                     !       ... on ik+1
+                     tg_e3w_0%d_value  (ji,jj,ik+1,1) = tg_e3t_0%d_value  (ji,jj,ik,1)
+                     tg_e3t_0%d_value  (ji,jj,ik+1,1) = tg_e3t_0%d_value  (ji,jj,ik,1)
+                     tg_gdept_0%d_value(ji,jj,ik+1,1) = tg_gdept_0%d_value(ji,jj,ik,1) + tg_e3t_0%d_value(ji,jj,ik,1)
+                  ENDIF
+               ENDIF
+            END DO
+         END DO
+         !
+         it = 0
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ik = tg_mbathy%d_value(ji,jj,1,1)
+               IF( ik > 0 ) THEN               ! ocean point only
+                  tg_e3tp%d_value (ji,jj,1,1) = tg_e3t_0%d_value(ji,jj,ik,1)
+                  tg_e3wp%d_value (ji,jj,1,1) = tg_e3w_0%d_value(ji,jj,ik,1)
+                  ! test
+                  zdiff= tg_gdepw_0%d_value(ji,jj,ik+1,1) - tg_gdept_0%d_value(ji,jj,ik,1)
+                  IF( zdiff <= 0._dp ) THEN 
+                     it = it + 1
+                     CALL logger_info(' it      = '//TRIM(fct_str(it))//&
+                        &             ' ik      = '//TRIM(fct_str(ik))//&
+                        &             ' (i,j)   = ('//TRIM(fct_str(ji))//','//TRIM(fct_str(jj))//')')
+                     CALL logger_info(' bathy = '//TRIM(fct_str(td_bathy%d_value(ji,jj,1,1))))
+                     CALL logger_info(' gdept_0 = '//TRIM(fct_str( tg_gdept_0%d_value(ji,jj,ik  ,1) ))//&
+                        &             ' gdepw_0 = '//TRIM(fct_str( tg_gdepw_0%d_value(ji,jj,ik+1,1) ))//&
+                        &             ' zdiff = '//TRIM(fct_str(zdiff)) )
+                     CALL logger_info(' e3tp    = '//TRIM(fct_str(tg_e3t_0%d_value(ji,jj,ik,1)))//&
+                        &             ' e3wp    = '//TRIM(fct_str(tg_e3w_0%d_value(ji,jj,ik,1)))  )
+                  ENDIF
+               ENDIF
+            END DO
+         END DO
+      ENDIF
+      !
+!      IF ( td_nam%l_isfcav ) THEN
+!      ! (ISF) Definition of e3t, u, v, w for ISF case
+!         CALL grid_zgr__isf_fill_e3x( jpi,jpj, &
+!            &                        td_risfdep )
+!      END IF
+
+      ! Scale factors and depth at U-, V-, UW and VW-points
+      DO jk = 1, jpk
+         ! initialisation to z-scale factors
+         tg_e3u_0%d_value (:,:,jk,1) = tg_e3t_1d%d_value(1,1,jk,1)
+         tg_e3v_0%d_value (:,:,jk,1) = tg_e3t_1d%d_value(1,1,jk,1)
+         tg_e3uw_0%d_value(:,:,jk,1) = tg_e3w_1d%d_value(1,1,jk,1)
+         tg_e3vw_0%d_value(:,:,jk,1) = tg_e3w_1d%d_value(1,1,jk,1)
+      END DO
+
+      ! Computed as the minimum of neighbooring scale factors
+      DO jk = 1,jpk
+         DO jj = 1, jpj - 1
+            DO ji = 1, jpi - 1 
+               tg_e3u_0%d_value (ji,jj,jk,1) = MIN( tg_e3t_0%d_value(ji,jj,jk,1), tg_e3t_0%d_value(ji+1,jj  ,jk,1) )
+               tg_e3v_0%d_value (ji,jj,jk,1) = MIN( tg_e3t_0%d_value(ji,jj,jk,1), tg_e3t_0%d_value(ji  ,jj+1,jk,1) )
+               tg_e3uw_0%d_value(ji,jj,jk,1) = MIN( tg_e3w_0%d_value(ji,jj,jk,1), tg_e3w_0%d_value(ji+1,jj  ,jk,1) )
+               tg_e3vw_0%d_value(ji,jj,jk,1) = MIN( tg_e3w_0%d_value(ji,jj,jk,1), tg_e3w_0%d_value(ji  ,jj+1,jk,1) )
+            END DO
+         END DO
+      END DO
+
+      IF ( td_nam%l_isfcav ) THEN
+         ! (ISF) define e3uw (adapted for 2 cells in the water column)
+         CALL grid_zgr__isf_fill_e3uw(jpi,jpj)
+      END IF
+
+      ! lateral boundary conditions
+      CALL lbc_lnk( tg_e3u_0%d_value (:,:,:,1), 'U', td_nam%i_perio, 1._dp )
+      CALL lbc_lnk( tg_e3v_0%d_value (:,:,:,1), 'V', td_nam%i_perio, 1._dp )
+      CALL lbc_lnk( tg_e3uw_0%d_value(:,:,:,1), 'U', td_nam%i_perio, 1._dp )
+      CALL lbc_lnk( tg_e3vw_0%d_value(:,:,:,1), 'V', td_nam%i_perio, 1._dp )
+
+      ! set to z-scale factor if zero (i.e. along closed boundaries)
+      DO jk = 1, jpk
+         WHERE( tg_e3u_0%d_value (:,:,jk,1) == 0._dp )   tg_e3u_0%d_value (:,:,jk,1) = tg_e3t_1d%d_value(1,1,jk,1)
+         WHERE( tg_e3v_0%d_value (:,:,jk,1) == 0._dp )   tg_e3v_0%d_value (:,:,jk,1) = tg_e3t_1d%d_value(1,1,jk,1)
+         WHERE( tg_e3uw_0%d_value(:,:,jk,1) == 0._dp )   tg_e3uw_0%d_value(:,:,jk,1) = tg_e3w_1d%d_value(1,1,jk,1)
+         WHERE( tg_e3vw_0%d_value(:,:,jk,1) == 0._dp )   tg_e3vw_0%d_value(:,:,jk,1) = tg_e3w_1d%d_value(1,1,jk,1)
+      END DO
+
+      !! Scale factor at F-point
+      !DO jk = 1, jpk                        
+      !   ! initialisation to z-scale factors
+      !   tg_e3f_0%d_value(:,:,jk,1) = tg_e3t_1d%d_value(1,1,jk,1)
+      !END DO
+      !
+      !! Computed as the minimum of neighbooring V-scale factors
+      !DO jk = 1, jpk
+      !   DO jj = 1, jpj - 1
+      !      DO ji = 1, jpi - 1
+      !         tg_e3f_0%d_value(ji,jj,jk,1) = MIN( tg_e3v_0%d_value(ji,jj,jk,1), tg_e3v_0%d_value(ji+1,jj,jk,1) )
+      !      END DO
+      !   END DO
+      !END DO
+      !! Lateral boundary conditions
+      !CALL lbc_lnk( tg_e3f_0%d_value(:,:,:,1), 'F', td_nam%i_perio, 1._dp )
+      !
+      !! set to z-scale factor if zero (i.e. along closed boundaries)
+      !DO jk = 1, jpk
+      !   WHERE( tg_e3f_0%d_value(:,:,jk,1) == 0._dp )   tg_e3f_0%d_value(:,:,jk,1) = tg_e3t_1d%d_value(1,1,jk,1)
+      !END DO
+
+!!gm  bug ? :  must be a do loop with mj0,mj1
+
+      ! we duplicate factor scales for jj = 1 and jj = 2
+      tg_e3t_0%d_value(:,1,:,1) = tg_e3t_0%d_value(:,2,:,1)
+      tg_e3w_0%d_value(:,1,:,1) = tg_e3w_0%d_value(:,2,:,1) 
+      tg_e3u_0%d_value(:,1,:,1) = tg_e3u_0%d_value(:,2,:,1) 
+      tg_e3v_0%d_value(:,1,:,1) = tg_e3v_0%d_value(:,2,:,1) 
+      !tg_e3f_0%d_value(:,1,:,1) = tg_e3f_0%d_value(:,2,:,1)
+
+      ! Control of the sign
+      IF( MINVAL( tg_e3t_0%d_value  (:,:,:,:) ) <= 0._dp )   CALL logger_fatal( ' GRID ZGR ZPS:   e r r o r   e3t_0 <= 0' )
+      IF( MINVAL( tg_e3w_0%d_value  (:,:,:,:) ) <= 0._dp )   CALL logger_fatal( ' GRID ZGR ZPS:   e r r o r   e3w_0 <= 0' )
+      IF( MINVAL( tg_gdept_0%d_value(:,:,:,:) ) <  0._dp )   CALL logger_fatal( ' GRID ZGR ZPS:   e r r o r   gdept_0 <  0' )
+      IF( MINVAL( tg_gdepw_0%d_value(:,:,:,:) ) <  0._dp )   CALL logger_fatal( ' GRID ZGR ZPS:   e r r o r   gdepw_0 <  0' )
+
+      !! Compute gdep3w_0 (vertical sum of e3w)
+      !IF ( td_nam%l_isfcav ) THEN 
+      !   ! if cavity
+      !   CALL grid_zgr__isf_fill_gdep3w_0(jpi, jpj, jpk, td_risfdep)
+      !ELSE 
+      !   ! no cavity
+      !   tg_gdep3w_0%d_value(:,:,1,1) = 0.5_dp * tg_e3w_0%d_value(:,:,1,1)
+      !   DO jk = 2, jpk
+      !      tg_gdep3w_0%d_value(:,:,jk,1) = tg_gdep3w_0%d_value(:,:,jk-1,1) + tg_e3w_0%d_value(:,:,jk,1)
+      !   END DO
+      !END IF
+
+   END SUBROUTINE grid_zgr__zps_fill
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_zgr__isf_fill(td_nam, jpi,jpj,jpk, td_bathy, td_risfdep) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine check the bathymetry in levels
+   !>
+   !> @details
+   !> ** Method  :   THe water column have to contained at least 2 cells
+   !>                Bathymetry and isfdraft are modified (dig/close) to respect
+   !>                this criterion.
+   !>                 
+   !>   
+   !> ** Action  : - test compatibility between isfdraft and bathy 
+   !>              - bathy and isfdraft are modified   
+   !> 
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from zgr_isf
+   !> @date October, 2016
+   !> - add ice sheet coupling case
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !> @param[in] jpk
+   !> @param[in] td_bathy
+   !> @param[in] td_risfdep
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+      INTEGER(i4), INTENT(IN   ) :: jpi
+      INTEGER(i4), INTENT(IN   ) :: jpj
+      INTEGER(i4), INTENT(IN   ) :: jpk
+      TYPE(TVAR) , INTENT(INOUT) :: td_bathy
+      TYPE(TVAR) , INTENT(INOUT) :: td_risfdep
+
+      ! local variable
+      INTEGER(i4) :: ik, it
+      INTEGER(i4) :: ibtest, ibtestim1, ibtestip1, ibtestjm1, ibtestjp1   ! (ISF)
+
+      INTEGER(i4), ALLOCATABLE, DIMENSION(:,:) :: zmbathy, zmisfdep     ! 2D workspace (ISH)
+
+      REAL(dp)    :: zdepth           ! Ajusted ocean depth to avoid too small e3t
+      REAL(dp)    :: zmax             ! Maximum and minimum depth
+      REAL(dp)    :: zbathydiff, zrisfdepdiff  ! isf temporary scalar
+      REAL(dp)    :: zdepwp           ! Ajusted ocean depth to avoid too small e3t
+      REAL(dp)    :: ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points
+      REAL(dp)    :: zdiff            ! temporary scalar
+
+      REAL(dp), ALLOCATABLE, DIMENSION(:,:) :: zrisfdep, zmask   ! 2D workspace (ISH)
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      ! (ISF) compute misfdep
+      WHERE( td_risfdep%d_value(:,:,1,1) == 0._dp .AND. &
+           & td_bathy%d_value  (:,:,1,1) /= 0 )
+        ! open water : set misfdep to 1
+        tg_misfdep%d_value(:,:,1,1) = 1
+      ELSEWHERE
+         ! iceshelf : initialize misfdep to second level
+         tg_misfdep%d_value(:,:,1,1) = 2
+      END WHERE
+
+      ALLOCATE(zmask   (jpi,jpj))
+      ALLOCATE(zrisfdep(jpi,jpj))
+      ALLOCATE(zmisfdep(jpi,jpj))
+
+      ! Compute misfdep for ocean points (i.e. first wet level) 
+      ! find the first ocean level such that the first level thickness 
+      ! is larger than the bot_level of e3zps_min and e3zps_rat * e3t_0 (where 
+      ! e3t_0 is the reference level thickness
+      DO jk = 2, jpk-1 
+         zdepth = tg_gdepw_1d%d_value(1,1,jk+1,1) - MIN( td_nam%d_e3zps_min, &
+            &                                            td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,jk,1) ) 
+         WHERE( 0._dp < td_risfdep%d_value(:,:,1,1) .AND. &
+         &              td_risfdep%d_value(:,:,1,1) >= zdepth )
+            tg_misfdep%d_value(:,:,1,1) = jk+1 
+         END WHERE
+      END DO 
+
+      WHERE( 0._dp < td_risfdep%d_value(:,:,1,1) .AND. &
+           &         td_risfdep%d_value(:,:,1,1) <= tg_e3t_1d%d_value(1,1,1,1) )
+         td_risfdep%d_value(:,:,1,1) = 0.
+         tg_misfdep%d_value(:,:,1,1) = 1
+      END WHERE
+
+      ! remove very shallow ice shelf (less than ~ 10m if 75L)
+      WHERE( td_risfdep%d_value(:,:,1,1) <= 10._dp .AND. &
+           & tg_misfdep%d_value(:,:,1,1) > 1 )
+         tg_misfdep%d_value(:,:,1,1) = 0
+         td_risfdep%d_value(:,:,1,1) = 0.0_dp
+         tg_mbathy%d_value (:,:,1,1) = 0
+         td_bathy%d_value  (:,:,1,1) = 0.0_dp
+      END WHERE
+      WHERE( td_bathy%d_value(:,:,1,1) <= 30.0_dp .AND. &
+           & tg_gphit%d_value(:,:,1,1) < -60._dp )
+         tg_misfdep%d_value(:,:,1,1) = 0
+         td_risfdep%d_value(:,:,1,1) = 0.0_dp
+         tg_mbathy%d_value (:,:,1,1) = 0
+         td_bathy%d_value  (:,:,1,1) = 0.0_dp
+      END WHERE
+
+      ! basic check for the compatibility of bathy and risfdep. 
+      ! I think it should be offline because it is not perfect and cannot solved all the situation
+      ! run the bathy check 10 times to be sure all the modif in the bathy or iceshelf draft are compatible together
+      DO jl = 1, 10
+
+         WHERE( td_bathy%d_value(:,:,1,1) <= td_risfdep%d_value(:,:,1,1) + td_nam%d_isfhmin )
+            tg_misfdep%d_value(:,:,1,1) = 0
+            td_risfdep%d_value(:,:,1,1) = 0._dp
+            tg_mbathy%d_value (:,:,1,1) = 0
+            td_bathy%d_value  (:,:,1,1) = 0._dp
+         END WHERE
+
+         WHERE( tg_mbathy%d_value(:,:,1,1) <= 0 )
+            tg_misfdep%d_value(:,:,1,1) = 0 
+            td_risfdep%d_value(:,:,1,1) = 0._dp
+            tg_mbathy%d_value (:,:,1,1) = 0
+            td_bathy%d_value  (:,:,1,1) = 0._dp
+         ENDWHERE
+
+         !! lk_mpp not added
+
+         IF( td_nam%i_perio == 1 .OR. &
+           & td_nam%i_perio == 4 .OR. &
+           & td_nam%i_perio == 6 )THEN 
+            ! local domain is cyclic east-west
+            tg_misfdep%d_value( 1 ,:,1,1) = tg_misfdep%d_value(jpi-1,:,1,1)
+            tg_misfdep%d_value(jpi,:,1,1) = tg_misfdep%d_value(  2  ,:,1,1) 
+
+            tg_mbathy%d_value( 1 ,:,1,1) = tg_mbathy%d_value(jpi-1,:,1,1)
+            tg_mbathy%d_value(jpi,:,1,1) = tg_mbathy%d_value(  2  ,:,1,1)
+         ENDIF
+
+         ! split last cell if possible (only where water column is 2 cell or less)
+         ! if coupled to ice sheet, we do not modify the bathymetry (can be discuss).
+         IF( .NOT. td_nam%l_iscpl )THEN
+            DO jk = jpk-1, 1, -1
+               zmax = tg_gdepw_1d%d_value(1,1,jk,1) + &
+                  &   MIN( td_nam%d_e3zps_min, &
+                  &        td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,jk,1) )
+
+               WHERE( td_bathy%d_value(:,:,1,1)       >  tg_gdepw_1d%d_value(1,1,jk,1).AND. &
+                   &  td_bathy%d_value(:,:,1,1)       <= zmax                         .AND. &
+                   &  tg_misfdep%d_value(:,:,1,1) + 1 >= tg_mbathy%d_value(:,:,1,1) )
+
+                  tg_mbathy%d_value(:,:,1,1) = jk
+                  td_bathy%d_value (:,:,1,1) = zmax
+
+               END WHERE
+            END DO
+         ENDIF
+
+         ! split top cell if possible (only where water column is 2 cell or less)
+         DO jk = 2, jpk-1
+            zmax = tg_gdepw_1d%d_value(1,1,jk+1,1) - &
+               &   MIN( td_nam%d_e3zps_min, &
+               &        td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,jk,1) )
+
+            WHERE( td_risfdep%d_value(:,:,1,1)     <  tg_gdepw_1d%d_value(1,1,jk+1,1) .AND. &
+                &  td_risfdep%d_value(:,:,1,1)     >= zmax                            .AND. &
+                &  tg_misfdep%d_value(:,:,1,1) + 1 >= tg_mbathy%d_value(:,:,1,1) )
+
+               tg_misfdep%d_value(:,:,1,1) = jk
+               td_risfdep%d_value(:,:,1,1) = zmax
+
+            END WHERE
+         END DO
+
+         ! Case where bathy and risfdep compatible but not the level 
+         ! variable mbathy/misfdep because of partial cell condition
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ! find the minimum change option:
+               ! test bathy
+               IF( td_risfdep%d_value(ji,jj,1,1) > 1 )THEN
+                  IF( .NOT. td_nam%l_iscpl )THEN
+
+                     ik=tg_mbathy%d_value(ji,jj,1,1)
+                     zbathydiff = ABS( td_bathy%d_value(ji,jj,1,1) - ( tg_gdepw_1d%d_value(1,1,ik+1,1) &
+                        &              + MIN(td_nam%d_e3zps_min,                                       &
+                        &                    td_nam%d_e3zps_rat * tg_e3t_1d%d_value(1,1,ik+1,1)) ))
+
+                     ik=tg_misfdep%d_value(ji,jj,1,1)
+                     zrisfdepdiff = ABS( td_risfdep%d_value(ji,jj,1,1) - ( tg_gdepw_1d%d_value(1,1,ik,1) &
+                        &                - MIN( td_nam%d_e3zps_min,                                      &
+                        &                       td_nam%d_e3zps_rat * tg_e3t_1d%d_value(1,1,ik-1,1)) ))
+ 
+                     IF( td_bathy%d_value (ji,jj,1,1) > td_risfdep%d_value (ji,jj,1,1) .AND. &
+                      &  tg_mbathy%d_value(ji,jj,1,1) < tg_misfdep%d_value(ji,jj,1,1) )THEN
+
+                        IF( zbathydiff <= zrisfdepdiff )THEN
+
+                           tg_mbathy%d_value(ji,jj,1,1) = tg_mbathy%d_value(ji,jj,1,1) + 1
+
+                           ik=tg_mbathy%d_value(ji,jj,1,1)
+                           td_bathy%d_value (ji,jj,1,1) = tg_gdepw_1d%d_value(1,1,ik,1) + &
+                              &                           MIN( td_nam%d_e3zps_min, &
+                              &                                td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik+1,1) )
+                        ELSE
+
+                           tg_misfdep%d_value(ji,jj,1,1) = tg_misfdep%d_value(ji,jj,1,1) - 1
+
+                           ik=tg_misfdep%d_value(ji,jj,1,1)
+                           td_risfdep%d_value(ji,jj,1,1) = tg_gdepw_1d%d_value(1,1,ik,1) - &
+                              &                            MIN( td_nam%d_e3zps_min, &
+                              &                                 td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik-1,1) )
+                        ENDIF
+
+                     ENDIF
+
+                  ELSE
+
+                     IF( td_bathy%d_value (ji,jj,1,1) > td_risfdep%d_value (ji,jj,1,1) .AND. &
+                       & tg_mbathy%d_value(ji,jj,1,1) < tg_misfdep%d_value(ji,jj,1,1) )THEN
+
+                        tg_misfdep%d_value(ji,jj,1,1) = tg_misfdep%d_value(ji,jj,1,1) - 1
+                    
+                        ik=tg_misfdep%d_value(ji,jj,1,1)
+                        td_risfdep%d_value(ji,jj,1,1) = tg_gdepw_1d%d_value(1,1,ik,1) - &
+                           &                            MIN( td_nam%d_e3zps_min, &
+                           &                                 td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik-1,1) )
+                     ENDIF
+
+                  ENDIF
+
+               ENDIF
+            ENDDO
+         ENDDO
+
+          ! At least 2 levels for water thickness at T, U, and V point.
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ! find the minimum change option:
+               ! test bathy
+               IF( tg_misfdep%d_value(ji,jj,1,1) == tg_mbathy%d_value(ji,jj,1,1) .AND. &
+                 & tg_mbathy%d_value (ji,jj,1,1) > 1) THEN
+
+                  IF ( .NOT. td_nam%l_iscpl ) THEN
+
+                     ik=tg_mbathy%d_value(ji,jj,1,1)
+                     zbathydiff  = ABS( td_bathy%d_value(ji,jj,1,1)  - ( tg_gdepw_1d%d_value(1,1,ik+1,1) &
+                        &               + MIN( td_nam%d_e3zps_min, &
+                        &                      td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik+1,1)) ))
+
+                     ik=tg_misfdep%d_value(ji,jj,1,1)
+                     zrisfdepdiff = ABS( td_risfdep%d_value(ji,jj,1,1) - ( tg_gdepw_1d%d_value(1,1,ik,1) &
+                        &                - MIN( td_nam%d_e3zps_min, &
+                        &                       td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik-1,1)) ))
+
+                     IF( zbathydiff <= zrisfdepdiff )THEN
+
+                        tg_mbathy%d_value(ji,jj,1,1) = tg_mbathy%d_value(ji,jj,1,1) + 1
+
+                        ik=tg_mbathy%d_value(ji,jj,1,1)
+                        td_bathy%d_value(ji,jj,1,1)  = tg_gdepw_1d%d_value(1,1,ik,1) + &
+                           &                           MIN( td_nam%d_e3zps_min, &
+                           &                                td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik+1,1) )
+                     ELSE
+
+                        tg_misfdep%d_value(ji,jj,1,1) = tg_misfdep%d_value(ji,jj,1,1) - 1
+
+                        ik=tg_misfdep%d_value(ji,jj,1,1)
+                        td_risfdep%d_value(ji,jj,1,1)  = tg_gdepw_1d%d_value(1,1,ik+1,1) - &
+                           &                            MIN( td_nam%d_e3zps_min, &
+                           &                                 td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik,1) )
+                     ENDIF
+
+                  ELSE
+
+                     tg_misfdep%d_value(ji,jj,1,1) = tg_misfdep%d_value(ji,jj,1,1) - 1
+
+                     ik=tg_misfdep%d_value(ji,jj,1,1)
+                     td_risfdep%d_value(ji,jj,1,1)  = tg_gdepw_1d%d_value(1,1,ik+1,1) - &
+                        &                            MIN( td_nam%d_e3zps_min, &
+                        &                                 td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik,1) )
+
+                  ENDIF
+               ENDIF
+
+            ENDDO
+         ENDDO
+
+         ! point V mbathy(ji,jj  ) == misfdep(ji,jj+1) 
+         DO jj = 1, jpj-1
+            DO ji = 1, jpi-1
+
+               IF( tg_mbathy%d_value(ji,jj  ,1,1) == tg_misfdep%d_value(ji,jj+1,1,1) .AND. &
+                &  tg_mbathy%d_value(ji,jj  ,1,1) >  1 )THEN
+                  IF ( .NOT. td_nam%l_iscpl ) THEN
+
+                     ik=tg_mbathy%d_value(ji,jj  ,1,1)
+                     zbathydiff = ABS( td_bathy%d_value(ji,jj  ,1,1) - ( tg_gdepw_1d%d_value(1,1,ik+1,1) &
+                        &              + MIN( td_nam%d_e3zps_min,                                        &
+                        &                     td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik+1,1)) ))
+
+                     ik=tg_misfdep%d_value(ji,jj+1,1,1)
+                     zrisfdepdiff = ABS( td_risfdep%d_value(ji,jj+1,1,1) - ( tg_gdepw_1d%d_value(1,1,ik,1) &
+                        &                - MIN( td_nam%d_e3zps_min,                                        &
+                        &                       td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik-1,1)) ))
+
+                     IF( zbathydiff <= zrisfdepdiff )THEN
+
+                        tg_mbathy%d_value(ji,jj  ,1,1) = tg_mbathy%d_value(ji,jj  ,1,1) + 1
+
+                        ik=tg_mbathy%d_value(ji,jj  ,1,1)
+                        td_bathy%d_value (ji,jj  ,1,1) = tg_gdepw_1d%d_value(1,1,ik,1) + &
+                           &                           MIN( td_nam%d_e3zps_min, &
+                           &                                td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik+1,1) )
+                     ELSE
+
+                        tg_misfdep%d_value(ji,jj+1,1,1) = tg_misfdep%d_value(ji,jj+1,1,1) - 1
+
+                        ik=tg_misfdep%d_value(ji,jj+1,1,1)
+                        td_risfdep%d_value(ji,jj+1,1,1) = tg_gdepw_1d%d_value(1,1,ik+1,1) - &
+                           &                             MIN( td_nam%d_e3zps_min, &
+                           &                                  td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik,1) )
+                     ENDIF
+
+                  ELSE
+                     tg_misfdep%d_value(ji,jj+1,1,1) = tg_misfdep%d_value(ji,jj+1,1,1) - 1
+
+                     ik=tg_misfdep%d_value(ji,jj+1,1,1)
+                     td_risfdep%d_value(ji,jj+1,1,1) = tg_gdepw_1d%d_value(1,1,ik+1,1) - &
+                        &                             MIN( td_nam%d_e3zps_min, &
+                        &                                  td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik,1) )
+                  ENDIF
+
+               ENDIF
+
+            ENDDO
+         ENDDO
+
+         !! lk_mpp not added
+
+         ! point V mbathy(ji,jj+1) == misfdep(ji,jj  ) 
+         DO jj = 1, jpj-1
+            DO ji = 1, jpi-1
+
+               IF( tg_mbathy%d_value(ji,jj+1,1,1) == tg_misfdep%d_value(ji,jj  ,1,1) .AND. &
+                &  tg_mbathy%d_value(ji,jj  ,1,1) > 1) THEN
+                  IF ( .NOT. td_nam%l_iscpl ) THEN
+
+                     ik=tg_mbathy%d_value(ji,jj+1,1,1)
+                     zbathydiff = ABS( td_bathy%d_value(ji,jj+1,1,1) - ( tg_gdepw_1d%d_value(1,1,ik+1,1) &
+                        &              + MIN( td_nam%d_e3zps_min,                                        &
+                        &                     td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik+1,1)) ))
+
+                     ik=tg_misfdep%d_value(ji,jj  ,1,1)
+                     zrisfdepdiff = ABS( td_risfdep%d_value(ji,jj,1,1) - ( tg_gdepw_1d%d_value(1,1,ik,1) &
+                        &                - MIN( td_nam%d_e3zps_min,                                      &
+                        &                       td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik-1,1)) ))
+
+                     IF( zbathydiff <= zrisfdepdiff )THEN
+
+                        tg_mbathy%d_value (ji,jj+1,1,1) = tg_mbathy%d_value(ji,jj+1,1,1) + 1
+
+                        ik=tg_mbathy%d_value(ji,jj+1,1,1)
+                        td_bathy%d_value  (ji,jj+1,1,1) = tg_gdepw_1d%d_value(1,1,ik,1) + &
+                           &                            MIN( td_nam%d_e3zps_min,          &
+                           &                                 td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik+1,1) )
+                     ELSE
+
+                        tg_misfdep%d_value(ji,jj  ,1,1) = tg_misfdep%d_value(ji,jj  ,1,1) - 1
+
+                        ik=tg_misfdep%d_value(ji,jj  ,1,1)
+                        td_risfdep%d_value(ji,jj  ,1,1) = tg_gdepw_1d%d_value(1,1,ik+1,1) - &
+                           &                           MIN( td_nam%d_e3zps_min,              &
+                           &                                td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik,1) )
+                     END IF
+
+                  ELSE
+
+                     tg_misfdep%d_value(ji,jj  ,1,1) = tg_misfdep%d_value(ji,jj  ,1,1) - 1
+
+                     ik=tg_misfdep%d_value(ji,jj  ,1,1)
+                     td_risfdep%d_value(ji,jj  ,1,1) = tg_gdepw_1d%d_value(1,1,ik+1,1) - &
+                        &                           MIN( td_nam%d_e3zps_min,           &
+                        &                                td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik,1) )
+
+                  ENDIF
+               
+               ENDIF
+
+            ENDDO
+         ENDDO         
+
+         !! lk_mpp not added
+
+         ! point U mbathy(ji  ,jj) EQ misfdep(ji+1,jj)
+         DO jj = 1, jpj-1
+            DO ji = 1, jpi-1
+
+               IF( tg_mbathy%d_value(ji  ,jj,1,1) == tg_misfdep%d_value(ji+1,jj,1,1) .AND. &
+                &  tg_mbathy%d_value(ji  ,jj,1,1) > 1 )THEN
+                  IF ( .NOT. td_nam%l_iscpl ) THEN
+
+                     ik=tg_mbathy%d_value(ji  ,jj,1,1)
+                     zbathydiff = ABS(     td_bathy%d_value(ji  ,jj,1,1) - ( tg_gdepw_1d%d_value(1,1,ik+1,1) &
+                        &              + MIN( td_nam%d_e3zps_min,                                     &
+                        &                     td_nam%d_e3zps_rat* tg_e3t_1d%d_value(1,1,ik+1,1)) ))
+
+                     ik=tg_misfdep%d_value(ji+1,jj,1,1)
+                     zrisfdepdiff = ABS( td_risfdep%d_value(ji+1,jj,1,1) - ( tg_gdepw_1d%d_value(1,1,ik,1) &
+                        &                - MIN( td_nam%d_e3zps_min,                                       &
+                        &                       td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik-1,1)) ))
+
+                     IF( zbathydiff <= zrisfdepdiff )THEN
+
+                        tg_mbathy%d_value (ji  ,jj,1,1) = tg_mbathy%d_value(ji  ,jj,1,1) + 1
+
+                        ik=tg_mbathy%d_value(ji  ,jj,1,1)
+                        td_bathy%d_value  (ji  ,jj,1,1) = tg_gdepw_1d%d_value(1,1,ik,1) + &
+                           &                           MIN( td_nam%d_e3zps_min, &
+                           &                                td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik+1,1) )
+                     ELSE
+                        tg_misfdep%d_value(ji+1,jj,1,1) = tg_misfdep%d_value(ji+1,jj,1,1) - 1
+
+                        ik=tg_misfdep%d_value(ji+1,jj,1,1)
+                        td_risfdep%d_value(ji+1,jj,1,1) = tg_gdepw_1d%d_value(1,1,ik+1,1) - &
+                           &                             MIN( td_nam%d_e3zps_min, &
+                           &                                  td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik,1) )
+                     END IF
+
+                  ELSE
+                     tg_misfdep%d_value(ji+1,jj,1,1)= tg_misfdep%d_value(ji+1,jj,1,1) - 1
+
+                     ik=tg_misfdep%d_value(ji+1,jj,1,1)
+                     td_risfdep%d_value(ji+1,jj,1,1) = tg_gdepw_1d%d_value(1,1,ik+1,1) - &
+                        &                             MIN( td_nam%d_e3zps_min, &
+                        &                                  td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik,1) )
+                  ENDIF
+               ENDIF
+
+            ENDDO
+         ENDDO
+
+         !! lk_mpp not added
+
+         ! point U mbathy(ji+1,jj) == misfdep(ji  ,jj) 
+         DO jj = 1, jpj-1
+            DO ji = 1, jpi-1
+
+               IF( tg_mbathy%d_value(ji+1,jj,1,1) == tg_misfdep%d_value(ji  ,jj,1,1) .AND. &
+                &  tg_mbathy%d_value(ji  ,jj,1,1) > 1 )THEN
+                  IF ( .NOT. td_nam%l_iscpl ) THEN
+
+                     ik=tg_mbathy%d_value(ji+1,jj,1,1)
+                     zbathydiff = ABS(     td_bathy%d_value(ji+1,jj,1,1) - ( tg_gdepw_1d%d_value(1,1,ik+1,1) &
+                        &              + MIN( td_nam%d_e3zps_min,                                        &
+                        &                     td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik+1,1)) ))
+
+                     ik=tg_misfdep%d_value(ji ,jj,1,1)
+                     zrisfdepdiff = ABS( td_risfdep%d_value(ji  ,jj,1,1) - ( tg_gdepw_1d%d_value(1,1,ik,1) &
+                        &                - MIN( td_nam%d_e3zps_min,                                      &
+                        &                       td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik-1,1)) ))
+
+                     IF( zbathydiff <= zrisfdepdiff )THEN
+
+                        tg_mbathy%d_value (ji+1,jj,1,1) = tg_mbathy%d_value(ji+1,jj,1,1) + 1
+
+                        ik=tg_mbathy%d_value(ji+1,jj,1,1)
+                        td_bathy%d_value  (ji+1,jj,1,1) = tg_gdepw_1d%d_value(1,1,ik,1) + &
+                           &                            MIN( td_nam%d_e3zps_min, &
+                           &                                 td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik+1,1) )
+                     ELSE
+                        tg_misfdep%d_value(ji  ,jj,1,1) = tg_misfdep%d_value(ji  ,jj,1,1) - 1
+
+                        ik=tg_misfdep%d_value(ji  ,jj,1,1)
+                        td_risfdep%d_value(ji  ,jj,1,1) = tg_gdepw_1d%d_value(1,1,ik+1,1) - &
+                           &                           MIN( td_nam%d_e3zps_min, &
+                           &                                td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik,1) )
+                     END IF
+
+                  ELSE
+
+                     tg_misfdep%d_value(ji ,jj,1,1) = tg_misfdep%d_value(ji ,jj,1,1) - 1
+
+                     ik=tg_misfdep%d_value(ji  ,jj,1,1)
+                     td_risfdep%d_value(ji  ,jj,1,1) = tg_gdepw_1d%d_value(1,1,ik+1,1) - &
+                        &                           MIN( td_nam%d_e3zps_min, &
+                        &                                td_nam%d_e3zps_rat*tg_e3t_1d%d_value(1,1,ik,1) )
+
+                  ENDIF
+
+               ENDIF
+
+            ENDDO
+         ENDDO
+
+      END DO ! jl 
+      ! end dig bathy/ice shelf to be compatible
+
+      ! now fill single point in "coastline" of ice shelf, bathy, hole, and test again one cell tickness
+      DO jl = 1,20
+
+         ! remove single point "bay" on isf coast line in the ice shelf draft'
+         DO jk = 2, jpk
+            WHERE( tg_misfdep%d_value(:,:,1,1) == 0 )
+               tg_misfdep%d_value(:,:,1,1)=jpk
+            END WHERE
+
+            zmask(:,:)=0
+            WHERE( tg_misfdep%d_value(:,:,1,1) <= jk ) zmask(:,:)=1
+            
+            DO jj = 2, jpj-1
+               DO ji = 2, jpi-1
+                  IF( tg_misfdep%d_value(ji,jj,1,1) == jk )THEN
+
+                     ibtest =   zmask(ji-1,jj  ) &
+                        &     + zmask(ji+1,jj  ) &
+                        &     + zmask(ji  ,jj-1) &
+                        &     + zmask(ji  ,jj+1)
+                     IF( ibtest <= 1 )THEN
+                        td_risfdep%d_value(ji,jj,1,1) = tg_gdepw_1d%d_value(1,1,jk+1,1)
+                        tg_misfdep%d_value(ji,jj,1,1) = jk+1
+                        IF( tg_misfdep%d_value(ji,jj,1,1) > tg_mbathy%d_value(ji,jj,1,1) )THEN
+                           tg_misfdep%d_value(ji,jj,1,1) = jpk
+                        ENDIF
+                     ENDIF
+
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDDO
+
+         WHERE( tg_misfdep%d_value(:,:,1,1) == jpk )
+             tg_misfdep%d_value(:,:,1,1)=0
+             td_risfdep%d_value(:,:,1,1)=0.
+             tg_mbathy%d_value (:,:,1,1)=0
+             td_bathy%d_value  (:,:,1,1)=0.
+         END WHERE
+
+         !! lk_mpp not added
+
+         ! remove single point "bay" on bathy coast line beneath an ice shelf'
+         DO jk = jpk,1,-1
+
+            zmask(:,:)=0
+            WHERE( tg_mbathy%d_value(:,:,1,1) >= jk ) zmask(:,:)=1
+
+            DO jj = 2, jpj-1
+               DO ji = 2, jpi-1
+                  IF( tg_mbathy%d_value (ji,jj,1,1) == jk .AND. &
+                    & tg_misfdep%d_value(ji,jj,1,1) >= 2 )THEN
+
+                     ibtest =   zmask(ji-1,jj  ) &
+                        &     + zmask(ji+1,jj  ) &
+                        &     + zmask(ji  ,jj-1) &
+                        &     + zmask(ji  ,jj+1)
+                     IF( ibtest <= 1 )THEN
+                        td_bathy%d_value (ji,jj,1,1) = tg_gdepw_1d%d_value(1,1,jk,1)
+                        tg_mbathy%d_value(ji,jj,1,1) = jk-1
+                        IF( tg_misfdep%d_value(ji,jj,1,1) > tg_mbathy%d_value(ji,jj,1,1) )THEN
+                           tg_mbathy%d_value(ji,jj,1,1) = 0
+                        ENDIF
+                     ENDIF
+
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDDO
+
+         WHERE( tg_mbathy%d_value(:,:,1,1) == 0 )
+             tg_misfdep%d_value(:,:,1,1)=0
+             td_risfdep%d_value(:,:,1,1)=0.
+             tg_mbathy%d_value (:,:,1,1)=0
+             td_bathy%d_value  (:,:,1,1)=0.
+         END WHERE
+
+         !! lk_mpp not added
+
+         ! fill hole in ice shelf
+         zmisfdep(:,:) = tg_misfdep%d_value(:,:,1,1)
+         zrisfdep(:,:) = td_risfdep%d_value(:,:,1,1)
+         WHERE( zmisfdep(:,:) <= 1 ) zmisfdep(:,:)=jpk
+
+         DO jj = 2, jpj-1
+            DO ji = 2, jpi-1
+
+               ibtestim1 = zmisfdep(ji-1,jj  )
+               ibtestip1 = zmisfdep(ji+1,jj  )
+               
+               ibtestjm1 = zmisfdep(ji  ,jj-1)
+               ibtestjp1 = zmisfdep(ji  ,jj+1)
+
+               IF( zmisfdep(ji,jj) >= tg_mbathy%d_value(ji-1,jj  ,1,1) ) ibtestim1 = jpk
+               IF( zmisfdep(ji,jj) >= tg_mbathy%d_value(ji+1,jj  ,1,1) ) ibtestip1 = jpk
+               IF( zmisfdep(ji,jj) >= tg_mbathy%d_value(ji  ,jj-1,1,1) ) ibtestjm1 = jpk
+               IF( zmisfdep(ji,jj) >= tg_mbathy%d_value(ji  ,jj+1,1,1) ) ibtestjp1 = jpk
+
+               ibtest=MIN(ibtestim1, ibtestip1, ibtestjm1, ibtestjp1)
+               IF( ibtest == jpk .AND. &
+                 & tg_misfdep%d_value(ji,jj,1,1) >= 2 )THEN
+                  tg_mbathy%d_value (ji,jj,1,1) = 0
+                  td_bathy%d_value  (ji,jj,1,1) = 0.0_dp
+                  tg_misfdep%d_value(ji,jj,1,1) = 0
+                  td_risfdep%d_value(ji,jj,1,1) = 0.0_dp
+               END IF
+
+               IF( zmisfdep(ji,jj) < ibtest .AND. &
+                 & tg_misfdep%d_value(ji,jj,1,1) >= 2 )THEN
+                  tg_misfdep%d_value(ji,jj,1,1) = ibtest
+                  td_risfdep%d_value(ji,jj,1,1) = tg_gdepw_1d%d_value(1,1,ibtest,1)
+               ENDIF
+
+            ENDDO
+         ENDDO         
+
+         !! lk_mpp not added
+
+         !! fill hole in bathymetry
+         zmbathy(:,:) = tg_mbathy%d_value(:,:,1,1)
+         DO jj = 2, jpj-1
+            DO ji = 2, jpi-1
+
+               ibtestim1 = zmbathy(ji-1,jj  )
+               ibtestip1 = zmbathy(ji+1,jj  )
+
+               ibtestjm1 = zmbathy(ji  ,jj-1)
+               ibtestjp1 = zmbathy(ji  ,jj+1)
+
+               IF( zmbathy(ji,jj) < tg_misfdep%d_value(ji-1,jj  ,1,1) ) ibtestim1 = 0
+               IF( zmbathy(ji,jj) < tg_misfdep%d_value(ji+1,jj  ,1,1) ) ibtestip1 = 0
+               IF( zmbathy(ji,jj) < tg_misfdep%d_value(ji  ,jj-1,1,1) ) ibtestjm1 = 0
+               IF( zmbathy(ji,jj) < tg_misfdep%d_value(ji  ,jj+1,1,1) ) ibtestjp1 = 0
+
+               ibtest=MAX(ibtestim1, ibtestip1, ibtestjm1, ibtestjp1)
+               IF( ibtest == 0 .AND. tg_misfdep%d_value(ji,jj,1,1) >= 2) THEN
+                  tg_mbathy%d_value (ji,jj,1,1) = 0
+                  td_bathy%d_value  (ji,jj,1,1) = 0.0_dp
+                  tg_misfdep%d_value(ji,jj,1,1) = 0
+                  td_risfdep%d_value(ji,jj,1,1) = 0.0_dp
+               END IF
+
+               IF( ibtest < zmbathy(ji,jj) .AND. &
+               &   tg_misfdep%d_value(ji,jj,1,1) >= 2) THEN
+                  tg_mbathy%d_value(ji,jj,1,1) = ibtest
+                  td_bathy%d_value (ji,jj,1,1) = tg_gdepw_1d%d_value(1,1,ibtest+1,1) 
+               ENDIF
+
+            ENDDO
+         ENDDO
+
+         !! lk_mpp not added
+
+         ! if not compatible after all check (ie U point water column less than 2 cells), mask U
+         DO jj = 1, jpj-1
+            DO ji = 1, jpi-1
+               IF( tg_mbathy%d_value(ji  ,jj,1,1) == tg_misfdep%d_value(ji+1,jj,1,1) .AND. &
+                 & tg_mbathy%d_value(ji  ,jj,1,1) >= 1   .AND. &
+                 & tg_mbathy%d_value(ji+1,jj,1,1) >= 1   )THEN
+
+                  tg_mbathy%d_value(ji,jj,1,1)  = tg_mbathy%d_value(ji,jj,1,1) - 1 
+
+                  ik=tg_mbathy%d_value(ji,jj,1,1)
+                  td_bathy%d_value (ji,jj,1,1)  = tg_gdepw_1d%d_value(1,1,ik+1,1)
+               ENDIF
+            ENDDO
+         ENDDO
+
+         !! lk_mpp not added
+
+         ! if not compatible after all check (ie U point water column less than 2 cells), mask U
+         DO jj = 1, jpj-1
+            DO ji = 1, jpi-1
+               IF( tg_misfdep%d_value(ji  ,jj,1,1) == tg_mbathy%d_value(ji+1,jj,1,1) .AND. &
+                 & tg_mbathy%d_value (ji  ,jj,1,1) >= 1 .AND.&
+                 & tg_mbathy%d_value (ji+1,jj,1,1) >= 1 )THEN
+
+                  tg_mbathy%d_value(ji+1,jj,1,1)  = tg_mbathy%d_value(ji+1,jj,1,1) - 1
+
+                  ik=tg_mbathy%d_value(ji+1,jj,1,1)
+                  td_bathy%d_value(ji+1,jj,1,1)   = tg_gdepw_1d%d_value(1,1,ik+1,1)
+               ENDIF
+            ENDDO
+         ENDDO         
+
+         !! lk_mpp not added
+
+         ! if not compatible after all check (ie V point water column less than 2 cells), mask V
+         DO jj = 1, jpj-1
+            DO ji = 1, jpi
+               IF( tg_mbathy%d_value(ji,jj  ,1,1) == tg_misfdep%d_value(ji,jj+1,1,1) .AND. &
+                 & tg_mbathy%d_value(ji,jj  ,1,1) >= 1 .AND. &
+                 & tg_mbathy%d_value(ji,jj+1,1,1) >= 1 )THEN
+
+                  tg_mbathy%d_value(ji,jj,1,1) = tg_mbathy%d_value(ji,jj,1,1) - 1
+
+                  ik=tg_mbathy%d_value(ji,jj,1,1)
+                  td_bathy%d_value (ji,jj,1,1) = tg_gdepw_1d%d_value(1,1,ik+1,1)
+
+               ENDIF
+            ENDDO
+         ENDDO
+
+         !! lk_mpp not added
+
+         ! if not compatible after all check (ie V point water column less than 2 cells), mask V
+         DO jj = 1, jpj-1
+            DO ji = 1, jpi
+               IF( tg_misfdep%d_value(ji,jj  ,1,1) == tg_mbathy%d_value(ji,jj+1,1,1) .AND.&
+                 & tg_mbathy%d_value (ji,jj  ,1,1) >= 1 .AND.&
+                 & tg_mbathy%d_value (ji,jj+1,1,1) >= 1 )THEN
+
+                  tg_mbathy%d_value(ji,jj+1,1,1) = tg_mbathy%d_value(ji,jj+1,1,1) - 1
+
+                  ik=tg_mbathy%d_value(ji,jj+1,1,1)
+                  td_bathy%d_value (ji,jj+1,1,1) = tg_gdepw_1d%d_value(1,1,ik+1,1)
+               ENDIF
+            ENDDO
+         ENDDO
+
+         !! lk_mpp not added
+
+         ! if not compatible after all check, mask T
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( tg_mbathy%d_value(ji,jj,1,1) <= tg_misfdep%d_value(ji,jj,1,1) )THEN
+                  tg_misfdep%d_value(ji,jj,1,1) = 0
+                  td_risfdep%d_value(ji,jj,1,1) = 0._dp
+                  tg_mbathy%d_value (ji,jj,1,1) = 0
+                  td_bathy%d_value  (ji,jj,1,1) = 0._dp
+               ENDIF
+            ENDDO
+         ENDDO
+ 
+         WHERE( tg_mbathy%d_value(:,:,1,1) == 1 )
+            tg_mbathy%d_value (:,:,1,1) = 0
+            td_bathy%d_value  (:,:,1,1) = 0.0_dp
+            tg_misfdep%d_value(:,:,1,1) = 0
+            td_risfdep%d_value(:,:,1,1) = 0.0_dp
+         END WHERE
+      ENDDO
+      ! end check compatibility ice shelf/bathy
+
+      ! remove very shallow ice shelf (less than ~ 10m if 75L)
+      WHERE( td_risfdep%d_value(:,:,1,1) <= 10._dp )
+         tg_misfdep%d_value(:,:,1,1) = 1
+         td_risfdep%d_value(:,:,1,1) = 0.0_dp;
+      END WHERE
+
+      DEALLOCATE(zmask   )
+      DEALLOCATE(zrisfdep)
+      DEALLOCATE(zmisfdep)
+
+      ! compute scale factor and depth at T- and W- points
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ik = tg_mbathy%d_value(ji,jj,1,1)
+            IF( ik > 0 ) THEN               ! ocean point only      
+               ! max ocean level case
+               IF( ik == jpk-1 ) THEN
+
+                  zdepwp = td_bathy%d_value(ji,jj,1,1)
+                  ze3tp  = td_bathy%d_value(ji,jj,1,1) - tg_gdepw_1d%d_value(1,1,ik,1)
+                  ze3wp  = 0.5_dp * tg_e3w_1d%d_value(1,1,ik,1) &
+                     &            * ( 1._dp + ( ze3tp/tg_e3t_1d%d_value(1,1,ik,1) ) )
+                  tg_e3t_0%d_value  (ji,jj,ik  ,1) = ze3tp
+                  tg_e3t_0%d_value  (ji,jj,ik+1,1) = ze3tp
+                  tg_e3w_0%d_value  (ji,jj,ik  ,1) = ze3wp
+                  tg_e3w_0%d_value  (ji,jj,ik+1,1) = ze3wp
+
+                  tg_gdepw_0%d_value(ji,jj,ik+1,1) = zdepwp
+                  tg_gdept_0%d_value(ji,jj,ik  ,1) = tg_gdept_1d%d_value(1 ,1 ,ik-1,1) + ze3wp
+                  tg_gdept_0%d_value(ji,jj,ik+1,1) = tg_gdept_0%d_value (ji,jj,ik  ,1) + ze3tp
+                  !
+               ELSE    ! standard case
+
+                  IF( td_bathy%d_value(ji,jj,1,1) <= tg_gdepw_1d%d_value(1,1,ik+1,1) ) THEN
+                     tg_gdepw_0%d_value(ji,jj,ik+1,1) = td_bathy%d_value(ji,jj,1,1)
+                  ELSE
+                     tg_gdepw_0%d_value(ji,jj,ik+1,1) = tg_gdepw_1d%d_value(1,1,ik+1,1)
+                  ENDIF      
+                  !
+                  !gm Bug?  check the gdepw_1d
+                  ! ... on ik
+                  tg_gdept_0%d_value(ji,jj,ik,1) = tg_gdepw_1d%d_value(1,1,ik,1) + &
+                     &     ( tg_gdepw_0%d_value(ji,jj,ik+1,1) - tg_gdepw_1d%d_value(1,1,ik,1) ) &
+                     & * ( ( tg_gdept_1d%d_value(1,1, ik  ,1) - tg_gdepw_1d%d_value(1,1,ik,1) ) &
+                     &   / ( tg_gdepw_1d%d_value(1,1, ik+1,1) - tg_gdepw_1d%d_value(1,1,ik,1) ) )
+
+                  tg_e3t_0%d_value(ji,jj,ik  ,1) = tg_gdepw_0%d_value(ji,jj,ik+1,1) - tg_gdepw_1d%d_value(1,1,ik  ,1)
+                  tg_e3w_0%d_value(ji,jj,ik  ,1) = tg_gdept_0%d_value(ji,jj,ik  ,1) - tg_gdept_1d%d_value(1,1,ik-1,1)
+                  ! ... on ik+1
+                  tg_e3w_0%d_value(ji,jj,ik+1,1) = tg_e3t_0%d_value(ji,jj,ik,1)
+                  tg_e3t_0%d_value(ji,jj,ik+1,1) = tg_e3t_0%d_value(ji,jj,ik,1)
+                  !
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      !
+      it = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ik = tg_mbathy%d_value(ji,jj,1,1)
+            IF( ik > 0 ) THEN               ! ocean point only
+               tg_e3tp%d_value(ji,jj,1,1) = tg_e3t_0%d_value(ji,jj,ik,1)
+               tg_e3wp%d_value(ji,jj,1,1) = tg_e3w_0%d_value(ji,jj,ik,1)
+               ! test
+               zdiff= tg_gdepw_0%d_value(ji,jj,ik+1,1) - tg_gdept_0%d_value(ji,jj,ik,1)
+               IF( zdiff <= 0._dp ) THEN 
+                  it = it + 1
+                  CALL logger_info(' it    = '//TRIM(fct_str(it))//&
+                     &             ' ik    = '//TRIM(fct_str(ik))//&
+                     &             ' (i,j) = '//trim(fct_str(ji))//' '//TRIM(fct_str(jj)))
+                  CALL logger_info(' bathy = '//TRIM(fct_str(td_bathy%d_value(ji,jj,1,1))))
+                  CALL logger_info(' gdept_0 = '//TRIM(fct_str(tg_gdept_0%d_value(ji,jj,ik,1)))//&
+                     &             ' gdepw_0 = '//TRIM(fct_str(tg_gdepw_0%d_value(ji,jj,ik+1,1)))//&
+                     &             ' zdiff   = '//TRIM(fct_str(zdiff)))
+                  CALL logger_info(' e3tp    = '//TRIM(fct_str(tg_e3t_0%d_value(ji,jj,ik,1)))//&
+                     &             ' e3wp    = '//TRIM(fct_str(tg_e3w_0%d_value(ji,jj,ik,1))))
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      !
+      ! (ISF) Definition of e3t, u, v, w for ISF case
+      DO jj = 1, jpj 
+         DO ji = 1, jpi 
+            ik = tg_misfdep%d_value(ji,jj,1,1) 
+            IF( ik > 1 ) THEN               ! ice shelf point only 
+
+               IF( td_risfdep%d_value(ji,jj,1,1) < tg_gdepw_1d%d_value(1,1,ik,1) )THEN
+                   td_risfdep%d_value(ji,jj,1,1) = tg_gdepw_1d%d_value(1,1,ik,1) 
+               ENDIF
+               tg_gdepw_0%d_value(ji,jj,ik,1) = td_risfdep%d_value(ji,jj,1,1) 
+!gm Bug?  check the gdepw_0 
+            !       ... on ik 
+               tg_gdept_0%d_value(ji,jj,ik,1) = tg_gdepw_1d%d_value(1,1,ik+1,1) &
+                  &        - ( tg_gdepw_1d%d_value(1,1,ik+1,1) - tg_gdepw_0%d_value(ji,jj,ik,1) )   & 
+                  &        * ( tg_gdepw_1d%d_value(1,1,ik+1,1) - tg_gdept_1d%d_value(1,1, ik,1) )   & 
+                  &        / ( tg_gdepw_1d%d_value(1,1,ik+1,1) - tg_gdepw_1d%d_value(1,1, ik,1) ) 
+
+               tg_e3t_0%d_value(ji,jj,ik  ,1) = tg_gdepw_1d%d_value(1,1,ik+1,1) - tg_gdepw_0%d_value(ji,jj,ik,1) 
+               tg_e3w_0%d_value(ji,jj,ik+1,1) = tg_gdept_1d%d_value(1,1,ik+1,1) - tg_gdept_0%d_value(ji,jj,ik,1)
+
+               IF( ik + 1 == tg_mbathy%d_value(ji,jj,1,1) )THEN    ! ice shelf point only (2 cell water column) 
+                  tg_e3w_0%d_value(ji,jj,ik+1,1) = tg_gdept_0%d_value(ji,jj,ik+1,1) - tg_gdept_0%d_value(ji,jj,ik,1) 
+               ENDIF 
+            !       ... on ik / ik-1 
+               tg_e3w_0%d_value  (ji,jj,ik  ,1) = tg_e3t_0%d_value  (ji,jj,ik,1) 
+               tg_e3t_0%d_value  (ji,jj,ik-1,1) = tg_gdepw_0%d_value(ji,jj,ik,1) - tg_gdepw_1d%d_value(1,1,ik-1,1)
+! The next line isn't required and doesn't affect results - included for consistency with bathymetry code 
+               tg_gdept_0%d_value(ji,jj,ik-1,1) = tg_gdept_1d%d_value(1,1,ik-1,1)
+
+            ENDIF 
+         END DO 
+      END DO
+
+      it = 0 
+      DO jj = 1, jpj 
+         DO ji = 1, jpi 
+            ik = tg_misfdep%d_value(ji,jj,1,1) 
+            IF( ik > 1 ) THEN               ! ice shelf point only 
+               tg_e3tp%d_value(ji,jj,1,1) = tg_e3t_0%d_value(ji,jj,ik  ,1) 
+               tg_e3wp%d_value(ji,jj,1,1) = tg_e3w_0%d_value(ji,jj,ik+1,1) 
+            ! test 
+               zdiff= tg_gdept_0%d_value(ji,jj,ik,1) - tg_gdepw_0%d_value(ji,jj,ik,1) 
+               IF( zdiff <= 0. ) THEN  
+                  it = it + 1 
+                  CALL logger_info(' it    = '//TRIM(fct_str(it))//&
+                  &                ' ik    = '//TRIM(fct_str(ik))//&
+                  &                ' (i,j) = '//trim(fct_str(ji))//' '//TRIM(fct_str(jj)))
+
+                  CALL logger_info(' risfdep = '//TRIM(fct_str(td_risfdep%d_value(ji,jj,1,1)))) 
+                  CALL logger_info(' gdept = '//TRIM(fct_str(tg_gdept_0%d_value(ji,jj,ik,1)))//&
+                  &                ' gdepw = '//TRIM(fct_str(tg_gdepw_0%d_value(ji,jj,ik+1,1)))//&
+                  &                ' zdiff = '//TRIM(fct_str(zdiff)))
+                  CALL logger_info(' e3tp  = '//TRIM(fct_str(tg_e3t_0%d_value(ji,jj,ik  ,1)))//&
+                  &                ' e3wp  = '//TRIM(fct_str(tg_e3w_0%d_value(ji,jj,ik+1,1))))
+               ENDIF 
+            ENDIF 
+         END DO 
+      END DO
+
+   END SUBROUTINE grid_zgr__isf_fill
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!   SUBROUTINE grid_zgr__isf_fill_e3x( jpi,jpj, &
+!         &                            td_risfdep) 
+!   !-------------------------------------------------------------------
+!   !> @brief This subroutine define e3t, u, v, w for ISF case 
+!   !>
+!   !> @details
+!   !>
+!   !> @author J.Paul
+!   !> @date September, 2015 - rewrite from zgr_zps
+!   !>
+!   !> @param[in] jpi
+!   !> @param[in] jpj
+!   !> @param[in] td_risfdep
+!   !-------------------------------------------------------------------
+!
+!      IMPLICIT NONE
+!
+!      ! Argument      
+!      INTEGER(i4), INTENT(IN   ) :: jpi
+!      INTEGER(i4), INTENT(IN   ) :: jpj
+!      TYPE(TVAR) , INTENT(INOUT) :: td_risfdep
+!
+!      ! local variable
+!      REAL(dp)    :: zdiff            ! temporary scalar
+!
+!      ! loop indices
+!      INTEGER(i4) :: ji
+!      INTEGER(i4) :: jj
+!      INTEGER(i4) :: it
+!      INTEGER(i4) :: ik
+!      !----------------------------------------------------------------
+!
+!      ! (ISF) Definition of e3t, u, v, w for ISF case
+!      DO jj = 1, jpj 
+!         DO ji = 1, jpi 
+!            ik = tg_misfdep%d_value(ji,jj,1,1) 
+!
+!            IF( ik > 1 ) THEN
+!               ! ice shelf point only
+!               IF( td_risfdep%d_value(ji,jj,1,1) < tg_gdepw_1d%d_value(1,1,ik,1) )THEN
+!                   td_risfdep%d_value(ji,jj,1,1) = tg_gdepw_1d%d_value(1,1,ik,1) 
+!               ENDIF
+!               tg_gdepw_0%d_value(ji,jj,ik,1) = td_risfdep%d_value(ji,jj,1,1) 
+!            !gm Bug?  check the gdepw_0 
+!            !       ... on ik 
+!               tg_gdept_0%d_value(ji,jj,ik  ,1) = tg_gdepw_1d%d_value(1,1,ik+1,1) - & 
+!                  &                               (tg_gdepw_1d%d_value(1,1,ik+1,1) - tg_gdepw_0%d_value (ji,jj,ik,1)) * &
+!                  &                               (tg_gdepw_1d%d_value(1,1,ik+1,1) - tg_gdept_1d%d_value( 1, 1,ik,1)) / & 
+!                  &                               (tg_gdepw_1d%d_value(1,1,ik+1,1) - tg_gdepw_1d%d_value( 1, 1,ik,1)) 
+!
+!               tg_e3t_0%d_value  (ji,jj,ik  ,1) = tg_gdepw_1d%d_value( 1, 1,ik+1,1) - &
+!                  &                               tg_gdepw_0%d_value (ji,jj,ik  ,1) 
+!
+!               tg_e3w_0%d_value  (ji,jj,ik+1,1) = tg_gdept_1d%d_value( 1, 1,ik+1,1) - &
+!                  &                               tg_gdept_0%d_value (ji,jj,ik  ,1)
+!
+!               IF( ik + 1 == tg_mbathy%d_value(ji,jj,1,1) ) THEN
+!
+!                  ! ice shelf point only (2 cell water column)
+!                  tg_e3w_0%d_value(ji,jj,ik+1,1) = tg_gdept_0%d_value(ji,jj,ik+1,1) - &
+!                     &                             tg_gdept_0%d_value(ji,jj,ik  ,1) 
+!
+!               ENDIF 
+!            !       ... on ik / ik-1 
+!               tg_e3w_0%d_value  (ji,jj,ik  ,1) = 2._dp * (tg_gdept_0%d_value(ji,jj,ik,1) - &
+!                  &                                        tg_gdepw_0%d_value(ji,jj,ik,1)) 
+!
+!               tg_e3t_0%d_value  (ji,jj,ik-1,1) = tg_gdepw_0%d_value (ji,jj,ik  ,1) - &
+!                  &                               tg_gdepw_1d%d_value( 1, 1,ik-1,1)
+!
+!               ! The next line isn't required and doesn't affect results - included for consistency with bathymetry code 
+!               tg_gdept_0%d_value(ji,jj,ik-1,1) = tg_gdept_1d%d_value(1,1,ik-1,1)
+!            ENDIF 
+!
+!         END DO 
+!      END DO 
+!      
+!      it = 0 
+!      DO jj = 1, jpj 
+!         DO ji = 1, jpi 
+!            ik = tg_misfdep%d_value(ji,jj,1,1) 
+!            IF( ik > 1 ) THEN               ! ice shelf point only 
+!               tg_e3tp%d_value(ji,jj,1,1) = tg_e3t_0%d_value(ji,jj,ik  ,1) 
+!               tg_e3wp%d_value(ji,jj,1,1) = tg_e3w_0%d_value(ji,jj,ik+1,1) 
+!            ! test 
+!               zdiff= tg_gdept_0%d_value(ji,jj,ik,1) - &
+!                  &   tg_gdepw_0%d_value(ji,jj,ik,1) 
+!
+!               IF( zdiff <= 0. ) THEN  
+!                  it = it + 1 
+!                  CALL logger_info(' it      = '//TRIM(fct_str(it))//&
+!                     &             ' ik      = '//TRIM(fct_str(ik))//&
+!                     &             ' (i,j)   =('//TRIM(fct_str(ji))//','//TRIM(fct_str(jj))//')')  
+!                  CALL logger_info(' risfdep = '//TRIM(fct_str(td_risfdep%d_value(ji,jj,1,1))) )
+!                  CALL logger_info(' gdept = '//TRIM(fct_str(tg_gdept_0%d_value(ji,jj,ik  ,1)))//&
+!                     &             ' gdepw = '//TRIM(fct_str(tg_gdepw_0%d_value(ji,jj,ik+1,1)))//&
+!                     &             ' zdiff = '//TRIM(fct_str(zdiff)) ) 
+!                  CALL logger_info(' e3tp  = '//TRIM(fct_str( tg_e3tp%d_value(ji,jj,1,1)))//&
+!                     &             ' e3wp  = '//TRIM(fct_str( tg_e3wp%d_value(ji,jj,1,1))) ) 
+!               ENDIF 
+!            ENDIF 
+!         END DO 
+!      END DO 
+!      ! END (ISF)
+!
+!   END SUBROUTINE grid_zgr__isf_fill_e3x
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_zgr__isf_fill_e3uw(jpi, jpj) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine define e3uw 
+   !>    (adapted for 2 cells in the water column) for ISF case 
+   !>
+   !> @details
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from zgr_zps
+   !>
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      INTEGER(i4)   , INTENT(IN   ) :: jpi
+      INTEGER(i4)   , INTENT(IN   ) :: jpj
+
+      ! local variable
+      INTEGER(i4) :: ikb, ikt
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      DO jj = 2, jpj - 1 
+         DO ji = 2, jpi - 1 
+
+            ikb = MAX(tg_mbathy%d_value (ji,jj,1,1), tg_mbathy%d_value (ji+1,jj,1,1))
+            ikt = MAX(tg_misfdep%d_value(ji,jj,1,1), tg_misfdep%d_value(ji+1,jj,1,1))
+            IF( ikb == ikt+1 )THEN
+               tg_e3uw_0%d_value(ji,jj,ikb,1) = MIN( tg_gdept_0%d_value(ji,jj,ikb  ,1), tg_gdept_0%d_value(ji+1,jj  ,ikb  ,1) ) - &
+               &                                MAX( tg_gdept_0%d_value(ji,jj,ikb-1,1), tg_gdept_0%d_value(ji+1,jj  ,ikb-1,1) )
+            ENDIF
+            
+            ikb = MAX( tg_mbathy%d_value (ji,jj,1,1), tg_mbathy%d_value (ji,jj+1,1,1))
+            ikt = MAX( tg_misfdep%d_value(ji,jj,1,1), tg_misfdep%d_value(ji,jj+1,1,1))
+            IF( ikb == ikt+1 )THEN
+               tg_e3vw_0%d_value(ji,jj,ikb,1) = MIN( tg_gdept_0%d_value(ji,jj,ikb  ,1), tg_gdept_0%d_value(ji  ,jj+1,ikb  ,1) ) - &
+               &                                MAX( tg_gdept_0%d_value(ji,jj,ikb-1,1), tg_gdept_0%d_value(ji  ,jj+1,ikb-1,1) )
+            ENDIF
+         END DO
+      END DO
+
+   END SUBROUTINE grid_zgr__isf_fill_e3uw
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!   SUBROUTINE grid_zgr__isf_fill_gdep3w_0( jpi,jpj,jpk,td_risfdep )
+!   !-------------------------------------------------------------------
+!   !> @brief This subroutine compute gdep3w_0 (vertical sum of e3w) 
+!   !>
+!   !> @details
+!   !>
+!   !> @author J.Paul
+!   !> @date September, 2015 - rewrite from zgr_zps
+!   !>
+!   !> @param[in] jpi
+!   !> @param[in] jpj
+!   !> @param[in] jpk
+!   !> @param[in] td_risfdep
+!   !-------------------------------------------------------------------
+!
+!      IMPLICIT NONE
+!
+!      ! Argument      
+!      INTEGER(i4), INTENT(IN   ) :: jpi
+!      INTEGER(i4), INTENT(IN   ) :: jpj
+!      INTEGER(i4), INTENT(IN   ) :: jpk
+!      TYPE(TVAR) , INTENT(INOUT) :: td_risfdep
+!
+!      ! local variable
+!      INTEGER(i4) :: ik
+!
+!      ! loop indices
+!      INTEGER(i4) :: ji
+!      INTEGER(i4) :: jj
+!      INTEGER(i4) :: jk
+!      !----------------------------------------------------------------
+!
+!      WHERE( tg_misfdep%d_value(:,:,:,:) == 0 ) tg_misfdep%d_value(:,:,:,:) = 1
+!      
+!      DO jj = 1,jpj
+!         DO ji = 1,jpi
+!
+!            tg_gdep3w_0%d_value(ji,jj,1,1) = 0.5_dp * tg_e3w_0%d_value(ji,jj,1,1)
+!            DO jk = 2, INT(tg_misfdep%d_value(ji,jj,1,1),i4)
+!               tg_gdep3w_0%d_value(ji,jj,jk,1) = tg_gdep3w_0%d_value(ji,jj,jk-1,1) + &
+!                  &                              tg_e3w_0%d_value   (ji,jj,jk  ,1) 
+!            END DO
+!
+!            ik=tg_misfdep%d_value(ji,jj,1,1)
+!            IF( ik >= 2 )THEN
+!               tg_gdep3w_0%d_value(ji,jj,ik,1) = td_risfdep%d_value(ji,jj, 1,1) + &
+!                  &                       0.5_dp * tg_e3w_0%d_value(ji,jj,ik,1)
+!            ENDIF
+!
+!            DO jk = ik + 1, jpk
+!               tg_gdep3w_0%d_value(ji,jj,jk,1) = tg_gdep3w_0%d_value(ji,jj,jk-1,1) + &
+!                  &                              tg_e3w_0%d_value   (ji,jj,jk  ,1) 
+!            END DO
+!
+!         END DO
+!      END DO
+!
+!   END SUBROUTINE grid_zgr__isf_fill_gdep3w_0
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_zgr_sco_init(jpi, jpj) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine initialise global variable needed to compute vertical
+   !>        mesh
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      INTEGER(i4), INTENT(IN) :: jpi
+      INTEGER(i4), INTENT(IN) :: jpj
+
+      ! local variable
+      REAL(dp), DIMENSION(jpi,jpj) :: dl_tmp
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      dl_tmp(:,:)=dp_fill
+
+      tg_rx1     =var_init('rx1      ',dl_tmp(:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)
+
+   END SUBROUTINE grid_zgr_sco_init
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_zgr_sco_clean() 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine clean structure
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial version
+   !>
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+
+      CALL var_clean(tg_rx1      )
+      
+   END SUBROUTINE grid_zgr_sco_clean
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_zgr__sco_fill(td_nam, jpi, jpj, jpk, td_bathy) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine define the s-coordinate system
+   !>
+   !> @details
+   !>
+   !> ** Method  :   s-coordinate
+   !>         The depth of model levels is defined as the product of an
+   !>      analytical function by the local bathymetry, while the vertical
+   !>      scale factors are defined as the product of the first derivative
+   !>      of the analytical function by the bathymetry.
+   !>      (this solution save memory as depth and scale factors are not
+   !>      3d fields)
+   !>          - Read bathymetry (in meters) at t-point and compute the
+   !>         bathymetry at u-, v-, and f-points.
+   !>            - hbatu = mi( hbatt )
+   !>            - hbatv = mj( hbatt )
+   !>            - hbatf = mi( mj( hbatt ) )
+   !>          - Compute z_gsigt, z_gsigw, z_esigt, z_esigw from an analytical
+   !>         function and its derivative given as function.
+   !>            - z_gsigt(k) = fssig (k    )
+   !>            - z_gsigw(k) = fssig (k-0.5)
+   !>            - z_esigt(k) = fsdsig(k    )
+   !>            - z_esigw(k) = fsdsig(k-0.5)
+   !>      Three options for stretching are give, and they can be modified
+   !>      following the users requirements. Nevertheless, the output as
+   !>      well as the way to compute the model levels and scale factors
+   !>      must be respected in order to insure second order accuracy
+   !>      schemes.
+   !>
+   !>      The three methods for stretching available are:
+   !> 
+   !>           s_sh94 (Song and Haidvogel 1994)
+   !>                a sinh/tanh function that allows sigma and stretched sigma
+   !>
+   !>           s_sf12 (Siddorn and Furner 2012?)
+   !>                allows the maintenance of fixed surface and or
+   !>                bottom cell resolutions (cf. geopotential coordinates) 
+   !>                within an analytically derived stretched S-coordinate framework.
+   !> 
+   !>          s_tanh  (Madec et al 1996)
+   !>                a cosh/tanh function that gives stretched coordinates
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from zgr_sco
+   !> @date October, 2016
+   !> - add wetting and drying boolean
+   !>
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+      INTEGER(i4), INTENT(IN   ) :: jpi
+      INTEGER(i4), INTENT(IN   ) :: jpj
+      INTEGER(i4), INTENT(IN   ) :: jpk
+      TYPE(TVAR) , INTENT(INOUT) :: td_bathy
+
+      ! local variable
+      INTEGER  ::   iip1, ijp1, iim1, ijm1   ! temporary integers
+
+      REAL(dp) :: zrmax, zrfact
+      REAL(dp) :: ztaper
+
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_hifv  !< interface depth between stretching at v--f
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_hiff
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_hift  !< and quasi-uniform spacing t--u points (m)
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_hifu
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_scosrf !< ocean surface topography
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_scobot !< ocean bottom topography
+
+!      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_hbatt
+!      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_hbatu
+!      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_hbatv
+!      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: dl_hbatf
+
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: zenv
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: zri
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: zrj
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: zhbat
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: ztmpi1
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: ztmpi2
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: ztmpj1
+      REAL(dp), DIMENSION(:,:), ALLOCATABLE :: ztmpj2
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      CALL logger_info('GRID ZGR SCO: s-coordinate or hybrid z-s-coordinate')
+      CALL logger_info('~~~~~~~~~~~')
+      CALL logger_info('   Namelist namzgr_sco')
+      CALL logger_info('     stretching coeffs ')
+      CALL logger_info('        maximum depth of s-bottom surface (>0)       dn_sbot_max   = '//TRIM(fct_str(td_nam%d_sbot_max)))
+      CALL logger_info('        minimum depth of s-bottom surface (>0)       dn_sbot_min   = '//TRIM(fct_str(td_nam%d_sbot_min)))
+      CALL logger_info('        Critical depth                               dn_hc         = '//TRIM(fct_str(td_nam%d_hc)))
+      CALL logger_info('        maximum cut-off r-value allowed              dn_rmax       = '//TRIM(fct_str(td_nam%d_rmax)))
+      CALL logger_info('     Song and Haidvogel 1994 stretching              ln_s_sh94     = '//TRIM(fct_str(td_nam%l_s_sh94)))
+      CALL logger_info('        Song and Haidvogel 1994 stretching coefficients')
+      CALL logger_info('        surface control parameter (0<=rn_theta<=20)  dn_theta      = '//TRIM(fct_str(td_nam%d_theta)))
+      CALL logger_info('        bottom  control parameter (0<=rn_thetb<= 1)  dn_thetb      = '//TRIM(fct_str(td_nam%d_thetb)))
+      CALL logger_info('        stretching parameter (song and haidvogel)    dn_bb         = '//TRIM(fct_str(td_nam%d_bb)))
+      CALL logger_info('     Siddorn and Furner 2012 stretching              ln_s_sf12     = '//TRIM(fct_str(td_nam%l_s_sf12)))
+      CALL logger_info('        switching to sigma (T) or Z (F) at H<Hc      ln_sigcrit    = '//TRIM(fct_str(td_nam%l_sigcrit)))
+      CALL logger_info('        Siddorn and Furner 2012 stretching coefficients')
+      CALL logger_info('        stretchin parameter ( >1 surface; <1 bottom) dn_alpha      = '//TRIM(fct_str(td_nam%d_alpha)))
+      CALL logger_info('        e-fold length scale for transition region    dn_efold      = '//TRIM(fct_str(td_nam%d_efold)))
+      CALL logger_info('        Surface cell depth (Zs) (m)                  dn_zs         = '//TRIM(fct_str(td_nam%d_zs)))
+      CALL logger_info('        Bathymetry multiplier for Zb                 dn_zb_a       = '//TRIM(fct_str(td_nam%d_zb_a)))
+      CALL logger_info('        Offset for Zb                                dn_zb_b       = '//TRIM(fct_str(td_nam%d_zb_b)))
+      CALL logger_info('        Bottom cell (Zb) (m) = H*rn_zb_a + rn_zb_b')
+
+      ALLOCATE(dl_hifv(jpi,jpj))
+      ALLOCATE(dl_hiff(jpi,jpj))
+      ALLOCATE(dl_hift(jpi,jpj))
+      ALLOCATE(dl_hifu(jpi,jpj))
+
+      ! set the minimum depth for the s-coordinate
+      dl_hift(:,:) = td_nam%d_sbot_min
+      dl_hifu(:,:) = td_nam%d_sbot_min
+      dl_hifv(:,:) = td_nam%d_sbot_min
+      dl_hiff(:,:) = td_nam%d_sbot_min
+
+      ! set maximum ocean depth
+      td_bathy%d_value(:,:,1,1) = MIN( td_nam%d_sbot_max, td_bathy%d_value(:,:,1,1) )
+      IF( .NOT. td_nam%l_wd )THEN
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+              IF( td_bathy%d_value(ji,jj,1,1) > 0._dp )THEN
+                 td_bathy%d_value(ji,jj,1,1) = MAX(td_nam%d_sbot_min, td_bathy%d_value(ji,jj,1,1))
+              ENDIF
+            END DO
+         END DO
+      ENDIF
+
+      ! =============================
+      ! Define the envelop bathymetry   (hbatt)
+      ! =============================
+      ! use r-value to create hybrid coordinates
+      ALLOCATE(zenv(jpi,jpj))
+      zenv(:,:) = td_bathy%d_value(:,:,1,1)
+
+      IF( .NOT. td_nam%l_wd )THEN
+      ! set first land point adjacent to a wet cell to sbot_min as this needs to be included in smoothing
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+              IF( td_bathy%d_value(ji,jj,1,1) == 0._dp )THEN
+                iip1 = MIN( ji+1, jpi )
+                ijp1 = MIN( jj+1, jpj )
+                iim1 = MAX( ji-1,  1  )
+                ijm1 = MAX( jj-1,  1  )
+                IF( ( td_bathy%d_value(iim1,ijm1,1,1) + &
+                   &  td_bathy%d_value(ji  ,ijp1,1,1) + &
+                   &  td_bathy%d_value(iip1,ijp1,1,1) + &
+                   &  td_bathy%d_value(iim1,jj  ,1,1) + &
+                   &  td_bathy%d_value(iip1,jj  ,1,1) + &
+                   &  td_bathy%d_value(iim1,ijm1,1,1) + &
+                   &  td_bathy%d_value(ji  ,ijm1,1,1) + &
+                   &  td_bathy%d_value(iip1,ijp1,1,1) ) > 0._dp )THEN
+                  zenv(ji,jj) = td_nam%d_sbot_min
+                ENDIF
+              ENDIF
+            END DO
+         END DO
+      ENDIF
+
+      ! apply lateral boundary condition   CAUTION: keep the value when the lbc field is zero
+      ! this is only in mpp case, so here just do nothing
+      !! CALL lbc_lnk( zenv(:,:), 'T', td_nam%i_perio, 1._dp, 'no0' ) 
+
+      ! smooth the bathymetry (if required)
+      ALLOCATE(dl_scosrf(jpi,jpj))
+      ALLOCATE(dl_scobot(jpi,jpj))
+      dl_scosrf(:,:) = 0._dp                      ! ocean surface depth (here zero: no under ice-shelf sea)
+      dl_scobot(:,:) = td_bathy%d_value(:,:,1,1)  ! ocean bottom  depth
+
+      jl    = 0
+      zrmax = 1._dp
+
+      ! set scaling factor used in reducing vertical gradients
+      zrfact = ( 1._dp - td_nam%d_rmax ) / ( 1._dp + td_nam%d_rmax )      
+
+      ! initialise temporary envelope depth arrays
+      ALLOCATE(ztmpi1(jpi,jpj))
+      ALLOCATE(ztmpi2(jpi,jpj))
+      ALLOCATE(ztmpj1(jpi,jpj))
+      ALLOCATE(ztmpj2(jpi,jpj))
+
+      ztmpi1(:,:) = zenv(:,:)
+      ztmpi2(:,:) = zenv(:,:)
+      ztmpj1(:,:) = zenv(:,:)
+      ztmpj2(:,:) = zenv(:,:)
+
+      ! initialise temporary r-value arrays
+      ALLOCATE(zri(jpi,jpj))
+      ALLOCATE(zrj(jpi,jpj))
+      zri(:,:) = 1._dp
+      zrj(:,:) = 1._dp
+
+      !  Iterative loop  !
+      ! ================ !
+      DO WHILE( jl <= 10000 .AND. ( zrmax - td_nam%d_rmax ) > 1.e-8_dp )
+
+         jl = jl + 1
+         zrmax = 0._dp
+         ! we set zrmax from previous r-values (zri and zrj) first
+         ! if set after current r-value calculation (as previously)
+         ! we could exit DO WHILE prematurely before checking r-value
+         ! of current zenv
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zrmax = MAX( zrmax, ABS(zri(ji,jj)), ABS(zrj(ji,jj)) )
+            END DO
+         END DO
+         zri(:,:) = 0._dp
+         zrj(:,:) = 0._dp
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               iip1 = MIN( ji+1, jpi )      ! force zri = 0 on last line (ji=ncli+1 to jpi)
+               ijp1 = MIN( jj+1, jpj )      ! force zrj = 0 on last raw  (jj=nclj+1 to jpj)
+               IF( (zenv(ji  ,jj) > 0._dp) .AND. &
+                 & (zenv(iip1,jj) > 0._dp) )THEN
+                  zri(ji,jj) = ( zenv(iip1,  jj) - zenv(ji,jj) ) / ( zenv(iip1,jj  ) + zenv(ji,jj) )
+               END IF
+               IF( (zenv(ji,jj  ) > 0._dp) .AND. &
+                 & (zenv(ji,ijp1) > 0._dp) )THEN
+                  zrj(ji,jj) = ( zenv(ji  ,ijp1) - zenv(ji,jj) ) / ( zenv(ji  ,ijp1) + zenv(ji,jj) )
+               END IF
+               IF( zri(ji,jj) >  td_nam%d_rmax ) ztmpi1(ji  ,jj  ) = zenv(iip1,jj  ) * zrfact
+               IF( zri(ji,jj) < -td_nam%d_rmax ) ztmpi2(iip1,jj  ) = zenv(ji  ,jj  ) * zrfact
+               IF( zrj(ji,jj) >  td_nam%d_rmax ) ztmpj1(ji  ,jj  ) = zenv(ji  ,ijp1) * zrfact
+               IF( zrj(ji,jj) < -td_nam%d_rmax ) ztmpj2(ji  ,ijp1) = zenv(ji  ,jj  ) * zrfact
+            END DO
+         END DO
+         !! 
+         !
+         CALL logger_info('zgr_sco :   iter= '//TRIM(fct_str(jl))//&
+            &             ' rmax= '//TRIM(fct_str(zrmax)) )
+         !
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zenv(ji,jj) = MAX( zenv  (ji,jj), &
+                                & ztmpi1(ji,jj), &
+                                & ztmpi2(ji,jj), &
+                                & ztmpj1(ji,jj), &
+                                & ztmpj2(ji,jj) )
+            END DO
+         END DO
+         ! apply lateral boundary condition   CAUTION: keep the value when the lbc field is zero
+         ! this is only in mpp case, so here just do nothing
+         !!CALL lbc_lnk( zenv, 'T', td_nam%i_perio, 1._dp, 'no0' )
+      ENDDO
+      !     End loop     !
+      ! ================ !
+
+      DEALLOCATE(zri)
+      DEALLOCATE(zrj)
+
+      DEALLOCATE(ztmpi1)
+      DEALLOCATE(ztmpi2)
+      DEALLOCATE(ztmpj1)
+      DEALLOCATE(ztmpj2)
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ! set all points to avoid undefined scale value warnings
+            zenv(ji,jj) = MAX( zenv(ji,jj), td_nam%d_sbot_min )
+         ENDDO
+      ENDDO
+      !
+      ! Envelope bathymetry saved in hbatt
+      !
+!      ALLOCATE(dl_hbatt(jpi,jpj))
+!      ALLOCATE(dl_hbatu(jpi,jpj))
+!      ALLOCATE(dl_hbatv(jpi,jpj))
+!      ALLOCATE(dl_hbatf(jpi,jpj))
+
+      tg_hbatt%d_value(:,:,1,1) = zenv(:,:) 
+      IF( MINVAL( tg_gphit%d_value(:,:,1,1) ) * &
+        & MAXVAL( tg_gphit%d_value(:,:,1,1) ) <= 0._dp ) THEN
+         CALL logger_warn( ' s-coordinates are tapered in vicinity of the Equator' )
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ztaper = EXP( -(tg_gphit%d_value(ji,jj,1,1)/8._dp)**2._dp )
+               tg_hbatt%d_value(ji,jj,1,1) =   td_nam%d_sbot_max           * ztaper           &
+               &                             + tg_hbatt%d_value(ji,jj,1,1) * (1._dp - ztaper)
+            END DO
+         END DO
+      ENDIF
+
+      DEALLOCATE(zenv)
+
+      CALL logger_info(' bathy  MAX '//TRIM(fct_str(MAXVAL( td_bathy%d_value(:,:,1,1) )))//&
+         &                    ' MIN '//TRIM(fct_str(MINVAL( td_bathy%d_value(:,:,1,1) ))) )
+      CALL logger_info(' hbatt  MAX '//TRIM(fct_str(MAXVAL( tg_hbatt%d_value(:,:,1,1) )))//&
+         &                    ' MIN '//TRIM(fct_str(MINVAL( tg_hbatt%d_value(:,:,1,1) ))) )
+      !
+      !   hbatu, hbatv, hbatf fields
+      !
+      tg_hbatu%d_value(:,:,1,1) = td_nam%d_sbot_min
+      tg_hbatv%d_value(:,:,1,1) = td_nam%d_sbot_min
+      tg_hbatf%d_value(:,:,1,1) = td_nam%d_sbot_min
+
+      DO jj = 1, jpj-1
+        DO ji = 1, jpi-1   ! NO vector opt.
+           tg_hbatu%d_value(ji,jj,1,1) = 0.50_dp * ( tg_hbatt%d_value(ji  ,jj  ,1,1) + &
+              &                                      tg_hbatt%d_value(ji+1,jj  ,1,1) )
+           tg_hbatv%d_value(ji,jj,1,1) = 0.50_dp * ( tg_hbatt%d_value(ji  ,jj  ,1,1) + &
+              &                                      tg_hbatt%d_value(ji  ,jj+1,1,1) )
+           tg_hbatf%d_value(ji,jj,1,1) = 0.25_dp * ( tg_hbatt%d_value(ji  ,jj  ,1,1) + &
+              &                                      tg_hbatt%d_value(ji  ,jj+1,1,1) + &
+              &                                      tg_hbatt%d_value(ji+1,jj  ,1,1) + &
+              &                                      tg_hbatt%d_value(ji+1,jj+1,1,1) )
+        ENDDO
+      ENDDO
+
+      IF( td_nam%l_wd ) THEN               !avoid the zero depth on T- (U-,V-,F-) points
+        DO jj = 1, jpj
+          DO ji = 1, jpi
+            IF( ABS(tg_hbatt%d_value(ji,jj,1,1)) < td_nam%d_wdmin1 )THEN
+               tg_hbatt%d_value(ji,jj,1,1) = SIGN(1._dp, tg_hbatt%d_value(ji,jj,1,1)) * td_nam%d_wdmin1
+            ENDIF
+            IF( ABS(tg_hbatu%d_value(ji,jj,1,1)) < td_nam%d_wdmin1 )THEN
+               tg_hbatu%d_value(ji,jj,1,1) = SIGN(1._dp, tg_hbatu%d_value(ji,jj,1,1)) * td_nam%d_wdmin1
+            ENDIF
+            IF( ABS(tg_hbatv%d_value(ji,jj,1,1)) < td_nam%d_wdmin1 )THEN
+               tg_hbatv%d_value(ji,jj,1,1) = SIGN(1._dp, tg_hbatv%d_value(ji,jj,1,1)) * td_nam%d_wdmin1
+            ENDIF
+            IF( ABS(tg_hbatf%d_value(ji,jj,1,1)) < td_nam%d_wdmin1 )THEN
+               tg_hbatf%d_value(ji,jj,1,1) = SIGN(1._dp, tg_hbatf%d_value(ji,jj,1,1)) * td_nam%d_wdmin1
+            ENDIF
+          END DO
+        END DO
+      ENDIF
+
+      ! Apply lateral boundary condition
+      ALLOCATE(zhbat(jpi,jpj))
+
+!!gm  ! CAUTION: retain non zero value in the initial file this should be OK for orca cfg, not for EEL
+      zhbat(:,:) = tg_hbatu%d_value(:,:,1,1)
+      CALL lbc_lnk( tg_hbatu%d_value(:,:,1,1), 'U', td_nam%i_perio, 1._dp )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( tg_hbatu%d_value(ji,jj,1,1) == 0._dp )THEN
+               !No worries about the following line when l_wd == .true.
+               IF( zhbat(ji,jj) == 0._dp ) tg_hbatu%d_value(ji,jj,1,1) = td_nam%d_sbot_min
+               IF( zhbat(ji,jj) /= 0._dp ) tg_hbatu%d_value(ji,jj,1,1) = zhbat(ji,jj)
+            ENDIF
+         ENDDO
+      ENDDO
+
+      zhbat(:,:) = tg_hbatv%d_value(:,:,1,1)
+      CALL lbc_lnk( tg_hbatv%d_value(:,:,1,1), 'V', td_nam%i_perio, 1._dp )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( tg_hbatv%d_value(ji,jj,1,1) == 0._dp ) THEN
+               IF( zhbat(ji,jj) == 0._dp ) tg_hbatv%d_value(ji,jj,1,1) = td_nam%d_sbot_min
+               IF( zhbat(ji,jj) /= 0._dp ) tg_hbatv%d_value(ji,jj,1,1) = zhbat(ji,jj)
+            ENDIF
+         ENDDO
+      ENDDO
+
+      zhbat(:,:) = tg_hbatf%d_value(:,:,1,1)
+      CALL lbc_lnk( tg_hbatf%d_value(:,:,1,1), 'F', td_nam%i_perio, 1._dp )
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( tg_hbatf%d_value(ji,jj,1,1) == 0._dp ) THEN
+               IF( zhbat(ji,jj) == 0._dp ) tg_hbatf%d_value(ji,jj,1,1) = td_nam%d_sbot_min
+               IF( zhbat(ji,jj) /= 0._dp ) tg_hbatf%d_value(ji,jj,1,1) = zhbat(ji,jj)
+            ENDIF
+         ENDDO
+      ENDDO
+
+      DEALLOCATE(zhbat)
+
+!!bug:  key_helsinki a verifer
+      IF( .NOT.td_nam%l_wd )THEN
+         dl_hift(:,:) = MIN( dl_hift(:,:), tg_hbatt%d_value(:,:,1,1) )
+         dl_hifu(:,:) = MIN( dl_hifu(:,:), tg_hbatu%d_value(:,:,1,1) )
+         dl_hifv(:,:) = MIN( dl_hifv(:,:), tg_hbatv%d_value(:,:,1,1) )
+         dl_hiff(:,:) = MIN( dl_hiff(:,:), tg_hbatf%d_value(:,:,1,1) )
+      ENDIF
+
+      CALL logger_info(' MAX val hif   t '//TRIM(fct_str(MAXVAL( dl_hift(:,:) )))//&
+         &                           ' f '//TRIM(fct_str(MAXVAL( dl_hiff(:,:) )))//&
+         &                           ' u '//TRIM(fct_str(MAXVAL( dl_hifu(:,:) )))//&
+         &                           ' v '//TRIM(fct_str(MAXVAL( dl_hifv(:,:) ))) )
+      CALL logger_info(' MIN val hif   t '//TRIM(fct_str(MINVAL( dl_hift(:,:) )))//&
+         &                           ' f '//TRIM(fct_str(MINVAL( dl_hiff(:,:) )))//&
+         &                           ' u '//TRIM(fct_str(MINVAL( dl_hifu(:,:) )))//&
+         &                           ' v '//TRIM(fct_str(MINVAL( dl_hifv(:,:) ))) )
+      CALL logger_info(' MAX val hbat  t '//TRIM(fct_str(MAXVAL( tg_hbatt%d_value(:,:,1,1) )))//&
+         &                           ' f '//TRIM(fct_str(MAXVAL( tg_hbatf%d_value(:,:,1,1) )))//&
+         &                           ' u '//TRIM(fct_str(MAXVAL( tg_hbatu%d_value(:,:,1,1) )))//&
+         &                           ' v '//TRIM(fct_str(MAXVAL( tg_hbatv%d_value(:,:,1,1) ))) )
+      CALL logger_info(' MIN val hbat  t '//TRIM(fct_str(MINVAL( tg_hbatt%d_value(:,:,1,1) )))//&
+         &                           ' f '//TRIM(fct_str(MINVAL( tg_hbatf%d_value(:,:,1,1) )))//&
+         &                           ' u '//TRIM(fct_str(MINVAL( tg_hbatu%d_value(:,:,1,1) )))//&
+         &                           ' v '//TRIM(fct_str(MINVAL( tg_hbatv%d_value(:,:,1,1) ))) )
+!! helsinki
+
+      ! =======================
+      !   s-ccordinate fields     (gdep., e3.)
+      ! =======================
+      !
+      ! non-dimensional "sigma" for model level depth at w- and t-levels
+
+!========================================================================
+! Song and Haidvogel  1994 (ln_s_sh94=T)
+! Siddorn and Furner  2012 (ln_sf12=T)
+! or  tanh function        (both false)                    
+!========================================================================
+      IF( td_nam%l_s_sh94 ) THEN 
+         CALL grid_zgr__sco_s_sh94( td_nam,jpi,jpj,jpk, &
+         &                          dl_scosrf )
+      ELSEIF( td_nam%l_s_sf12 ) THEN
+         CALL grid_zgr__sco_s_sf12( td_nam,jpi,jpj,jpk, &
+         &                          dl_scosrf )
+      ELSE                 
+         CALL grid_zgr__sco_s_tanh( td_nam,jpi,jpj,jpk, &
+         &                          dl_scosrf, &
+         &                          dl_hift, dl_hifu, dl_hifv, dl_hiff )
+      ENDIF
+
+      DEALLOCATE(dl_scosrf)
+
+      DEALLOCATE(dl_hifv)
+      DEALLOCATE(dl_hiff)
+      DEALLOCATE(dl_hift)
+      DEALLOCATE(dl_hifu)
+
+      CALL lbc_lnk( tg_e3t_0%d_value(:,:,:,1) , 'T', td_nam%i_perio, 1._dp )
+      CALL lbc_lnk( tg_e3u_0%d_value(:,:,:,1) , 'U', td_nam%i_perio, 1._dp )
+      CALL lbc_lnk( tg_e3v_0%d_value(:,:,:,1) , 'V', td_nam%i_perio, 1._dp )
+      CALL lbc_lnk( tg_e3f_0%d_value(:,:,:,1) , 'F', td_nam%i_perio, 1._dp )
+      CALL lbc_lnk( tg_e3w_0%d_value(:,:,:,1) , 'W', td_nam%i_perio, 1._dp )
+      CALL lbc_lnk( tg_e3uw_0%d_value(:,:,:,1), 'U', td_nam%i_perio, 1._dp )
+      CALL lbc_lnk( tg_e3vw_0%d_value(:,:,:,1), 'V', td_nam%i_perio, 1._dp )
+
+      IF( .NOT. td_nam%l_wd ) THEN
+         WHERE( tg_e3t_0%d_value(:,:,:,1) == 0_dp )  tg_e3t_0%d_value(:,:,:,1) = 1._dp
+         WHERE( tg_e3u_0%d_value(:,:,:,1) == 0_dp )  tg_e3u_0%d_value(:,:,:,1) = 1._dp
+         WHERE( tg_e3v_0%d_value(:,:,:,1) == 0_dp )  tg_e3v_0%d_value(:,:,:,1) = 1._dp
+         WHERE( tg_e3f_0%d_value(:,:,:,1) == 0_dp )  tg_e3f_0%d_value(:,:,:,1) = 1._dp
+         WHERE( tg_e3w_0%d_value(:,:,:,1) == 0_dp )  tg_e3w_0%d_value(:,:,:,1) = 1._dp
+         WHERE( tg_e3uw_0%d_value(:,:,:,1)== 0_dp )  tg_e3uw_0%d_value(:,:,:,1)= 1._dp
+         WHERE( tg_e3vw_0%d_value(:,:,:,1)== 0_dp )  tg_e3vw_0%d_value(:,:,:,1)= 1._dp
+      ENDIF
+
+      ! HYBRID : 
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpk-1
+               IF( dl_scobot(ji,jj) >= tg_gdept_0%d_value(ji,jj,jk,1) )THEN
+                  tg_mbathy%d_value(ji,jj,1,1) = REAL(MAX( 2, jk ),dp)
+               ENDIF
+            END DO
+
+            IF( td_nam%l_wd ) THEN
+               IF( dl_scobot(ji,jj) <= -(td_nam%d_wdld - td_nam%d_wdmin2) )THEN
+
+                  tg_mbathy%d_value(ji,jj,1,1) = 0._dp
+
+               ELSEIF( dl_scobot(ji,jj) <= td_nam%d_wdmin1 )THEN
+
+                  tg_mbathy%d_value(ji,jj,1,1) = 2._dp
+
+               ENDIF
+            ELSE
+               IF( dl_scobot(ji,jj) == 0._dp )THEN
+                  tg_mbathy%d_value(ji,jj,1,1) = 0._dp
+               ENDIF
+            ENDIF
+
+         ENDDO
+      ENDDO
+
+      DEALLOCATE(dl_scobot)
+
+      CALL logger_info(' MIN val mbathy MIN '//TRIM(fct_str(MINVAL( tg_mbathy%d_value(:,:,1,1) )))//&
+         &             ' MAX '//TRIM(fct_str(MAXVAL( tg_mbathy%d_value(:,:,1,1) ))) )
+      CALL logger_info(' MIN val depth t '//TRIM(fct_str(MINVAL( tg_gdept_0%d_value(:,:,:,1) )))//&
+         &                           ' w '//TRIM(fct_str(MINVAL( tg_gdepw_0%d_value(:,:,:,1) ))) )!//&
+         !&                           '3w '//TRIM(fct_str(MINVAL( tg_gdep3w_0%d_value(:,:,:,1)))) )
+
+      CALL logger_info(' MIN val e3    t '//TRIM(fct_str(MINVAL( tg_e3t_0%d_value(:,:,:,1) )))//&
+         &                           ' f '//TRIM(fct_str(MINVAL( tg_e3f_0%d_value(:,:,:,1) )))//&
+         &                           ' u '//TRIM(fct_str(MINVAL( tg_e3u_0%d_value(:,:,:,1) )))//&
+         &                           ' v '//TRIM(fct_str(MINVAL( tg_e3v_0%d_value(:,:,:,1) )))//&
+         &                          ' uw '//TRIM(fct_str(MINVAL( tg_e3uw_0%d_value(:,:,:,1) )))//&
+         &                          ' vw '//TRIM(fct_str(MINVAL( tg_e3vw_0%d_value(:,:,:,1) )))//&
+         &                           ' w '//TRIM(fct_str(MINVAL( tg_e3w_0%d_value(:,:,:,1) ))) )
+
+      CALL logger_info(' MAX val depth t '//TRIM(fct_str(MAXVAL( tg_gdept_0%d_value(:,:,:,1) )))//&
+         &                           ' w '//TRIM(fct_str(MAXVAL( tg_gdepw_0%d_value(:,:,:,1) ))) )!//&
+         !&                           '3w '//TRIM(fct_str(MAXVAL( tg_gdep3w_0%d_value(:,:,:,1) ))) )
+
+      CALL logger_info(' MAX val e3    t '//TRIM(fct_str(MAXVAL( tg_e3t_0%d_value(:,:,:,1) )))//&
+         &                           ' f '//TRIM(fct_str(MAXVAL( tg_e3f_0%d_value(:,:,:,1) )))//&
+         &                           ' u '//TRIM(fct_str(MAXVAL( tg_e3u_0%d_value(:,:,:,1) )))//&
+         &                           ' v '//TRIM(fct_str(MAXVAL( tg_e3v_0%d_value(:,:,:,1) )))//&
+         &                          ' uw '//TRIM(fct_str(MAXVAL( tg_e3uw_0%d_value(:,:,:,1) )))//&
+         &                          ' vw '//TRIM(fct_str(MAXVAL( tg_e3vw_0%d_value(:,:,:,1) )))//&
+         &                           ' w '//TRIM(fct_str(MAXVAL( tg_e3w_0%d_value(:,:,:,1) ))) )
+
+!================================================================================
+! check the coordinate makes sense
+!================================================================================
+      DO ji = 1, jpi
+         DO jj = 1, jpj
+
+            IF( tg_hbatt%d_value(ji,jj,1,1) > 0._dp )THEN
+               DO jk = 1, INT(tg_mbathy%d_value(ji,jj,1,1),i4)
+                  ! check coordinate is monotonically increasing
+                  IF( tg_e3w_0%d_value(ji,jj,jk,1) <= 0._dp .OR. &
+                    & tg_e3t_0%d_value(ji,jj,jk,1) <= 0._dp )THEN
+                     CALL logger_fatal(' GRID ZGR SCO:   e3w   or e3t   =< 0  at point ('//&
+                       &               TRIM(fct_str(ji))//","//&
+                       &               TRIM(fct_str(jj))//","//&
+                       &               TRIM(fct_str(jk))//")" )
+                    !WRITE(numout,*) 'e3w',fse3w(ji,jj,:)
+                    !WRITE(numout,*) 'e3t',fse3t(ji,jj,:)
+                  ENDIF
+                  ! and check it has never gone negative
+                  IF( tg_gdepw_0%d_value(ji,jj,jk,1) < 0._dp .OR. &
+                    & tg_gdept_0%d_value(ji,jj,jk,1) < 0._dp ) THEN
+                     CALL logger_fatal('GRId ZGR SCO :   gdepw or gdept =< 0  at point ('//&
+                       &               TRIM(fct_str(ji))//","//&
+                       &               TRIM(fct_str(jj))//","//&
+                       &               TRIM(fct_str(jk))//")" )
+                    !WRITE(numout,*) 'gdepw',fsdepw(ji,jj,:)
+                    !WRITE(numout,*) 'gdept',fsdept(ji,jj,:)
+                  ENDIF
+                  ! and check it never exceeds the total depth
+                  IF( tg_gdepw_0%d_value(ji,jj,jk,1) > tg_hbatt%d_value(ji,jj,1,1) ) THEN
+                     CALL logger_fatal('GRID ZGR SCO:   gdepw > hbatt  at point ('//&
+                       &               TRIM(fct_str(ji))//","//&
+                       &               TRIM(fct_str(jj))//","//&
+                       &               TRIM(fct_str(jk))//")" )
+                    !WRITE(numout,*) 'gdepw',fsdepw(ji,jj,:)
+                  ENDIF
+               ENDDO
+
+               DO jk = 1, INT(tg_mbathy%d_value(ji,jj,1,1),i4)-1
+                  ! and check it never exceeds the total depth
+                  IF( tg_gdept_0%d_value(ji,jj,jk,1) > tg_hbatt%d_value(ji,jj,1,1) ) THEN
+                    CALL logger_fatal('GRID ZGR SCO:   gdept > hbatt  at point ('//&
+                       &               TRIM(fct_str(ji))//","//&
+                       &               TRIM(fct_str(jj))//","//&
+                       &               TRIM(fct_str(jk))//")" )
+                    !WRITE(numout,*) 'gdept',fsdept(ji,jj,:)
+                  ENDIF
+               ENDDO
+            ENDIF
+
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE grid_zgr__sco_fill
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_zgr__sco_s_sh94(td_nam, jpi, jpj, jpk, dd_scosrf) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine stretch the s-coordinate system
+   !>
+   !> @details
+   !> ** Method  :   s-coordinate stretch using the Song and Haidvogel 1994
+   !>                mixed S/sigma coordinate
+   !>
+   !> Reference : Song and Haidvogel 1994.   
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from domzgr 
+   !> @date October, 2016
+   !> - add wetting and drying option
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !> @param[in] jpk
+   !> @param[in] dd_scosrf
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TNAMZ),                 INTENT(IN   ) :: td_nam
+      INTEGER(i4),                 INTENT(IN   ) :: jpi
+      INTEGER(i4),                 INTENT(IN   ) :: jpj
+      INTEGER(i4),                 INTENT(IN   ) :: jpk
+      REAL(dp)   , DIMENSION(:,:), INTENT(IN   ) :: dd_scosrf
+
+      ! local variable
+      REAL(dp) :: zcoeft
+      REAL(dp) :: zcoefw
+
+      REAL(dp) ::   ztmpu
+      REAL(dp) ::   ztmpv
+      REAL(dp) ::   ztmpf
+      REAL(dp) ::   ztmpu1
+      REAL(dp) ::   ztmpv1
+      REAL(dp) ::   ztmpf1
+
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_gsigw3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_gsigt3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_gsi3w3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigt3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigw3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigtu3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigtv3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigtf3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigwu3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigwv3
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      ALLOCATE( z_gsigw3(jpi,jpj,jpk))
+      ALLOCATE( z_gsigt3(jpi,jpj,jpk))
+      ALLOCATE( z_gsi3w3(jpi,jpj,jpk))
+      ALLOCATE( z_esigt3(jpi,jpj,jpk))
+      ALLOCATE( z_esigw3(jpi,jpj,jpk))
+      ALLOCATE( z_esigtu3(jpi,jpj,jpk))
+      ALLOCATE( z_esigtv3(jpi,jpj,jpk))
+      ALLOCATE( z_esigtf3(jpi,jpj,jpk))
+      ALLOCATE( z_esigwu3(jpi,jpj,jpk))
+      ALLOCATE( z_esigwv3(jpi,jpj,jpk))
+
+      z_gsigw3(:,:,:) =0._dp
+      z_gsigt3(:,:,:) =0._dp  
+      z_gsi3w3(:,:,:) =0._dp  
+      z_esigt3(:,:,:) =0._dp  
+      z_esigw3(:,:,:) =0._dp  
+
+      z_esigtu3(:,:,:)=0._dp 
+      z_esigtv3(:,:,:)=0._dp
+      z_esigtf3(:,:,:)=0._dp
+      z_esigwu3(:,:,:)=0._dp
+      z_esigwv3(:,:,:)=0._dp
+
+      DO ji = 1, jpi
+         DO jj = 1, jpj
+   
+            IF( tg_hbatt%d_value(ji,jj,1,1) > td_nam%d_hc ) THEN    !deep water, stretched sigma
+               DO jk = 1, jpk
+                  z_gsigw3(ji,jj,jk) = -grid_zgr__sco_fssig1( td_nam, jpk, REAL(jk,dp)-0.5_dp, td_nam%d_bb )
+                  z_gsigt3(ji,jj,jk) = -grid_zgr__sco_fssig1( td_nam, jpk, REAL(jk,dp)       , td_nam%d_bb )
+               END DO
+            ELSE ! shallow water, uniform sigma
+               DO jk = 1, jpk
+                  z_gsigw3(ji,jj,jk) =   REAL(jk-1,dp)            / REAL(jpk-1,dp)
+                  z_gsigt3(ji,jj,jk) = ( REAL(jk-1,dp) + 0.5_dp ) / REAL(jpk-1,dp)
+               END DO
+            ENDIF         
+
+            DO jk = 1, jpk-1
+               z_esigt3(ji,jj,jk  ) = z_gsigw3(ji,jj,jk+1) - z_gsigw3(ji,jj,jk)
+               z_esigw3(ji,jj,jk+1) = z_gsigt3(ji,jj,jk+1) - z_gsigt3(ji,jj,jk)
+            END DO            
+            z_esigw3(ji,jj,1  ) = 2._dp * ( z_gsigt3(ji,jj,1  ) - z_gsigw3(ji,jj,1  ) )
+            z_esigt3(ji,jj,jpk) = 2._dp * ( z_gsigt3(ji,jj,jpk) - z_gsigw3(ji,jj,jpk) )
+
+            ! Coefficients for vertical depth as the sum of e3w scale factors
+            z_gsi3w3(ji,jj,1) = 0.5_dp * z_esigw3(ji,jj,1)
+            DO jk = 2, jpk
+               z_gsi3w3(ji,jj,jk) = z_gsi3w3(ji,jj,jk-1) + z_esigw3(ji,jj,jk)
+            END DO
+            !
+            DO jk = 1, jpk
+               zcoeft = ( REAL(jk,dp) - 0.5_dp ) / REAL(jpk-1,dp)
+               zcoefw = ( REAL(jk,dp) - 1.0_dp ) / REAL(jpk-1,dp)
+               tg_gdept_0%d_value(ji,jj,jk,1)  = (  dd_scosrf(ji,jj) &
+                  &                              + (tg_hbatt%d_value(ji,jj,1,1)-td_nam%d_hc)*z_gsigt3(ji,jj,jk) &
+                  &                              +  td_nam%d_hc*zcoeft )
+               tg_gdepw_0%d_value(ji,jj,jk,1)  = (  dd_scosrf(ji,jj) &
+                  &                              + (tg_hbatt%d_value(ji,jj,1,1)-td_nam%d_hc)*z_gsigw3(ji,jj,jk) &
+                  &                              +  td_nam%d_hc*zcoefw )
+               !tg_gdep3w_0%d_value(ji,jj,jk,1) = (  dd_scosrf(ji,jj) &
+               !   &                              + (tg_hbatt%d_value(ji,jj,1,1)-td_nam%d_hc)*z_gsi3w3(ji,jj,jk) &
+               !   &                              +  td_nam%d_hc*zcoeft )
+            END DO
+
+         END DO   ! for all jj's
+      END DO    ! for all ji's
+
+      DO ji = 1, jpi-1
+         DO jj = 1, jpj-1
+            ! extended for Wetting/Drying case
+            ztmpu  = tg_hbatt%d_value(ji  ,jj  ,1,1) + tg_hbatt%d_value(ji+1,jj  ,1,1)
+            ztmpv  = tg_hbatt%d_value(ji  ,jj  ,1,1) + tg_hbatt%d_value(ji  ,jj+1,1,1)
+            ztmpf  = tg_hbatt%d_value(ji  ,jj  ,1,1) + tg_hbatt%d_value(ji+1,jj  ,1,1) + &
+                   & tg_hbatt%d_value(ji  ,jj+1,1,1) + tg_hbatt%d_value(ji+1,jj+1,1,1)
+
+            ztmpu1 = tg_hbatt%d_value(ji  ,jj  ,1,1) * tg_hbatt%d_value(ji+1,jj  ,1,1)
+            ztmpv1 = tg_hbatt%d_value(ji  ,jj  ,1,1) * tg_hbatt%d_value(ji  ,jj+1,1,1)
+            ztmpf1 =    MIN(tg_hbatt%d_value(ji  ,jj  ,1,1), tg_hbatt%d_value(ji+1,jj  ,1,1), &
+                   &        tg_hbatt%d_value(ji  ,jj+1,1,1), tg_hbatt%d_value(ji+1,jj+1,1,1)) &
+                   & *  MAX(tg_hbatt%d_value(ji  ,jj  ,1,1), tg_hbatt%d_value(ji+1,jj  ,1,1), &
+                   &        tg_hbatt%d_value(ji  ,jj+1,1,1), tg_hbatt%d_value(ji+1,jj+1,1,1))
+
+            DO jk = 1, jpk
+
+               IF( td_nam%l_wd .AND. &
+                 & ( ztmpu1 < 0._dp .OR. ABS(ztmpu) < td_nam%d_wdmin1 ) )THEN
+                  z_esigtu3(ji,jj,jk) = 0.5_dp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji+1,jj,jk) )
+                  z_esigwu3(ji,jj,jk) = 0.5_dp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji+1,jj,jk) )
+               ELSE
+                  z_esigtu3(ji,jj,jk) = ( tg_hbatt%d_value(ji  ,jj,1,1)*z_esigt3(ji  ,jj,jk) &
+                                      & + tg_hbatt%d_value(ji+1,jj,1,1)*z_esigt3(ji+1,jj,jk) ) / ztmpu
+                  z_esigwu3(ji,jj,jk) = ( tg_hbatt%d_value(ji  ,jj,1,1)*z_esigw3(ji  ,jj,jk) &
+                                      & + tg_hbatt%d_value(ji+1,jj,1,1)*z_esigw3(ji+1,jj,jk)) / ztmpu
+               ENDIF
+
+               IF( td_nam%l_wd .AND. &
+                 & ( ztmpv1 < 0._dp .OR. ABS(ztmpv) < td_nam%d_wdmin1 ) )THEN
+                  z_esigtv3(ji,jj,jk) = 0.5_dp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji,jj+1,jk) )
+                  z_esigwv3(ji,jj,jk) = 0.5_dp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji,jj+1,jk) )
+               ELSE
+                  z_esigtv3(ji,jj,jk) = ( tg_hbatt%d_value(ji,jj  ,1,1)*z_esigt3(ji,jj  ,jk) &
+                                      & + tg_hbatt%d_value(ji,jj+1,1,1)*z_esigt3(ji,jj+1,jk)) / ztmpv
+                  z_esigwv3(ji,jj,jk) = ( tg_hbatt%d_value(ji,jj  ,1,1)*z_esigw3(ji,jj  ,jk) &
+                                      & + tg_hbatt%d_value(ji,jj+1,1,1)*z_esigw3(ji,jj+1,jk)) / ztmpv
+               ENDIF
+
+               IF( td_nam%l_wd .AND. &
+                 & ( ztmpf1 < 0._dp .OR. ABS(ztmpf) < td_nam%d_wdmin1 ) )THEN
+                  z_esigtf3(ji,jj,jk) = 0.25_dp * ( z_esigt3(ji  ,jj  ,jk) &
+                                      &           + z_esigt3(ji+1,jj  ,jk) &
+                                      &           + z_esigt3(ji  ,jj+1,jk) &
+                                      &           + z_esigt3(ji+1,jj+1,jk) )
+               ELSE
+                  z_esigtf3(ji,jj,jk) = ( tg_hbatt%d_value(ji  ,jj  ,1,1)*z_esigt3(ji  ,jj  ,jk) &
+                                      & + tg_hbatt%d_value(ji+1,jj  ,1,1)*z_esigt3(ji+1,jj  ,jk) &
+                                      & + tg_hbatt%d_value(ji  ,jj+1,1,1)*z_esigt3(ji  ,jj+1,jk) &
+                                      & + tg_hbatt%d_value(ji+1,jj+1,1,1)*z_esigt3(ji+1,jj+1,jk) ) / ztmpf
+               ENDIF
+               !
+               tg_e3t_0%d_value(ji,jj,jk,1) = ( ( tg_hbatt%d_value(ji,jj,1,1) - td_nam%d_hc )*z_esigt3 (ji,jj,jk) &
+                  &                            + td_nam%d_hc / REAL(jpk-1,dp) )
+               tg_e3u_0%d_value(ji,jj,jk,1) = ( ( tg_hbatu%d_value(ji,jj,1,1) - td_nam%d_hc )*z_esigtu3(ji,jj,jk) &
+                  &                            + td_nam%d_hc / REAL(jpk-1,dp) )
+               tg_e3v_0%d_value(ji,jj,jk,1) = ( ( tg_hbatv%d_value(ji,jj,1,1) - td_nam%d_hc )*z_esigtv3(ji,jj,jk) &
+                  &                            + td_nam%d_hc / REAL(jpk-1,dp) )
+               tg_e3f_0%d_value(ji,jj,jk,1) = ( ( tg_hbatf%d_value(ji,jj,1,1) - td_nam%d_hc ) *z_esigtf3(ji,jj,jk) &
+                  &                            + td_nam%d_hc/REAL(jpk-1,dp) )
+               
+               tg_e3w_0%d_value (ji,jj,jk,1)= ( ( tg_hbatt%d_value(ji,jj,1,1) - td_nam%d_hc )*z_esigw3 (ji,jj,jk) &
+                  &                            + td_nam%d_hc / REAL(jpk-1,dp) )
+               tg_e3uw_0%d_value(ji,jj,jk,1)= ( ( tg_hbatu%d_value(ji,jj,1,1) - td_nam%d_hc)*z_esigwu3(ji,jj,jk) &
+                 &                             + td_nam%d_hc/REAL(jpk-1,dp) )
+               tg_e3vw_0%d_value(ji,jj,jk,1)= ( ( tg_hbatv%d_value(ji,jj,1,1) - td_nam%d_hc)*z_esigwv3(ji,jj,jk) &
+                 &                             + td_nam%d_hc/REAL(jpk-1,dp) )
+            END DO
+        END DO
+      END DO
+
+      DEALLOCATE( z_gsigw3  )
+      DEALLOCATE( z_gsigt3  )
+      DEALLOCATE( z_gsi3w3  )
+      DEALLOCATE( z_esigt3  )
+      DEALLOCATE( z_esigw3  )
+      DEALLOCATE( z_esigtu3 )
+      DEALLOCATE( z_esigtv3 )
+      DEALLOCATE( z_esigtf3 )
+      DEALLOCATE( z_esigwu3 )
+      DEALLOCATE( z_esigwv3 )
+
+   END SUBROUTINE grid_zgr__sco_s_sh94
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_zgr__sco_s_sf12(td_nam, jpi, jpj, jpk, dd_scosrf) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine stretch the s-coordinate system
+   !>
+   !> ** Method  :   s-coordinate stretch using the Siddorn and Furner 2012?
+   !>                mixed S/sigma/Z coordinate
+   !>
+   !>                This method allows the maintenance of fixed surface and or
+   !>                bottom cell resolutions (cf. geopotential coordinates) 
+   !>                within an analytically derived stretched S-coordinate framework.
+   !>
+   !>
+   !> Reference : Siddorn and Furner 2012 (submitted Ocean modelling).   
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from domzgr 
+   !> @date October, 2016
+   !> - add wetting and drying option
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !> @param[in] jpk
+   !> @param[in] dd_scosrf
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TNAMZ),                 INTENT(IN   ) :: td_nam
+      INTEGER(i4),                 INTENT(IN   ) :: jpi
+      INTEGER(i4),                 INTENT(IN   ) :: jpj
+      INTEGER(i4),                 INTENT(IN   ) :: jpk
+      REAL(dp)   , DIMENSION(:,:), INTENT(IN   ) :: dd_scosrf
+
+      ! local variable
+      REAL(dp) ::   zsmth     ! smoothing around critical depth
+      REAL(dp) ::   zzs, zzb  ! Surface and bottom cell thickness in sigma space
+
+      REAL(dp) ::   ztmpu
+      REAL(dp) ::   ztmpv
+      REAL(dp) ::   ztmpf
+      REAL(dp) ::   ztmpu1
+      REAL(dp) ::   ztmpv1
+      REAL(dp) ::   ztmpf1
+
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_gsigw3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_gsigt3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_gsi3w3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigt3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigw3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigtu3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigtv3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigtf3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigwu3
+      REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_esigwv3
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+      ALLOCATE( z_gsigw3(jpi,jpj,jpk))
+      ALLOCATE( z_gsigt3(jpi,jpj,jpk))
+      ALLOCATE( z_gsi3w3(jpi,jpj,jpk))
+      ALLOCATE( z_esigt3(jpi,jpj,jpk))
+      ALLOCATE( z_esigw3(jpi,jpj,jpk))
+      ALLOCATE( z_esigtu3(jpi,jpj,jpk))
+      ALLOCATE( z_esigtv3(jpi,jpj,jpk))
+      ALLOCATE( z_esigtf3(jpi,jpj,jpk))
+      ALLOCATE( z_esigwu3(jpi,jpj,jpk))
+      ALLOCATE( z_esigwv3(jpi,jpj,jpk))
+
+      z_gsigw3(:,:,:) =0._dp
+      z_gsigt3(:,:,:) =0._dp  
+      z_gsi3w3(:,:,:) =0._dp  
+      z_esigt3(:,:,:) =0._dp  
+      z_esigw3(:,:,:) =0._dp  
+      z_esigtu3(:,:,:)=0._dp 
+      z_esigtv3(:,:,:)=0._dp
+      z_esigtf3(:,:,:)=0._dp
+      z_esigwu3(:,:,:)=0._dp
+      z_esigwv3(:,:,:)=0._dp
+
+      DO ji = 1, jpi
+         DO jj = 1, jpj
+
+          IF( tg_hbatt%d_value(ji,jj,1,1) > td_nam%d_hc )THEN !deep water, stretched sigma
+              
+             ! this forces a linear bottom cell depth relationship with H,.
+             ! could be changed by users but care must be taken to do so carefully
+              zzb = tg_hbatt%d_value(ji,jj,1,1)*td_nam%d_zb_a + td_nam%d_zb_b
+
+              zzb = 1.0_dp-(zzb/tg_hbatt%d_value(ji,jj,1,1))
+            
+              zzs = td_nam%d_zs / tg_hbatt%d_value(ji,jj,1,1) 
+              
+              IF( td_nam%d_efold /= 0.0_dp )THEN
+                zsmth = TANH( (tg_hbatt%d_value(ji,jj,1,1)-td_nam%d_hc ) / td_nam%d_efold )
+              ELSE
+                zsmth = 1.0_dp 
+              ENDIF
+               
+              DO jk = 1, jpk
+                z_gsigw3(ji,jj,jk) =  REAL(jk-1,dp)        /REAL(jpk-1,dp)
+                z_gsigt3(ji,jj,jk) = (REAL(jk-1,dp)+0.5_dp)/REAL(jpk-1,dp)
+              ENDDO
+              z_gsigw3(ji,jj,:) = grid_zgr__sco_fgamma( td_nam, jpk, z_gsigw3(ji,jj,:), zzb, zzs, zsmth  )
+              z_gsigt3(ji,jj,:) = grid_zgr__sco_fgamma( td_nam, jpk, z_gsigt3(ji,jj,:), zzb, zzs, zsmth  )
+ 
+          ELSE IF( td_nam%l_sigcrit )THEN ! shallow water, uniform sigma
+
+            DO jk = 1, jpk
+              z_gsigw3(ji,jj,jk) =  REAL(jk-1,dp)     /REAL(jpk-1,dp)
+              z_gsigt3(ji,jj,jk) = (REAL(jk-1,dp)+0.5)/REAL(jpk-1,dp)
+            END DO
+
+          ELSE  ! shallow water, z coordinates
+
+            DO jk = 1, jpk
+              z_gsigw3(ji,jj,jk) =  REAL(jk-1,dp)        /REAL(jpk-1,dp)*(td_nam%d_hc/tg_hbatt%d_value(ji,jj,1,1))
+              z_gsigt3(ji,jj,jk) = (REAL(jk-1,dp)+0.5_dp)/REAL(jpk-1,dp)*(td_nam%d_hc/tg_hbatt%d_value(ji,jj,1,1))
+            END DO
+
+          ENDIF
+
+          DO jk = 1, jpk-1
+             z_esigt3(ji,jj,jk  ) = z_gsigw3(ji,jj,jk+1) - z_gsigw3(ji,jj,jk)
+             z_esigw3(ji,jj,jk+1) = z_gsigt3(ji,jj,jk+1) - z_gsigt3(ji,jj,jk)
+          END DO
+          z_esigw3(ji,jj,1  ) = 2.0_dp * (z_gsigt3(ji,jj,1  ) - z_gsigw3(ji,jj,1  ))
+          z_esigt3(ji,jj,jpk) = 2.0_dp * (z_gsigt3(ji,jj,jpk) - z_gsigw3(ji,jj,jpk))
+
+          ! Coefficients for vertical depth as the sum of e3w scale factors
+          z_gsi3w3(ji,jj,1) = 0.5_dp * z_esigw3(ji,jj,1)
+          DO jk = 2, jpk
+             z_gsi3w3(ji,jj,jk) = z_gsi3w3(ji,jj,jk-1) + z_esigw3(ji,jj,jk)
+          END DO
+
+          DO jk = 1, jpk
+             tg_gdept_0%d_value(ji,jj,jk,1) = (dd_scosrf(ji,jj)+tg_hbatt%d_value(ji,jj,1,1))*z_gsigt3(ji,jj,jk)
+             tg_gdepw_0%d_value(ji,jj,jk,1) = (dd_scosrf(ji,jj)+tg_hbatt%d_value(ji,jj,1,1))*z_gsigw3(ji,jj,jk)
+             !tg_gdep3w_0%d_value(ji,jj,jk,1) = (dd_scosrf(ji,jj)+tg_hbatt%d_value(ji,jj,1,1))*z_gsi3w3(ji,jj,jk)
+          END DO
+
+        ENDDO   ! for all jj's
+      ENDDO    ! for all ji's
+
+      DO ji=1,jpi-1
+        DO jj=1,jpj-1
+
+           ! extend to suit for Wetting/Drying case
+           ztmpu  = tg_hbatt%d_value(ji  ,jj  ,1,1) + tg_hbatt%d_value(ji+1,jj  ,1,1)
+           ztmpv  = tg_hbatt%d_value(ji  ,jj  ,1,1) + tg_hbatt%d_value(ji  ,jj+1,1,1)
+           ztmpf  = tg_hbatt%d_value(ji  ,jj  ,1,1) + tg_hbatt%d_value(ji+1,jj  ,1,1) + &
+                  & tg_hbatt%d_value(ji  ,jj+1,1,1) + tg_hbatt%d_value(ji+1,jj+1,1,1)
+
+           ztmpu1 = tg_hbatt%d_value(ji  ,jj  ,1,1) * tg_hbatt%d_value(ji+1,jj  ,1,1)
+           ztmpv1 = tg_hbatt%d_value(ji  ,jj  ,1,1) * tg_hbatt%d_value(ji  ,jj+1,1,1)
+           ztmpf1 =    MIN(tg_hbatt%d_value(ji  ,jj  ,1,1), tg_hbatt%d_value(ji+1,jj  ,1,1), &
+                  &        tg_hbatt%d_value(ji  ,jj+1,1,1), tg_hbatt%d_value(ji+1,jj+1,1,1)) & 
+                  &  * MAX(tg_hbatt%d_value(ji  ,jj  ,1,1), tg_hbatt%d_value(ji+1,jj  ,1,1), &
+                  &        tg_hbatt%d_value(ji  ,jj+1,1,1), tg_hbatt%d_value(ji+1,jj+1,1,1))
+
+          DO jk = 1, jpk
+
+            IF( td_nam%l_wd .AND. &
+              & ( ztmpu1 < 0._dp .OR. ABS(ztmpu) < td_nam%d_wdmin1 ) )THEN
+               z_esigtu3(ji,jj,jk) = 0.5_dp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji+1,jj,jk) )
+               z_esigwu3(ji,jj,jk) = 0.5_dp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji+1,jj,jk) )
+            ELSE
+               z_esigtu3(ji,jj,jk) = ( tg_hbatt%d_value(ji  ,jj,1,1)*z_esigt3(ji  ,jj,jk) &
+                                   & + tg_hbatt%d_value(ji+1,jj,1,1)*z_esigt3(ji+1,jj,jk) ) / ztmpu
+               z_esigwu3(ji,jj,jk) = ( tg_hbatt%d_value(ji  ,jj,1,1)*z_esigw3(ji  ,jj,jk) &
+                                   & + tg_hbatt%d_value(ji+1,jj,1,1)*z_esigw3(ji+1,jj,jk) ) / ztmpu
+            ENDIF
+
+            IF( td_nam%l_wd .AND. &
+              & ( ztmpv1 < 0._dp .OR. ABS(ztmpv) < td_nam%d_wdmin1 ) )THEN
+               z_esigtv3(ji,jj,jk) = 0.5_dp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji,jj+1,jk) )
+               z_esigwv3(ji,jj,jk) = 0.5_dp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji,jj+1,jk) )
+            ELSE
+               z_esigtv3(ji,jj,jk) = ( tg_hbatt%d_value(ji,jj  ,1,1)*z_esigt3(ji,jj  ,jk) &
+                                   & + tg_hbatt%d_value(ji,jj+1,1,1)*z_esigt3(ji,jj+1,jk)) / ztmpv
+               z_esigwv3(ji,jj,jk) = ( tg_hbatt%d_value(ji,jj  ,1,1)*z_esigw3(ji,jj  ,jk) &
+                                   & + tg_hbatt%d_value(ji,jj+1,1,1)*z_esigw3(ji,jj+1,jk)) / ztmpv
+            ENDIF
+
+            IF( td_nam%l_wd .AND. &
+              & ( ztmpf1 < 0._dp .OR. ABS(ztmpf) < td_nam%d_wdmin1 ) )THEN
+               z_esigtf3(ji,jj,jk) = 0.25_dp * ( z_esigt3(ji  ,jj  ,jk) &
+                                   &           + z_esigt3(ji+1,jj  ,jk) &
+                                   &           + z_esigt3(ji  ,jj+1,jk) &
+                                   &           + z_esigt3(ji+1,jj+1,jk) )
+            ELSE
+               z_esigtf3(ji,jj,jk) = ( tg_hbatt%d_value(ji  ,jj  ,1,1)*z_esigt3(ji  ,jj  ,jk) &
+                                   & + tg_hbatt%d_value(ji+1,jj  ,1,1)*z_esigt3(ji+1,jj  ,jk) &
+                                   & + tg_hbatt%d_value(ji  ,jj+1,1,1)*z_esigt3(ji  ,jj+1,jk) &
+                                   & + tg_hbatt%d_value(ji+1,jj+1,1,1)*z_esigt3(ji+1,jj+1,jk) ) / ztmpf
+            ENDIF
+
+             tg_e3t_0%d_value(ji,jj,jk,1) = (dd_scosrf(ji,jj)+tg_hbatt%d_value(ji,jj,1,1))*z_esigt3 (ji,jj,jk)
+             tg_e3u_0%d_value(ji,jj,jk,1) = (dd_scosrf(ji,jj)+tg_hbatu%d_value(ji,jj,1,1))*z_esigtu3(ji,jj,jk)
+             tg_e3v_0%d_value(ji,jj,jk,1) = (dd_scosrf(ji,jj)+tg_hbatv%d_value(ji,jj,1,1))*z_esigtv3(ji,jj,jk)
+             tg_e3f_0%d_value(ji,jj,jk,1) = (dd_scosrf(ji,jj)+tg_hbatf%d_value(ji,jj,1,1))*z_esigtf3(ji,jj,jk)
+             !
+             tg_e3w_0%d_value(ji,jj,jk,1)  = tg_hbatt%d_value(ji,jj,1,1)*z_esigw3 (ji,jj,jk)
+             tg_e3uw_0%d_value(ji,jj,jk,1) = tg_hbatu%d_value(ji,jj,1,1)*z_esigwu3(ji,jj,jk)
+             tg_e3vw_0%d_value(ji,jj,jk,1) = tg_hbatv%d_value(ji,jj,1,1)*z_esigwv3(ji,jj,jk)
+          END DO
+
+        ENDDO
+      ENDDO
+
+      CALL lbc_lnk(tg_e3t_0 %d_value(:,:,:,1),'T', td_nam%i_perio, 1._dp) 
+      CALL lbc_lnk(tg_e3u_0 %d_value(:,:,:,1),'T', td_nam%i_perio, 1._dp)
+      CALL lbc_lnk(tg_e3v_0 %d_value(:,:,:,1),'T', td_nam%i_perio, 1._dp) 
+      CALL lbc_lnk(tg_e3f_0 %d_value(:,:,:,1),'T', td_nam%i_perio, 1._dp)
+      CALL lbc_lnk(tg_e3w_0 %d_value(:,:,:,1),'T', td_nam%i_perio, 1._dp)
+      CALL lbc_lnk(tg_e3uw_0%d_value(:,:,:,1),'T', td_nam%i_perio, 1._dp) 
+      CALL lbc_lnk(tg_e3vw_0%d_value(:,:,:,1),'T', td_nam%i_perio, 1._dp)
+
+      DEALLOCATE( z_gsigw3  )
+      DEALLOCATE( z_gsigt3  )
+      DEALLOCATE( z_gsi3w3  )
+      DEALLOCATE( z_esigt3  )
+      DEALLOCATE( z_esigw3  )
+      DEALLOCATE( z_esigtu3 )
+      DEALLOCATE( z_esigtv3 )
+      DEALLOCATE( z_esigtf3 )
+      DEALLOCATE( z_esigwu3 )
+      DEALLOCATE( z_esigwv3 )
+
+   END SUBROUTINE grid_zgr__sco_s_sf12
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_zgr__sco_s_tanh(td_nam, jpi, jpj, jpk, &
+         &                         dd_scosrf,             &
+         &                         dd_hift, dd_hifu, dd_hifv, dd_hiff) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine stretch the s-coordinate system
+   !>
+   !>
+   !> ** Method  :   s-coordinate stretch 
+   !>
+   !> Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408.   
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from domzgr
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !> @param[in] jpk
+   !> @param[in] dd_scosrf
+   !> @param[in] dd_hift 
+   !> @param[in] dd_hifu 
+   !> @param[in] dd_hifv 
+   ! @param[in] dd_hiff 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TNAMZ),                 INTENT(IN   ) :: td_nam
+      INTEGER(i4),                 INTENT(IN   ) :: jpi
+      INTEGER(i4),                 INTENT(IN   ) :: jpj
+      INTEGER(i4),                 INTENT(IN   ) :: jpk
+      REAL(dp)   , DIMENSION(:,:), INTENT(IN   ) :: dd_scosrf
+      REAL(dp)   , DIMENSION(:,:), INTENT(IN   ) :: dd_hift
+      REAL(dp)   , DIMENSION(:,:), INTENT(IN   ) :: dd_hifu
+      REAL(dp)   , DIMENSION(:,:), INTENT(IN   ) :: dd_hifv
+      REAL(dp)   , DIMENSION(:,:), INTENT(IN   ) :: dd_hiff
+
+      ! local variable
+      REAL(dp) :: zcoeft
+      REAL(dp) :: zcoefw
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      tg_gsigt%d_value(1,1,:,1) =0._dp  
+      tg_gsigw%d_value(1,1,:,1) =0._dp
+      tg_gsi3w%d_value(1,1,:,1) =0._dp  
+      tg_esigt%d_value(1,1,:,1) =0._dp  
+      tg_esigw%d_value(1,1,:,1) =0._dp
+
+      DO jk = 1, jpk
+        tg_gsigw%d_value(1,1,jk,1) = -grid_zgr__sco_fssig( td_nam, jpk, REAL(jk,dp)-0.5_dp )
+        tg_gsigt%d_value(1,1,jk,1) = -grid_zgr__sco_fssig( td_nam, jpk, REAL(jk,dp)        )
+      END DO
+      CALL logger_info('z_gsigw 1 jpk '//TRIM(fct_str(tg_gsigw%d_value(1,1,1,1)))//&
+         &             TRIM(fct_str(tg_gsigw%d_value(1,1,jpk,1))) )
+
+      ! Coefficients for vertical scale factors at w-, t- levels
+!!gm bug :  define it from analytical function, not like juste bellow....
+!!gm        or betteroffer the 2 possibilities....
+      DO jk = 1, jpk-1
+         tg_esigt%d_value(1,1,jk  ,1) = tg_gsigw%d_value(1,1,jk+1,1) - tg_gsigw%d_value(1,1,jk,1)
+         tg_esigw%d_value(1,1,jk+1,1) = tg_gsigt%d_value(1,1,jk+1,1) - tg_gsigt%d_value(1,1,jk,1)
+      END DO
+      tg_esigw%d_value(1,1, 1 ,1) = 2._dp * ( tg_gsigt%d_value(1,1,1  ,1) - tg_gsigw%d_value(1,1,1  ,1) ) 
+      tg_esigt%d_value(1,1,jpk,1) = 2._dp * ( tg_gsigt%d_value(1,1,jpk,1) - tg_gsigw%d_value(1,1,jpk,1) )
+
+      ! Coefficients for vertical depth as the sum of e3w scale factors
+      tg_gsi3w%d_value(1,1,1,1) = 0.5_dp * tg_esigw%d_value(1,1,1,1)
+      DO jk = 2, jpk
+         tg_gsi3w%d_value(1,1,jk,1) = tg_gsi3w%d_value(1,1,jk-1,1) + tg_esigw%d_value(1,1,jk,1)
+      END DO
+!!gm: depuw, depvw can be suppressed (modif in ldfslp) and depw=dep3w can be set (save 3 3D arrays)
+      DO jk = 1, jpk
+         zcoeft = ( REAL(jk,dp) - 0.5_dp ) / REAL(jpk-1,dp)
+         zcoefw = ( REAL(jk,dp) - 1.0_dp ) / REAL(jpk-1,dp)
+         tg_gdept_0%d_value (:,:,jk,1) = dd_scosrf(:,:) + ( tg_hbatt%d_value(:,:,1 ,1) - dd_hift(:,:) ) &
+            &                                             * tg_gsigt%d_value(1,1,jk,1) + dd_hift(:,:)*zcoeft
+         tg_gdepw_0%d_value (:,:,jk,1) = dd_scosrf(:,:) + ( tg_hbatt%d_value(:,:,1 ,1) - dd_hift(:,:) ) &
+            &                                             * tg_gsigw%d_value(1,1,jk,1) + dd_hift(:,:)*zcoefw
+         !tg_gdep3w_0%d_value(:,:,jk,1) = dd_scosrf(:,:) + ( tg_hbatt%d_value(:,:,1 ,1) - dd_hift(:,:)) &
+         !                                                 * tg_gsi3w%d_value(1,1,jk,1) + dd_hift(:,:)*zcoeft
+      END DO
+!!gm: e3uw, e3vw can be suppressed  (modif in dynzdf, dynzdf_iso, zdfbfr) (save 2 3D arrays)
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpk
+              tg_e3t_0%d_value(ji,jj,jk,1) = ( (tg_hbatt%d_value(ji,jj,1 ,1) - dd_hift(ji,jj)) &
+                 &                            * tg_esigt%d_value(1 ,1 ,jk,1) + dd_hift(ji,jj)/REAL(jpk-1,dp) )
+              tg_e3u_0%d_value(ji,jj,jk,1) = ( (tg_hbatu%d_value(ji,jj,1 ,1) - dd_hifu(ji,jj)) &
+                 &                            * tg_esigt%d_value(1 ,1 ,jk,1) + dd_hifu(ji,jj)/REAL(jpk-1,dp) )
+              tg_e3v_0%d_value(ji,jj,jk,1) = ( (tg_hbatv%d_value(ji,jj,1 ,1) - dd_hifv(ji,jj)) &
+                 &                            * tg_esigt%d_value(1 ,1 ,jk,1) + dd_hifv(ji,jj)/REAL(jpk-1,dp) )
+              tg_e3f_0%d_value(ji,jj,jk,1) = ( (tg_hbatf%d_value(ji,jj,1 ,1) - dd_hiff(ji,jj)) &
+                 &                            * tg_esigt%d_value(1 ,1, jk,1) + dd_hiff(ji,jj)/REAL(jpk-1,dp) )
+               
+              tg_e3w_0%d_value (ji,jj,jk,1)= ( (tg_hbatt%d_value(ji,jj,1 ,1) - dd_hift(ji,jj)) &
+                 &                            * tg_esigw%d_value(1 ,1 ,jk,1) + dd_hift(ji,jj)/REAL(jpk-1,dp) )
+              tg_e3uw_0%d_value(ji,jj,jk,1)= ( (tg_hbatu%d_value(ji,jj,1 ,1) - dd_hifu(ji,jj)) &
+                 &                            * tg_esigw%d_value(1 ,1 ,jk,1) + dd_hifu(ji,jj)/REAL(jpk-1,dp) )
+              tg_e3vw_0%d_value(ji,jj,jk,1)= ( (tg_hbatv%d_value(ji,jj,1 ,1) - dd_hifv(ji,jj)) &
+                 &                            * tg_esigw%d_value(1 ,1 ,jk,1) + dd_hifv(ji,jj)/REAL(jpk-1,dp) )
+            END DO
+         END DO
+      END DO
+
+   END SUBROUTINE grid_zgr__sco_s_tanh
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid_zgr__sco_fssig(td_nam, jpk, pk) &
+         &  RESULT( pf )
+   !!----------------------------------------------------------------------
+   !> @brief This function provide the analytical function in s-coordinate
+   !>        
+   !> @details
+   !> ** Method  :   the function provide the non-dimensional position of
+   !>                T and W (i.e. between 0 and 1)
+   !>                T-points at integer values (between 1 and jpk)
+   !>                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from domzgr
+   !>
+   !> @param[in] td_nam 
+   !> @param[in] jpk
+   !> @param[in] pk
+   !!----------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+      INTEGER(i4), INTENT(IN   ) :: jpk
+      REAL(dp)   , INTENT(IN   ) :: pk   ! continuous "k" coordinate
+      REAL(dp)                   :: pf   ! sigma value
+      !!----------------------------------------------------------------------
+      !
+      pf =   (   TANH( td_nam%d_theta * ( -(pk-0.5_dp) / REAL(jpk-1,dp) + td_nam%d_thetb )  ) &
+         &     - TANH( td_nam%d_thetb * td_nam%d_theta                                   )  ) &
+         & * (   COSH( td_nam%d_theta                                      )                  &
+         &     + COSH( td_nam%d_theta * ( 2._dp * td_nam%d_thetb - 1._dp ) )  )               &
+         & / ( 2._dp * SINH( td_nam%d_theta ) )
+      !
+   END FUNCTION grid_zgr__sco_fssig
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid_zgr__sco_fssig1(td_nam, jpk, pk1, pbb) &
+         & RESULT( pf1 )
+   !!----------------------------------------------------------------------
+   !> @brief This function provide the Song and Haidvogel version of the analytical function in s-coordinate
+   !>
+   !> @details
+   !> ** Method  :   the function provides the non-dimensional position of
+   !>                T and W (i.e. between 0 and 1)
+   !>                T-points at integer values (between 1 and jpk)
+   !>                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from domzgr
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !> @param[in] pk1 
+   !> @param[in] pbb
+   !!----------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+      INTEGER(i4), INTENT(IN   ) :: jpk
+      REAL(dp)   , INTENT(IN   ) :: pk1   ! continuous "k" coordinate
+      REAL(dp)   , INTENT(IN   ) :: pbb   ! Stretching coefficient
+      REAL(dp)                   :: pf1   ! sigma value
+      !!----------------------------------------------------------------------
+      !
+      IF ( td_nam%d_theta == 0 ) then      ! uniform sigma
+         pf1 = - ( pk1 - 0.5_dp ) / REAL(jpk-1,dp)
+      ELSE                        ! stretched sigma
+         pf1 =   ( 1._dp - pbb ) * ( SINH( td_nam%d_theta*(-(pk1-0.5_dp)/REAL(jpk-1,dp)) ) ) / SINH( td_nam%d_theta )              &
+            &  + pbb * (  (TANH( td_nam%d_theta*( (-(pk1-0.5_dp)/REAL(jpk-1,dp)) + 0.5_dp) ) - TANH( 0.5_dp * td_nam%d_theta )  )  &
+            &        / ( 2._dp * TANH( 0.5_dp * td_nam%d_theta ) )  )
+      ENDIF
+      !
+   END FUNCTION grid_zgr__sco_fssig1
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION grid_zgr__sco_fgamma(td_nam, jpk, pk1, pzb, pzs, psmth) &
+         & RESULT( p_gamma )
+   !!----------------------------------------------------------------------
+   !> @brief This function provide analytical function for the s-coordinate
+   !>
+   !> @details
+   !> ** Method  :   the function provides the non-dimensional position of
+   !>                T and W (i.e. between 0 and 1)
+   !>                T-points at integer values (between 1 and jpk)
+   !>                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
+   !>
+   !>                This method allows the maintenance of fixed surface and or
+   !>                bottom cell resolutions (cf. geopotential coordinates) 
+   !>                within an analytically derived stretched S-coordinate framework.
+   !>
+   !> Reference  :   Siddorn and Furner, in prep
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from domzgr 
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpk
+   !> @param[in] pk1 
+   !> @param[in] pzb
+   !> @param[in] pzs
+   !> @param[in] pzsmth
+   !!----------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+      INTEGER(i4), INTENT(IN   ) :: jpk
+      REAL(dp)   , DIMENSION(:) , INTENT(IN   ) :: pk1       ! continuous "k" coordinate
+
+      ! function
+      REAL(dp)   , DIMENSION(jpk) :: p_gamma   ! stretched coordinate
+
+      ! local variable
+      REAL(dp)   , INTENT(IN   ) :: pzb           ! Bottom box depth
+      REAL(dp)   , INTENT(IN   ) :: pzs           ! surface box depth
+      REAL(dp)   , INTENT(IN   ) :: psmth       ! Smoothing parameter
+      REAL(dp)                   :: za1,za2,za3    ! local variables
+      REAL(dp)                   :: zn1,zn2        ! local variables
+      REAL(dp)                   :: za,zb,zx       ! local variables
+
+      ! loop indices
+      INTEGER(i4)             ::   jk
+      !!----------------------------------------------------------------------
+      !
+      zn1  =  1._dp / REAL(jpk-1,dp)
+      zn2  =  1._dp -  zn1
+
+      za1 = (td_nam%d_alpha+2.0_dp)*zn1**(td_nam%d_alpha+1.0_dp)-(td_nam%d_alpha+1.0_dp)*zn1**(td_nam%d_alpha+2.0_dp) 
+      za2 = (td_nam%d_alpha+2.0_dp)*zn2**(td_nam%d_alpha+1.0_dp)-(td_nam%d_alpha+1.0_dp)*zn2**(td_nam%d_alpha+2.0_dp)
+      za3 = (zn2**3.0_dp - za2)/( zn1**3.0_dp - za1)
+     
+      za = pzb - za3*(pzs-za1)-za2
+      za = za/( zn2-0.5_dp*(za2+zn2**2.0_dp) - za3*(zn1-0.5_dp*(za1+zn1**2.0_dp) ) )
+      zb = (pzs - za1 - za*( zn1-0.5_dp*(za1+zn1**2.0_dp ) ) ) / (zn1**3.0_dp - za1)
+      zx = 1.0_dp-za/2.0_dp-zb
+ 
+      DO jk = 1, jpk
+        p_gamma(jk) = za*(pk1(jk)*(1.0_dp-pk1(jk)/2.0_dp))+zb*pk1(jk)**3.0_dp +  &
+                    & zx*( (td_nam%d_alpha+2.0_dp)*pk1(jk)**(td_nam%d_alpha+1.0_dp)- &
+                    &      (td_nam%d_alpha+1.0_dp)*pk1(jk)**(td_nam%d_alpha+2.0_dp) )
+        p_gamma(jk) = p_gamma(jk)*psmth+pk1(jk)*(1.0_dp-psmth)
+      ENDDO 
+
+      !
+   END FUNCTION grid_zgr__sco_fgamma
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE grid_zgr_sco_stiff(td_nam, jpi, jpj, jpk)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine stretch the s-coordinate system
+   !>
+   !>
+   !> ** Method  :   s-coordinate stretch 
+   !>
+   !> Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408.   
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - rewrite from domain (dom_stiff) 
+   !>
+   !> @param[in] td_nam
+   !> @param[in] jpi
+   !> @param[in] jpj
+   !> @param[in] jpk
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TNAMZ), INTENT(IN   ) :: td_nam
+      INTEGER(i4), INTENT(IN   ) :: jpi
+      INTEGER(i4), INTENT(IN   ) :: jpj
+      INTEGER(i4), INTENT(IN   ) :: jpk
+
+      ! local variable
+      REAL(dp) ::   zrxmax
+      REAL(dp), DIMENSION(4) :: zr1
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+      tg_rx1%d_value(:,:,1,1) = 0._dp
+
+      zrxmax   = 0._dp
+      zr1(:)   = 0._dp
+
+      DO ji = 2, jpi-1
+         DO jj = 2, jpj-1
+            DO jk = 1, jpk-1
+               zr1(1) = tg_umask%d_value(ji-1,jj  ,jk,1) &
+                  &            * ABS( ( tg_gdepw_0%d_value(ji  ,jj  ,jk  ,1) &
+                  &                   - tg_gdepw_0%d_value(ji-1,jj  ,jk  ,1) & 
+                  &                   + tg_gdepw_0%d_value(ji  ,jj  ,jk+1,1) &
+                  &                   - tg_gdepw_0%d_value(ji-1,jj  ,jk+1,1) ) &
+                  &                 / ( tg_gdepw_0%d_value(ji  ,jj  ,jk  ,1) &
+                  &                   + tg_gdepw_0%d_value(ji-1,jj  ,jk  ,1) &
+                  &                   - tg_gdepw_0%d_value(ji  ,jj  ,jk+1,1) &
+                  &                   - tg_gdepw_0%d_value(ji-1,jj  ,jk+1,1) &
+                  &                   + dp_eps) )
+               zr1(2) = tg_umask%d_value(ji  ,jj  ,jk,1) &
+                  &            * ABS( ( tg_gdepw_0%d_value(ji+1,jj  ,jk  ,1) &
+                  &                   - tg_gdepw_0%d_value(ji  ,jj  ,jk  ,1) &
+                  &                   + tg_gdepw_0%d_value(ji+1,jj  ,jk+1,1) &
+                  &                   - tg_gdepw_0%d_value(ji  ,jj  ,jk+1,1) ) &
+                  &                 / ( tg_gdepw_0%d_value(ji+1,jj  ,jk  ,1)&
+                  &                   + tg_gdepw_0%d_value(ji  ,jj  ,jk  ,1)&
+                  &                   - tg_gdepw_0%d_value(ji+1,jj  ,jk+1,1)&
+                  &                   - tg_gdepw_0%d_value(ji  ,jj  ,jk+1,1)&
+                  &                   + dp_eps) )
+               zr1(3) = tg_vmask%d_value(ji  ,jj  ,jk,1) &
+                  &              * ABS( ( tg_gdepw_0%d_value(ji  ,jj+1,jk  ,1)&
+                  &                     - tg_gdepw_0%d_value(ji  ,jj  ,jk  ,1)&
+                  &                     + tg_gdepw_0%d_value(ji  ,jj+1,jk+1,1)&
+                  &                     - tg_gdepw_0%d_value(ji  ,jj  ,jk+1,1) ) &
+                  &                   / ( tg_gdepw_0%d_value(ji  ,jj+1,jk  ,1)&
+                  &                     + tg_gdepw_0%d_value(ji  ,jj  ,jk  ,1)&
+                  &                     - tg_gdepw_0%d_value(ji  ,jj+1,jk+1,1)&
+                  &                     - tg_gdepw_0%d_value(ji  ,jj  ,jk+1,1)&
+                  &                     + dp_eps) )
+               zr1(4) = tg_vmask%d_value(ji  ,jj-1,jk,1) &
+                  &              * ABS( ( tg_gdepw_0%d_value(ji  ,jj  ,jk  ,1)&
+                  &                     - tg_gdepw_0%d_value(ji  ,jj-1,jk  ,1)&
+                  &                     + tg_gdepw_0%d_value(ji  ,jj  ,jk+1,1)&
+                  &                     - tg_gdepw_0%d_value(ji  ,jj-1,jk+1,1) ) &
+                  &                   / ( tg_gdepw_0%d_value(ji  ,jj  ,jk  ,1)&
+                  &                     + tg_gdepw_0%d_value(ji  ,jj-1,jk  ,1)&
+                  &                     - tg_gdepw_0%d_value(ji  ,jj  ,jk+1,1)&
+                  &                     - tg_gdepw_0%d_value(ji  ,jj-1,jk+1,1)&
+                  &                     + dp_eps) )
+               zrxmax = MAXVAL(zr1(1:4))
+               tg_rx1%d_value(ji,jj,1,1) = MAX(tg_rx1%d_value(ji,jj,1,1), zrxmax)
+            END DO
+         END DO
+      END DO
+
+      CALL lbc_lnk( tg_rx1%d_value(:,:,1,1), 'T', td_nam%i_perio, 1._dp )
+
+      zrxmax = MAXVAL(tg_rx1%d_value(:,:,1,1))
+      CALL logger_info(' GRID ZGR SCO STIFF: maximum grid stiffness ratio: '//&
+         &  TRIM(fct_str(zrxmax)) )
+
+   END SUBROUTINE grid_zgr_sco_stiff
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE grid_zgr
Index: /utils/tools_ticket2413/SIREN/src/interp.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/interp.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/interp.f90	(revision 12863)
@@ -0,0 +1,985 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief 
+!> This module manage interpolation on regular grid.
+!>
+!> @details Interpolation method to be used is specify inside variable 
+!>    strcuture, as array of string character.<br/> 
+!>    - td_var\%c_interp(1) string character is the interpolation name choose between:
+!>       - 'nearest'
+!>       - 'cubic  '
+!>       - 'linear '
+!>    - td_var\%c_interp(2) string character is an operation to be used 
+!>    on interpolated value.<br/>
+!>          operation have to be mulitplication '*' or division '/'.<br/>
+!>          coefficient have to be refinement factor following i-direction 'rhoi', 
+!>          j-direction 'rhoj', or k-direction 'rhok'.<br/>
+!>
+!>          Examples: '*rhoi', '/rhoj'.
+!> 
+!>    @note Those informations are read from namelist or variable configuration file (default).<br/>
+!>    Interplation method could be specify for each variable in namelist _namvar_,
+!>    defining string character _cn\_varinfo_.<br/>
+!>    Example:
+!>       - cn_varinfo='varname1:int=cubic/rhoi', 'varname2:int=linear' 
+!>
+!>    to create mixed grid (with coarse grid point needed to compute
+!> interpolation):<br/>
+!> @code
+!>    CALL interp_create_mixed_grid( td_var, td_mix [,id_rho] )
+!> @endcode
+!>       - td_var is coarse grid variable (should be extrapolated)
+!>       - td_mix is mixed grid variable structure [output]
+!>       - id_rho is array of refinment factor [optional]
+!>
+!>    to detected point to be interpolated:<br/>
+!> @code
+!>    il_detect(:,:,:)=interp_detect( td_mix [,id_rho] )
+!> @endcode
+!>       - il_detect(:,:,:) is 3D array of detected point to be interpolated
+!>       - td_mix is mixed grid variable
+!>       - id_rho is array of refinement factor [optional]
+!>
+!>    to interpolate variable value:<br/>
+!> @code
+!>    CALL  interp_fill_value( td_var [,id_rho] [,id_offset] )
+!> @endcode
+!>       - td_var is variable structure
+!>       - id_rho is array of refinement factor [optional]
+!>       - id_offset is array of offset between fine and coarse grid [optional]
+!>
+!>    to clean mixed grid (remove points added on mixed grid to compute interpolation):<br/>
+!> @code
+!>    CALL interp_clean_mixed_grid( td_mix, td_var, id_rho )
+!> @endcode
+!>       - td_mix is mixed grid variable structure
+!>       - td_var is variable structure [output]
+!>       - id_rho is array of refinement factor [optional]
+!>       - id_offset is array of offset between fine and coarse grid [optional]
+!>
+!> @note It use to work on ORCA grid, as we work only with grid indices.
+!>
+!> @warning due to the use of second derivative when using cubic interpolation
+!> you should add at least 2 extrabands.
+!>
+!> @author
+!> J.Paul
+!> 
+!> @date November, 2013 - Initial Version
+!> @date September, 2014
+!> - add header
+!> - use interpolation method modules
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE interp
+
+   USE netcdf                          ! nf90 library
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+   USE date                            ! date manager
+   USE att                             ! attribute manager
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+   USE grid                            ! grid manager
+   USE extrap                          ! extrapolation manager
+   USE interp_cubic                    !   cubic interpolation manager
+   USE interp_linear                   !  linear interpolation manager
+   USE interp_nearest                  ! nearest interpolation manager
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+
+   ! function and subroutine
+   PUBLIC :: interp_detect             !< detected point to be interpolated
+   PUBLIC :: interp_fill_value         !< interpolate value
+   PUBLIC :: interp_create_mixed_grid  !< create mixed grid
+   PUBLIC :: interp_clean_mixed_grid   !< clean mixed grid
+
+   PRIVATE :: interp__detect              ! detected point to be interpolated
+   PRIVATE :: interp__detect_wrapper      ! detected point to be interpolated
+   PRIVATE :: interp__fill_value_wrapper  ! interpolate value over detectected point
+   PRIVATE :: interp__fill_value          ! interpolate value over detectected point
+   PRIVATE :: interp__clean_even_grid     ! clean even mixed grid
+   PRIVATE :: interp__check_method        ! check if interpolation method available
+   
+   TYPE TINTERP
+      CHARACTER(LEN=lc) :: c_name   = '' !< interpolation method name
+      CHARACTER(LEN=lc) :: c_factor = '' !< interpolation factor
+      CHARACTER(LEN=lc) :: c_divisor= '' !< interpolation divisor
+   END TYPE TINTERP
+
+   INTERFACE interp_detect
+      MODULE PROCEDURE interp__detect_wrapper 
+   END INTERFACE interp_detect
+
+   INTERFACE interp_fill_value
+      MODULE PROCEDURE interp__fill_value_wrapper 
+   END INTERFACE interp_fill_value
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION interp__check_method(cd_method) &
+         & RESULT (lf_avail)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function check if interpolation method is available.
+   !> 
+   !> @details 
+   !> check if name of interpolation method is present in global list of string
+   !> character cp_interp_list (see global.f90).
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] cd_method interpolation method
+   !> @return true if interpolation method is available
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=lc) :: cd_method
+
+      ! function
+      LOGICAL           :: lf_avail
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_interp
+      CHARACTER(LEN=lc) :: cl_method
+
+      ! loop indices
+      INTEGER(I4) :: ji
+      !----------------------------------------------------------------
+
+      cl_method=fct_lower(cd_method)
+
+      lf_avail=.FALSE.
+      DO ji=1,ip_ninterp
+         cl_interp=fct_lower(cp_interp_list(ji))
+         IF( TRIM(cl_interp) == TRIM(cl_method) )THEN
+            lf_avail=.TRUE.
+            EXIT
+         ENDIF
+      ENDDO
+
+   END FUNCTION interp__check_method
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION interp__detect_wrapper(td_mix, id_rho) &
+         & RESULT (if_detect)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function detected point to be interpolated.
+   !> 
+   !> @details 
+   !> Actually it checks, the number of dimension used for this variable
+   !> and launch interp__detect which detected point to be interpolated.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_mix mixed grid variable (to interpolate)
+   !> @param[in] id_rho array of refinement factor
+   !> @return 3D array of detected point to be interpolated 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) , INTENT(IN) :: td_mix
+      INTEGER(I4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho
+
+      ! function
+      INTEGER(i4), DIMENSION(td_mix%t_dim(1)%i_len,&
+         &                   td_mix%t_dim(2)%i_len,&
+         &                   td_mix%t_dim(3)%i_len )  :: if_detect
+
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( .NOT. ANY(td_mix%t_dim(1:3)%l_use) )THEN
+         ! no dimension I-J-K used
+         CALL logger_debug(" INTERP DETECT: nothing done for variable"//&
+            &              TRIM(td_mix%c_name) )
+         
+         if_detect(:,:,:)=0
+
+      ELSE IF( ALL(td_mix%t_dim(1:3)%l_use) )THEN
+         
+         ! detect point to be interpolated on I-J-K
+         CALL logger_debug(" INTERP DETECT: detect point "//&
+            &              TRIM(td_mix%c_point)//" for variable "//&
+            &              TRIM(td_mix%c_name) )
+         
+         if_detect(:,:,:)=interp__detect( td_mix, id_rho(:) )
+
+      ELSE IF( ALL(td_mix%t_dim(1:2)%l_use) )THEN
+
+         ! detect point to be interpolated on I-J
+         CALL logger_debug(" INTERP DETECT: detect point "//&
+            &              TRIM(td_mix%c_point)//" for variable "//&
+            &              TRIM(td_mix%c_name) )
+         
+         if_detect(:,:,1:1)=interp__detect( td_mix, id_rho(:))
+
+      ELSE IF( td_mix%t_dim(3)%l_use )THEN
+         
+         ! detect point to be interpolated on K
+         CALL logger_debug(" INTERP DETECT: detect vertical point "//&
+            &              " for variable "//TRIM(td_mix%c_name) )
+         
+         if_detect(1:1,1:1,:)=interp__detect( td_mix, id_rho(:) )
+
+      ENDIF              
+
+   END FUNCTION interp__detect_wrapper
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION interp__detect(td_mix, id_rho) &
+         & RESULT (if_detect)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function detected point to be interpolated.
+   !> 
+   !> @details 
+   !> A special case is done for even refinement on ARAKAWA-C grid.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[in] td_mix mixed grid variable (to interpolate)
+   !> @param[in] id_rho array of refinement factor
+   !> @return 3D array of detected point to be interpolated 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) , INTENT(IN) :: td_mix
+      INTEGER(I4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_rho
+
+      ! function
+      INTEGER(i4), DIMENSION(td_mix%t_dim(1)%i_len,&
+         &                   td_mix%t_dim(2)%i_len,&
+         &                   td_mix%t_dim(3)%i_len )  :: if_detect
+
+      ! local variable
+      INTEGER(I4), DIMENSION(:), ALLOCATABLE :: il_rho
+
+      INTEGER(I4) :: il_xextra
+      INTEGER(I4) :: il_yextra
+      INTEGER(I4) :: il_zextra
+
+      INTEGER(i4), DIMENSION(3) :: il_dim
+
+      LOGICAL    , DIMENSION(3) :: ll_even
+
+      ! loop indices
+      INTEGER(I4) :: ji
+      INTEGER(I4) :: jj
+      INTEGER(I4) :: jk
+      !----------------------------------------------------------------
+      ALLOCATE( il_rho(ip_maxdim) )
+      il_rho(:)=1
+      IF( PRESENT(id_rho) ) il_rho(1:SIZE(id_rho(:)))=id_rho(:)
+
+      ! special case for even refinement on ARAKAWA-C grid
+      ll_even(:)=.FALSE.
+      IF( MOD(il_rho(jp_I),2) == 0 ) ll_even(1)=.TRUE.
+      IF( MOD(il_rho(jp_J),2) == 0 ) ll_even(2)=.TRUE.
+      IF( MOD(il_rho(jp_K),2) == 0 ) ll_even(3)=.TRUE.         
+
+      SELECT CASE(TRIM(td_mix%c_point))
+         CASE('U')
+            ll_even(1)=.FALSE.
+         CASE('V')
+            ll_even(2)=.FALSE.
+         CASE('F')
+            ll_even(:)=.FALSE.
+      END SELECT
+
+      IF( ll_even(1) ) il_rho(jp_I)=il_rho(jp_I)+1
+      IF( ll_even(2) ) il_rho(jp_J)=il_rho(jp_J)+1
+      IF( ll_even(3) ) il_rho(jp_K)=il_rho(jp_K)+1
+
+      ! special case for cubic interpolation
+      il_xextra=0
+      il_yextra=0
+      il_zextra=0
+      SELECT CASE(TRIM(td_mix%c_interp(1)))
+      CASE('cubic')
+         ! those points can not be compute cause cubic interpolation
+         ! need second derivative.
+         IF( il_rho(jp_I) /= 1 ) il_xextra=3*il_rho(jp_I)
+         IF( il_rho(jp_J) /= 1 ) il_yextra=3*il_rho(jp_J)
+         IF( il_rho(jp_K) /= 1 ) il_zextra=3*il_rho(jp_K)
+      END SELECT
+
+      il_dim(:)=td_mix%t_dim(1:3)%i_len
+
+      ! init
+      if_detect(:,:,:)=1
+
+      ! do not compute coarse grid point
+      if_detect(1:td_mix%t_dim(1)%i_len:il_rho(jp_I), &
+         &      1:td_mix%t_dim(2)%i_len:il_rho(jp_J), &
+         &      1:td_mix%t_dim(3)%i_len:il_rho(jp_K)  ) = 0
+
+      ! do not compute point near fill value
+      DO jk=1,il_dim(3),il_rho(jp_K)
+         DO jj=1,il_dim(2),il_rho(jp_J)
+            DO ji=1,il_dim(1),il_rho(jp_I)
+
+               IF( td_mix%d_value(ji,jj,jk,1) == td_mix%d_fill )THEN
+
+                  ! i-direction
+                  if_detect(MAX(1,ji-il_xextra):MIN(ji+il_xextra,il_dim(1)),&
+                     &      MAX(1,jj-(il_rho(jp_J)-1)):MIN(jj+(il_rho(jp_J)-1),il_dim(2)),&
+                     &      MAX(1,jk-(il_rho(jp_K)-1)):MIN(jk+(il_rho(jp_K)-1),il_dim(3)) )=0 
+                  ! j-direction
+                  if_detect(MAX(1,ji-(il_rho(jp_I)-1)):MIN(ji+(il_rho(jp_I)-1),il_dim(1)),&
+                     &      MAX(1,jj-il_yextra):MIN(jj+il_yextra,il_dim(2)),&
+                     &      MAX(1,jk-(il_rho(jp_K)-1)):MIN(jk+(il_rho(jp_K)-1),il_dim(3)) )=0
+                  ! k-direction
+                  if_detect(MAX(1,ji-(il_rho(jp_I)-1)):MIN(ji+(il_rho(jp_I)-1),il_dim(1)),&
+                     &      MAX(1,jj-(il_rho(jp_J)-1)):MIN(jj+(il_rho(jp_J)-1),il_dim(2)),&
+                     &      MAX(1,jk-il_zextra):MIN(jk+il_zextra,il_dim(3)) )=0         
+
+               ENDIF
+
+            ENDDO
+         ENDDO
+      ENDDO
+
+      DEALLOCATE( il_rho )
+
+   END FUNCTION interp__detect
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE interp_create_mixed_grid(td_var, td_mix, id_rho)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine create mixed grid.
+   !> 
+   !> @details 
+   !> Created grid is fine resolution grid.
+   !> First and last point are coasre grid point. 
+   !>
+   !> A special case is done for even refinement on ARAKAWA-C grid.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_var    coarse grid variable (should be extrapolated)
+   !> @param[out] td_mix   mixed grid variable
+   !> @param[in] id_rho    array of refinment factor (default 1) 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) ,               INTENT(IN   ) :: td_var 
+      TYPE(TVAR) ,               INTENT(  OUT) :: td_mix 
+      INTEGER(I4), DIMENSION(:), INTENT(IN   ), OPTIONAL :: id_rho
+
+      ! local variable
+      INTEGER(I4), DIMENSION(:), ALLOCATABLE :: il_rho
+
+      INTEGER(i4) :: il_xextra
+      INTEGER(i4) :: il_yextra
+      INTEGER(i4) :: il_zextra
+
+      LOGICAL, DIMENSION(3) :: ll_even
+
+      ! loop indices
+      !----------------------------------------------------------------
+      ALLOCATE(il_rho(ip_maxdim))
+      il_rho(:)=1
+      IF( PRESENT(id_rho) ) il_rho(1:SIZE(id_rho(:)))=id_rho(:)
+
+      ! special case for even refinement on ARAKAWA-C grid
+      ll_even(:)=.FALSE.
+      IF( MOD(il_rho(jp_I),2) == 0 ) ll_even(1)=.TRUE.
+      IF( MOD(il_rho(jp_J),2) == 0 ) ll_even(2)=.TRUE.
+      IF( MOD(il_rho(jp_K),2) == 0 ) ll_even(3)=.TRUE.         
+
+      SELECT CASE(TRIM(td_var%c_point))
+         CASE('U')
+            ll_even(1)=.FALSE.
+         CASE('V')
+            ll_even(2)=.FALSE.
+         CASE('F')
+            ll_even(:)=.FALSE.
+      END SELECT
+
+      IF( ll_even(1) ) il_rho(jp_I)=il_rho(jp_I)+1
+      IF( ll_even(2) ) il_rho(jp_J)=il_rho(jp_J)+1
+      IF( ll_even(3) ) il_rho(jp_K)=il_rho(jp_K)+1
+
+      ! copy variable
+      td_mix=var_copy(td_var)
+
+      ! compute new dimension length
+      il_xextra=il_rho(jp_I)-1
+      td_mix%t_dim(1)%i_len=td_mix%t_dim(1)%i_len*il_rho(jp_I)-il_xextra
+
+      il_yextra=il_rho(jp_J)-1
+      td_mix%t_dim(2)%i_len=td_mix%t_dim(2)%i_len*il_rho(jp_J)-il_yextra
+
+      il_zextra=il_rho(jp_K)-1
+      td_mix%t_dim(3)%i_len=td_mix%t_dim(3)%i_len*il_rho(jp_K)-il_zextra
+
+      IF( ASSOCIATED(td_mix%d_value) ) DEALLOCATE( td_mix%d_value )
+      ALLOCATE( td_mix%d_value( td_mix%t_dim(1)%i_len, &
+      &                         td_mix%t_dim(2)%i_len, &
+      &                         td_mix%t_dim(3)%i_len, &
+      &                         td_mix%t_dim(4)%i_len) )
+
+      ! initialise to FillValue
+      td_mix%d_value(:,:,:,:)=td_mix%d_fill
+
+      ! quid qd coord ou bathy fourni par user ?? (offset ??)
+      td_mix%d_value(1:td_mix%t_dim(1)%i_len:il_rho(jp_I), &
+      &              1:td_mix%t_dim(2)%i_len:il_rho(jp_J), &
+      &              1:td_mix%t_dim(3)%i_len:il_rho(jp_K), :) = &
+      &     td_var%d_value(:,:,:,:)
+
+      DEALLOCATE(il_rho)
+
+   END SUBROUTINE interp_create_mixed_grid
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE interp__clean_even_grid(td_mix, id_rho)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine remove points added to mixed grid to compute
+   !> interpolation in the special case of even refinement on ARAKAWA-C grid.
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_mix mixed grid variable
+   !> @param[in] id_rho    array of refinment factor 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) ,               INTENT(INOUT) :: td_mix 
+      INTEGER(I4), DIMENSION(:), INTENT(IN   ), OPTIONAL :: id_rho
+
+      ! local variable
+      INTEGER(I4), DIMENSION(:), ALLOCATABLE :: il_rho
+
+      INTEGER(i4) :: il_xextra
+      INTEGER(i4) :: il_yextra
+      INTEGER(i4) :: il_zextra
+
+      LOGICAL, DIMENSION(3) :: ll_even
+
+      LOGICAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ll_mask
+
+      REAL(dp), DIMENSION(:)     , ALLOCATABLE :: dl_vect
+
+      TYPE(TVAR) :: tl_mix
+
+      ! loop indices
+      !----------------------------------------------------------------
+      ALLOCATE(il_rho(ip_maxdim))
+      il_rho(:)=1
+      IF( PRESENT(id_rho) ) il_rho(:)=id_rho(:)
+
+      ! special case for even refinement on ARAKAWA-C grid
+      ll_even(:)=.FALSE.
+      IF( MOD(il_rho(jp_I),2) == 0 ) ll_even(1)=.TRUE.
+      IF( MOD(il_rho(jp_J),2) == 0 ) ll_even(2)=.TRUE.
+      IF( MOD(il_rho(jp_K),2) == 0 ) ll_even(3)=.TRUE.         
+
+      SELECT CASE(TRIM(td_mix%c_point))
+         CASE('U')
+            ll_even(1)=.FALSE.
+         CASE('V')
+            ll_even(2)=.FALSE.
+         CASE('F')
+            ll_even(:)=.FALSE.
+      END SELECT
+
+      ! remove some point only if refinement in some direction is even
+      IF( ANY(ll_even(:)) )THEN
+
+         ! copy variable
+         tl_mix=var_copy(td_mix)
+
+         ALLOCATE( ll_mask( tl_mix%t_dim(1)%i_len, &
+         &                  tl_mix%t_dim(2)%i_len, &
+         &                  tl_mix%t_dim(3)%i_len, &
+         &                  tl_mix%t_dim(4)%i_len) )
+
+         ll_mask(:,:,:,:)=.TRUE.
+
+         IF( tl_mix%t_dim(1)%l_use .AND. ll_even(1) )THEN
+
+            il_rho(jp_I)=il_rho(jp_I)+1
+
+            ! locate wrong point on mixed grid
+            ll_mask(1:td_mix%t_dim(1)%i_len:il_rho(jp_I),:,:,:)=.FALSE.
+
+            ! compute coasre grid dimension length
+            il_xextra=il_rho(jp_I)-1
+            td_mix%t_dim(1)%i_len=(tl_mix%t_dim(1)%i_len+il_xextra)/il_rho(jp_I)
+
+            il_rho(jp_I)=il_rho(jp_I)-1
+            ! compute right fine grid dimension length
+            td_mix%t_dim(1)%i_len=td_mix%t_dim(1)%i_len*il_rho(jp_I)-il_xextra
+
+         ENDIF
+
+         IF( tl_mix%t_dim(2)%l_use .AND. ll_even(2) )THEN
+
+            il_rho(jp_J)=il_rho(jp_J)+1
+
+            ! locate wrong point on mixed grid
+            ll_mask(:,1:tl_mix%t_dim(2)%i_len:il_rho(jp_J),:,:)=.FALSE.
+
+            ! compute coasre grid dimension length
+            il_yextra=il_rho(jp_J)-1
+            td_mix%t_dim(2)%i_len=(tl_mix%t_dim(2)%i_len+il_yextra)/il_rho(jp_J)
+
+            il_rho(jp_J)=il_rho(jp_J)-1
+            ! compute right fine grid dimension length
+            td_mix%t_dim(2)%i_len=td_mix%t_dim(2)%i_len*il_rho(jp_J)-il_yextra
+            
+         ENDIF
+
+         IF( tl_mix%t_dim(3)%l_use .AND. ll_even(3) )THEN
+
+            il_rho(jp_K)=il_rho(jp_K)+1
+
+            ! locate wrong point on mixed grid
+            ll_mask(:,:,1:tl_mix%t_dim(3)%i_len:il_rho(jp_K),:)=.FALSE.
+
+            ! compute coasre grid dimension length
+            il_zextra=il_rho(jp_K)-1
+            td_mix%t_dim(3)%i_len=(tl_mix%t_dim(3)%i_len+il_zextra)/il_rho(jp_K)
+
+            il_rho(jp_K)=il_rho(jp_K)-1
+            ! compute right fine grid dimension length
+            td_mix%t_dim(3)%i_len=td_mix%t_dim(3)%i_len*il_rho(jp_K)-il_zextra
+
+         ENDIF      
+
+         IF( ASSOCIATED(td_mix%d_value) ) DEALLOCATE( td_mix%d_value )
+         ALLOCATE( td_mix%d_value( td_mix%t_dim(1)%i_len, &
+         &                         td_mix%t_dim(2)%i_len, &
+         &                         td_mix%t_dim(3)%i_len, &
+         &                         td_mix%t_dim(4)%i_len) )
+
+         ! initialise to FillValue
+         td_mix%d_value(:,:,:,:)=td_mix%d_fill
+
+         IF( COUNT(ll_mask(:,:,:,:)) /= SIZE(td_mix%d_value(:,:,:,:)) )THEN
+
+            CALL logger_error("INTERP CLEAN EVEN GRID: output value size "//&
+            &  " and mask count differ ")
+
+         ELSE
+
+            ALLOCATE( dl_vect(COUNT(ll_mask(:,:,:,:))) )
+
+            dl_vect(:)= PACK( tl_mix%d_value(:,:,:,:), &
+            &                 MASK=ll_mask(:,:,:,:)     )
+
+            td_mix%d_value(:,:,:,:)=RESHAPE( dl_vect(:), &
+            &                                SHAPE=(/td_mix%t_dim(1)%i_len, &
+            &                                        td_mix%t_dim(2)%i_len, &
+            &                                        td_mix%t_dim(3)%i_len, &
+            &                                        td_mix%t_dim(4)%i_len/) )
+
+            DEALLOCATE( dl_vect )
+
+         ENDIF
+
+         DEALLOCATE( ll_mask )
+
+         ! clean
+         CALL var_clean(tl_mix)
+
+      ENDIF
+
+      ! clean
+      DEALLOCATE(il_rho)
+
+   END SUBROUTINE interp__clean_even_grid
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE interp_clean_mixed_grid(td_mix, td_var, &
+         &                            id_rho, id_offset)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine remove points added on mixed grid 
+   !> to compute interpolation. And save interpolated value over domain. 
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014
+   !> - use offset to save useful domain
+   !>
+   !> @param[in] td_mix    mixed grid variable structure
+   !> @param[out] td_var   variable structure
+   !> @param[in] id_rho    array of refinement factor (default 1)
+   !> @param[in] id_offset 2D array of offset between fine and coarse grid
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR)                 , INTENT(IN   ) :: td_mix
+      TYPE(TVAR)                 , INTENT(  OUT) :: td_var
+      INTEGER(I4), DIMENSION(:)  , INTENT(IN   ) :: id_rho
+      INTEGER(I4), DIMENSION(2,2), INTENT(IN   ) :: id_offset
+
+      ! local variable
+      INTEGER(i4) :: il_imin0
+      INTEGER(i4) :: il_imax0
+      INTEGER(i4) :: il_jmin0
+      INTEGER(i4) :: il_jmax0
+
+      INTEGER(i4) :: il_imin1
+      INTEGER(i4) :: il_jmin1
+      INTEGER(i4) :: il_imax1
+      INTEGER(i4) :: il_jmax1
+
+      REAL(dp), DIMENSION(:,:,:,:) , ALLOCATABLE :: dl_value
+
+      TYPE(TVAR) :: tl_mix
+
+      ! loop indices
+      !----------------------------------------------------------------
+      ! copy mixed variable in temporary structure
+      tl_mix=var_copy(td_mix)
+
+      ! remove useless points over mixed grid for even refinement
+      CALL interp__clean_even_grid(tl_mix, id_rho(:))
+
+      ! copy cleaned mixed variable
+      td_var=var_copy(tl_mix)
+
+      ! delete array of value
+      CALL var_del_value(td_var)
+
+      ! compute domain indices in i-direction
+      il_imin0=1  ; il_imax0=td_var%t_dim(1)%i_len
+ 
+      IF( td_var%t_dim(1)%l_use )THEN
+         il_imin1=il_imin0+id_offset(Jp_I,1)
+         il_imax1=il_imax0-id_offset(Jp_I,2)
+      ELSE
+
+         il_imin1=il_imin0
+         il_imax1=il_imax0
+
+      ENDIF
+
+      ! compute domain indices in j-direction
+      il_jmin0=1  ; il_jmax0=td_var%t_dim(2)%i_len
+ 
+      IF( td_var%t_dim(2)%l_use )THEN
+         il_jmin1=il_jmin0+id_offset(Jp_J,1)
+         il_jmax1=il_jmax0-id_offset(Jp_J,2)
+      ELSE
+
+         il_jmin1=il_jmin0
+         il_jmax1=il_jmax0
+ 
+      ENDIF
+
+      ! compute new dimension
+      td_var%t_dim(1)%i_len=il_imax1-il_imin1+1
+      td_var%t_dim(2)%i_len=il_jmax1-il_jmin1+1
+ 
+      ALLOCATE(dl_value(td_var%t_dim(1)%i_len, &
+      &                 td_var%t_dim(2)%i_len, &
+      &                 td_var%t_dim(3)%i_len, &
+      &                 td_var%t_dim(4)%i_len) )
+
+      dl_value( 1:td_var%t_dim(1)%i_len, &
+      &         1:td_var%t_dim(2)%i_len, &
+      &         :,:) = tl_mix%d_value( il_imin1:il_imax1, &
+      &                                il_jmin1:il_jmax1, &
+      &                                     :, : )
+
+      ! add variable value
+      CALL var_add_value(td_var,dl_value(:,:,:,:))
+
+      DEALLOCATE(dl_value)
+ 
+      ! clean
+      CALL var_clean(tl_mix)
+
+   END SUBROUTINE interp_clean_mixed_grid
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE interp__fill_value_wrapper(td_var, & 
+         &                               id_rho, &
+         &                               id_offset)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine interpolate variable value.
+   !> 
+   !> @details 
+   !> Actually it checks, the number of dimension used for this variable
+   !> and launch interp__fill_value.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure
+   !> @param[in] id_rho    array of refinement factor
+   !> @param[in] id_offset 2D array of offset between fine and coarse grid
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
+      INTEGER(I4), DIMENSION(:)  , INTENT(IN   ), OPTIONAL :: id_rho
+      INTEGER(I4), DIMENSION(:,:), INTENT(IN   ), OPTIONAL :: id_offset
+
+      ! local variable
+      CHARACTER(LEN=lc)                            :: cl_method
+      INTEGER(i4)      , DIMENSION(:), ALLOCATABLE :: il_rho
+      INTEGER(i4)      , DIMENSION(2,2)            :: il_offset
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ALLOCATE( il_rho(ip_maxdim) )
+      il_rho(:)=1
+      IF( PRESENT(id_rho) ) il_rho(1:SIZE(id_rho(:)))=id_rho(:)
+      IF( ANY(il_rho(:) < 0) )THEN
+         CALL logger_error("INTERP FILL VALUE: invalid "//&
+         &  " refinement factor ")
+      ENDIF
+
+      il_offset(:,:)=0
+      IF( PRESENT(id_offset) )THEN
+         IF( ANY(SHAPE(id_offset(:,:)) /= (/2,2/)) )THEN
+            CALL logger_error("INTERP FILL VALUE: invalid array of offset")
+         ELSE
+            il_offset(:,:)=id_offset(:,:)
+         ENDIF
+      ENDIF
+
+      IF( (il_rho(jp_I) /= 1 .AND. td_var%t_dim(1)%l_use) .OR. &
+      &   (il_rho(jp_J) /= 1 .AND. td_var%t_dim(2)%l_use) .OR. &
+      &   (il_rho(jp_K) /= 1 .AND. td_var%t_dim(3)%l_use) )THEN
+
+         SELECT CASE(TRIM(td_var%c_interp(1)))
+            CASE('cubic','linear','nearest')
+               cl_method=TRIM(td_var%c_interp(1))
+            CASE DEFAULT
+               CALL logger_warn("INTERP FILL VALUE: interpolation method unknown."//&
+               &  " use linear interpolation")
+               cl_method='linear'
+               ! update variable structure value
+               td_var%c_interp(1)='linear'
+         END SELECT
+
+         CALL logger_info("INTERP FILL: interpolate "//TRIM(td_var%c_name)//&
+         &             " using "//TRIM(cl_method)//" method." )
+         CALL logger_info("INTERP FILL: refinement factor "//&
+         &                        TRIM(fct_str(il_rho(jp_I)))//&
+         &                   " "//TRIM(fct_str(il_rho(jp_J)))//&
+         &                   " "//TRIM(fct_str(il_rho(jp_K))) )
+ 
+         CALL interp__fill_value( td_var, cl_method, & 
+         &                        il_rho(:), il_offset(:,:) )
+
+         SELECT CASE(TRIM(td_var%c_interp(2)))
+         CASE('/rhoi')
+            WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )
+               td_var%d_value(:,:,:,:) = &
+               &  td_var%d_value(:,:,:,:) / REAL(il_rho(jp_I),dp)
+            END WHERE
+         CASE('/rhoj')
+            WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )
+               td_var%d_value(:,:,:,:) = &
+               &  td_var%d_value(:,:,:,:) / REAL(il_rho(jp_J),dp)
+            END WHERE
+         CASE('/rhok')
+            WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )
+               td_var%d_value(:,:,:,:) = &
+               &  td_var%d_value(:,:,:,:) / REAL(il_rho(jp_K),dp)
+            END WHERE
+         CASE('*rhoi')
+            WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )
+               td_var%d_value(:,:,:,:) = &
+               &  td_var%d_value(:,:,:,:) * REAL(il_rho(jp_I),dp)
+            END WHERE
+         CASE('*rhoj')
+            WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill ) 
+               td_var%d_value(:,:,:,:) = &
+               &  td_var%d_value(:,:,:,:) * REAL(il_rho(jp_J),dp)
+            END WHERE
+         CASE('*rhok')
+            WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill ) 
+               td_var%d_value(:,:,:,:) = &
+               &  td_var%d_value(:,:,:,:) * REAL(il_rho(jp_K),dp)
+            END WHERE
+         CASE DEFAULT
+            td_var%c_interp(2)=''
+         END SELECT
+
+      ELSE
+         td_var%c_interp(:)=''
+      ENDIF
+
+      DEALLOCATE(il_rho)
+
+   END SUBROUTINE interp__fill_value_wrapper
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE interp__fill_value(td_var, cd_method, &
+         &                       id_rho, id_offset)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine interpolate value over mixed grid.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014
+   !> - use interpolation method modules
+   !>
+   !> @param[inout] td_var variable structure
+   !> @param[in] cd_method interpolation method 
+   !> @param[in] id_rho    array of refinment factor 
+   !> @param[in] id_offset 2D array of offset between fine and coarse grid
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR)                      , INTENT(INOUT) :: td_var 
+      CHARACTER(LEN=*)                , INTENT(IN   ) :: cd_method
+      INTEGER(I4)     , DIMENSION(:)  , INTENT(IN   ) :: id_rho
+      INTEGER(I4)     , DIMENSION(2,2), INTENT(IN   ) :: id_offset
+
+      ! local variable
+      CHARACTER(LEN=lc)                                :: cl_interp
+
+      INTEGER(I4)    , DIMENSION(:)      , ALLOCATABLE :: il_rho
+      INTEGER(i4)    , DIMENSION(:,:,:)  , ALLOCATABLE :: il_detect
+ 
+      REAL(dp)                                         :: dl_min
+      REAL(dp)                                         :: dl_max
+
+      LOGICAL        , DIMENSION(3)                    :: ll_even
+      LOGICAL                                          :: ll_discont
+ 
+      TYPE(TVAR)                                       :: tl_mix
+
+      TYPE(TATT)                                       :: tl_att
+ 
+      ! loop indices
+      !----------------------------------------------------------------
+
+      !1- create mixed grid
+      CALL interp_create_mixed_grid( td_var, tl_mix, id_rho(:) )
+
+      ! clean variable structure
+      CALL var_clean(td_var)
+
+      !2- detect point to be interpolated
+      ALLOCATE( il_detect( tl_mix%t_dim(1)%i_len, &
+      &                    tl_mix%t_dim(2)%i_len, &
+      &                    tl_mix%t_dim(3)%i_len) )
+
+      il_detect(:,:,:)=0
+
+      il_detect(:,:,:)=interp_detect(tl_mix, id_rho(:) )
+
+      ! add attribute to variable
+      cl_interp=fct_concat(tl_mix%c_interp(:))
+      tl_att=att_init('interpolation',cl_interp)
+      CALL var_move_att(tl_mix, tl_att)
+
+      ! clean
+      CALL att_clean(tl_att)
+
+      ! special case for even refinement on ARAKAWA-C grid
+      ll_even(:)=.FALSE.
+      IF( MOD(id_rho(jp_I),2) == 0 ) ll_even(1)=.TRUE.
+      IF( MOD(id_rho(jp_J),2) == 0 ) ll_even(2)=.TRUE.
+      IF( MOD(id_rho(jp_K),2) == 0 ) ll_even(3)=.TRUE.         
+
+      SELECT CASE(TRIM(tl_mix%c_point))
+         CASE('U')
+            ll_even(1)=.FALSE.
+         CASE('V')
+            ll_even(2)=.FALSE.
+         CASE('F')
+            ll_even(:)=.FALSE.
+      END SELECT
+
+      ALLOCATE(il_rho(ip_maxdim))
+      il_rho(:)=id_rho(:)
+
+      IF( ll_even(1) ) il_rho(jp_I)=id_rho(jp_I)+1
+      IF( ll_even(2) ) il_rho(jp_J)=id_rho(jp_J)+1
+      IF( ll_even(3) ) il_rho(jp_K)=id_rho(jp_K)+1
+
+      ! special case for longitude
+      ll_discont=.FALSE.
+      IF( TRIM(tl_mix%c_units) == 'degrees_east' )THEN
+         dl_min=MINVAL( tl_mix%d_value(:,:,:,:), &
+         &              tl_mix%d_value(:,:,:,:)/=tl_mix%d_fill)
+         dl_max=MAXVAL( tl_mix%d_value(:,:,:,:), &
+         &              tl_mix%d_value(:,:,:,:)/=tl_mix%d_fill)         
+         IF( dl_min < -170_dp .AND. dl_max > 170_dp .OR. &
+         &   dl_min <   10_dp .AND. dl_max > 350_dp )THEN
+            ll_discont=.TRUE.
+         ENDIF
+      ENDIF
+
+      !3- interpolate
+      CALL logger_debug("INTERP 2D: interpolation method "//TRIM(cd_method)//&
+      &  " discont "//TRIM(fct_str(ll_discont)) )
+      SELECT CASE(TRIM(cd_method))
+      CASE('cubic')
+         CALL interp_cubic_fill(tl_mix%d_value(:,:,:,:), tl_mix%d_fill, &
+           &                    il_detect(:,:,:),                        &
+           &                    il_rho(:), ll_even(:), ll_discont )
+      CASE('nearest')
+         CALL interp_nearest_fill(tl_mix%d_value(:,:,:,:), &
+              &                   il_detect(:,:,:),         &
+              &                   il_rho(:) )
+      CASE DEFAULT ! linear
+         CALL interp_linear_fill(tl_mix%d_value(:,:,:,:), tl_mix%d_fill, &
+              &                  il_detect(:,:,:),                        &
+              &                  il_rho(:), ll_even(:), ll_discont )
+      END SELECT         
+
+      IF( ANY(il_detect(:,:,:)==1) )THEN
+         CALL logger_warn("INTERP FILL: some points can not be interpolated "//&
+         &             "for variable "//TRIM(tl_mix%c_name) )
+      ENDIF
+
+      DEALLOCATE(il_detect)
+
+      !4- save useful domain (remove offset)
+      CALL interp_clean_mixed_grid( tl_mix, td_var, &
+      &                             id_rho(:), id_offset(:,:)  )  
+
+      ! clean variable structure
+      DEALLOCATE(il_rho)
+      CALL var_clean(tl_mix)
+
+   END SUBROUTINE interp__fill_value
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE interp
Index: /utils/tools_ticket2413/SIREN/src/interp_cubic.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/interp_cubic.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/interp_cubic.f90	(revision 12863)
@@ -0,0 +1,819 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief 
+!> This module manage cubic interpolation on regular grid.
+!>
+!>
+!> @details
+!> to compute cubic interpolation:<br/>
+!> @code
+!> CALL interp_cubic_fill(dd_value, dd_fill, id_detect, id_rho, ld_even [,ld_discont] )
+!> @endcode
+!>    - dd_value is 2D array of variable value 
+!>    - dd_fill is the FillValue of variable
+!>    - id_detect is 2D array of point to be interpolated (see interp module) 
+!>    - id_rho  is array of refinment factor
+!>    - ld_even indicates even refinment or not 
+!>    - ld_discont indicates longitudinal discontinuity (-180°/180°, 0°/360°) or not
+!>
+!> @author
+!> J.Paul
+!>
+!> @date September, 2014 -Initial version
+!> @date June, 2015
+!> - use math module
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE interp_cubic
+
+   USE netcdf                          ! nf90 library
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+   USE math                            ! mathematical function
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+
+   ! function and subroutine
+   PUBLIC :: interp_cubic_fill  !< compute interpolation using cubic method
+
+   PRIVATE :: interp_cubic__2D           !< compute bicubic interpolation on 2D gid
+   PRIVATE :: interp_cubic__1D           !< compute   cubic interpolation on 1D gid
+   PRIVATE :: interp_cubic__2D_coef      !< compute coefficient for bicubic interpolation
+   PRIVATE :: interp_cubic__2D_fill      !< fill value using bicubic interpolation
+   PRIVATE :: interp_cubic__1D_coef      !< compute coefficient for   cubic interpolation
+   PRIVATE :: interp_cubic__1D_fill      !< fill value using   cubic interpolation
+   PRIVATE :: interp_cubic__get_weight2D !< compute interpoaltion weight for 2D array 
+   PRIVATE :: interp_cubic__get_weight1D !< compute interpoaltion weight for 1D array
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE interp_cubic_fill(dd_value, dd_fill, &
+         &                      id_detect,         &
+         &                      id_rho,            &
+         &                      ld_even, ld_discont)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute horizontal cubic interpolation on 4D array of value. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !> @date July, 2015 
+   !> - reinitialise detect array for each level
+   !>
+   !> @param[inout] dd_value  2D array of variable value 
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[inout] id_detect 2D array of point to be interpolated 
+   !> @param[in] id_rho       array of refinment factor
+   !> @param[in] ld_even      even refinment or not 
+   !> @param[in] ld_discont   longitudinal discontinuity (-180°/180°, 0°/360°) or not
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)        , DIMENSION(:,:,:,:), INTENT(INOUT) :: dd_value 
+      REAL(dp)                            , INTENT(IN   ) :: dd_fill 
+      INTEGER(I4)     , DIMENSION(:,:,:)  , INTENT(INOUT) :: id_detect
+      INTEGER(I4)     , DIMENSION(:)      , INTENT(IN   ) :: id_rho
+      LOGICAL         , DIMENSION(:)      , INTENT(IN   ) :: ld_even
+      LOGICAL                             , INTENT(IN   ), OPTIONAL :: ld_discont
+
+      ! local variable
+      INTEGER(i4), DIMENSION(4)                  :: il_shape
+
+      INTEGER(I4), DIMENSION(:,:,:), ALLOCATABLE :: il_detect
+
+      LOGICAL                                    :: ll_discont
+
+      REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_IJ
+      REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_I
+      REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_J
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+      ll_discont=.FALSE.
+      IF( PRESENT(ld_discont) ) ll_discont=ld_discont
+
+      il_shape(:)=SHAPE(dd_value)
+
+      ! compute vect2D
+      ALLOCATE(dl_weight_IJ(16,((id_rho(jp_I)+1)*(id_rho(jp_J)+1))) )
+      CALL interp_cubic__get_weight2D(dl_weight_IJ(:,:), &
+      &                               id_rho(:), ld_even(:))
+
+      ALLOCATE( dl_weight_I( 4,((id_rho(jp_I)+1)                 )) )
+      ALLOCATE( dl_weight_J( 4,(                 (id_rho(jp_J)+1))) )
+      CALL interp_cubic__get_weight1D(dl_weight_I(:,:), &
+      &                               id_rho(jp_I), ld_even(jp_I))
+      CALL interp_cubic__get_weight1D(dl_weight_J(:,:), &
+      &                               id_rho(jp_J), ld_even(jp_J))
+
+      ALLOCATE(il_detect(il_shape(1),il_shape(2),il_shape(3)))
+
+      DO jl=1,il_shape(4)
+         il_detect(:,:,:)=id_detect(:,:,:)
+         ! loop on vertical level
+         DO jk=1,il_shape(3)
+
+            ! I-J plan
+            CALL interp_cubic__2D(dd_value(:,:,jk,jl), dd_fill, &
+            &                     il_detect(:,:,jk),            &
+            &                     dl_weight_IJ(:,:),            &
+            &                     id_rho(jp_I), id_rho(jp_J),   &
+            &                     ll_discont)            
+            IF( ANY(il_detect(:,:,jk)==1) )THEN
+               ! I direction
+               DO jj=1,il_shape(2)
+                  CALL interp_cubic__1D( dd_value(:,jj,jk,jl), dd_fill, &
+                  &                      il_detect(:,jj,jk),            &
+                  &                      dl_weight_I(:,:),              &
+                  &                      id_rho(jp_I), ll_discont )
+               ENDDO
+               IF( ALL(il_detect(:,:,jk)==0) )THEN
+                  CYCLE
+               ELSE
+                  ! J direction
+                  DO ji=1,il_shape(1)
+                     CALL interp_cubic__1D( dd_value(ji,:,jk,jl), dd_fill, &
+                     &                      il_detect(ji,:,jk),            &
+                     &                      dl_weight_J(:,:),              &
+                     &                      id_rho(jp_J), ll_discont )
+                  ENDDO
+               ENDIF
+            ENDIF
+
+         ENDDO
+      ENDDO
+
+      id_detect(:,:,:)=il_detect(:,:,:)
+      DEALLOCATE(il_detect)
+
+      DEALLOCATE(dl_weight_IJ)
+      DEALLOCATE(dl_weight_I)
+      DEALLOCATE(dl_weight_J)
+
+   END SUBROUTINE interp_cubic_fill
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE interp_cubic__2D(dd_value,  dd_fill,   &
+         &                     id_detect,            &
+         &                     dd_weight,            &
+         &                     id_rhoi, id_rhoj,     &
+         &                     ld_discont)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute cubic interpolation on 2D array of value. 
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] dd_value  2D array of variable value 
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[inout] id_detect 2D array of point to be interpolated 
+   !> @param[in] id_rhoi      refinment factor in i-direction
+   !> @param[in] id_rhoj      refinment factor in j-direction
+   !> @param[in] id_rhok      refinment factor in k-direction
+   !> @param[in] ld_even      even refinment or not 
+   !> @param[in] ld_discont   longitudinal discontinuity (-180°/180°, 0°/360°) or not
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)        , DIMENSION(:,:), INTENT(INOUT) :: dd_value 
+      REAL(dp)                        , INTENT(IN   ) :: dd_fill 
+      INTEGER(I4)     , DIMENSION(:,:), INTENT(INOUT) :: id_detect
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight
+      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoi
+      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoj
+      LOGICAL                         , INTENT(IN   ) :: ld_discont
+
+      ! local variable
+      INTEGER(I4)                              :: il_xextra
+      INTEGER(I4)                              :: il_yextra
+      INTEGER(i4), DIMENSION(2)                :: il_shape
+      INTEGER(i4), DIMENSION(2)                :: il_dim
+
+      REAL(dp)                                 :: dl_min 
+      REAL(dp)                                 :: dl_max 
+      REAL(dp)   , DIMENSION(:)  , ALLOCATABLE :: dl_coef
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_coarse
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_tmp
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_dfdx
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_dfdy
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_d2fdxy
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: ii
+      INTEGER(i4) :: ij
+      !----------------------------------------------------------------
+
+      IF( ANY(id_detect(:,:)==1) )THEN
+         il_shape(:)=SHAPE(dd_value)
+
+         ! compute coarse grid dimension
+         il_xextra=id_rhoi-1
+         il_dim(1)=(il_shape(1)+il_xextra)/id_rhoi
+
+         il_yextra=id_rhoj-1
+         il_dim(2)=(il_shape(2)+il_yextra)/id_rhoj
+
+         ALLOCATE( dl_coarse(il_dim(1),il_dim(2)) )
+
+         ! value on coarse grid
+         dl_coarse(:,:)=dd_value( 1:il_shape(1):id_rhoi, &
+         &                        1:il_shape(2):id_rhoj )
+
+         ALLOCATE( dl_dfdx(  il_dim(1),il_dim(2)), &
+         &         dl_dfdy(  il_dim(1),il_dim(2)), &
+         &         dl_d2fdxy(il_dim(1),il_dim(2)) )
+
+         ! compute derivative on coarse grid
+         dl_dfdx(:,:)=math_deriv_2D(dl_coarse(:,:), dd_fill, 'I', ld_discont)
+         dl_dfdy(:,:)=math_deriv_2D(dl_coarse(:,:), dd_fill, 'J', ld_discont)
+
+         ! compute cross derivative on coarse grid
+         dl_d2fdxy(:,:)=math_deriv_2D(dl_dfdx(:,:), dd_fill, 'J', ld_discont)
+
+         ALLOCATE( dl_tmp(2,2) )
+         ALLOCATE( dl_coef(16) )
+
+         DO jj=1,il_shape(2)-1,id_rhoj
+            ij=((jj-1)/id_rhoj)+1
+            DO ji=1,il_shape(1)-1,id_rhoi
+               ii=((ji-1)/id_rhoi)+1
+         
+               ! check if point to be interpolated
+               IF( ALL(id_detect(ji:ji+id_rhoi,   &
+               &                 jj:jj+id_rhoj)==0) ) CYCLE
+               ! check data needed to interpolate
+               IF( ANY(dl_coarse(ii:ii+1,ij:ij+1)==dd_fill) .OR. &
+               &   ANY(  dl_dfdx(ii:ii+1,ij:ij+1)==dd_fill) .OR. &
+               &   ANY(  dl_dfdy(ii:ii+1,ij:ij+1)==dd_fill) .OR. &
+               &   ANY(dl_d2fdxy(ii:ii+1,ij:ij+1)==dd_fill) ) CYCLE
+
+               dl_tmp(:,:)=dl_coarse(ii:ii+1,ij:ij+1)
+               ! check longitude discontinuity
+               IF( ld_discont )THEN
+
+                  dl_min=MINVAL( dl_tmp(:,:), dl_tmp(:,:)/=dd_fill )
+                  dl_max=MAXVAL( dl_tmp(:,:), dl_tmp(:,:)/=dd_fill )
+                  IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                     WHERE( dl_tmp(:,:) < 0_dp ) 
+                        dl_tmp(:,:) = dl_tmp(:,:)+360._dp
+                     END WHERE
+                  ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                     WHERE( dl_tmp(:,:) > 180_dp ) 
+                        dl_tmp(:,:) = dl_tmp(:,:)-180._dp
+                     END WHERE
+                  ENDIF
+
+               ENDIF
+
+               ! compute bicubic coefficient
+               dl_coef(:)=interp_cubic__2D_coef(dl_tmp(:,:),&
+               &                                dl_dfdx(  ii:ii+1,ij:ij+1),&
+               &                                dl_dfdy(  ii:ii+1,ij:ij+1),&
+               &                                dl_d2fdxy(ii:ii+1,ij:ij+1),&
+               &                                dd_fill )
+
+               ! compute value on detetected point
+               CALL interp_cubic__2D_fill(dd_value( ji:ji+id_rhoi,   &
+               &                                    jj:jj+id_rhoj ), &
+               &                          id_detect(ji:ji+id_rhoi,   &
+               &                                    jj:jj+id_rhoj ), &
+               &                          dd_weight(:,:), dl_coef(:),&
+               &                          dd_fill, id_rhoi, id_rhoj )
+
+               IF( ld_discont )THEN
+                  WHERE( dd_value( ji:ji+id_rhoi, &
+                     &             jj:jj+id_rhoj ) >= 180._dp .AND. &
+                     &   dd_value( ji:ji+id_rhoi, &
+                     &             jj:jj+id_rhoj ) /= dd_fill )
+                     dd_value( ji:ji+id_rhoi, &
+                     &         jj:jj+id_rhoj ) = &
+                     &           dd_value( ji:ji+id_rhoi, &
+                     &                     jj:jj+id_rhoj ) - 360._dp
+                  END WHERE
+               ENDIF
+
+            ENDDO
+         ENDDO
+
+         DEALLOCATE(dl_coef)
+         DEALLOCATE(dl_tmp )
+
+         DEALLOCATE(dl_dfdx, &
+         &          dl_dfdy, &
+         &          dl_d2fdxy )
+
+         DEALLOCATE( dl_coarse )
+      ENDIF
+
+   END SUBROUTINE interp_cubic__2D
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE interp_cubic__1D(dd_value,  dd_fill,   &
+         &                     id_detect,            &
+         &                     dd_weight,            &
+         &                     id_rhoi,              &
+         &                     ld_discont)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute cubic interpolation on 1D array of value. 
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] dd_value  1D array of variable value 
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[inout] id_detect 1D array of point to be interpolated 
+   !> @param[in] id_rhoi      refinment factor
+   !> @param[in] ld_even      even refinment or not 
+   !> @param[in] ld_discont   longitudinal discontinuity (-180°/180°, 0°/360°) or not
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)        , DIMENSION(:)  , INTENT(INOUT) :: dd_value 
+      REAL(dp)                        , INTENT(IN   ) :: dd_fill 
+      INTEGER(I4)     , DIMENSION(:)  , INTENT(INOUT) :: id_detect
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight
+      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoi
+      LOGICAL                         , INTENT(IN   ) :: ld_discont
+
+      ! local variable
+      INTEGER(I4)                            :: il_xextra
+      INTEGER(i4), DIMENSION(1)              :: il_shape
+      INTEGER(i4), DIMENSION(1)              :: il_dim
+
+      REAL(dp)                               :: dl_min 
+      REAL(dp)                               :: dl_max 
+      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_coef
+      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_coarse
+      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_tmp
+      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_dfdx
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: ii
+      !----------------------------------------------------------------
+
+      IF( ANY(id_detect(:)==1) )THEN
+         il_shape(:)=SHAPE(dd_value)
+
+         ! compute coarse grid dimension
+         il_xextra=id_rhoi-1
+         il_dim(1)=(il_shape(1)+il_xextra)/id_rhoi
+
+         ALLOCATE( dl_coarse(il_dim(1)) )
+
+         ! value on coarse grid
+         dl_coarse(:)=dd_value( 1:il_shape(1):id_rhoi )
+
+         ALLOCATE( dl_dfdx(il_dim(1)) )
+
+         ! compute derivative on coarse grid
+         dl_dfdx(:)=math_deriv_1D(dl_coarse(:), dd_fill, ld_discont)
+
+         ALLOCATE( dl_tmp(2) )
+         ALLOCATE( dl_coef(4) )
+
+         DO ji=1,il_shape(1)-1,id_rhoi
+            ii=((ji-1)/id_rhoi)+1
+         
+            ! check if point to be interpolated
+            IF( ALL(id_detect(ji:ji+id_rhoi)==0) ) CYCLE
+            ! check data needed to interpolate
+            IF( ANY(dl_coarse(ii:ii+1)==dd_fill) .OR. &
+            &   ANY(  dl_dfdx(ii:ii+1)==dd_fill) ) CYCLE
+            ! check longitude discontinuity
+            dl_tmp(:)=dl_coarse(ii:ii+1)
+            IF( ld_discont )THEN
+
+               dl_min=MINVAL( dl_tmp(:), dl_tmp(:)/=dd_fill )
+               dl_max=MAXVAL( dl_tmp(:), dl_tmp(:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_tmp(:) < 0_dp ) 
+                     dl_tmp(:) = dl_tmp(:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_tmp(:) > 180_dp ) 
+                     dl_tmp(:) = dl_tmp(:)-180._dp
+                  END WHERE
+               ENDIF
+
+            ENDIF
+
+            ! compute bicubic coefficient
+            dl_coef(:)=interp_cubic__1D_coef(dl_tmp(:),       &
+            &                                dl_dfdx(ii:ii+1),&
+            &                                dd_fill )
+
+            ! compute value on detetected point
+            CALL interp_cubic__1D_fill( dd_value( ji:ji+id_rhoi ), &
+            &                           id_detect(ji:ji+id_rhoi ), &
+            &                           dd_weight(:,:), dl_coef(:),  &
+            &                           dd_fill, id_rhoi )
+
+            IF( ld_discont )THEN
+               WHERE( dd_value( ji:ji+id_rhoi ) >= 180._dp .AND. &
+                  &   dd_value( ji:ji+id_rhoi ) /= dd_fill )
+                  dd_value(ji:ji+id_rhoi) = dd_value(ji:ji+id_rhoi) - 360._dp
+               END WHERE
+            ENDIF
+
+         ENDDO
+
+         DEALLOCATE(dl_coef)
+         DEALLOCATE(dl_tmp )
+
+         DEALLOCATE(dl_dfdx )
+         DEALLOCATE( dl_coarse )
+      ENDIF
+
+   END SUBROUTINE interp_cubic__1D
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION interp_cubic__2D_coef(dd_value,                    &
+         &                        dd_dfdx,  dd_dfdy, dd_d2fdxy,&
+         &                        dd_fill) &
+         & RESULT (df_coef)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute 2D array of coefficient for cubic interpolation.
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[in] dd_value  2D array of value
+   !> @param[in] dd_dfdx   2D array of first derivative in i-direction 
+   !> @param[in] dd_dfdy   2D array of first derivative in j-direction
+   !> @param[in] dd_d2fdxy 2D array of cross derivative in i-j-direction
+   !> @param[in] dd_fill   FillValue of variable
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_value 
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_dfdx  
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_dfdy  
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_d2fdxy
+      REAL(dp)                , INTENT(IN) :: dd_fill
+
+      ! function
+      REAL(dp), DIMENSION(16)              :: df_coef
+
+      ! local variable
+      REAL(dp), DIMENSION(16,16), PARAMETER :: dl_matrix = RESHAPE( &
+      & (/ 1 , 0 ,-3 , 2 , 0 , 0 , 0 , 0 ,-3 , 0 , 9 ,-6 , 2 , 0 ,-6 , 4 ,& 
+           0 , 0 , 3 ,-2 , 0 , 0 , 0 , 0 , 0 , 0 ,-9 , 6 , 0 , 0 , 6 ,-4 ,& 
+           0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 3 , 0 ,-9 , 6 ,-2 , 0 , 6 ,-4 ,& 
+           0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 9 ,-6 , 0 , 0 ,-6 , 4 ,& 
+           0 , 1 ,-2 , 1 , 0 , 0 , 0 , 0 , 0 ,-3 , 6 ,-3 , 0 , 2 ,-4 , 2 ,& 
+           0 , 0 ,-1 , 1 , 0 , 0 , 0 , 0 , 0 , 0 , 3 ,-3 , 0 , 0 ,-2 , 2 ,& 
+           0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 3 ,-6 , 3 , 0 ,-2 , 4 ,-2 ,& 
+           0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,-3 , 3 , 0 , 0 , 2 ,-2 ,& 
+           0 , 0 , 0 , 0 , 1 , 0 ,-3 , 2 ,-2 , 0 , 6 ,-4 , 1 , 0 ,-3 , 2 ,& 
+           0 , 0 , 0 , 0 , 0 , 0 , 3 ,-2 , 0 , 0 ,-6 , 4 , 0 , 0 , 3 ,-2 ,& 
+           0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,-1 , 0 , 3 ,-2 , 1 , 0 ,-3 , 2 ,& 
+           0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,-3 , 2 , 0 , 0 , 3 ,-2 ,& 
+           0 , 0 , 0 , 0 , 0 , 1 ,-2 , 1 , 0 ,-2 , 4 ,-2 , 0 , 1 ,-2 , 1 ,& 
+           0 , 0 , 0 , 0 , 0 , 0 ,-1 , 1 , 0 , 0 , 2 ,-2 , 0 , 0 ,-1 , 1 ,& 
+           0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ,-1 , 2 ,-1 , 0 , 1 ,-2 , 1 ,& 
+           0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 1 ,-1 , 0 , 0 ,-1 , 1 /), &
+      & (/ 16, 16 /) )
+
+      REAL(dp), DIMENSION(16) :: dl_vect
+
+      !----------------------------------------------------------------
+      ! init
+      df_coef(:)=dd_fill
+
+      dl_vect( 1: 4)=PACK(dd_value(:,:),.TRUE. )
+      dl_vect( 5: 8)=PACK(dd_dfdx(:,:),.TRUE. )
+      dl_vect( 9:12)=PACK(dd_dfdy(:,:),.TRUE. )
+      dl_vect(13:16)=PACK(dd_d2fdxy(:,:),.TRUE. )
+
+      df_coef(:)=MATMUL(dl_matrix(:,:),dl_vect(:))
+
+   END FUNCTION interp_cubic__2D_coef
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE interp_cubic__2D_fill(dd_value, id_detect, &
+         &                          dd_weight, dd_coef,  &
+         &                          dd_fill, id_rhoi, id_rhoj)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute cubic interpolation of a 2D array of value. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] dd_value  2D array of mixed grid value
+   !> @param[inout] id_detect 2D array of point to be interpolated
+   !> @param[in] dd_coef      2D array of coefficient
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[in] ld_even      even refinment or not
+   !> @param[in] id_rhoi      refinement factor in i-direction 
+   !> @param[in] id_rhoj      refinement factor in j-direction
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)        , DIMENSION(:,:), INTENT(INOUT) :: dd_value 
+      INTEGER(i4)     , DIMENSION(:,:), INTENT(INOUT) :: id_detect
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight
+      REAL(dp)        , DIMENSION(:)  , INTENT(IN   ) :: dd_coef 
+      REAL(dp)                        , INTENT(IN   ) :: dd_fill 
+      INTEGER(I4)     ,                 INTENT(IN   ) :: id_rhoi
+      INTEGER(I4)     ,                 INTENT(IN   ) :: id_rhoj
+
+      ! local variable
+
+      ! loop indices
+      INTEGER(i4) :: ii
+
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      IF( ANY( dd_coef(:)==dd_fill ) )THEN
+         CALL logger_error("INTERP CUBIC FILL: fill value detected in coef . "//&
+         &              "can not compute interpolation.")
+      ELSE
+
+         ii=0
+         DO jj=1,id_rhoj+1
+            DO ji=1,id_rhoi+1
+              
+               ii=ii+1
+               IF(id_detect(ji,jj)==1)THEN
+                  
+                  dd_value(ji,jj)=DOT_PRODUCT(dd_coef(:),dd_weight(:,ii))
+                  id_detect(ji,jj)=0
+
+               ENDIF
+
+            ENDDO
+         ENDDO
+
+      ENDIF
+
+   END SUBROUTINE interp_cubic__2D_fill
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION interp_cubic__1D_coef(dd_value, &
+         &                        dd_dfdx,  &
+         &                        dd_fill)  &
+         &  RESULT (df_coef)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute 1D array of coefficient for cubic interpolation. 
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[in] dd_value  1D array of value
+   !> @param[in] dd_dfdx   1D array of first derivative 
+   !> @param[in] dd_fill   FillValue of variable
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp), DIMENSION(:)  , INTENT(IN) :: dd_value 
+      REAL(dp), DIMENSION(:)  , INTENT(IN) :: dd_dfdx  
+      REAL(dp)                , INTENT(IN) :: dd_fill  
+
+      ! function
+      REAL(dp), DIMENSION(4)               :: df_coef
+
+      ! local variable
+      REAL(dp), DIMENSION(4,4), PARAMETER :: dl_matrix = RESHAPE( &
+      & (/  1 ,-1 ,-3 , 2 ,& 
+            0 , 1 , 3 ,-2 ,& 
+            0 , 0 ,-2 , 1 ,& 
+            0 , 0 ,-1 , 1  /), &
+      & (/ 4, 4 /) )      
+
+      REAL(dp), DIMENSION(4) :: dl_vect
+
+      !----------------------------------------------------------------
+      ! init
+      df_coef(:)=dd_fill
+
+      dl_vect( 1: 2)=PACK(dd_value(:),.TRUE. )
+      dl_vect( 3: 4)=PACK(dd_dfdx(:),.TRUE. )
+
+      df_coef(:)=MATMUL(dl_matrix(:,:),dl_vect(:))
+
+   END FUNCTION interp_cubic__1D_coef
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE interp_cubic__1D_fill(dd_value, id_detect, &
+         &                          dd_weight, dd_coef,  &
+         &                          dd_fill, id_rhoi)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute cubic interpolation of a 1D array of value. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] dd_value  1D array of mixed grid value
+   !> @param[inout] id_detect 1D array of point to be interpolated
+   !> @param[in] dd_coef      1D array of coefficient
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[in] ld_even      even refinment or not
+   !> @param[in] id_rho       refinement factor 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)        , DIMENSION(:)  , INTENT(INOUT) :: dd_value 
+      INTEGER(i4)     , DIMENSION(:)  , INTENT(INOUT) :: id_detect
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight 
+      REAL(dp)        , DIMENSION(4)  , INTENT(IN   ) :: dd_coef 
+      REAL(dp)                        , INTENT(IN   ) :: dd_fill 
+      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoi
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( ANY( dd_coef(:)==dd_fill ) )THEN
+         CALL logger_error("INTERP CUBIC FILL: fill value detected. "//&
+         &              "can not compute interpolation")
+      ELSE
+
+         DO ji=1,id_rhoi+1
+            
+            IF(id_detect(ji)==1)THEN
+
+               dd_value(ji)=DOT_PRODUCT(dd_coef(:),dd_weight(:,ji))
+               id_detect(ji)=0
+
+            ENDIF
+
+         ENDDO
+
+      ENDIF
+
+   END SUBROUTINE interp_cubic__1D_fill
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE interp_cubic__get_weight2D(dd_weight, &
+         &                               id_rho, ld_even)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute interpoaltion weight for 2D array. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[in] dd_weight interpolation weight of 2D array
+   !> @param[in] ld_even   even refinment or not
+   !> @param[in] id_rho    refinement factor 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)   , DIMENSION(:,:), INTENT(INOUT) :: dd_weight
+      INTEGER(I4), DIMENSION(:)  , INTENT(IN   ) :: id_rho
+      LOGICAL    , DIMENSION(:)  , INTENT(IN   ) :: ld_even
+
+      ! local variable
+      REAL(dp)                  :: dl_dx
+      REAL(dp)                  :: dl_x      
+      REAL(dp)                  :: dl_x2
+      REAL(dp)                  :: dl_x3
+      REAL(dp)                  :: dl_dy
+      REAL(dp)                  :: dl_y      
+      REAL(dp)                  :: dl_y2
+      REAL(dp)                  :: dl_y3
+      
+      ! loop indices
+      INTEGER(i4) :: ii 
+      INTEGER(i4) :: ji 
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+      
+      IF( ld_even(jp_I) )THEN
+         dl_dx=1./REAL(id_rho(jp_I)-1)
+      ELSE ! odd refinement
+         dl_dx=1./REAL(id_rho(jp_I))
+      ENDIF
+
+      IF( ld_even(jp_J) )THEN
+         dl_dy=1./REAL(id_rho(jp_J)-1)
+      ELSE ! odd refinement
+         dl_dy=1./REAL(id_rho(jp_J))
+      ENDIF
+
+      ii=0
+      DO jj=1,id_rho(jp_J)+1
+
+         IF( ld_even(jp_J) )THEN
+            dl_y=(jj-1)*dl_dy - dl_dy*0.5 
+         ELSE ! odd refinement
+            dl_y=(jj-1)*dl_dy 
+         ENDIF
+         dl_y2=dl_y*dl_y
+         dl_y3=dl_y2*dl_y
+
+         DO ji=1,id_rho(jp_I)+1
+
+            ! iter
+            ii=ii+1
+
+            IF( ld_even(jp_I) )THEN
+               dl_x=(ji-1)*dl_dx - dl_dx*0.5 
+            ELSE ! odd refinement
+               dl_x=(ji-1)*dl_dx 
+            ENDIF
+            dl_x2=dl_x*dl_x
+            dl_x3=dl_x2*dl_x
+
+            dd_weight(:,ii)=(/1._dp, dl_x      , dl_x2      , dl_x3      , &
+            &                 dl_y , dl_x*dl_y , dl_x2*dl_y , dl_x3*dl_y , &
+            &                 dl_y2, dl_x*dl_y2, dl_x2*dl_y2, dl_x3*dl_y2, &
+            &                 dl_y3, dl_x*dl_y3, dl_x2*dl_y3, dl_x3*dl_y3 /)
+
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE interp_cubic__get_weight2D
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE interp_cubic__get_weight1D(dd_weight, &
+         &                               id_rho, ld_even)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute interpoaltion weight for 1D array. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[in] dd_weight interpolation weight of 1D array
+   !> @param[in] ld_even   even refinment or not
+   !> @param[in] id_rho    refinement factor 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)   , DIMENSION(:,:), INTENT(INOUT) :: dd_weight
+      INTEGER(I4)                , INTENT(IN   ) :: id_rho
+      LOGICAL                    , INTENT(IN   ) :: ld_even
+
+      ! local variable
+      REAL(dp)                  :: dl_dx
+      REAL(dp)                  :: dl_x      
+      REAL(dp)                  :: dl_x2
+      REAL(dp)                  :: dl_x3
+
+      ! loop indices
+      INTEGER(i4) :: ji   
+      !----------------------------------------------------------------
+      
+      IF( ld_even )THEN
+         dl_dx=1./REAL(id_rho-1)
+      ELSE ! odd refinement
+         dl_dx=1./REAL(id_rho)
+      ENDIF
+
+      DO ji=1,id_rho+1
+         IF( ld_even )THEN
+            dl_x=(ji-1)*dl_dx - dl_dx*0.5 
+         ELSE ! odd refinement
+            dl_x=(ji-1)*dl_dx 
+         ENDIF
+         dl_x2=dl_x*dl_x
+         dl_x3=dl_x2*dl_x
+
+         dd_weight(:,ji)=(/1._dp, dl_x, dl_x2, dl_x3 /)
+      ENDDO
+
+   END SUBROUTINE interp_cubic__get_weight1D
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE interp_cubic
Index: /utils/tools_ticket2413/SIREN/src/interp_linear.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/interp_linear.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/interp_linear.f90	(revision 12863)
@@ -0,0 +1,735 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief 
+!> This module manage linear interpolation on regular grid.
+!>
+!> @details
+!> to compute linear interpolation:<br/>
+!> @code
+!> CALL interp_linear_fill(dd_value, dd_fill, id_detect, id_rho, ld_even [,ld_discont] )
+!> @endcode
+!>    - dd_value is 2D array of variable value 
+!>    - dd_fill is the FillValue of variable
+!>    - id_detect is 2D array of point to be interpolated (see interp module) 
+!>    - id_rho  is array of refinment factor
+!>    - ld_even indicates even refinment or not 
+!>    - ld_discont indicates longitudinal discontinuity (-180°/180°, 0°/360°) or not
+!>
+!> @author
+!> J.Paul
+!>
+!> @date September, 2014 - Initial version
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE interp_linear
+
+   USE netcdf                          ! nf90 library
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+   USE extrap                          ! extrapolation manager
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+
+   ! function and subroutine
+   PUBLIC :: interp_linear_fill  !< compute interpolation using linear method
+
+   PRIVATE :: interp_linear__2D           !< compute bilinear interpolation on 2D gid
+   PRIVATE :: interp_linear__1D           !< compute   linear interpolation on 1D gid
+   PRIVATE :: interp_linear__2D_coef      !< compute coefficient for bilinear interpolation
+   PRIVATE :: interp_linear__2D_fill      !< fill value using bilinear interpolation
+   PRIVATE :: interp_linear__1D_coef      !< compute coefficient for   linear interpolation
+   PRIVATE :: interp_linear__1D_fill      !< fill value using   linear interpolation
+   PRIVATE :: interp_linear__get_weight2D !< compute interpoaltion weight for 2D array.
+   PRIVATE :: interp_linear__get_weight1D !< compute interpoaltion weight for 1D array.
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE interp_linear_fill(dd_value, dd_fill, id_detect, &
+         &                       id_rho, ld_even, ld_discont)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute horizontal linear interpolation on 4D array of value. 
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !> @date July, 2015 - reinitialise detect array for each level
+   !>
+   !> @param[inout] dd_value  2D array of variable value 
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[inout] id_detect 2D array of point to be interpolated 
+   !> @param[in] id_rho       array of refinment factor
+   !> @param[in] ld_even      even refinment or not 
+   !> @param[in] ld_discont   longitudinal discontinuity (-180°/180°, 0°/360°) or not
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)        , DIMENSION(:,:,:,:), INTENT(INOUT) :: dd_value 
+      REAL(dp)                            , INTENT(IN   ) :: dd_fill 
+      INTEGER(I4)     , DIMENSION(:,:,:)  , INTENT(INOUT) :: id_detect
+      INTEGER(I4)     , DIMENSION(:)      , INTENT(IN   ) :: id_rho
+      LOGICAL         , DIMENSION(:)      , INTENT(IN   ) :: ld_even
+      LOGICAL                             , INTENT(IN   ), OPTIONAL :: ld_discont
+
+      ! local variable
+      INTEGER(i4), DIMENSION(4)                  :: il_shape
+
+      INTEGER(I4), DIMENSION(:,:,:), ALLOCATABLE :: il_detect
+
+      LOGICAL                                    :: ll_discont
+ 
+      REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_IJ
+      REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_I
+      REAL(dp)   , DIMENSION(:,:)  , ALLOCATABLE :: dl_weight_J
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+      ll_discont=.FALSE.
+      IF( PRESENT(ld_discont) ) ll_discont=ld_discont
+
+      il_shape(:)=SHAPE(dd_value)
+
+      ! compute vect2D
+      ALLOCATE(dl_weight_IJ(4,((id_rho(jp_I)+1)*(id_rho(jp_J)+1))) )
+      CALL interp_linear__get_weight2D(dl_weight_IJ(:,:), &
+      &                               id_rho(:), ld_even(:))
+
+      ALLOCATE( dl_weight_I( 2,((id_rho(jp_I)+1)                 )) )
+      ALLOCATE( dl_weight_J( 2,(                 (id_rho(jp_J)+1))) )
+      CALL interp_linear__get_weight1D(dl_weight_I(:,:), &
+      &                               id_rho(jp_I), ld_even(jp_I))
+      CALL interp_linear__get_weight1D(dl_weight_J(:,:), &
+      &                               id_rho(jp_J), ld_even(jp_J))
+
+      ALLOCATE(il_detect(il_shape(1),il_shape(2),il_shape(3)))
+
+      DO jl=1,il_shape(4)
+         il_detect(:,:,:)=id_detect(:,:,:)
+         ! loop on vertical level
+         DO jk=1,il_shape(3)
+
+            ! I-J plan
+            CALL interp_linear__2D(dd_value(:,:,jk,jl), dd_fill,&
+            &                     il_detect(:,:,jk),            &
+            &                     dl_weight_IJ(:,:),            &
+            &                     id_rho(jp_I), id_rho(jp_J),   &
+            &                     ll_discont)            
+            IF( ANY(il_detect(:,:,jk)==1) )THEN
+               ! I direction
+               DO jj=1,il_shape(2)
+                  CALL interp_linear__1D( dd_value(:,jj,jk,jl), dd_fill,&
+                  &                       il_detect(:,jj,jk),           &
+                  &                       dl_weight_I(:,:),             &
+                  &                       id_rho(jp_I), ll_discont )
+               ENDDO
+               IF( ALL(il_detect(:,:,jk)==0) )THEN
+                  CYCLE
+               ELSE
+                  ! J direction
+                  DO ji=1,il_shape(1)
+                     CALL interp_linear__1D( dd_value(ji,:,jk,jl), dd_fill,&
+                     &                       il_detect(ji,:,jk),           &
+                     &                       dl_weight_J(:,:),             &
+                     &                       id_rho(jp_J), ll_discont )
+                  ENDDO
+               ENDIF
+            ENDIF
+
+         ENDDO
+      ENDDO
+
+      id_detect(:,:,:)=il_detect(:,:,:)
+      DEALLOCATE(il_detect)
+
+      DEALLOCATE(dl_weight_IJ)
+      DEALLOCATE(dl_weight_I)
+      DEALLOCATE(dl_weight_J)
+ 
+   END SUBROUTINE interp_linear_fill
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE interp_linear__2D(dd_value,  dd_fill,   &
+         &                      id_detect,            &
+         &                      dd_weight,            &
+         &                      id_rhoi, id_rhoj,     &
+         &                      ld_discont)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute linear interpolation on 2D array of value. 
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] dd_value  2D array of variable value 
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[inout] id_detect 2D array of point to be interpolated 
+   !> @param[in] id_rhoi      refinment factor in i-direction
+   !> @param[in] id_rhoj      refinment factor in j-direction
+   !> @param[in] id_rhok      refinment factor in k-direction
+   !> @param[in] ld_even      even refinment or not 
+   !> @param[in] ld_discont   longitudinal discontinuity (-180°/180°, 0°/360°) or not
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)        , DIMENSION(:,:), INTENT(INOUT) :: dd_value 
+      REAL(dp)                        , INTENT(IN   ) :: dd_fill 
+      INTEGER(I4)     , DIMENSION(:,:), INTENT(INOUT) :: id_detect
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight
+      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoi
+      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoj
+      LOGICAL                         , INTENT(IN   ) :: ld_discont
+
+      ! local variable
+      INTEGER(I4)                              :: il_xextra
+      INTEGER(I4)                              :: il_yextra
+      INTEGER(i4), DIMENSION(2)                :: il_shape
+      INTEGER(i4), DIMENSION(2)                :: il_dim
+
+      REAL(dp)                                 :: dl_min 
+      REAL(dp)                                 :: dl_max 
+      REAL(dp)   , DIMENSION(:)  , ALLOCATABLE :: dl_coef
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_coarse
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: ii
+      INTEGER(i4) :: ij
+
+      !----------------------------------------------------------------
+
+      IF( ANY(id_detect(:,:)==1) )THEN
+         il_shape(:)=SHAPE(dd_value)
+
+         ! compute coarse grid dimension
+         il_xextra=id_rhoi-1
+         il_dim(1)=(il_shape(1)+il_xextra)/id_rhoi
+
+         il_yextra=id_rhoj-1
+         il_dim(2)=(il_shape(2)+il_yextra)/id_rhoj
+
+         ALLOCATE( dl_coarse(il_dim(1),il_dim(2)) )
+
+         ! value on coarse grid
+         dl_coarse(:,:)=dd_value( 1:il_shape(1):id_rhoi, &
+         &                        1:il_shape(2):id_rhoj )
+
+         ALLOCATE( dl_tmp(2,2) )
+         ALLOCATE( dl_coef(4) )
+
+         DO jj=1,il_shape(2)-1,id_rhoj
+            ij=((jj-1)/id_rhoj)+1
+            DO ji=1,il_shape(1)-1,id_rhoi
+               ii=((ji-1)/id_rhoi)+1
+         
+               ! check if point to be interpolated
+               IF( ALL(id_detect(ji:ji+id_rhoi,   &
+               &                 jj:jj+id_rhoj)==0) ) CYCLE
+               ! check data needed to interpolate
+               IF( ANY(dl_coarse(ii:ii+1,ij:ij+1)==dd_fill) ) CYCLE
+               ! check longitude discontinuity
+               dl_tmp(:,:)=dl_coarse(ii:ii+1,ij:ij+1)
+               IF( ld_discont )THEN
+
+                  dl_min=MINVAL( dl_tmp(:,:), dl_tmp(:,:)/=dd_fill )
+                  dl_max=MAXVAL( dl_tmp(:,:), dl_tmp(:,:)/=dd_fill )
+                  IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                     WHERE( dl_tmp(:,:) < 0_dp ) 
+                        dl_tmp(:,:) = dl_tmp(:,:)+360._dp
+                     END WHERE
+                  ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                     WHERE( dl_tmp(:,:) > 180_dp ) 
+                        dl_tmp(:,:) = dl_tmp(:,:)-180._dp
+                     END WHERE
+                  ENDIF
+
+               ENDIF
+
+               ! compute bilinear coefficient
+               dl_coef(:)=interp_linear__2D_coef(dl_tmp(:,:),&
+               &                                 dd_fill )
+
+               ! compute value on detetected point
+               CALL interp_linear__2D_fill(dd_value( ji:ji+id_rhoi,   &
+               &                                     jj:jj+id_rhoj ), &
+               &                           id_detect(ji:ji+id_rhoi,   &
+               &                                     jj:jj+id_rhoj ), &
+               &                           dd_weight(:,:), dl_coef(:),&
+               &                           dd_fill, id_rhoi, id_rhoj )
+
+               IF( ld_discont )THEN
+                  WHERE( dd_value( ji:ji+id_rhoi, &
+                     &             jj:jj+id_rhoj ) >= 180._dp .AND. &
+                     &   dd_value( ji:ji+id_rhoi, &
+                     &             jj:jj+id_rhoj ) /= dd_fill )
+                     dd_value( ji:ji+id_rhoi, &
+                     &         jj:jj+id_rhoj ) = &
+                     &           dd_value( ji:ji+id_rhoi, &
+                     &                     jj:jj+id_rhoj ) - 360._dp
+                  END WHERE
+               ENDIF
+
+            ENDDO
+         ENDDO
+
+         DEALLOCATE(dl_coef)
+         DEALLOCATE(dl_tmp )
+
+         DEALLOCATE( dl_coarse )
+      ENDIF
+
+   END SUBROUTINE interp_linear__2D
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE interp_linear__1D(dd_value,  dd_fill,   &
+         &                      id_detect,            &
+         &                      dd_weight,            &
+         &                      id_rhoi,              &
+         &                      ld_discont)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute linear interpolation on 1D array of value. 
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] dd_value  1D array of variable value 
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[inout] id_detect 1D array of point to be interpolated 
+   !> @param[in] id_rhoi      refinment factor
+   !> @param[in] ld_even      even refinment or not 
+   !> @param[in] ld_discont   longitudinal discontinuity (-180°/180°, 0°/360°) or not
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)        , DIMENSION(:)  , INTENT(INOUT) :: dd_value 
+      REAL(dp)                        , INTENT(IN   ) :: dd_fill 
+      INTEGER(I4)     , DIMENSION(:)  , INTENT(INOUT) :: id_detect
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight
+      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoi
+      LOGICAL                         , INTENT(IN   ) :: ld_discont
+
+      ! local variable
+      INTEGER(I4)                            :: il_xextra
+      INTEGER(i4), DIMENSION(1)              :: il_shape
+      INTEGER(i4), DIMENSION(1)              :: il_dim
+
+      REAL(dp)                               :: dl_min 
+      REAL(dp)                               :: dl_max 
+      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_coef
+      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_coarse
+      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: ii
+
+      !----------------------------------------------------------------
+
+      IF( ANY(id_detect(:)==1) )THEN
+         il_shape(:)=SHAPE(dd_value)
+
+         ! compute coarse grid dimension
+         il_xextra=id_rhoi-1
+         il_dim(1)=(il_shape(1)+il_xextra)/id_rhoi
+
+         ALLOCATE( dl_coarse(il_dim(1)) )
+
+         ! value on coarse grid
+         dl_coarse(:)=dd_value( 1:il_shape(1):id_rhoi )
+
+         ALLOCATE( dl_tmp(2) )
+         ALLOCATE( dl_coef(4) )
+
+         DO ji=1,il_shape(1)-1,id_rhoi
+            ii=((ji-1)/id_rhoi)+1
+         
+            ! check if point to be interpolated
+            IF( ALL(id_detect(ji:ji+id_rhoi)==0) ) CYCLE
+            ! check data needed to interpolate
+            IF( ANY(dl_coarse(ii:ii+1)==dd_fill) ) CYCLE
+            ! check longitude discontinuity
+            dl_tmp(:)=dl_coarse(ii:ii+1)
+            IF( ld_discont )THEN
+
+               dl_min=MINVAL( dl_tmp(:), dl_tmp(:)/=dd_fill )
+               dl_max=MAXVAL( dl_tmp(:), dl_tmp(:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_tmp(:) < 0_dp ) 
+                     dl_tmp(:) = dl_tmp(:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_tmp(:) > 180_dp ) 
+                     dl_tmp(:) = dl_tmp(:)-180._dp
+                  END WHERE
+               ENDIF
+
+            ENDIF
+
+            ! compute bilinear coefficient
+            dl_coef(:)=interp_linear__1D_coef(dl_tmp(:),       &
+            &                                 dd_fill )
+
+            ! compute value on detetected point
+            CALL interp_linear__1D_fill( dd_value( ji:ji+id_rhoi ), &
+            &                            id_detect(ji:ji+id_rhoi ), &
+            &                            dd_weight(:,:), dl_coef(:),&
+            &                            dd_fill, id_rhoi )
+
+            IF( ld_discont )THEN
+               WHERE( dd_value( ji:ji+id_rhoi ) >= 180._dp .AND. &
+                  &   dd_value( ji:ji+id_rhoi ) /= dd_fill )
+                  dd_value(ji:ji+id_rhoi) = dd_value(ji:ji+id_rhoi) - 360._dp
+               END WHERE
+            ENDIF
+
+         ENDDO
+
+         DEALLOCATE(dl_coef)
+         DEALLOCATE(dl_tmp )
+
+         DEALLOCATE( dl_coarse )
+      ENDIF
+
+   END SUBROUTINE interp_linear__1D
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION interp_linear__2D_coef(dd_value, dd_fill) &
+         & RESULT (df_coef)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute 2D array of coefficient for linear interpolation. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[in] dd_value  2D array of value
+   !> @param[in] dd_fill   FillValue of variable
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp), DIMENSION(:,:)  , INTENT(IN) :: dd_value 
+      REAL(dp)                  , INTENT(IN) :: dd_fill 
+
+      ! function
+      REAL(dp), DIMENSION(4)                 :: df_coef
+
+      ! local variable
+      REAL(dp), DIMENSION(4,4), PARAMETER :: dl_matrix = RESHAPE( &
+      & (/  1 ,-1 ,-1 , 1 ,& 
+            0 , 1 , 0 ,-1 ,& 
+            0 , 0 , 1 ,-1 ,& 
+            0 , 0 , 0 , 1 /), &
+      & (/ 4, 4 /) )
+
+      REAL(dp), DIMENSION(4) :: dl_vect
+
+      !----------------------------------------------------------------
+      ! init
+      df_coef(:)=dd_fill
+
+      dl_vect( 1: 4)=PACK(dd_value(:,:),.TRUE. )
+      df_coef(:)=MATMUL(dl_matrix(:,:),dl_vect(:))
+
+   END FUNCTION interp_linear__2D_coef
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE interp_linear__2D_fill(dd_value, id_detect, &
+         &                           dd_weight, dd_coef,  &
+         &                           dd_fill, id_rhoi, id_rhoj)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute linear interpolation of a 2D array of value. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] dd_value  2D array of mixed grid value
+   !> @param[inout] id_detect 2D array of point to be interpolated
+   !> @param[in] dd_coef      2D array of coefficient
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[in] ld_even      even refinment or not
+   !> @param[in] id_rhoi      refinement factor in i-direction 
+   !> @param[in] id_rhoj      refinement factor in j-direction
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)        , DIMENSION(:,:), INTENT(INOUT) :: dd_value 
+      INTEGER(i4)     , DIMENSION(:,:), INTENT(INOUT) :: id_detect
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight
+      REAL(dp)        , DIMENSION(:)  , INTENT(IN   ) :: dd_coef 
+      REAL(dp)                        , INTENT(IN   ) :: dd_fill 
+      INTEGER(I4)     ,                 INTENT(IN   ) :: id_rhoi
+      INTEGER(I4)     ,                 INTENT(IN   ) :: id_rhoj
+
+      ! local variable
+
+      ! loop indices
+      INTEGER(i4) :: ii
+
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      IF( ANY( dd_coef(:)==dd_fill ) )THEN
+         CALL logger_error("INTERP LINEAR FILL: fill value detected in coef. "//&
+         &              "can not compute interpolation.")
+      ELSE
+
+         ii=0
+         DO jj=1,id_rhoj+1
+            DO ji=1,id_rhoi+1
+
+               ii=ii+1
+               IF(id_detect(ji,jj)==1)THEN
+
+                  dd_value(ji,jj)=DOT_PRODUCT(dd_coef(:),dd_weight(:,ii))
+                  id_detect(ji,jj)=0
+
+               ENDIF
+
+            ENDDO
+         ENDDO
+
+      ENDIF
+
+   END SUBROUTINE interp_linear__2D_fill
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION interp_linear__1D_coef(dd_value, dd_fill) &
+         & RESULT (df_coef)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute 1D array of coefficient for linear interpolation. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[in] dd_value  1D array of value
+   !> @param[in] dd_fill   FillValue of variable
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp), DIMENSION(:)  , INTENT(IN) :: dd_value 
+      REAL(dp)                , INTENT(IN) :: dd_fill  
+
+      ! function
+      REAL(dp), DIMENSION(2)               :: df_coef
+
+      ! local variable
+      REAL(dp), DIMENSION(2,2), PARAMETER :: dl_matrix = RESHAPE( &
+      & (/  1 ,-1 ,& 
+            0 , 1  /), &
+      &  (/ 2, 2 /) )
+
+      REAL(dp), DIMENSION(2) :: dl_vect
+
+      !----------------------------------------------------------------
+      ! init
+      df_coef(:)=dd_fill
+
+      dl_vect( 1: 2)=PACK(dd_value(:),.TRUE. )
+      df_coef(:)=MATMUL(dl_matrix(:,:),dl_vect(:))
+
+   END FUNCTION interp_linear__1D_coef
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE interp_linear__1D_fill(dd_value, id_detect, &
+         &                           dd_weight, dd_coef,  &
+         &                           dd_fill, id_rho)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute linear interpolation of a 1D array of value. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !> 
+   !> @param[inout] dd_value  1D array of mixed grid value
+   !> @param[inout] id_detect 1D array of point to be interpolated
+   !> @param[in] dd_coef      1D array of coefficient
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[in] ld_even      even refinment or not
+   !> @param[in] id_rho       refinement factor
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)        , DIMENSION(:)  , INTENT(INOUT) :: dd_value 
+      INTEGER(i4)     , DIMENSION(:)  , INTENT(INOUT) :: id_detect
+      REAL(dp)        , DIMENSION(:,:), INTENT(IN   ) :: dd_weight
+      REAL(dp)        , DIMENSION(:)  , INTENT(IN   ) :: dd_coef 
+      REAL(dp)                        , INTENT(IN   ) :: dd_fill 
+      INTEGER(I4)                     , INTENT(IN   ) :: id_rho      
+
+      ! local variable
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( ANY( dd_coef(:)==dd_fill ) )THEN
+         CALL logger_error("INTERP LINEAR FILL: fill value detected. "//&
+         &              "can not compute interpolation")
+      ELSE
+
+         DO ji=1,id_rho+1
+            
+            IF(id_detect(ji)==1)THEN
+
+               dd_value(ji)=DOT_PRODUCT(dd_coef(:),dd_weight(:,ji))
+               id_detect(ji)=0
+
+            ENDIF
+
+         ENDDO
+
+      ENDIF
+
+   END SUBROUTINE interp_linear__1D_fill
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE interp_linear__get_weight2D(dd_weight, id_rho, ld_even)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute interpoaltion weight for 2D array. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[in] dd_weight interpolation weight of 2D array
+   !> @param[in] ld_even   even refinment or not
+   !> @param[in] id_rho    refinement factor 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+
+      REAL(dp)   , DIMENSION(:,:), INTENT(INOUT) :: dd_weight
+      INTEGER(I4), DIMENSION(:)  , INTENT(IN   ) :: id_rho
+      LOGICAL    , DIMENSION(:)  , INTENT(IN   ) :: ld_even
+
+      ! local variable
+      REAL(dp)                  :: dl_dx
+      REAL(dp)                  :: dl_x      
+      REAL(dp)                  :: dl_dy
+      REAL(dp)                  :: dl_y      
+      
+      ! loop indices
+      INTEGER(i4) :: ii 
+
+      INTEGER(i4) :: ji 
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+      
+      IF( ld_even(jp_I) )THEN
+         dl_dx=1._dp/REAL(id_rho(jp_I)-1,dp)
+      ELSE ! odd refinement
+         dl_dx=1._dp/REAL(id_rho(jp_I),dp)
+      ENDIF
+
+      IF( ld_even(jp_J) )THEN
+         dl_dy=1._dp/REAL(id_rho(jp_J)-1,dp)
+      ELSE ! odd refinement
+         dl_dy=1._dp/REAL(id_rho(jp_J),dp)
+      ENDIF
+
+      ii=0
+      DO jj=1,id_rho(jp_J)+1
+
+         IF( ld_even(jp_J) )THEN
+            dl_y=REAL(jj-1,dp)*dl_dy - dl_dy*0.5_dp
+         ELSE ! odd refinement
+            dl_y=REAL(jj-1,dp)*dl_dy 
+         ENDIF
+
+         DO ji=1,id_rho(jp_I)+1
+
+            ! iter
+            ii=ii+1
+
+            IF( ld_even(jp_I) )THEN
+               dl_x=REAL(ji-1,dp)*dl_dx - dl_dx*0.5_dp 
+            ELSE ! odd refinement
+               dl_x=REAL(ji-1,dp)*dl_dx 
+            ENDIF
+
+            dd_weight(:,ii)=(/1._dp, dl_x, dl_y, dl_x*dl_y /)
+
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE interp_linear__get_weight2D
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE interp_linear__get_weight1D(dd_weight, id_rho, ld_even)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute interpoaltion weight for 1D array. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[in] dd_weight interpolation weight of 1D array
+   !> @param[in] ld_even   even refinment or not
+   !> @param[in] id_rho    refinement factor 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)   , DIMENSION(:,:), INTENT(INOUT) :: dd_weight
+      INTEGER(I4)                , INTENT(IN   ) :: id_rho
+      LOGICAL                    , INTENT(IN   ) :: ld_even
+
+      ! local variable
+      REAL(dp)                  :: dl_dx
+      REAL(dp)                  :: dl_x      
+
+      ! loop indices
+      INTEGER(i4) :: ji   
+      !----------------------------------------------------------------
+      
+      IF( ld_even )THEN
+         dl_dx=1._dp/REAL(id_rho-1,dp)
+      ELSE ! odd refinement
+         dl_dx=1._dp/REAL(id_rho,dp)
+      ENDIF
+
+      DO ji=1,id_rho+1
+         IF( ld_even )THEN
+            dl_x=REAL(ji-1,dp)*dl_dx - dl_dx*0.5_dp 
+         ELSE ! odd refinement
+            dl_x=REAL(ji-1,dp)*dl_dx 
+         ENDIF
+
+         dd_weight(:,ji)=(/1._dp, dl_x /)
+      ENDDO
+
+   END SUBROUTINE interp_linear__get_weight1D
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE interp_linear
Index: /utils/tools_ticket2413/SIREN/src/interp_nearest.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/interp_nearest.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/interp_nearest.f90	(revision 12863)
@@ -0,0 +1,369 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief 
+!> This module manage nearest interpolation on regular grid.
+!>
+!> @details
+!> to compute nearest interpolation:<br/>
+!> @code
+!> CALL interp_nearest_fill(dd_value, dd_fill, id_detect, id_rho, ld_even [,ld_discont] )
+!> @endcode
+!>    - dd_value is 2D array of variable value 
+!>    - dd_fill is the FillValue of variable
+!>    - id_detect is 2D array of point to be interpolated (see interp module) 
+!>    - id_rho  is array of refinment factor
+!>    - ld_even indicates even refinment or not 
+!>    - ld_discont indicates longitudinal discontinuity (-180°/180°, 0°/360°) or not
+!>
+!> @author
+!> J.Paul
+!>
+!> @date September, 2014 - Initial version
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE interp_nearest
+
+   USE netcdf                          ! nf90 library
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+
+   ! function and subroutine
+   PUBLIC :: interp_nearest_fill  !< compute interpolation using nearest method
+
+   PRIVATE :: interp_nearest__2D       !< compute binearest interpolation on 2D gid
+   PRIVATE :: interp_nearest__1D       !< compute   nearest interpolation on 1D gid
+   PRIVATE :: interp_nearest__2D_fill  !< fill value using binearest interpolation
+   PRIVATE :: interp_nearest__1D_fill  !< fill value using   nearest interpolation
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE interp_nearest_fill(dd_value, id_detect, id_rho)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute horizontal nearest interpolation on 4D array of value. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] dd_value  2D array of variable value 
+   !> @param[inout] id_detect 2D array of point to be interpolated 
+   !> @param[in]    id_rho    array of refinment factor
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)        , DIMENSION(:,:,:,:), INTENT(INOUT) :: dd_value 
+      INTEGER(I4)     , DIMENSION(:,:,:)  , INTENT(INOUT) :: id_detect
+      INTEGER(I4)     , DIMENSION(:)      , INTENT(IN   ) :: id_rho
+
+      ! local variable
+      INTEGER(i4), DIMENSION(4)                  :: il_shape
+
+      INTEGER(I4), DIMENSION(:,:,:), ALLOCATABLE :: il_detect
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      il_shape(:)=SHAPE(dd_value)
+
+      ALLOCATE(il_detect(il_shape(1),il_shape(2),il_shape(3)))
+      DO jl=1,il_shape(4)
+         il_detect(:,:,:)=id_detect(:,:,:)
+         ! loop on vertical level
+         DO jk=1,il_shape(3)
+
+            ! I-J plan
+            CALL interp_nearest__2D(dd_value(:,:,jk,jl),&
+            &                       il_detect(:,:,jk),  &
+            &                       id_rho(jp_I), id_rho(jp_J) )            
+            IF( ANY(il_detect(:,:,jk)==1) )THEN
+               ! I direction
+               DO jj=1,il_shape(2)
+                  CALL interp_nearest__1D( dd_value(:,jj,jk,jl),&
+                  &                        il_detect(:,jj,jk),  &
+                  &                        id_rho(jp_I) )
+               ENDDO
+               IF( ALL(il_detect(:,:,jk)==0) )THEN
+                  CYCLE
+               ELSE
+                  ! J direction
+                  DO ji=1,il_shape(1)
+                     CALL interp_nearest__1D( dd_value(ji,:,jk,jl),&
+                     &                        il_detect(ji,:,jk),  &
+                     &                        id_rho(jp_J) )
+                  ENDDO
+               ENDIF
+            ENDIF
+
+         ENDDO
+      ENDDO
+
+      id_detect(:,:,:)=il_detect(:,:,:)
+      DEALLOCATE(il_detect)
+
+   END SUBROUTINE interp_nearest_fill
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE interp_nearest__2D(dd_value, id_detect, id_rhoi, id_rhoj)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute nearest interpolation on 2D array of value. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] dd_value  2D array of variable value 
+   !> @param[inout] id_detect 2D array of point to be interpolated 
+   !> @param[in] id_rhoi      refinment factor in i-direction
+   !> @param[in] id_rhoj      refinment factor in j-direction
+   !> @param[in] id_rhok      refinment factor in k-direction
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)        , DIMENSION(:,:), INTENT(INOUT) :: dd_value 
+      INTEGER(I4)     , DIMENSION(:,:), INTENT(INOUT) :: id_detect
+      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoi
+      INTEGER(I4)                     , INTENT(IN   ) :: id_rhoj
+
+      ! local variable
+      INTEGER(i4), DIMENSION(2)                :: il_shape
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+
+      !----------------------------------------------------------------
+
+      IF( ANY(id_detect(:,:)==1) )THEN
+
+         il_shape(:)=SHAPE(dd_value)
+
+         DO jj=1,il_shape(2)-1,id_rhoj
+            DO ji=1,il_shape(1)-1,id_rhoi
+         
+               ! check if point to be interpolated
+               IF( ALL(id_detect(ji:ji+id_rhoi,   &
+               &                 jj:jj+id_rhoj)==0) ) CYCLE
+
+               ! compute value on detetected point
+               CALL interp_nearest__2D_fill(dd_value( ji:ji+id_rhoi,   &
+               &                                      jj:jj+id_rhoj ), &
+               &                            id_detect(ji:ji+id_rhoi,   &
+               &                                      jj:jj+id_rhoj ) )
+
+            ENDDO
+         ENDDO
+
+      ENDIF
+
+   END SUBROUTINE interp_nearest__2D
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE interp_nearest__1D(dd_value, id_detect, id_rhoi)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute nearest interpolation on 1D array of value. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] dd_value  1D array of variable value 
+   !> @param[inout] id_detect 1D array of point to be interpolated 
+   !> @param[in]    id_rhoi   refinment factor
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)        , DIMENSION(:), INTENT(INOUT) :: dd_value 
+      INTEGER(I4)     , DIMENSION(:), INTENT(INOUT) :: id_detect
+      INTEGER(I4)                   , INTENT(IN   ) :: id_rhoi
+
+      ! local variable
+      INTEGER(i4), DIMENSION(1)              :: il_shape
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( ANY(id_detect(:)==1) )THEN
+         il_shape(:)=SHAPE(dd_value)
+
+         DO ji=1,il_shape(1)-1,id_rhoi
+         
+            ! check if point to be interpolated
+            IF( ALL(id_detect(ji:ji+id_rhoi)==0) ) CYCLE
+
+            ! compute value on detetected point
+            CALL interp_nearest__1D_fill( dd_value( ji:ji+id_rhoi ), &
+            &                             id_detect(ji:ji+id_rhoi ) )
+
+         ENDDO
+
+      ENDIF
+
+   END SUBROUTINE interp_nearest__1D
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE interp_nearest__2D_fill(dd_value, id_detect)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute nearest interpolation of a 2D array of value. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] dd_value  2D array of mixed grid value
+   !> @param[inout] id_detect 2D array of point to be interpolated
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)   , DIMENSION(:,:)  , INTENT(INOUT) :: dd_value 
+      INTEGER(i4), DIMENSION(:,:)  , INTENT(INOUT) :: id_detect
+
+      ! local variable
+      INTEGER(i4), DIMENSION(2) :: il_shape
+
+      INTEGER(i4) :: il_i1
+      INTEGER(i4) :: il_i2
+      INTEGER(i4) :: il_j1
+      INTEGER(i4) :: il_j2
+
+      INTEGER(i4) :: il_half1
+      INTEGER(i4) :: il_half2
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      il_shape(:)=SHAPE(dd_value(:,:))
+
+      il_i1=1
+      il_i2=il_shape(1)
+
+      il_j1=1
+      il_j2=il_shape(2)
+
+      il_half1=CEILING(il_shape(1)*0.5)
+      il_half2=CEILING(il_shape(2)*0.5)
+
+      DO jj=1,il_half2
+
+         DO ji=1,il_half1
+            
+            ! lower left point
+            IF(id_detect(ji,jj)==1)THEN
+
+               dd_value( ji,jj)=dd_value(il_i1,il_j1)
+               id_detect(ji,jj)=0
+
+            ENDIF
+
+            ! lower right point
+            IF(id_detect(il_shape(1)-ji+1,jj)==1)THEN
+
+               dd_value( il_shape(1)-ji+1,jj)=dd_value(il_i2,il_j1)
+               id_detect(il_shape(1)-ji+1,jj)=0
+
+            ENDIF
+
+            ! upper left point
+            IF(id_detect(ji,il_shape(2)-jj+1)==1)THEN
+
+               dd_value( ji,il_shape(2)-jj+1)=dd_value(il_i1,il_j2)
+               id_detect(ji,il_shape(2)-jj+1)=0
+
+            ENDIF            
+
+            ! upper right point
+            IF(id_detect(il_shape(1)-ji+1,il_shape(2)-jj+1)==1)THEN
+
+               dd_value( il_shape(1)-ji+1,il_shape(2)-jj+1)=dd_value(il_i2,il_j2)
+               id_detect(il_shape(1)-ji+1,il_shape(2)-jj+1)=0
+
+            ENDIF            
+
+         ENDDO
+
+      ENDDO
+
+   END SUBROUTINE interp_nearest__2D_fill
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE interp_nearest__1D_fill(dd_value, id_detect)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute nearest interpolation of a 1D array of value. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] dd_value  1D array of mixed grid value
+   !> @param[inout] id_detect 1D array of point to be interpolated
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)   , DIMENSION(:), INTENT(INOUT) :: dd_value 
+      INTEGER(i4), DIMENSION(:), INTENT(INOUT) :: id_detect
+
+      ! local variable
+      INTEGER(i4), DIMENSION(1) :: il_shape
+
+      INTEGER(i4) :: il_i1
+      INTEGER(i4) :: il_i2
+
+      INTEGER(i4) :: il_half1
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      il_shape(:)=SHAPE(dd_value)
+
+      il_i1=1
+      il_i2=il_shape(1)
+
+      il_half1=CEILING(il_shape(1)*0.5)
+      
+      DO ji=1,il_half1
+         
+         ! lower left point
+         IF(id_detect(ji)==1)THEN
+
+            dd_value( ji)=dd_value(il_i1)
+            id_detect(ji)=0
+
+         ENDIF
+
+         ! lower right point
+         IF(id_detect(il_shape(1)-ji+1)==1)THEN
+
+            dd_value( il_shape(1)-ji+1)=dd_value(il_i2)
+            id_detect(il_shape(1)-ji+1)=0
+
+         ENDIF
+
+      ENDDO
+
+   END SUBROUTINE interp_nearest__1D_fill
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE interp_nearest
Index: /utils/tools_ticket2413/SIREN/src/iom.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/iom.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/iom.f90	(revision 12863)
@@ -0,0 +1,733 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief Input/Output manager :  Library to read input files
+!>
+!> @details
+!>    to open file:<br/>
+!> @code
+!>    CALL iom_open(td_file)
+!> @endcode
+!>       - td_file is file structure
+!>
+!>    to create file:<br/>
+!> @code
+!>    CALL iom_create(td_file)
+!> @endcode
+!>       - td_file is file structure
+!> 
+!>    to write in file:<br/>
+!> @code
+!>    CALL  iom_write_file(td_file)
+!> @endcode
+!>
+!>    to close file:<br/>
+!> @code
+!>    CALL iom_close(tl_file)
+!> @endcode
+!>
+!>    to read one dimension in file:<br/>
+!> @code
+!>    tl_dim = iom_read_dim(tl_file, id_dimid)
+!> @endcode
+!>    or<br/>
+!> @code
+!>    tl_dim = iom_read_dim(tl_file, cd_name)
+!> @endcode
+!>       - id_dimid is dimension id
+!>       - cd_name is dimension name
+!>
+!>    to read variable or global attribute in file:<br/>
+!> @code
+!>    tl_att = iom_read_att(tl_file, id_varid, id_attid)
+!> @endcode
+!>    or
+!> @code
+!>    tl_att = iom_read_att(tl_file, id_varid, cd_attname)
+!> @endcode
+!>    or
+!> @code
+!>    tl_att = iom_read_att(tl_file, cd_varname, id_attid)
+!> @endcode
+!>    or
+!> @code
+!>    tl_att = iom_read_att(tl_file, cd_varname, cd_attname)
+!> @endcode
+!>       - id_varid is variable id
+!>       - id_attid is attribute id
+!>       - cd_attname is attribute name
+!>       - cd_varname is variable name or standard name
+!>    
+!>    to read one variable in file:<br/>
+!> @code
+!>    tl_var = iom_read_var(td_file, id_varid, [id_start, id_count])
+!> @endcode
+!>    or
+!> @code
+!>    tl_var = iom_read_var(td_file, cd_name, [id_start, [id_count,]])
+!> @endcode
+!>       - id_varid is variabale id
+!>       - cd_name is variabale name or standard name.
+!>       - id_start is a integer(4) 1D array of index from which the data 
+!>          values will be read [optional]
+!>       - id_count is a integer(4) 1D array of the number of indices selected
+!>          along each dimension [optional]
+!>
+!> @author
+!> J.Paul
+!>
+!> @date November, 2013 - Initial Version
+!> @date August, 2017
+!> - permit to write header and variable independantly
+!>
+!> @todo
+!> - see lbc_lnk
+!> - see goup netcdf4
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE iom
+
+   USE netcdf                          ! nf90 library
+   USE global                          ! global parameter
+   USE kind                            ! F90 kind parameter
+   USE fct                             ! basic useful function
+   USE logger                          ! log file manager
+   USE dim                             ! dimension manager
+   USE att                             ! attribute manager
+   USE var                             ! variable manager
+   USE file                            ! file manager
+   USE iom_cdf                         ! netcdf I/O manager
+   USE iom_rstdimg                     ! restart dimg I/O manager
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! function and subroutine
+   PUBLIC :: iom_open        !< open or create file, fill file structure
+   PUBLIC :: iom_create      !< create file, fill file structure
+   PUBLIC :: iom_close       !< close file
+   PUBLIC :: iom_read_dim    !< read one dimension in an opened file
+   PUBLIC :: iom_read_att    !< read one attribute in an opened file
+   PUBLIC :: iom_read_var    !< read one variable  in an opened file   
+   PUBLIC :: iom_write_file  !< write file structure contents in an opened file
+   PUBLIC :: iom_write_header!< write header in an opened file
+   PUBLIC :: iom_write_var   !< write variable an opened file
+
+                                          ! read variable or global attribute in an opened file
+   PRIVATE :: iom__read_att_varname_id   ! given variable name or standard name and attribute id.
+   PRIVATE :: iom__read_att_varid_id     ! given variable id and attribute id.
+   PRIVATE :: iom__read_att_varname_name ! given variable name or standard name, and attribute name.
+   PRIVATE :: iom__read_att_varid_name   ! given variable id and attribute name.
+
+   PRIVATE :: iom__read_dim_id            ! read one dimension in an opened file, given dimension id.
+   PRIVATE :: iom__read_dim_name          ! read one dimension in an opened netcdf file, given dimension name.
+   PRIVATE :: iom__read_var_id            ! read variable value in an opened file, given variable id.
+   PRIVATE :: iom__read_var_name          ! read variable value in an opened file, given variable name or standard name.
+
+   INTERFACE iom_read_var
+      MODULE PROCEDURE iom__read_var_id
+      MODULE PROCEDURE iom__read_var_name
+   END INTERFACE iom_read_var
+
+   INTERFACE iom_read_dim
+      MODULE PROCEDURE iom__read_dim_id
+      MODULE PROCEDURE iom__read_dim_name
+   END INTERFACE iom_read_dim
+
+   INTERFACE iom_read_att    !< read variable or global attribute in an opened file
+      MODULE PROCEDURE iom__read_att_varname_id   !< given variable name or standard name and attribute id.
+      MODULE PROCEDURE iom__read_att_varid_id     !< given variable id and attribute id.
+      MODULE PROCEDURE iom__read_att_varname_name !< given variable name or standard name, and attribute name.
+      MODULE PROCEDURE iom__read_att_varid_name   !< given variable id and attribute name.
+   END INTERFACE iom_read_att
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_open(td_file)
+   !-------------------------------------------------------------------
+   !> @brief This function open a file in read or write mode
+   !> @details
+   !> If try to open a file in write mode that did not exist, create it.<br/>
+   !> 
+   !> If file exist, get information about:
+   !> - the number of variables
+   !> - the number of dimensions
+   !> - the number of global attributes
+   !> - the ID of the unlimited dimension
+   !> - the file format
+   !> and finally read dimensions.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_file file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT)  :: td_file
+      !----------------------------------------------------------------
+
+      ! add suffix to file name
+      td_file%c_name = file_add_suffix( TRIM(td_file%c_name), &
+      &                                 TRIM(td_file%c_type)  )
+      ! check type
+      SELECT CASE(TRIM(ADJUSTL(fct_lower(td_file%c_type))))
+
+         CASE('cdf')
+            CALL iom_cdf_open(td_file)
+         !CASE('cdf4')
+         CASE('dimg')
+            CALL iom_rstdimg_open(td_file)
+         CASE DEFAULT
+            CALL logger_error("IOM OPEN: unknow type : "//TRIM(td_file%c_name))
+
+      END SELECT
+
+   END SUBROUTINE iom_open
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_create(td_file)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine create a file.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_file file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT)  :: td_file
+
+      ! local variable
+      LOGICAL     :: ll_exist
+      !----------------------------------------------------------------
+
+      INQUIRE(FILE=TRIM(td_file%c_name), EXIST=ll_exist )
+      IF( ll_exist )THEN
+         CALL logger_fatal("IOM CREATE: can not create file "//&
+         &  TRIM(td_file%c_name)//". file exist already.")
+      ENDIF
+
+      ! forced to open in write mode
+      td_file%l_wrt=.TRUE.
+      ! check type
+      SELECT CASE(TRIM(td_file%c_type))
+         CASE('cdf')
+            CALL iom_cdf_open(td_file)
+         CASE('dimg')
+            CALL iom_rstdimg_open(td_file)
+         CASE DEFAULT
+            CALL logger_error( "IOM CREATE: can't create file "//&
+            &               TRIM(td_file%c_name)//": type unknown " )
+      END SELECT
+
+   END SUBROUTINE iom_create
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_close(td_file)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine close file
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_file file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+      !----------------------------------------------------------------
+
+      ! open file
+      SELECT CASE(TRIM(td_file%c_type))
+         CASE('cdf')
+            CALL iom_cdf_close(td_file)
+         CASE('dimg')
+            CALL iom_rstdimg_close(td_file)
+         CASE DEFAULT
+            CALL logger_debug( "IOM CLOSE: type "//TRIM(td_file%c_type))
+            CALL logger_error( "IOM CLOSE: can't close file "//&
+            &               TRIM(td_file%c_name)//": type unknown " )
+      END SELECT
+
+   END SUBROUTINE iom_close
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION iom__read_att_varname_id(td_file, cd_varname, id_attid) &
+         & RESULT (tf_att)
+   !-------------------------------------------------------------------
+   !> @brief This function read attribute (of variable or global) in an opened 
+   !> file, given variable name or standard name and attribute id.
+   !> @details
+   !>  - to get global attribute use 'GLOBAL' as variable name. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_file      file structure
+   !> @param[in] cd_varname   variable name. use 'GLOBAL' to read global 
+   !> attribute in a file
+   !> @param[in] id_attid     attribute id
+   !> @return  attribute structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TFILE),       INTENT(IN) :: td_file
+      CHARACTER(LEN=lc), INTENT(IN) :: cd_varname
+      INTEGER(i4),       INTENT(IN) :: id_attid
+
+      ! function
+      TYPE(TATT)                    :: tf_att
+
+      ! local variable
+      INTEGER(i4) :: il_varid
+      !----------------------------------------------------------------
+
+      ! get variable id
+      IF( TRIM(fct_upper(cd_varname)) == 'GLOBAL' )THEN
+         il_varid=NF90_GLOBAL
+      ELSE
+         il_varid=var_get_id(td_file%t_var(:), cd_varname)
+      ENDIF
+
+      IF( il_varid /= 0 .OR. TRIM(fct_upper(cd_varname)) == 'GLOBAL' )THEN
+         ! open file
+         SELECT CASE(TRIM(td_file%c_type))
+            CASE('cdf')
+               tf_att=iom_read_att( td_file, il_varid, id_attid)
+            CASE('dimg')
+               CALL logger_warn( " IOM READ ATT: can't read attribute "//&
+               &              "in dimg file : "//TRIM(td_file%c_name) )
+            CASE DEFAULT
+               CALL logger_error( " IOM READ ATT: can't read attribute "//&
+               &    " in file "//TRIM(td_file%c_name)//" : type unknown " )
+         END SELECT
+      ENDIF
+
+   END FUNCTION iom__read_att_varname_id
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION iom__read_att_varid_id(td_file, id_varid, id_attid) &
+         & RESULT (tf_att)
+   !-------------------------------------------------------------------
+   !> @brief This function read attribute (of variable or global) in an opened 
+   !> file, given variable id and attribute id.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] id_varid  variable id. use NF90_GLOBAL to read global 
+   !> attribute in a file
+   !> @param[in] id_attid  attribute id
+   !> @return  attribute structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TFILE), INTENT(IN) :: td_file
+      INTEGER(i4), INTENT(IN) :: id_varid
+      INTEGER(i4), INTENT(IN) :: id_attid
+
+      ! function
+      TYPE(TATT)              :: tf_att
+      !----------------------------------------------------------------
+
+      ! open file
+      SELECT CASE(TRIM(td_file%c_type))
+         CASE('cdf')
+            tf_att=iom_cdf_read_att(td_file, id_varid, id_attid)
+         CASE('dimg')
+            CALL logger_warn( " IOM READ ATT: can't read attribute in dimg file "//&
+            &              TRIM(td_file%c_name) )
+         CASE DEFAULT
+            CALL logger_error( " IOM READ ATT: can't read attribute in file "//&
+            &               TRIM(td_file%c_name)//" : type unknown " )
+      END SELECT
+
+   END FUNCTION iom__read_att_varid_id
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION iom__read_att_varname_name(td_file, cd_varname, cd_attname) &
+         & RESULT (tf_att)
+   !-------------------------------------------------------------------
+   !> @brief This function read attribute (of variable or global) in an opened 
+   !> file, given variable name or standard name, and attribute name.
+   !> @details
+   !> - to get global attribute use 'GLOBAL' as variable name.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_file      file structure
+   !> @param[in] cd_varname   variable name or standard name. use 'GLOBAL' to read global
+   !> attribute in a file
+   !> @param[in] cd_attname   attribute name
+   !> @return  attribute structure    
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TFILE),      INTENT(IN) :: td_file
+      CHARACTER(LEN=*), INTENT(IN) :: cd_varname
+      CHARACTER(LEN=*), INTENT(IN) :: cd_attname
+
+      ! function
+      TYPE(TATT)                   :: tf_att
+
+      ! local variable
+      INTEGER(i4) :: il_varid
+      !----------------------------------------------------------------
+
+      ! get variable id
+      IF( TRIM(fct_upper(cd_varname)) == 'GLOBAL' )THEN
+         il_varid=NF90_GLOBAL
+      ELSE
+         il_varid=var_get_id(td_file%t_var(:), cd_varname)
+      ENDIF
+
+      IF( il_varid /= 0 .OR. TRIM(fct_upper(cd_varname)) == 'GLOBAL' )THEN
+         ! open file
+         SELECT CASE(TRIM(td_file%c_type))
+            CASE('cdf')
+               tf_att=iom_cdf_read_att(td_file, il_varid, cd_attname)
+            CASE('dimg')
+               CALL logger_warn( " IOM READ ATT: can't read attribute "//&
+               &              "in dimg file :"//TRIM(td_file%c_name) )
+            CASE DEFAULT
+               CALL logger_error( " IOM READ ATT: can't read attribute in file "//&
+               &               TRIM(td_file%c_name)//" : type unknown " )
+         END SELECT
+      ENDIF
+
+   END FUNCTION iom__read_att_varname_name
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION iom__read_att_varid_name(td_file, id_varid, cd_attname) &
+         & RESULT (tf_att)
+   !-------------------------------------------------------------------
+   !> @brief This function read attribute (of variable or global) in an opened 
+   !> file, given variable id and attribute name.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_file      file structure
+   !> @param[in] id_varid     variable id. use NF90_GLOBAL to read global
+   !> attribute in a file
+   !> @param[in] cd_attname   attribute name
+   !> @return  attribute structure    
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TFILE), INTENT(IN) :: td_file
+      INTEGER(i4), INTENT(IN) :: id_varid
+      CHARACTER(LEN=*), INTENT(IN) :: cd_attname
+
+      ! function
+      TYPE(TATT)              :: tf_att
+      !----------------------------------------------------------------
+
+      ! open file
+      SELECT CASE(TRIM(td_file%c_type))
+         CASE('cdf')
+            tf_att=iom_cdf_read_att(td_file, id_varid, cd_attname)
+         CASE('dimg')
+            CALL logger_warn( " IOM READ ATT: can't read attribute in dimg file :"&
+            &              //TRIM(td_file%c_name) )
+         CASE DEFAULT
+            CALL logger_error( " IOM READ ATT: can't read attribute in file "//&
+            &               TRIM(td_file%c_name)//" : type unknown " )
+      END SELECT
+
+   END FUNCTION iom__read_att_varid_name
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION iom__read_dim_id(td_file, id_dimid) &
+         & RESULT (tf_dim)
+   !-------------------------------------------------------------------
+   !> @brief This function read one dimension in an opened file, 
+   !> given dimension id.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] id_dimid  dimension id
+   !> @return  dimension structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(IN) :: td_file
+      INTEGER(i4), INTENT(IN) :: id_dimid
+
+      ! function
+      TYPE(TDIM)              :: tf_dim
+      !----------------------------------------------------------------
+
+      ! open file
+      SELECT CASE(TRIM(td_file%c_type))
+         CASE('cdf')
+            tf_dim=iom_cdf_read_dim(td_file, id_dimid)
+         CASE('dimg')
+            tf_dim=iom_rstdimg_read_dim(td_file, id_dimid)
+         CASE DEFAULT
+            CALL logger_error( " IOM READ DIM: can't read dimension in file "//&
+            &               TRIM(td_file%c_name)//" : type unknown " )
+      END SELECT      
+
+   END FUNCTION iom__read_dim_id
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION iom__read_dim_name(td_file, cd_name) &
+         & RESULT(tf_dim)
+   !-------------------------------------------------------------------
+   !> @brief This function read one dimension in an opened netcdf file, 
+   !> given dimension name.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] cd_name   dimension name
+   !> @return  dimension structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE),      INTENT(IN) :: td_file
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+
+      ! function
+      TYPE(TDIM)                   :: tf_dim
+      !----------------------------------------------------------------
+
+      ! open file
+      SELECT CASE(TRIM(td_file%c_type))
+         CASE('cdf')
+            tf_dim=iom_cdf_read_dim(td_file, cd_name)
+         CASE('dimg')
+            tf_dim=iom_rstdimg_read_dim(td_file, cd_name)
+         CASE DEFAULT
+            CALL logger_error( " IOM READ DIM: can't read dimension in file "//&
+            &               TRIM(td_file%c_name)//" : type unknown " )
+      END SELECT      
+
+   END FUNCTION iom__read_dim_name
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION iom__read_var_id(td_file, id_varid, id_start, id_count) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function read variable value in an opened 
+   !> file, given variable id.
+   !> @details
+   !> start indices and number of indices selected along each dimension 
+   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] id_varid  variable id
+   !> @param[in] id_start  index in the variable from which the data values 
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !> @return  variable structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE),                       INTENT(IN) :: td_file
+      INTEGER(i4),                       INTENT(IN) :: id_varid
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
+
+      ! function
+      TYPE(TVAR)                                    :: tf_var
+      !----------------------------------------------------------------
+
+      ! open file
+      SELECT CASE(TRIM(td_file%c_type))
+         CASE('cdf')
+            tf_var=iom_cdf_read_var(td_file, id_varid, id_start, id_count)
+         CASE('dimg')
+            tf_var=iom_rstdimg_read_var(td_file, id_varid, id_start, id_count)
+         CASE DEFAULT
+            CALL logger_error( " IOM READ VAR: can't read variable in file "//&
+            &               TRIM(td_file%c_name)//" : type unknown " )
+      END SELECT
+
+   END FUNCTION iom__read_var_id
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION iom__read_var_name(td_file, cd_name, id_start, id_count) &
+      & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function read variable value in an opened 
+   !> file, given variable name or standard name.
+   !> @details
+   !> start indices and number of indices selected along each dimension 
+   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
+   !>
+   !> look first for variable name. If it doesn't
+   !> exist in file, look for variable standard name.<br/>
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] cd_name   variable name or standard name
+   !> @param[in] id_start  index in the variable from which the data values
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !> @return  variable structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE)                   , INTENT(IN) :: td_file
+      CHARACTER(LEN=*)              , INTENT(IN) :: cd_name
+      INTEGER(i4)     , DIMENSION(:), INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:), INTENT(IN), OPTIONAL :: id_count
+
+      ! function
+      TYPE(TVAR)                                 :: tf_var
+      !----------------------------------------------------------------
+      
+      ! open file
+      SELECT CASE(TRIM(td_file%c_type))
+         CASE('cdf')
+            tf_var=iom_cdf_read_var(td_file, cd_name, id_start, id_count )
+         CASE('dimg')
+            tf_var=iom_rstdimg_read_var(td_file, cd_name, id_start, id_count )
+         CASE DEFAULT
+            CALL logger_error( " IOM READ VAR: can't read variable in file "//&
+            &               TRIM(td_file%c_name)//" : type unknown " )
+      END SELECT
+
+   END FUNCTION iom__read_var_name
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_write_file(td_file, cd_dimorder)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write file structure in an opened file.
+   !>
+   !> @details
+   !> optionally, you could specify dimension order (default 'xyzt')
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 - add dimension order option
+   !> @date August, 2017
+   !> - split in write_header and write_var
+   !>
+   !> @param[in] td_file   file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE)     , INTENT(INOUT) :: td_file
+      CHARACTER(LEN=*), INTENT(IN   ), OPTIONAL :: cd_dimorder
+      !----------------------------------------------------------------
+
+      CALL iom_write_header(td_file, cd_dimorder)
+
+      CALL iom_write_var(td_file)
+
+   END SUBROUTINE iom_write_file
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_write_header(td_file, cd_dimorder, td_dim)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write header from file structure
+   !> of an opened file.
+   !>
+   !> @details
+   !> optionally, you could specify dimension order (default 'xyzt'), 
+   !> and dimension structure for netcdf case.
+   !>
+   !> @author J.Paul
+   !> @date August, 2017 - Initial Version
+   !>
+   !> @param[inout] td_file      file structure
+   !> @param[in] cd_dimorder  dimension order
+   !> @param[in] td_dim       array of dimension structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE)                           , INTENT(INOUT) :: td_file
+      CHARACTER(LEN=*)                      , INTENT(IN   ), OPTIONAL :: cd_dimorder
+      TYPE(TDIM)      , DIMENSION(ip_maxdim), INTENT(IN   ), OPTIONAL :: td_dim
+      !----------------------------------------------------------------
+
+      ! open file
+      SELECT CASE(TRIM(td_file%c_type))
+         CASE('cdf')
+            CALL iom_cdf_write_header(td_file, cd_dimorder, td_dim)
+         CASE('dimg')
+            ! note: can not change dimension order in restart dimg file
+            CALL iom_rstdimg_write_header(td_file)
+         CASE DEFAULT
+            CALL logger_error( " IOM WRITE HEADER: can't write header&
+            &                  , file "//TRIM(td_file%c_name)//" : &
+            &                  type unknown " )
+      END SELECT
+
+   END SUBROUTINE iom_write_header
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_write_var(td_file, cd_dimorder, id_start, id_count)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write variables from file structure 
+   !> in an opened file.
+   !>
+   !> @details
+   !>
+   !> @author J.Paul
+   !> @date August, 2017 - Initial Version
+   !>
+   !> @param[inout] td_file   file structure
+   !> @param[in] cd_dimorder  dimension order
+   !> @param[in] id_start  index in the variable from which the data values
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE)                   , INTENT(INOUT) :: td_file
+      CHARACTER(LEN=*)              , INTENT(IN   ), OPTIONAL :: cd_dimorder
+      INTEGER(i4)     , DIMENSION(:), INTENT(IN   ), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:), INTENT(IN   ), OPTIONAL :: id_count
+      !----------------------------------------------------------------
+
+      ! open file
+      SELECT CASE(TRIM(td_file%c_type))
+         CASE('cdf')
+            CALL iom_cdf_write_var(td_file, cd_dimorder, &
+                 &                 id_start, id_count)
+         CASE('dimg')
+            ! note: can not change dimension order in restart dimg file
+            CALL iom_rstdimg_write_var(td_file)
+         CASE DEFAULT
+            CALL logger_error( " IOM WRITE VAR: can't write variable, file "//&
+            &               TRIM(td_file%c_name)//" : type unknown " )
+      END SELECT
+
+   END SUBROUTINE iom_write_var
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE iom
+
Index: /utils/tools_ticket2413/SIREN/src/iom_cdf.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/iom_cdf.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/iom_cdf.f90	(revision 12863)
@@ -0,0 +1,2714 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief NETCDF Input/Output manager :  Library to read Netcdf input files
+!>
+!> @details
+!>    to open netcdf file:<br/>
+!> @code
+!>    CALL iom_cdf_open(td_file)
+!> @endcode
+!>       - td_file is file structure (see @ref file)
+!>
+!>    to write in netcdf file:<br/>
+!> @code
+!>    CALL  iom_cdf_write_file(td_file)
+!> @endcode
+!>
+!>    to close netcdf file:<br/>
+!> @code
+!>    CALL iom_cdf_close(tl_file)
+!> @endcode
+!>
+!>    to read one dimension in netcdf file:<br/>
+!> @code
+!>    tl_dim = iom_cdf_read_dim(tl_file, id_dimid)
+!> @endcode
+!>    or
+!> @code
+!>    tl_dim = iom_cdf_read_dim(tl_file, cd_name)
+!> @endcode
+!>       - id_dimid is dimension id<br/>
+!>       - cd_name is dimension name
+!>
+!>    to read one attribute in netcdf file:<br/>
+!> @code
+!>    tl_att = iom_cdf_read_att(tl_file, id_varid, id_attid)
+!> @endcode
+!>    or
+!> @code
+!>    tl_att = iom_cdf_read_att(tl_file, id_varid, cd_name)
+!> @endcode
+!>       - id_varid is variable id
+!>       - id_attid is attribute id<br/>
+!>       - cd_name is attribute name
+!>    
+!>    to read one variable in netcdf file:<br/>
+!> @code
+!>    tl_var = iom_cdf_read_var(td_file, id_varid, [id_start, id_count])
+!> @endcode
+!>    or
+!> @code
+!>    tl_var = iom_cdf_read_var(td_file, cd_name, [id_start, [id_count,]])
+!> @endcode
+!>       - id_varid is variabale id
+!>       - cd_name is variabale name
+!>       - id_start is a integer(4) 1D array of index from which the data 
+!>          values will be read [optional]
+!>       - id_count is a integer(4) 1D array of the number of indices selected
+!>          along each dimension [optional]
+!>
+!> @author
+!> J.Paul
+!>
+!> @date November, 2013 - Initial Version
+!> @date August, 2017
+!> - permit to write header and variable independantly
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE iom_cdf
+
+   USE netcdf                          ! nf90 library
+   USE global                          ! global parameter
+   USE kind                            ! F90 kind parameter
+   USE fct                             ! basic useful function
+   USE logger                          ! log file manager
+   USE att                             ! attribute manage
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+   USE file                            ! file manager
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! function and subroutine
+   PUBLIC :: iom_cdf_open           !< open or create netcdf file, return file structure
+   PUBLIC :: iom_cdf_close          !< close netcdf file
+   PUBLIC :: iom_cdf_read_dim       !< read one dimension in an opened netcdf file, return dimension structure
+   PUBLIC :: iom_cdf_read_att       !< read one attribute in an opened netcdf file, return attribute structure
+   PUBLIC :: iom_cdf_read_var       !< read one variable  in an opened netcdf file, return variable  structure
+   PUBLIC :: iom_cdf_fill_var       !< fill variable value in an opened netcdf file
+   PUBLIC :: iom_cdf_write_header   !< write header in an opened netcdf file
+   PUBLIC :: iom_cdf_write_var      !< write variables in an opened netcdf file
+
+   PRIVATE :: iom_cdf__check           ! provides a simple interface to netcdf error message
+   PRIVATE :: iom_cdf__get_info        ! get global information in an opened netcdf file
+   PRIVATE :: iom_cdf__get_file_dim    ! read dimension on an opened netcdf file, and reorder it
+   PRIVATE :: iom_cdf__get_file_att    ! read global attribute on an opened netcdf file
+   PRIVATE :: iom_cdf__get_file_var    ! read information about variable on an opened netcdf file
+   PRIVATE :: iom_cdf__read_dim_id     ! read one dimension in an opened netcdf file, given dimension id.
+   PRIVATE :: iom_cdf__read_dim_name   ! read one dimension in an opened netcdf file, given dimension name.
+   PRIVATE :: iom_cdf__read_att_name   ! read variable or global attribute in an opened netcdf file, given attribute name. 
+   PRIVATE :: iom_cdf__read_att_id     ! read variable or global attribute in an opened netcdf file, given attribute id.
+   PRIVATE :: iom_cdf__read_var_id     ! read variable value in an opened netcdf file, given variable id.
+   PRIVATE :: iom_cdf__read_var_name   ! read variable value in an opened netcdf file, given variable name or standard name.
+   PRIVATE :: iom_cdf__read_var_meta   ! read metadata of a variable in an opened netcdf file.
+   PRIVATE :: iom_cdf__read_var_dim    ! read variable dimension in an opened netcdf file.
+   PRIVATE :: iom_cdf__read_var_att    ! read variable attributes in an opened netcdf file.
+   PRIVATE :: iom_cdf__read_var_value  ! read variable value in an opened netcdf file.
+   PRIVATE :: iom_cdf__write_dim_def   ! write dimension definition in an opened netcdf file.
+   PRIVATE :: iom_cdf__write_att_def   ! write attribute definition in an opened netcdf file.
+   PRIVATE :: iom_cdf__write_var_def   ! write variable definition in an opened netcdf file.
+   PRIVATE :: iom_cdf__write_var       ! write a variable in an opened netcdf file.
+   PRIVATE :: iom_cdf__write_var_value ! put variable value in an opened netcdf file.
+   PRIVATE :: iom_cdf__fill_var_id     ! fill variable value in an opened netcdf file, given variable id
+   PRIVATE :: iom_cdf__fill_var_name   ! fill variable value in an opened netcdf file, given variable name
+   PRIVATE :: iom_cdf__fill_var_all    ! fill all variable value in an opened netcdf file
+   PRIVATE :: iom_cdf__del_coord_var   ! remove coordinate variable from an opened netcdf file
+
+   INTERFACE iom_cdf_read_var
+      MODULE PROCEDURE iom_cdf__read_var_id
+      MODULE PROCEDURE iom_cdf__read_var_name
+   END INTERFACE iom_cdf_read_var
+
+   INTERFACE iom_cdf_fill_var
+      MODULE PROCEDURE iom_cdf__fill_var_id
+      MODULE PROCEDURE iom_cdf__fill_var_name
+      MODULE PROCEDURE iom_cdf__fill_var_all
+   END INTERFACE iom_cdf_fill_var
+
+   INTERFACE iom_cdf_read_dim
+      MODULE PROCEDURE iom_cdf__read_dim_id
+      MODULE PROCEDURE iom_cdf__read_dim_name
+   END INTERFACE iom_cdf_read_dim
+
+   INTERFACE iom_cdf_read_att
+      MODULE PROCEDURE iom_cdf__read_att_id
+      MODULE PROCEDURE iom_cdf__read_att_name
+   END INTERFACE iom_cdf_read_att
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_cdf__check(id_status, cd_msg)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine provides a simple interface to 
+   !> netcdf error message 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date May, 2015 
+   !> - add optional message to netcdf error message
+   !>
+   !> @param[in] id_status error status
+   !> @param[in] cd_msg    message
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      INTEGER(i4)     , INTENT(IN)           :: id_status
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_msg
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_msg
+      !----------------------------------------------------------------
+
+      cl_msg=""
+      IF( PRESENT(cd_msg) ) cl_msg=cd_msg
+
+      IF( id_status /= NF90_NOERR )THEN
+         CALL logger_error(TRIM(cl_msg)//TRIM(NF90_STRERROR(id_status)))
+      ENDIF
+
+   END SUBROUTINE iom_cdf__check
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_cdf_open(td_file)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine open a netcdf file in read or write mode.
+   !> @details
+   !> if try to open a file in write mode that did not exist, create it.<br/>
+   !> if file already exist, get information about0:<br/>
+   !> - the number of variables
+   !> - the number of dimensions
+   !> - the number of global attributes
+   !> - the ID of the unlimited dimension
+   !> - the file format
+   !> Finally it read dimensions, and 'longitude' variable to compute East-West
+   !> overlap.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2018
+   !> - write netcdf file as netcdf4
+   !>
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT)  :: td_file
+
+      ! local variable
+      LOGICAL     :: ll_exist
+      LOGICAL     :: ll_open
+
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_oldmode
+      !----------------------------------------------------------------
+
+      ! check file existence
+      INQUIRE(FILE=TRIM(td_file%c_name), EXIST=ll_exist, OPENED=ll_open)
+      ! ll_open do not work for netcdf file, always return FALSE
+      IF( .NOT. ll_exist .OR. TRIM(td_file%c_type) /= 'cdf' )THEN
+
+         IF( .NOT. td_file%l_wrt )THEN
+
+            CALL logger_fatal( " IOM CDF OPEN: can not open file "//&
+            &               TRIM(td_file%c_name) )
+ 
+         ELSE
+
+            CALL logger_info( " IOM CDF CREATE: file "//TRIM(td_file%c_name) )
+
+            il_status = NF90_CREATE(TRIM(td_file%c_name),&
+               &                    cmode=NF90_NETCDF4,  &
+               &                    ncid=td_file%i_id)
+            CALL iom_cdf__check(il_status," IOM CDF CREATE: ")
+            il_status = NF90_SET_FILL(td_file%i_id,   &
+               &                      NF90_NOFILL,    &
+               &                      il_oldmode)
+            CALL iom_cdf__check(il_status," IOM CDF SET FILL: ")
+
+            td_file%l_def=.TRUE.
+            CALL logger_debug( " IOM CDF CREATE: td_file%l_def"//fct_str(td_file%l_def))
+
+         ENDIF
+
+      ELSE
+
+         IF( td_file%i_id /= 0 )THEN
+
+            CALL logger_error( " IOM CDF OPEN: file "//&
+            &               TRIM(td_file%c_name)//" already opened")
+
+         ELSE
+ 
+            IF( .NOT. td_file%l_wrt )THEN
+
+               CALL logger_info( " IOM CDF OPEN: file "//&
+               &              TRIM(td_file%c_name)//" in read only mode" )
+
+               il_status = NF90_OPEN( TRIM(td_file%c_name), &
+               &                      NF90_NOWRITE,         &
+               &                      td_file%i_id)
+               CALL iom_cdf__check(il_status," IOM CDF OPEN: ")
+
+            ELSE
+
+               CALL logger_info( "IOM CDF OPEN: file "//&
+               &              TRIM(td_file%c_name)//" in write mode" )
+
+               il_status = NF90_OPEN( TRIM(td_file%c_name), &
+               &                      NF90_WRITE,           &
+               &                      td_file%i_id)
+               CALL iom_cdf__check(il_status,"IOM CDF OPEN: ")
+
+            ENDIF
+
+            ! get general information about file
+            CALL iom_cdf__get_info(td_file)
+
+            ! read dimension in file
+            CALL iom_cdf__get_file_dim(td_file) 
+
+            ! read global attribute in file
+            CALL iom_cdf__get_file_att(td_file)
+
+            ! get information about variables in file
+            CALL iom_cdf__get_file_var(td_file)
+
+            ! remove dimension variable from list of variable
+            CALL iom_cdf__del_coord_var(td_file)
+
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE iom_cdf_open
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_cdf_close(td_file)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine close netcdf file.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      !----------------------------------------------------------------
+
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " IOM CDF CLOSE: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+         CALL logger_info( &
+         &  " IOM CDF CLOSE: file "//TRIM(td_file%c_name))
+
+         il_status = NF90_CLOSE(td_file%i_id)
+         CALL iom_cdf__check(il_status,"IOM CDF CLOSE: ")
+
+         td_file%i_id = 0
+
+      ENDIF
+
+   END SUBROUTINE iom_cdf_close
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_cdf__get_info(td_file)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine get global information in an opened netcdf 
+   !> file.
+   !> @details
+   !> It gets the number of variables, the number of dimensions, 
+   !> the number of global attributes, the ID of the unlimited dimension
+   !> and finally the format version and filled file strucuture with it.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date October, 2016
+   !> - define cdf4 as cdf.
+   !>
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      INTEGER(i4) :: il_fmt   ! format version
+      INTEGER(i4) :: il_status
+      !----------------------------------------------------------------
+
+      CALL logger_trace( &
+      &  " IOM CDF GET INFO: about netcdf file "//TRIM(td_file%c_name))
+
+      il_status=NF90_INQUIRE(td_file%i_id, td_file%i_ndim, &
+      &     td_file%i_nvar, td_file%i_natt, td_file%i_uldid, il_fmt)
+      CALL iom_cdf__check(il_status,"IOM CDF GET INFO: ")
+
+      SELECT CASE(il_fmt)
+         CASE(nf90_format_classic, nf90_format_64bit)
+            td_file%c_type='cdf'
+         CASE(nf90_format_netcdf4,nf90_format_netcdf4_classic)
+            td_file%c_type='cdf'
+      END SELECT
+      CALL logger_debug("IOM CDF GET INFO: type "//TRIM(td_file%c_type)) 
+
+      ! record header infos
+      td_file%i_rhd=1
+
+   END SUBROUTINE iom_cdf__get_info
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_cdf__get_file_dim(td_file)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read dimension on an opened netcdf file, and
+   !> reorder dimension to ('x', 'y', 'z', 't').
+   !> The dimension structure inside file structure is then completed.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date October, 2016
+   !> - check unknown dimension
+   !> @date January, 2019
+   !> - clean dimension structure
+   !>
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      TYPE(TDIM) :: tl_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: ii
+      !----------------------------------------------------------------
+
+      ! clean dimension
+      DO ji=1,ip_maxdim
+         CALL dim_clean(td_file%t_dim(ji))
+      ENDDO
+
+      IF( td_file%i_ndim > 0 )THEN
+
+         ii=1
+         DO ji = 1, td_file%i_ndim
+            ! read dimension information
+            tl_dim=iom_cdf_read_dim( td_file, ji)
+            ! sname == 'u' if dimension is unknown (not to be used)
+            IF( TRIM(tl_dim%c_sname) /= 'u' )THEN
+               IF( ii > ip_maxdim )THEN
+                  CALL logger_fatal("IOM CDF OPEN: too much dimension "//&
+                  & "to be read. you could choose dimension to be used. see "//&
+                  & " configuration file")
+               ENDIF
+               td_file%t_dim(ii)=dim_copy(tl_dim)
+               ii=ii+1
+            ENDIF
+            ! clean
+            CALL dim_clean(tl_dim)
+         ENDDO
+
+         ! inform unlimited dimension
+         IF( td_file%i_uldid == -1 )THEN
+            CALL logger_warn( &
+            &  " IOM CDF GET FILE DIM: there is no unlimited dimension in file "//&
+            &  TRIM(td_file%c_name))
+         !ELSE
+         !   td_file%t_dim( td_file%i_uldid )%l_uld=.TRUE.
+         ENDIF
+
+      ELSE
+
+         CALL logger_warn( &
+         &  " IOM CDF GET FILE DIM: there is no dimension in file "//&
+         &  TRIM(td_file%c_name))
+
+      ENDIF
+
+      ! reorder dimension to ('x','y','z','t')
+      CALL dim_reorder(td_file%t_dim(:))
+
+   END SUBROUTINE iom_cdf__get_file_dim
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_cdf__get_file_att(td_file)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read global attribute on an opened netcdf 
+   !> file.
+   !> The attribute structure inside file structure is then completed.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014
+   !> - use attribute periodicity read from the file if present.
+   !> @date January, 2019
+   !> - clean attribute structure
+   !>
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      TYPE(TATT) :: tl_att
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: ii
+      !----------------------------------------------------------------
+      CALL logger_trace("IOM CDF GET FILE ATT : get attr(s) in &
+         &     file "//TRIM(td_file%c_name))
+
+      IF( td_file%i_natt > 0 )THEN
+         IF(ASSOCIATED(td_file%t_att))THEN
+            CALL att_clean(td_file%t_att(:))
+            DEALLOCATE(td_file%t_att)
+         ENDIF
+         ALLOCATE(td_file%t_att(td_file%i_natt))
+
+         ii=1
+         DO ji = 1, td_file%i_natt
+            ! read global attribute
+            tl_att=iom_cdf_read_att( td_file, NF90_GLOBAL, ji)
+            IF( .NOT. att_is_dummy(tl_att) )THEN
+               td_file%t_att(ii)=att_copy(tl_att)
+               ii=ii+1
+            ENDIF
+            ! clean
+            CALL att_clean(tl_att)
+         ENDDO
+
+      ELSE
+         CALL logger_debug( &
+         &  " IOM CDF GET FILE ATT: there is no global attribute in file "//&
+         &  TRIM(td_file%c_name))
+      ENDIF
+
+   END SUBROUTINE iom_cdf__get_file_att
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_cdf__get_file_var(td_file)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read information about variable of an 
+   !> opened netcdf file.
+   !> The variable structure inside file structure is then completed.
+   !> @note variable value are not read !
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2015
+   !> - manage useless (dummy) variable
+   !> @date January, 2016
+   !> - increment n3d for 4D variable
+   !> @date October, 2016
+   !> - check variable to be used (variable's dimension allowed and variable
+   !> not "dummy")
+   !>
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      INTEGER(i4) :: il_attid
+      INTEGER(i4) :: il_nvar
+
+      TYPE(TVAR), DIMENSION(:), ALLOCATABLE  :: tl_var
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: ii
+      !----------------------------------------------------------------
+
+      IF( td_file%i_nvar > 0 )THEN
+
+         IF(ASSOCIATED(td_file%t_var))THEN
+            CALL var_clean(td_file%t_var(:))
+            DEALLOCATE(td_file%t_var)
+         ENDIF
+
+         il_nvar=td_file%i_nvar
+         ALLOCATE(tl_var(il_nvar))
+         DO ji = 1, il_nvar
+           ! read variable information
+           tl_var(ji)=iom_cdf__read_var_meta( td_file, ji) 
+         ENDDO
+
+         ! update number of variable used
+         td_file%i_nvar=COUNT(tl_var(:)%l_use)
+
+         ALLOCATE(td_file%t_var(td_file%i_nvar))
+
+         ii=0
+         DO ji = 1, il_nvar
+            IF( tl_var(ji)%l_use )THEN
+               ii=ii+1
+               td_file%t_var(ii)=var_copy(tl_var(ji))
+               SELECT CASE(td_file%t_var(ii)%i_ndim)
+                  CASE(0)
+                     td_file%i_n0d=td_file%i_n0d+1
+                  CASE(1)
+                     td_file%i_n1d=td_file%i_n1d+1
+                     td_file%i_rhd=td_file%i_rhd+1
+                  CASE(2)
+                     td_file%i_n2d=td_file%i_n2d+1
+                     td_file%i_rhd=td_file%i_rhd+1
+                  CASE(3,4)
+                     td_file%i_n3d=td_file%i_n3d+1
+                     td_file%i_rhd=td_file%i_rhd+td_file%t_dim(3)%i_len
+               END SELECT
+
+               ! look for depth id
+               IF( INDEX(TRIM(fct_lower(td_file%t_var(ii)%c_name)),'depth')/=0 )THEN
+                  IF( td_file%i_depthid == 0 )THEN
+                     td_file%i_depthid=ji
+                  ELSE
+                     IF( td_file%i_depthid /= ji )THEN
+                        CALL logger_error("IOM CDF GET FILE VAR: find more"//&
+                           &  " than one depth variable in file "//&
+                           &  TRIM(td_file%c_name) )
+                     ENDIF
+                  ENDIF
+               ENDIF
+
+               ! look for time id
+               IF( INDEX(TRIM(fct_lower(td_file%t_var(ii)%c_name)),'time')/=0 )THEN
+                  IF( td_file%i_timeid == 0 )THEN
+                     td_file%i_timeid=ji
+                  ELSE
+                     IF( td_file%i_timeid /= ji )THEN
+                        CALL logger_warn("IOM CDF GET FILE VAR: find more "//&
+                        &                 "than one time variable in file "//&
+                        &                 TRIM(td_file%c_name)//". see "//&
+                        &                 "dummy.cfg configuration file to"//&
+                        &                 " not used dummy variables.")
+                     ENDIF
+                     il_attid=0
+                     IF( ASSOCIATED(td_file%t_var(ii)%t_att) )THEN
+                        il_attid=att_get_id(td_file%t_var(ii)%t_att(:),'calendar')
+                     ENDIF
+                     IF( il_attid /= 0 )THEN
+                        td_file%i_timeid=ji
+                     ENDIF
+                  ENDIF
+               ENDIF
+
+            ENDIF
+         ENDDO
+
+         CALL var_clean(tl_var(:))
+         DEALLOCATE(tl_var)
+
+      ELSE
+         CALL logger_debug( &
+         &  " IOM CDF GET FILE VAR: there is no variable in file "//&
+         &  TRIM(td_file%c_name))
+      ENDIF
+
+   END SUBROUTINE iom_cdf__get_file_var
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_cdf__del_coord_var(td_file)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine delete coordinate variable from an 
+   !> opened netcdf file if present.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_name
+      CHARACTER(LEN=lc) :: cl_sname
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      IF( td_file%i_nvar > 0 )THEN
+         DO ji=td_file%i_nvar,1,-1
+            cl_name=TRIM(td_file%t_var(ji)%c_name)
+            DO jj=1,ip_maxdim
+               IF( td_file%t_dim(jj)%l_use )THEN
+                  cl_sname=fct_upper(td_file%t_dim(jj)%c_sname)
+                  IF( TRIM(cl_name) == TRIM(cl_sname) )THEN
+                     CALL file_del_var(td_file,TRIM(cl_name))
+                     EXIT
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDDO
+      ELSE
+         CALL logger_debug( &
+         &  " IOM CDF DEL VAR DIM: there is no variable in file "//&
+         &  TRIM(td_file%c_name))
+      ENDIF
+
+   END SUBROUTINE iom_cdf__del_coord_var
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION iom_cdf__read_dim_id(td_file, id_dimid) &
+         & RESULT (tf_dim)
+   !-------------------------------------------------------------------
+   !> @brief This function read one dimension in an opened netcdf file, 
+   !> given dimension id.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 - create unused dimension, when reading dimension
+   !> of length less or equal to zero
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] id_dimid  dimension id
+   !> @return  dimension structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(IN) :: td_file
+      INTEGER(i4), INTENT(IN) :: id_dimid
+
+      ! function
+      TYPE(TDIM)              :: tf_dim
+
+      ! local variable
+      INTEGER(i4)       :: il_status
+      INTEGER(i4)       :: il_len
+      CHARACTER(LEN=lc) :: cl_name
+      LOGICAL           :: ll_use
+      !----------------------------------------------------------------
+
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " IOM CDF READ DIM: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+
+         CALL logger_trace( &
+         &  " IOM CDF READ DIM: dimension "//TRIM(fct_str(id_dimid))//&
+         &  " in file "//TRIM(td_file%c_name))
+
+         il_status=NF90_INQUIRE_DIMENSION(td_file%i_id, id_dimid, &
+         &                                cl_name, il_len )
+         CALL iom_cdf__check(il_status,"IOM CDF READ DIM: ")
+
+         ll_use=.TRUE.
+         IF( il_len <= 0 )THEN
+            CALL logger_warn( &
+         &  " IOM CDF READ DIM: dimension "//TRIM(fct_str(id_dimid))//&
+         &  " in file "//TRIM(td_file%c_name)//" is less or equel to zero")
+            il_len=1
+            ll_use=.FALSE.
+         ENDIF
+         tf_dim=dim_init(cl_name, il_len, ld_use=ll_use)
+
+      ENDIF
+
+      tf_dim%i_id=id_dimid
+
+   END FUNCTION iom_cdf__read_dim_id
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION iom_cdf__read_dim_name(td_file, cd_name) &
+         & RESULT (tf_dim)
+   !-------------------------------------------------------------------
+   !> @brief This function read one dimension in an opened netcdf file, 
+   !> given dimension name.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] cd_name   dimension name
+   !> @return  dimension structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE),      INTENT(IN) :: td_file
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+
+      ! function
+      TYPE(TDIM)                   :: tf_dim 
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_dimid
+      !----------------------------------------------------------------
+
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " IOM CDF READ DIM: no id associated to file "//&
+         &  TRIM(td_file%c_name))
+
+      ELSE      
+
+         il_status=NF90_INQ_DIMID( td_file%i_id, TRIM(ADJUSTL(cd_name)), &
+         &                         il_dimid)
+         CALL iom_cdf__check(il_status,"IOM CDF READ DIM: ")
+
+         tf_dim=iom_cdf_read_dim(td_file, il_dimid)
+
+      ENDIF
+
+   END FUNCTION iom_cdf__read_dim_name
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION iom_cdf__read_att_name(td_file, id_varid, cd_name) &
+         & RESULT (tf_att)
+   !-------------------------------------------------------------------
+   !> @brief This function read variable or global attribute in an opened 
+   !> netcdf file, given attribute name.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November 2017
+   !> - check if cl_value is not bug 
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] id_varid  variable id. use NF90_GLOBAL to read global
+   !> attribute in a file
+   !> @param[in] cd_name   attribute name
+   !> @return  attribute structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE),      INTENT(IN) :: td_file
+      INTEGER(i4),      INTENT(IN) :: id_varid
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+   
+      ! function
+      TYPE(TATT)                   :: tf_att
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_name
+
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_attid
+      INTEGER(i4) :: il_type
+      INTEGER(i4) :: il_len
+
+      CHARACTER(LEN=lc) :: cl_value
+      
+      INTEGER(i1), DIMENSION(:), ALLOCATABLE :: bl_value
+      INTEGER(i2), DIMENSION(:), ALLOCATABLE :: sl_value
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_value
+      REAL(sp)   , DIMENSION(:), ALLOCATABLE :: rl_value
+      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_value
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+            &  " IOM CDF READ ATT: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE      
+
+         cl_name=TRIM(ADJUSTL(cd_name))
+
+         ! inquire attribute
+         IF( id_varid == NF90_GLOBAL )THEN
+
+            CALL logger_trace( &
+               &  " IOM CDF READ ATT: inquire global attribute "//&
+               &  " in file "//TRIM(td_file%c_name))
+
+         ELSE
+
+            CALL logger_trace( &
+               &  " IOM CDF READ ATT: inquire attribute "//&
+               &  " of variable "//TRIM(fct_str(id_varid))//&
+               &  " in file "//TRIM(td_file%c_name))
+
+         ENDIF
+
+         il_status=NF90_INQUIRE_ATTRIBUTE(td_file%i_id, id_varid,  &
+            &                             cl_name,&
+            &                             il_type,&
+            &                             il_len, &
+            &                             il_attid )
+         CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")
+
+         !! get attribute value
+         CALL logger_debug( " IOM CDF READ ATT: get attribute "//&
+            &            TRIM(cl_name)//" in file "//TRIM(td_file%c_name))
+
+         SELECT CASE( il_type )
+
+            CASE(NF90_CHAR)
+               CALL logger_debug( " IOM CDF READ ATT: get NF90_CHAR ")
+
+               ! check string lengths
+               IF( LEN(cl_value) < il_len )THEN
+
+                  CALL logger_warn( &
+                     &  " IOM CDF READ ATT: not enough space to put "//&
+                     &  "attribute "//TRIM(cl_name) )
+
+               ELSE
+
+                  ! Read the attributes
+                  il_status=NF90_GET_ATT(td_file%i_id, id_varid, &
+                     &                   cl_name, &
+                     &                   cl_value )
+                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")
+
+                  ! check cl_value
+                  CALL logger_trace("IOM CDF READ ATT: value = "//TRIM(cl_value))
+                  IF( LLT(cl_value,'') ) cl_value = ''
+                  tf_att=att_init(cl_name, cl_value)
+
+               ENDIF
+         
+            CASE(NF90_BYTE)
+               CALL logger_debug( " IOM CDF READ ATT: get NF90_BYTE ")
+
+               ALLOCATE( bl_value(il_len), &
+                  &      stat=il_status)
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( "IOM CDF READ ATT: "//&
+                     &  "not enough space to put attribute "//TRIM(cl_name) )
+
+               ELSE
+
+                  ! Read the attributes
+                  il_status=NF90_GET_ATT(td_file%i_id, id_varid, &
+                     &                   cl_name, &
+                     &                   bl_value(:))
+                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
+
+                  tf_att=att_init(cl_name, bl_value(:))
+
+               ENDIF
+
+               DEALLOCATE(bl_value)
+
+            CASE(NF90_SHORT)
+               CALL logger_debug( " IOM CDF READ ATT: get NF90_SHORT ")
+
+               ALLOCATE( sl_value(il_len), &
+                  &      stat=il_status)
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( &
+                     &  " IOM CDF READ ATT: not enough space to put "//&
+                     &  "attribute "//TRIM(cl_name) )
+
+               ELSE
+
+                  ! Read the attributes
+                  il_status=NF90_GET_ATT(td_file%i_id, id_varid, &
+                     &                   cl_name, &
+                     &                   sl_value(:))
+                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
+
+                  tf_att=att_init(cl_name, sl_value(:))
+
+               ENDIF
+
+               DEALLOCATE(sl_value)
+
+            CASE(NF90_INT)
+               CALL logger_debug( " IOM CDF READ ATT: get NF90_INT ")
+
+               ALLOCATE( il_value(il_len), &
+                  &      stat=il_status)
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( &
+                     &  " IOM CDF READ ATT: not enough space to put "//&
+                     &  "attribute "//TRIM(cl_name) )
+
+               ELSE
+
+                  ! Read the attributes
+                  il_status=NF90_GET_ATT(td_file%i_id, id_varid, &
+                     &                   cl_name, &
+                     &                   il_value(:))
+                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
+
+                  tf_att=att_init(cl_name, il_value(:))
+               ENDIF
+
+               DEALLOCATE(il_value)
+
+            CASE(NF90_FLOAT)
+               CALL logger_debug( " IOM CDF READ ATT: get NF90_FLOAT ")
+
+               ALLOCATE( rl_value(il_len), &
+                  &      stat=il_status)
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( &
+                  &  " IOM CDF READ ATT: not enough space to put "//&
+                  &  "attribute "//TRIM(cl_name) )
+
+               ELSE
+
+                  ! Read the attributes
+                  il_status=NF90_GET_ATT(td_file%i_id, id_varid, &
+                     &                   cl_name, &
+                     &                   rl_value(:))
+                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
+
+                  tf_att=att_init(cl_name, rl_value(:))
+
+               ENDIF
+
+               DEALLOCATE(rl_value)
+
+            CASE(NF90_DOUBLE)
+               CALL logger_debug( " IOM CDF READ ATT: get NF90_DOUBLE ")
+
+               ALLOCATE( dl_value(il_len), &
+                  &      stat=il_status)
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( &
+                     &  " IOM CDF READ ATT: not enough space to put "//&
+                     &  "attribute "//TRIM(cl_name) )
+
+               ELSE
+
+                  ! Read the attributes
+                  il_status=NF90_GET_ATT(td_file%i_id, id_varid, &
+                     &                   cl_name, &
+                     &                   dl_value(:))
+                  CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")   
+
+                  tf_att=att_init(cl_name, dl_value(:))
+
+               ENDIF
+
+               DEALLOCATE(dl_value)
+
+         END SELECT
+
+         tf_att%i_id=il_attid
+
+      ENDIF
+
+   END FUNCTION iom_cdf__read_att_name
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION iom_cdf__read_att_id(td_file, id_varid, id_attid) &
+         & RESULT (tf_att)
+   !-------------------------------------------------------------------
+   !> @brief This function read variable or global attribute in an opened 
+   !> netcdf file, given attribute id.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] id_varid  variable id. use NF90_GLOBAL to read global 
+   !> attribute in a file
+   !> @param[in] id_attid  attribute id
+   !> @return  attribute structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(IN) :: td_file
+      INTEGER(i4), INTENT(IN) :: id_varid
+      INTEGER(i4), INTENT(IN) :: id_attid
+
+      ! function
+      TYPE(TATT)              :: tf_att
+
+      ! local variable
+      INTEGER(i4)       :: il_status
+      CHARACTER(LEN=lc) :: cl_name
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+            &  "IOM CDF READ ATT: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+
+         CALL logger_trace( " IOM CDF READ ATT ID: get attribute "//&
+            &               TRIM(fct_str(id_attid))//" of var "//&
+            &               TRIM(fct_str(id_varid))//" in file "//&
+            &               TRIM(td_file%c_name) &
+         )
+
+         ! get attribute name
+         il_status=NF90_INQ_ATTNAME(td_file%i_id, id_varid, id_attid, cl_name)
+         CALL iom_cdf__check(il_status,"IOM CDF READ ATT: ")
+
+         ! read attribute
+         tf_att=iom_cdf__read_att_name(td_file, id_varid, cl_name)
+
+      ENDIF
+
+   END FUNCTION iom_cdf__read_att_id
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION iom_cdf__read_var_id(td_file, id_varid, id_start, id_count) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function read variable value in an opened 
+   !> netcdf file, given variable id.
+   !> @details
+   !> Optionaly, start indices and number of indices selected along each dimension 
+   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] id_varid  variable id
+   !> @param[in] id_start  index in the variable from which the data values 
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !> @return  variable structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE),               INTENT(IN) :: td_file
+      INTEGER(i4),               INTENT(IN) :: id_varid
+      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count
+
+      ! function
+      TYPE(TVAR)                            :: tf_var
+
+      ! local variable
+      INTEGER(i4), DIMENSION(1) :: il_ind
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " IOM CDF READ VAR: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+
+         ! look for variable index
+         il_ind(:)=MINLOC(td_file%t_var(:)%i_id,mask=(td_file%t_var(:)%i_id==id_varid))
+         IF( il_ind(1) /= 0 )THEN
+
+            tf_var=var_copy(td_file%t_var(il_ind(1)))
+
+            !!! read variable value
+            CALL iom_cdf__read_var_value(td_file, tf_var, id_start, id_count)
+
+         ELSE
+            CALL logger_error( &
+            &  " IOM CDF READ VAR: there is no variable with id "//&
+            &  TRIM(fct_str(id_varid))//" in file "//TRIM(td_file%c_name))
+         ENDIF
+
+      ENDIF
+   END FUNCTION iom_cdf__read_var_id
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION iom_cdf__read_var_name(td_file, cd_name, id_start, id_count) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function read variable value in an opened 
+   !> netcdf file, given variable name or standard name.
+   !> @details
+   !> Optionaly, start indices and number of indices selected along each dimension 
+   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
+   !>
+   !> look first for variable name. If it doesn't
+   !> exist in file, look for variable standard name.<br/>
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] cd_name   variable name or standard name.
+   !> @param[in] id_start  index in the variable from which the data values will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !> @return  variable structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE)     ,                INTENT(IN) :: td_file
+      CHARACTER(LEN=*),                INTENT(IN), OPTIONAL :: cd_name
+      INTEGER(i4)     , DIMENSION(:),  INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:),  INTENT(IN), OPTIONAL :: id_count
+
+      ! function
+      TYPE(TVAR)                                  :: tf_var
+
+      ! local variable
+      INTEGER(i4)       :: il_varid
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " IOM CDF READ VAR: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+
+         IF( .NOT. PRESENT(cd_name) )THEN
+
+            CALL logger_error( &
+            &  " IOM CDF READ VAR: you must specify a variable to read "//&
+            &  " in file "//TRIM(td_file%c_name))
+
+         ELSE
+
+            il_varid=var_get_index(td_file%t_var(:), cd_name)
+            IF( il_varid /= 0 )THEN
+
+               tf_var=var_copy(td_file%t_var(il_varid))
+
+               !!! read variable value
+               CALL iom_cdf__read_var_value( td_file, tf_var, id_start, id_count)
+
+            ELSE
+
+               CALL logger_error( &
+               &  " IOM CDF READ VAR: there is no variable with "//&
+               &  " name or standard name "//TRIM(cd_name)//&
+               &  " in file "//TRIM(td_file%c_name) )
+            ENDIF
+
+         ENDIF
+
+      ENDIF
+ 
+   END FUNCTION iom_cdf__read_var_name
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_cdf__fill_var_all(td_file, id_start, id_count)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill all variable value from an opened 
+   !> netcdf file.
+   !> @details
+   !> Optionaly, start indices and number of indices selected along each dimension 
+   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_file   file structure
+   !> @param[in] id_start     index in the variable from which the data values 
+   !> will be read
+   !> @param[in] id_count     number of indices selected along each dimension
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE),               INTENT(INOUT) :: td_file
+      INTEGER(i4), DIMENSION(:), INTENT(IN   ),  OPTIONAL :: id_start
+      INTEGER(i4), DIMENSION(:), INTENT(IN   ),  OPTIONAL :: id_count
+
+      ! local variable
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " IOM CDF FILL VAR: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+
+         DO ji=1,td_file%i_nvar
+            CALL iom_cdf_fill_var(td_file, td_file%t_var(ji)%i_id, &
+            &                     id_start, id_count)
+         ENDDO
+
+      ENDIF
+
+   END SUBROUTINE iom_cdf__fill_var_all
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_cdf__fill_var_id(td_file, id_varid, id_start, id_count)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill variable value in an opened 
+   !> netcdf file, given variable id.
+   !> @details
+   !> Optionaly, start indices and number of indices selected along each dimension 
+   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
+   !
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !
+   !> @param[inout] td_file   file structure
+   !> @param[in] id_varid     variable id
+   !> @param[in] id_start     index in the variable from which the data values 
+   !> will be read
+   !> @param[in] id_count     number of indices selected along each dimension
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE),               INTENT(INOUT) :: td_file
+      INTEGER(i4),               INTENT(IN)    :: id_varid
+      INTEGER(i4), DIMENSION(:), INTENT(IN),  OPTIONAL :: id_start
+      INTEGER(i4), DIMENSION(:), INTENT(IN),  OPTIONAL :: id_count
+
+      ! local variable
+      INTEGER(i4), DIMENSION(1) :: il_varid
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  "IOM CDF FILL VAR: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+
+         ! look for variable id
+         il_varid(:)=MINLOC( td_file%t_var(:)%i_id, &
+         &                 mask=(td_file%t_var(:)%i_id==id_varid))
+         IF( il_varid(1) /= 0 )THEN
+
+            !!! read variable value
+            CALL iom_cdf__read_var_value(td_file, td_file%t_var(il_varid(1)), &
+            &                            id_start, id_count)
+
+            DO ji=1,td_file%i_nvar
+               CALL logger_debug(" IOM CDF FILL VAR: var id "//&
+               &     TRIM(td_file%t_var(ji)%c_name)//" "//&
+               &     TRIM(fct_str(td_file%t_var(ji)%i_id)) )
+            ENDDO
+         ELSE
+            CALL logger_error( &
+            &  " IOM CDF FILL VAR: there is no variable with id "//&
+            &  TRIM(fct_str(id_varid))//" in file "//TRIM(td_file%c_name))
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE iom_cdf__fill_var_id
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_cdf__fill_var_name(td_file, cd_name, id_start, id_count)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill variable value in an opened 
+   !> netcdf file, given variable name or standard name.
+   !> @details
+   !> Optionaly, start indices and number of indices selected along each dimension 
+   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
+   !>
+   !> look first for variable name. If it doesn't
+   !> exist in file, look for variable standard name.<br/>
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_file   file structure
+   !> @param[in] cd_name      variable name or standard name
+   !> @param[in] id_start     index in the variable from which the data values will be read
+   !> @param[in] id_count     number of indices selected along each dimension
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE),                   INTENT(INOUT) :: td_file
+      CHARACTER(LEN=*),              INTENT(IN)    :: cd_name
+      INTEGER(i4),     DIMENSION(:), INTENT(IN),  OPTIONAL :: id_start
+      INTEGER(i4),     DIMENSION(:), INTENT(IN),  OPTIONAL :: id_count
+
+      ! local variable
+      INTEGER(i4)       :: il_varid
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  "IOM CDF FILL VAR: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+
+            il_varid=var_get_index(td_file%t_var(:), cd_name)
+            IF( il_varid /= 0 )THEN
+
+               !!! read variable value
+               CALL iom_cdf__read_var_value(td_file, td_file%t_var(il_varid), &
+               &                            id_start, id_count)
+
+            ELSE
+
+               CALL logger_error( &
+               &  "IOM CDF FILL VAR: there is no variable with "//&
+               &  "name or standard name"//TRIM(cd_name)//&
+               &  " in file "//TRIM(td_file%c_name))
+            ENDIF
+
+      ENDIF
+      
+   END SUBROUTINE iom_cdf__fill_var_name
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION iom_cdf__read_var_meta(td_file, id_varid) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function read metadata of a variable in an opened 
+   !> netcdf file.
+   !>
+   !> @note variable value are not read
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014
+   !> - force to use FillValue=1.e20 if no FillValue for coordinate variable.
+   !> @date September, 2015
+   !> - manage useless (dummy) attribute
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] id_varid  variable id
+   !> @return  variable structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(IN) :: td_file
+      INTEGER(i4), INTENT(IN) :: id_varid
+
+      ! function
+      TYPE(TVAR)              :: tf_var
+
+      ! local variable
+      CHARACTER(LEN=lc)                                       :: cl_name
+
+      INTEGER(i4)                                             :: il_status
+      INTEGER(i4)                                             :: il_type
+      INTEGER(i4)                                             :: il_ndim
+      INTEGER(i4)                                             :: il_natt
+      INTEGER(i4)                                             :: il_attid
+      INTEGER(i4), DIMENSION(NF90_MAX_VAR_DIMS)               :: il_dimid
+
+      TYPE(TDIM) , DIMENSION(ip_maxdim)                       :: tl_dim
+      TYPE(TATT)                                              :: tl_fill
+      TYPE(TATT) , DIMENSION(:)                 , ALLOCATABLE :: tl_att
+      TYPE(TATT) , DIMENSION(:)                 , ALLOCATABLE :: tl_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+            &  " IOM CDF READ VAR META: no id associated to file "//&
+            &   TRIM(td_file%c_name))
+
+      ELSE
+
+         ! inquire variable
+         CALL logger_debug( &
+            &  " IOM CDF READ VAR META: inquire variable "//&
+            &  TRIM(fct_str(id_varid))//&
+            &  " in file "//TRIM(td_file%c_name))
+         
+         il_dimid(:)=0
+
+         il_status=NF90_INQUIRE_VARIABLE( td_file%i_id, id_varid,        &
+            &                             cl_name,    &
+            &                             il_type,    &
+            &                             il_ndim,    &
+            &                             il_dimid(:),&
+            &                             il_natt )
+         CALL iom_cdf__check(il_status,"IOM CDF READ VAR META: ")
+
+         !!! fill variable dimension structure
+         tl_dim(:)=iom_cdf__read_var_dim( td_file, il_ndim, cl_name, il_dimid(:) )
+
+         IF( il_natt /= 0 )THEN
+            ALLOCATE( tl_att(il_natt) )
+            !!! fill variable attribute structure
+            tl_att(:)=iom_cdf__read_var_att(td_file, id_varid, il_natt)
+
+            !! look for _FillValue. if none add one
+            il_attid=att_get_id(tl_att(:),'_FillValue')
+            IF( il_attid == 0 )THEN
+               CALL logger_info("IOM CDF READ VAR META: no _FillValue for variable "//&
+                  &  TRIM(cl_name)//" in file "//TRIM(td_file%c_name) )
+
+               il_attid=att_get_id(tl_att(:),'missing_value')
+               IF( il_attid /= 0 )THEN
+                  ! create attribute _FillValue
+                  CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//&
+                     &             "missing_value for variable "//TRIM(cl_name) )
+                  tl_fill=att_init('_FillValue',tl_att(il_attid)%d_value(:), &
+                     &             id_type=tl_att(il_attid)%i_type)
+               ELSE
+                  ! create attribute _FillValue
+                  SELECT CASE(TRIM(fct_lower(cl_name)))
+                     CASE DEFAULT
+                        CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//&
+                           &             "zero for variable "//TRIM(cl_name) )
+                        tl_fill=att_init('_FillValue',0.)
+                     CASE('nav_lon','nav_lat', 'nav_lev', &
+                        &  'glamt','glamu','glamv','glamf', &
+                        &  'gphit','gphiu','gphiv','gphif')
+                        CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//&
+                           &             "dummy fillValue (1.e20) for variable "//TRIM(cl_name) )
+                        tl_fill=att_init('_FillValue',1.e20)
+                  END SELECT
+               ENDIF
+
+               ALLOCATE( tl_tmp(il_natt) )
+               ! save read attribut
+               tl_tmp(:)=att_copy(tl_att(:))
+               ! change number of attribute in array
+               CALL att_clean(tl_att(:))
+               DEALLOCATE( tl_att )
+               ALLOCATE( tl_att(il_natt+1) )
+               ! copy read attribut
+               tl_att(1:il_natt)=att_copy(tl_tmp(:))
+               ! clean
+               CALL att_clean(tl_tmp(:))
+               DEALLOCATE( tl_tmp )
+
+               ! create attribute _FillValue
+               tl_att(il_natt+1)=att_copy(tl_fill)
+
+            ENDIF
+
+         ELSE
+            ALLOCATE(tl_att(il_natt+1) )
+            ! create attribute _FillValue
+            SELECT CASE(TRIM(fct_lower(cl_name)))
+               CASE DEFAULT
+                  CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//&
+                     &             "zero for variable "//TRIM(cl_name) )
+                  tl_fill=att_init('_FillValue',0.)
+               CASE('nav_lon','nav_lat', &
+                  &  'glamt','glamu','glamv','glamf', &
+                  &  'gphit','gphiu','gphiv','gphif')
+                  CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//&
+                     &             "dummy fillValue (1.e20) for variable "//TRIM(cl_name) )
+                  tl_fill=att_init('_FillValue',1.e20)
+            END SELECT            
+            ! create attribute _FillValue
+            tl_att(il_natt+1)=att_copy(tl_fill)
+         ENDIF
+
+         !! initialize variable
+         tf_var=var_init( cl_name, il_type, tl_dim(:), tl_att(:), id_id=id_varid )
+
+         !! look for dummy attribute
+         DO ji=il_natt,1,-1
+            IF( att_is_dummy(tl_att(ji)) )THEN
+               CALL var_del_att(tf_var, tl_att(ji))
+            ENDIF
+         ENDDO
+
+         !! check if variable is dummy
+         IF( var_is_dummy(tf_var) )THEN
+            tf_var%l_use=.FALSE.
+         ENDIF
+
+         !! check if all dimensions are allowed
+         DO ji=1,il_ndim
+            IF( ALL(td_file%t_dim(:)%i_id /= il_dimid(ji)) )THEN
+               tf_var%l_use=.FALSE.
+            ENDIF
+         ENDDO
+
+         ! clean
+         CALL dim_clean(tl_dim(:))
+         CALL att_clean(tl_fill)
+         CALL att_clean(tl_att(:))
+         DEALLOCATE( tl_att )
+
+      ENDIF
+
+   END FUNCTION iom_cdf__read_var_meta
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION iom_cdf__read_var_dim(td_file, id_ndim, cd_name, id_dimid) &
+         & RESULT (tf_dim)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read variable dimension
+   !> in an opened netcdf file.
+   !>
+   !> @details
+   !> the number of dimension can't exceed 4, 
+   !> and should be 'x', 'y', 'z', 't' (whatever their order).<br/>
+   !> If the number of dimension read is less than 4, the array of dimension
+   !> strucure is filled with unused dimension.<br/>
+   !> So the array of dimension structure of a variable is always compose of 4
+   !> dimension (use or not). 
+   !>
+   !> @warn dummy dimension are not used. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - Bug fix: use order to disorder table (see dim_init)
+   !> @date September, 2015
+   !> - check dummy dimension
+   !> @date April, 2018
+   !> - Bug fix : use dimid to look for the index of the dimension, and not as
+   !> dimension index
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] id_ndim   number of dimension
+   !> @param[in] cd_name   variable name
+   !> @param[in] id_dimid  array of dimension id
+   !> @return array dimension structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE),               INTENT(IN) :: td_file
+      INTEGER(i4),               INTENT(IN) :: id_ndim
+      CHARACTER(LEN=*)         , INTENT(IN) :: cd_name
+      INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_dimid
+
+      ! function
+      TYPE(TDIM), DIMENSION(ip_maxdim)      :: tf_dim
+
+      ! local variable
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_xyzt2
+      INTEGER(i4)                       :: il_idx
+
+      TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: ii
+      !----------------------------------------------------------------
+
+      IF( id_ndim == 0 )THEN
+
+         tl_dim(:)%l_use=.FALSE.
+
+         ! reorder dimension to ('x','y','z','t')
+         CALL dim_reorder(tl_dim(:))
+
+         tf_dim(:)=dim_copy(tl_dim(:))
+
+         ! clean
+         CALL dim_clean(tl_dim(:))
+
+      ELSE IF( id_ndim > 0 )THEN
+
+         ii=1
+         DO ji = 1, id_ndim
+
+            ! check if dimension to be used, is allowed
+            IF( ANY(td_file%t_dim(:)%i_id == id_dimid(ji)) )THEN
+               IF( ii > ip_maxdim )THEN
+                  CALL logger_error(" IOM CDF READ VAR DIM: "//&
+                     &  "too much dimensions for variable "//&
+                     &  TRIM(cd_name)//". check dummy configuration file.")
+               ENDIF
+
+               CALL logger_debug( " IOM CDF READ VAR DIM: get variable "//&
+                  &  "dimension "//TRIM(fct_str(ji)) )
+
+               ! look for dimension index
+               DO jj=1,ip_maxdim
+                  IF( td_file%t_dim(jj)%i_id == id_dimid(ji) )THEN
+                     il_idx=jj
+                     EXIT
+                  ENDIF
+               ENDDO
+               !il_xyzt2(ii)=td_file%t_dim(id_dimid(ji))%i_xyzt2
+               il_xyzt2(ii)=td_file%t_dim(il_idx)%i_xyzt2
+
+               ! read dimension information
+               tl_dim(ii) = dim_init( td_file%t_dim(il_xyzt2(ii))%c_name, &
+                  &                   td_file%t_dim(il_xyzt2(ii))%i_len )
+
+               ii=ii+1
+            ELSE
+               CALL logger_debug(" IOM CDF READ VAR DIM: dummy variable "//&
+                  &              "dimension "//TRIM(fct_str(ji))//" not used.")
+            ENDIF
+         ENDDO
+
+         ! reorder dimension to ('x','y','z','t')
+         CALL dim_reorder(tl_dim(:))
+ 
+         tf_dim(:)=dim_copy(tl_dim(:))
+
+         ! clean
+         CALL dim_clean(tl_dim(:))
+
+      ENDIF
+
+   END FUNCTION iom_cdf__read_var_dim
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION iom_cdf__read_var_att(td_file, id_varid, id_natt) &
+         & RESULT (tf_att)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read variable attributes
+   !> in an opened netcdf file.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] id_varid  variable id
+   !> @param[in] id_natt   number of attributes
+   !> @return array of attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(IN) :: td_file
+      INTEGER(i4), INTENT(IN) :: id_varid
+      INTEGER(i4), INTENT(IN) :: id_natt      
+
+      ! function
+      TYPE(TATT), DIMENSION(id_natt) :: tf_att
+
+      ! local variable
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( id_natt > 0 )THEN
+      
+         ! read attributes
+         DO ji = 1, id_natt
+            CALL logger_trace( " IOM CDF READ VAR ATT: get attribute "//&
+               &               TRIM(fct_str(ji))//" in file "//&
+               &               TRIM(td_file%c_name) &
+            )
+
+            tf_att(ji)=iom_cdf_read_att(td_file, id_varid, ji)
+
+         ENDDO
+
+      ELSE
+
+         CALL logger_debug( " IOM CDF READ VAR ATT: no attribute for variable " )
+
+      ENDIF
+
+   END FUNCTION iom_cdf__read_var_att
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_cdf__read_var_value(td_file, td_var, id_start, id_count)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read variable value
+   !> in an opened netcdf file.
+   !> @details
+   !> Optionaly, start indices and number of indices selected along each dimension 
+   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - use scale factor and offset, as soon as read variable value
+   !> @date January, 2019
+   !> - read array in netcdf file, level by level, and time step by time step
+   !> - apply scale factor and offset, level by level, and time step by time step
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[inout] td_var variable structure
+   !> @param[in] id_start  index in the variable from which the data values will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !> @return variable structure completed 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE),               INTENT(IN)    :: td_file
+      TYPE(TVAR) ,               INTENT(INOUT) :: td_var
+      INTEGER(i4), DIMENSION(:), INTENT(IN),   OPTIONAL :: id_start
+      INTEGER(i4), DIMENSION(:), INTENT(IN),   OPTIONAL :: id_count
+
+      ! local variable
+      INTEGER(i4)                                    :: il_status
+      INTEGER(i4)                                    :: il_tmp1
+      INTEGER(i4)                                    :: il_tmp2
+      INTEGER(i4)                                    :: il_varid
+      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_start
+      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_count
+      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_start_ord
+      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_count_ord
+      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_start_tmp
+      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_count_tmp
+
+      REAL(dp)   , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_value
+      REAL(dp)   , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      ! check if variable in file structure
+      il_varid=var_get_id(td_file%t_var(:),TRIM(td_var%c_name))
+      IF( il_varid /= 0 )THEN
+
+         ! check id_count and id_start optionals parameters...
+         IF( (       PRESENT(id_start)  .AND. (.NOT. PRESENT(id_count))) .OR. &
+             ((.NOT. PRESENT(id_start)) .AND.        PRESENT(id_count) ) )THEN
+            CALL logger_warn( "IOM CDF READ VAR VALUE: id_start and id_count"//&
+               & " should be both specify")
+         ENDIF
+         IF( PRESENT(id_start).AND.PRESENT(id_count) )THEN
+
+            IF( SIZE(id_start(:)) /= ip_maxdim .OR. &
+            &   SIZE(id_count(:)) /= ip_maxdim )THEN
+               CALL logger_error("IOM CDF READ VAR: dimension of array start"//&
+                  &  " or count are invalid to read variable "//&
+                  &  TRIM(td_var%c_name)//" in file "//TRIM(td_file%c_name) )
+            ENDIF
+
+            ! change dimension order from ('x','y','z','t')
+            il_start(:)=dim_reorder_xyzt2(td_var%t_dim, id_start(:))
+            il_count(:)=dim_reorder_xyzt2(td_var%t_dim, id_count(:))
+
+            ! keep ordered array ('x','y','z','t')
+            il_start_ord(:)=id_start(:)
+            il_count_ord(:)=id_count(:)
+
+         ELSE
+
+            ! change dimension order from ('x','y','z','t')
+            il_start(:)=(/1,1,1,1/)
+            il_count(:)=dim_reorder_xyzt2(td_var%t_dim(:),td_var%t_dim(:)%i_len)
+
+            ! keep ordered array ('x','y','z','t')
+            il_start_ord(:)=(/1,1,1,1/)
+            il_count_ord(:)=td_var%t_dim(:)%i_len
+
+         ENDIF
+
+         ! check dimension
+         IF( .NOT. ALL(il_start_ord(:)>=(/1,1,1,1/)) )THEN
+
+            CALL logger_error( "IOM CDF READ VAR VALUE: start indices should"//&
+            &  " be greater than or equal to 1")
+
+         ENDIF
+
+         IF(.NOT.ALL(il_start_ord(:)+il_count_ord(:)-1 <= &
+            &  (/td_var%t_dim( 1 )%i_len,&
+            &    td_var%t_dim( 2 )%i_len,&
+            &    td_var%t_dim( 3 )%i_len,&
+            &    td_var%t_dim( 4 )%i_len &
+            &                                            /)) )THEN
+
+            DO ji = 1, ip_maxdim
+               il_tmp1=il_start_ord(ji)+il_count_ord(ji)-1
+               il_tmp2=td_var%t_dim(ji)%i_len
+               CALL logger_debug( "IOM CDF READ VAR VALUE: start + count -1:"//&
+               &  TRIM(fct_str(il_tmp1))//" variable dimension"//&
+               &  TRIM(fct_str(il_tmp2)))
+            ENDDO
+            CALL logger_error( "IOM CDF READ VAR VALUE: start + count exceed "//&
+            &  "variable dimension for "//TRIM(td_var%c_name) )
+
+         ELSE
+
+            ! Allocate space to hold variable value (disorder)
+            ALLOCATE(dl_value( il_count(1), &
+               &               il_count(2), &
+               &               il_count(3), &
+               &               il_count(4)),&
+               &               stat=il_status)
+            IF( il_status /= 0 )THEN
+
+              CALL logger_fatal( &
+               &  "IOM CDF READ VAR VALUE: not enough space to put variable "//&
+               &  TRIM(td_var%c_name))
+
+            ENDIF
+
+            ! read values
+            CALL logger_debug( &
+            &  "IOM CDF READ VAR VALUE: get variable "//TRIM(td_var%c_name)//&
+            &  " in file "//TRIM(td_file%c_name))
+
+            il_start_tmp(:)=il_start(:)
+            il_count_tmp(:)=il_count(:)
+            DO jl=il_start(jp_L),il_start(jp_L)+il_count(jp_L)-1
+               il_start_tmp(jp_L)=jl
+               il_count_tmp(jp_L) = 1
+               DO jk=il_start(jp_K),il_start(jp_K)+il_count(jp_K)-1
+                  il_start_tmp(jp_K)=jk
+                  il_count_tmp(jp_K)=1 
+                  il_status = NF90_GET_VAR( td_file%i_id, il_varid,           &
+                  &                                       dl_value(:,:,jk,jl),&
+                  &                                       start = il_start_tmp(:),&
+                  &                                       count = il_count_tmp(:) )
+            !   il_status = NF90_GET_VAR( td_file%i_id, il_varid,           &
+            !   &                                       dl_value(:,:,:,:),&
+               CALL iom_cdf__check(il_status,"IOM CDF READ VAR VALUE: ")
+               ENDDO
+            ENDDO
+
+            ! Allocate space to hold variable value in structure
+            IF( ASSOCIATED(td_var%d_value) )THEN
+               DEALLOCATE(td_var%d_value)   
+            ENDIF
+ 
+            ! new dimension length
+            td_var%t_dim(:)%i_len=il_count_ord(:)
+
+!>   dummy patch for pgf95
+            ALLOCATE( dl_tmp( td_var%t_dim(1)%i_len, &
+            &                 td_var%t_dim(2)%i_len, &
+            &                 td_var%t_dim(3)%i_len, &
+            &                 td_var%t_dim(4)%i_len),&
+            &        stat=il_status)
+            IF(il_status /= 0 )THEN
+
+               CALL logger_fatal( &
+               &  "IOM CDF READ VAR VALUE: not enough space to put variable "//&
+               &  TRIM(td_var%c_name)//&
+               &  " in variable structure")
+            ENDIF
+            dl_tmp(:,:,:,:)=td_var%d_fill
+
+            ! reshape values to be ordered as ('x','y','z','t')
+            dl_tmp(:,:,:,:)=dim_reshape_2xyzt(td_var%t_dim(:), &
+            &                                 dl_value(:,:,:,:))
+
+            DEALLOCATE(dl_value)
+
+            ALLOCATE(td_var%d_value( td_var%t_dim(1)%i_len, &
+            &                        td_var%t_dim(2)%i_len, &
+            &                        td_var%t_dim(3)%i_len, &
+            &                        td_var%t_dim(4)%i_len),&
+            &        stat=il_status)
+            IF(il_status /= 0 )THEN
+
+               CALL logger_fatal( &
+               &  "IOM CDF READ VAR VALUE: not enough space to put variable "//&
+               &  TRIM(td_var%c_name)//&
+               &  " in variable structure")
+
+            ENDIF
+!            ! FillValue by default
+!            td_var%d_value(:,:,:,:)=td_var%d_fill
+!
+!            ! reshape values to be ordered as ('x','y','z','t')
+!            td_var%d_value(:,:,:,:)=dim_reshape_2xyzt(td_var%t_dim(:), &
+!            &                                         dl_value(:,:,:,:))
+!
+!            DEALLOCATE(dl_value)
+
+            DO jl=1,td_var%t_dim(jp_L)%i_len
+               DO jk=1,td_var%t_dim(jp_K)%i_len
+                  DO jj=1,td_var%t_dim(jp_J)%i_len
+                     DO ji=1,td_var%t_dim(jp_I)%i_len
+                        td_var%d_value(ji,jj,jk,jl)=dl_tmp(ji,jj,jk,jl)
+                     ENDDO
+                  ENDDO
+               ENDDO
+            ENDDO
+            DEALLOCATE(dl_tmp)
+!<   dummy patch for pgf95
+
+            ! force to change _FillValue to avoid mistake 
+            ! with dummy zero _FillValue
+            IF( td_var%d_fill == 0._dp )THEN
+               CALL var_chg_FillValue(td_var)
+            ENDIF
+
+            ! use scale factor and offset
+            DO jl=1,td_var%t_dim(jp_L)%i_len
+               DO jk=1,td_var%t_dim(jp_K)%i_len
+                  WHERE( td_var%d_value(:,:,jk,jl) /= td_var%d_fill )
+                     td_var%d_value(:,:,jk,jl) = &
+                     &  td_var%d_value(:,:,jk,jl)*td_var%d_scf + td_var%d_ofs
+                  END WHERE
+               ENDDO
+            ENDDO
+
+         ENDIF
+      ELSE
+         CALL logger_error( &
+         &  "IOM CDF READ VAR VALUE: no variable "//TRIM(td_var%c_name)//&
+         &  " in file structure "//TRIM(td_file%c_name))
+      ENDIF
+
+   END SUBROUTINE iom_cdf__read_var_value
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_cdf_write_header(td_file, cd_dimorder, td_dim)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write file header in an opened netcdf file.
+   !>
+   !> @details
+   !> optionally, you could specify dimension order (default 'xyzt'),
+   !> and/or dimension structure to be used.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - add dimension order option 
+   !> @date August, 2017
+   !> - split write_file into write_header and write_var
+   !> - add dimension structure as optional argument
+   !> @date September, 2017
+   !> - do not check variable dimension if dimension forced
+   !>
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE)                           , INTENT(INOUT) :: td_file
+      CHARACTER(LEN=*)                      , INTENT(IN   ), OPTIONAL :: cd_dimorder
+      TYPE(TDIM )     , DIMENSION(ip_maxdim), INTENT(IN   ), OPTIONAL :: td_dim
+
+      ! local variable
+      INTEGER(i4)                            :: il_status
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_value
+
+      CHARACTER(LEN=lc)                      :: cl_dimorder
+
+      LOGICAL                                :: ll_chkdim
+
+      TYPE(TVAR), DIMENSION(ip_maxdim)       :: tl_var
+
+      TYPE(TDIM), DIMENSION(ip_maxdim)       :: tl_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jvar
+      !----------------------------------------------------------------
+
+      cl_dimorder='xyzt'
+      IF( PRESENT(cd_dimorder) ) cl_dimorder=TRIM(cd_dimorder)
+
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " IOM CDF WRITE HEADER: no id associated to file "//&
+         &  TRIM(td_file%c_name)//". Check if file is opened.")
+
+      ELSE
+         IF( td_file%l_wrt )THEN
+
+            ! remove dummy variable
+            CALL file_del_var(td_file,'no0d')
+            CALL file_del_var(td_file,'no1d')
+            CALL file_del_var(td_file,'no2d')
+            CALL file_del_var(td_file,'no3d')
+
+            DO ji = 1, td_file%i_nvar
+               CALL var_check_dim( td_file%t_var(ji) )
+            ENDDO
+
+            IF( PRESENT(td_dim) )THEN
+               ! special case to rebuild mpp layout
+               DO ji=1,ip_maxdim
+                  IF( td_dim(ji)%l_use ) CALL file_move_dim(td_file, td_dim(ji))
+               ENDDO
+            ELSE
+               ! save useful dimension
+               IF( ASSOCIATED(td_file%t_var) )THEN
+                  tl_dim(:) = var_max_dim( td_file%t_var(:) )
+
+                  DO ji=1,ip_maxdim
+                     IF( tl_dim(ji)%l_use ) CALL file_move_dim(td_file, tl_dim(ji))
+                  ENDDO
+                  ! clean
+                  CALL dim_clean(tl_dim(:))
+               ENDIF
+            ENDIF
+
+            ! Enter in define mode
+            IF( .NOT. td_file%l_def )THEN
+               CALL logger_debug( &
+               &  " IOM CDF WRITE HEADER: Enter define mode, file "//&
+               &  TRIM(td_file%c_name))
+
+               ! Enter define mode
+               il_status=NF90_REDEF(td_file%i_id)
+               CALL iom_cdf__check(il_status,"IOM CDF WRITE HEADER: ")
+
+               td_file%l_def=.TRUE.
+            ENDIF            
+
+            ! write dimension definition in header of file
+            IF( TRIM(cl_dimorder) /= 'xyzt' )THEN
+               CALL dim_reorder(td_file%t_dim(:),TRIM(cl_dimorder))
+               DO jvar=1,td_file%i_nvar
+                  CALL logger_debug("VAR REORDER: "//TRIM(td_file%t_var(jvar)%c_name))
+                  CALL var_reorder(td_file%t_var(jvar),TRIM(cl_dimorder))
+               ENDDO
+            ENDIF
+
+            ! write dimension in file
+            DO ji = 1, ip_maxdim
+               IF( td_file%t_dim(ji)%l_use )THEN
+                  CALL iom_cdf__write_dim_def(td_file, td_file%t_dim(ji))
+
+                  ! write dimension variable
+                  ALLOCATE(il_value(td_file%t_dim(ji)%i_len))
+                  il_value(:)=(/(jj,jj=1,td_file%t_dim(ji)%i_len)/)
+
+                  tl_var(ji)=var_init( fct_upper(td_file%t_dim(ji)%c_sname), &
+                  &                    il_value(:),                          &
+                  &                    td_dim=td_file%t_dim(ji) )
+
+                  DEALLOCATE(il_value)
+
+                  ! do not use FillValue for dimension variable
+                  CALL var_del_att(tl_var(ji), "_FillValue")
+                   
+                  ! write dimension variable definition in header of file
+                  CALL iom_cdf__write_var_def(td_file,tl_var(ji))
+                  
+               ENDIF
+            ENDDO
+
+            ! write global attibute in file
+            DO ji = 1, td_file%i_natt
+               CALL iom_cdf__write_att_def(td_file, NF90_GLOBAL, td_file%t_att(ji))
+            ENDDO
+ 
+            ! write variable definition in header of file
+            ll_chkdim=.TRUE.
+            IF( PRESENT(td_dim) )THEN
+               ! special case to rebuild mpp layout
+               ! do not check dimension length of variable
+               ll_chkdim=.FALSE.
+            ENDIF
+            DO ji=1,td_file%i_nvar
+               CALL iom_cdf__write_var_def(td_file, td_file%t_var(ji),ll_chkdim)
+            ENDDO
+
+            ! Leave define mode
+            IF( td_file%l_def )THEN
+               CALL logger_debug( &
+               &  " IOM CDF WRITE HEADER: Leave define mode, file "//&
+               &  TRIM(td_file%c_name))
+
+               ! Leave define mode
+               il_status=NF90_ENDDEF(td_file%i_id)
+               CALL iom_cdf__check(il_status,"IOM CDF WRITE HEADER: ")
+
+               td_file%l_def=.FALSE.
+            ENDIF
+
+            ! write dimension variable in file
+            DO ji = 1, ip_maxdim
+               IF( td_file%t_dim(ji)%l_use )THEN
+                  ! do not use FillValue for dimension variable
+                  CALL var_del_att(tl_var(ji), "_FillValue")
+                  CALL iom_cdf__write_var(td_file,tl_var(ji))
+               ENDIF
+            ENDDO
+            ! clean
+            CALL var_clean(tl_var(:))
+
+         ELSE
+
+            CALL logger_error( &
+            &  "IOM CDF WRITE HEADER: try to write in file "//TRIM(td_file%c_name)//&
+            &  ", not opened in write mode")
+
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE iom_cdf_write_header
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_cdf_write_var(td_file, cd_dimorder, id_start, id_count)!, ld_first)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write variable(s) in an opened netcdf file.
+   !>
+   !> @details
+   !> optionally, you could specify dimension order (default 'xyzt')
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - add dimension order option 
+   !> @date August, 2017
+   !> - add start and count array as optional argument
+   !>
+   !> @param[inout] td_file   file structure
+   !> @param[in] td_var       array of variable structure
+   !> @param[in] cd_dimorder  dimension order
+   !> @param[in] id_start     index in the variable from which the data values 
+   !> will be read
+   !> @param[in] id_count     number of indices selected along each dimension
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE)                   , INTENT(INOUT) :: td_file
+      CHARACTER(LEN=*)              , INTENT(IN   ), OPTIONAL :: cd_dimorder
+      INTEGER(i4)     , DIMENSION(:), INTENT(IN   ), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:), INTENT(IN   ), OPTIONAL :: id_count
+      ! local variable
+      CHARACTER(LEN=lc)                      :: cl_dimorder
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      cl_dimorder='xyzt'
+      IF( PRESENT(cd_dimorder) ) cl_dimorder=TRIM(cd_dimorder)
+
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " IOM CDF WRITE VAR: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+         IF( td_file%l_wrt )THEN
+
+            ! write variable in file
+            DO ji = 1, td_file%i_nvar
+
+               ! change dimension order
+               IF( TRIM(cl_dimorder) /= 'xyzt' )THEN
+                  CALL logger_debug("VAR REORDER: "//TRIM(td_file%t_var(ji)%c_name))
+                  CALL var_reorder(td_file%t_var(ji),TRIM(cl_dimorder))
+               ENDIF
+
+               IF( ASSOCIATED(td_file%t_var(ji)%d_value) )THEN
+                  ! write variable value in file
+                  CALL iom_cdf__write_var_value( td_file, td_file%t_var(ji), &
+                     &                           id_start, id_count)
+               ENDIF
+            ENDDO
+
+         ELSE
+
+            CALL logger_error( &
+            &  "IOM CDF WRITE VAR: try to write in file "//TRIM(td_file%c_name)//&
+            &  ", not opened in write mode")
+
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE iom_cdf_write_var
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_cdf__write_dim_def(td_file, td_dim)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine define a dimension in the header of a netcdf 
+   !> file.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date August, 2017
+   !> - rename in write_dim_def
+   !> - do not check define mode here anymore
+   !>
+   !> @param[inout] td_file   file structure
+   !> @param[inout] td_dim    dimension structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+      TYPE(TDIM),  INTENT(INOUT) :: td_dim
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      !----------------------------------------------------------------
+
+      IF( td_dim%l_use )THEN
+         IF( td_dim%l_uld )THEN
+            ! write unlimited dimension
+            CALL logger_trace( &
+            &  "IOM CDF WRITE FILE DIM: write unlimited dimension "//&
+            &  TRIM(td_dim%c_name)//" in file "//TRIM(td_file%c_name))
+
+            il_status=NF90_DEF_DIM(td_file%i_id, fct_upper(td_dim%c_sname), &
+            &                      NF90_UNLIMITED, td_dim%i_id)
+            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE DIM: ")
+
+         ELSE
+            ! write not unlimited dimension
+            CALL logger_debug( &
+            &  "IOM CDF WRITE FILE DIM: write dimension "//TRIM(td_dim%c_name)//&
+            &  " in file "//TRIM(td_file%c_name))
+            
+            CALL logger_debug("IOM CDF WRITE FILE DIM: id "//TRIM(fct_str(td_file%i_id))//&
+               & " sname "//TRIM(td_dim%c_sname))
+            il_status=NF90_DEF_DIM(td_file%i_id, fct_upper(td_dim%c_sname), &
+            &                      td_dim%i_len, td_dim%i_id)
+            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE DIM: ")
+
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE iom_cdf__write_dim_def
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_cdf__write_att_def(td_file, id_varid, td_att)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write a variable attribute in
+   !> an opened netcdf file.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date August, 2017
+   !> - rename in write_att_def
+   !> - do not check define mode here anymore
+   !>
+   !> @param[inout] td_file   file structure
+   !> @param[in] id_varid     variable id. use NF90_GLOBAL to write 
+   !> global attribute in a file
+   !> @param[in] td_att       attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+      INTEGER(i4), INTENT(IN)    :: id_varid
+      TYPE(TATT),  INTENT(IN)    :: td_att
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      !----------------------------------------------------------------
+
+      !! put attribute value
+      CALL logger_trace( &
+      &  "IOM CDF WRITE FILE ATT: write attribute "//TRIM(td_att%c_name)//&
+      &  " of variable "//TRIM(fct_str(id_varid))//&
+      &  " in file "//TRIM(td_file%c_name))
+      SELECT CASE( td_att%i_type )
+
+         CASE(NF90_CHAR)
+            ! put the attribute
+            il_status = NF90_PUT_ATT(td_file%i_id, id_varid, &
+            &  td_att%c_name, td_att%c_value )
+            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE ATT: ")
+
+         CASE(NF90_BYTE, NF90_SHORT, NF90_INT, NF90_FLOAT, NF90_DOUBLE)
+            ! put the attribute
+            il_status = NF90_PUT_ATT(td_file%i_id, id_varid, &
+            &  td_att%c_name, td_att%d_value )
+            CALL iom_cdf__check(il_status,"IOM CDF WRITE FILE ATT: ")
+
+      END SELECT
+
+   END SUBROUTINE iom_cdf__write_att_def
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_cdf__write_var(td_file, td_var, id_start, id_count)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write a variable in an opened netcdf file.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2015
+   !> - do not force to use zero as FillValue for any meshmask variable
+   !> @date August, 2017
+   !> - add start and count array as optional argument
+   !> - variable definition now done in write_var_def 
+   !>
+   !> @param[inout] td_file   file structure
+   !> @param[inout] td_var    variable structure
+   !> @param[in] id_start     index in the variable from which the data 
+   !> values will be read
+   !> @param[in] id_count     number of indices selected along each dimension
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE)              , INTENT(INOUT) :: td_file
+      TYPE(TVAR)               , INTENT(INOUT) :: td_var
+      INTEGER(i4), DIMENSION(:), INTENT(IN   ), OPTIONAL :: id_start
+      INTEGER(i4), DIMENSION(:), INTENT(IN   ), OPTIONAL :: id_count
+
+      ! local variable
+      !----------------------------------------------------------------
+
+      IF( ASSOCIATED(td_var%d_value) )THEN
+         
+         ! write variable value in file
+         CALL iom_cdf__write_var_value(td_file, td_var, id_start, id_count)
+      ENDIF
+
+   END SUBROUTINE iom_cdf__write_var
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_cdf__write_var_def(td_file, td_var,ld_chkdim)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine define variable in the header of a netcdf
+   !> file.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2017
+   !> - add option to not check dimension length
+   !> @date August, 2017
+   !> - extract from write_var
+   !> @date November, 2019
+   !> - compress 2D,3D, and 4D variables in netcdf4 files
+   !> - set no_fill mode on every variables
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] td_var    variable structure
+   !> @param[in] ld_chkdim check dimension length
+   !> @return  variable id
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(IN   ) :: td_file
+      TYPE(TVAR),  INTENT(INOUT) :: td_var
+      LOGICAL    , INTENT(IN   ), OPTIONAL :: ld_chkdim
+
+      ! local variable
+      INTEGER(i4)                       :: il_status
+      INTEGER(i4)                       :: il_ind
+      INTEGER(i4)                       :: il_deflate
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dimid
+
+      LOGICAL                           :: ll_chg
+      LOGICAL                           :: ll_defdim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      ll_defdim=file_check_var_dim(td_file, td_var, ld_chkdim )
+      IF( ll_defdim )THEN
+         ll_chg=.TRUE.
+         DO ji=1,ip_maxdim
+            IF( TRIM(fct_lower(cp_dimorder(ji:ji))) == &
+            &   TRIM(fct_lower(td_var%c_name)) )THEN
+               ll_chg=.FALSE.
+               CALL logger_trace(TRIM(fct_lower(td_var%c_name))//' is var dimension')
+               EXIT
+            ENDIF
+         ENDDO
+         ! ugly patch until NEMO do not force to use 0. as FillValue 
+         IF( ll_chg )THEN
+            ! not a dimension variable
+            ! change FillValue
+            SELECT CASE( TRIM(fct_lower(td_var%c_name)) )
+               CASE DEFAULT
+                  CALL var_chg_FillValue(td_var,0._dp)
+               CASE('nav_lon','nav_lat', &
+                  & 'glamt','glamu','glamv','glamf', &
+                  & 'gphit','gphiu','gphiv','gphif', &
+                  & 'e1t','e1u','e1v','e1f',         &
+                  & 'e2t','e2u','e2v','e2f','ff',    &
+                  & 'gcost','gcosu','gcosv','gcosf', &
+                  & 'gsint','gsinu','gsinv','gsinf', &
+                  & 'mbathy','misf','isf_draft','isfdraft',     &
+                  & 'hbatt','hbatu','hbatv','hbatf', &
+                  & 'gsigt','gsigu','gsigv','gsigf', &
+                  & 'e3t_0','e3u_0','e3v_0','e3w_0', &
+                  & 'e3f_0','gdepw_1d','gdept_1d',   &
+                  & 'e3tp','e3wp','gdepw_0','rx1',   &
+                  & 'gdept_0','gdepu','gdepv',       &
+                  & 'hdept','hdepw','e3w_1d','e3t_1d',&
+                  & 'tmask','umask','vmask','fmask'  )
+                  ! do not change for coordinates and meshmask variables
+               !CASE('no3','o2','po4','si', &
+               !   & 'solub','ndepo','dust','fr_par', &
+               !   & 'alk','dic','doc','fer' )
+               !   ! do not change for BGC variables
+            END SELECT
+         ENDIF         
+
+         ! forced to use float type
+         IF( td_var%d_unf /= 1. .AND. td_var%i_type==NF90_SHORT )THEN
+            td_var%i_type=NF90_FLOAT
+         ENDIF
+
+         IF( ALL( .NOT. td_var%t_dim(:)%l_use ) )THEN
+            CALL logger_debug( &
+            &  "IOM CDF WRITE VAR DEF scalar: define variable "//&
+            &  TRIM(td_var%c_name)//" in file "//TRIM(td_file%c_name))
+            ! scalar value
+            il_status = NF90_DEF_VAR(td_file%i_id,          &
+               &                     TRIM(td_var%c_name),   &
+               &                     td_var%i_type,         &
+               &                     varid=td_var%i_id) 
+            CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ")
+         ELSE
+
+            ! check which dimension use
+            jj=0
+            il_dimid(:)=0
+            ! reorder dimension, so unused dimension won't be written
+            DO ji = 1,  ip_maxdim
+               IF( td_var%t_dim(ji)%l_use )THEN
+                  jj=jj+1
+                  il_dimid(jj)=dim_get_id(td_file%t_dim(:),td_var%t_dim(ji)%c_name)
+               ENDIF
+            ENDDO
+
+            CALL logger_debug( &
+            &  "IOM CDF WRITE VAR DEF: define dimension to be used for variable "//&
+            &  TRIM(td_var%c_name)//" in file "//TRIM(td_file%c_name))
+
+            DO ji=1,jj
+               CALL logger_debug("IOM CDF WRITE VAR DEF: dimname : "//TRIM(td_var%t_dim(ji)%c_name))
+               CALL logger_debug("IOM CDF WRITE VAR DEF: dimid "//TRIM(fct_str(il_dimid(ji))) )
+            ENDDO
+
+            il_deflate=0
+            ! compress 2D,3D, and 4D variables
+            if( jj > 1 ) il_deflate=1
+            CALL logger_debug("IOM CDF WRITE VAR DEF: deflate = "//TRIM(fct_str(il_deflate)))
+            il_status = NF90_DEF_VAR(td_file%i_id,       &
+               &                     TRIM(td_var%c_name),&
+               &                     td_var%i_type,      &
+               &                     il_dimid(1:jj),     &
+               &                     varid=td_var%i_id,  &
+               &                     deflate_level=il_deflate )
+            CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ")
+         ENDIF
+         CALL logger_debug("IOM CDF WRITE VAR DEF: type = "//TRIM(fct_str(td_var%i_type)))
+
+         ! remove useless attribute
+         il_ind=att_get_index( td_var%t_att(:), "ew_overlap" )
+         IF( il_ind /= 0 )THEN
+            IF( td_var%t_att(il_ind)%d_value(1) == -1 )THEN
+               CALL var_del_att(td_var, td_var%t_att(il_ind))
+            ENDIF
+         ENDIF
+
+         DO ji = 1, td_var%i_natt
+            CALL logger_debug( &
+            &  " IOM CDF WRITE VAR DEF: put attribute "//TRIM(td_var%t_att(ji)%c_name)//&
+            &  " for variable "//TRIM(td_var%c_name)//&
+            &  " in file "//TRIM(td_file%c_name) )
+
+            ! forced FillValue to have same type than variable
+            IF( TRIM(td_var%t_att(ji)%c_name) == '_FillValue' )THEN
+
+               td_var%t_att(ji)%i_type=td_var%i_type
+
+               SELECT CASE(td_var%t_att(ji)%i_type)
+                  CASE(NF90_BYTE)
+                     il_status = NF90_DEF_VAR_FILL(td_file%i_id,  &
+                        &                          td_var%i_id,   &
+                        &                          1_i4,          &
+                        &                          INT(td_var%d_fill,i1))
+                  CASE(NF90_SHORT)
+                     il_status = NF90_DEF_VAR_FILL(td_file%i_id,  &
+                        &                          td_var%i_id,   &
+                        &                          1_i4,          &
+                        &                          INT(td_var%d_fill,i2))
+                  CASE(NF90_INT)
+                     il_status = NF90_DEF_VAR_FILL(td_file%i_id,  &
+                        &                          td_var%i_id,   &
+                        &                          1_i4,          &
+                        &                          INT(td_var%d_fill,i4))
+                  CASE(NF90_FLOAT)
+                     il_status = NF90_DEF_VAR_FILL(td_file%i_id,  &
+                        &                          td_var%i_id,   &
+                        &                          1_i4,          &
+                        &                          REAL(td_var%d_fill,sp))
+                  CASE(NF90_DOUBLE)
+                     il_status = NF90_DEF_VAR_FILL(td_file%i_id,  &
+                        &                          td_var%i_id,   &
+                        &                          1_i4,          &
+                        &                          REAL(td_var%d_fill,dp))
+               END SELECT
+               CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF FILL: ")
+
+            ELSE
+
+               SELECT CASE(td_var%t_att(ji)%i_type)
+                  CASE(NF90_CHAR)
+                     IF( TRIM(td_var%t_att(ji)%c_value) /= '' )THEN
+                        il_status = NF90_PUT_ATT(td_file%i_id, td_var%i_id,      &
+                        &                        TRIM(td_var%t_att(ji)%c_name),  &
+                        &                        TRIM(td_var%t_att(ji)%c_value)  )
+                     ENDIF
+                  CASE(NF90_BYTE)
+                     il_status = NF90_PUT_ATT(td_file%i_id,                   &
+                     &                        td_var%i_id,                    &
+                     &                        TRIM(td_var%t_att(ji)%c_name),  &
+                     &                        INT(td_var%t_att(ji)%d_value(:),i1))
+                  CASE(NF90_SHORT)
+                     il_status = NF90_PUT_ATT(td_file%i_id,                   &
+                     &                        td_var%i_id,                    &
+                     &                        TRIM(td_var%t_att(ji)%c_name),  &
+                     &                        INT(td_var%t_att(ji)%d_value(:),i2))
+                  CASE(NF90_INT)
+                     il_status = NF90_PUT_ATT(td_file%i_id,                   &
+                     &                        td_var%i_id,                    &
+                     &                        TRIM(td_var%t_att(ji)%c_name),  &
+                     &                        INT(td_var%t_att(ji)%d_value(:),i4))
+                  CASE(NF90_FLOAT)
+                     il_status = NF90_PUT_ATT(td_file%i_id,                   &
+                     &                        td_var%i_id,                    &
+                     &                        TRIM(td_var%t_att(ji)%c_name),  &
+                     &                        REAL(td_var%t_att(ji)%d_value(:),sp))
+                  CASE(NF90_DOUBLE)
+                     il_status = NF90_PUT_ATT(td_file%i_id,                   &
+                     &                        td_var%i_id,                    &
+                     &                        TRIM(td_var%t_att(ji)%c_name),  &
+                     &                        REAL(td_var%t_att(ji)%d_value(:),dp))
+               END SELECT
+               CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR DEF: ")
+
+            ENDIF
+
+         ENDDO
+
+      ENDIF
+      CALL logger_debug("IOM CDF WRITE VAR DEF: type = "//TRIM(fct_str(td_var%i_type)))
+
+   END SUBROUTINE iom_cdf__write_var_def
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_cdf__write_var_value(td_file, td_var, id_start, id_count)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine put variable value in an opened netcdf file.
+   !>
+   !> @details
+   !> The variable is written in the type define in variable structure.
+   !> Only dimension used are printed, and fillValue in array are
+   !> replaced by default fill values defined in module netcdf for each type. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - reuse scale factor and offset, before writing variable
+   !> @August, 2017
+   !> - use start and count array to write variable value
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] td_var    variable structure
+   !> @param[in] id_start  index in the variable from which the data 
+   !> values will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE)                   , INTENT(IN   ) :: td_file
+      TYPE(TVAR)                    , INTENT(IN   ) :: td_var
+      INTEGER(i4)     , DIMENSION(:), INTENT(IN   ), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:), INTENT(IN   ), OPTIONAL :: id_count
+
+      ! local variable
+      INTEGER(i4)                       :: il_status
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_order
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_shape
+      REAL(dp),    DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count      
+
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start_ord
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count_ord      
+      ! loop indices
+      INTEGER(i4) :: ji, jj
+      !----------------------------------------------------------------
+
+      ! check which dimension use
+      CALL logger_debug( &
+      &  "IOM CDF WRITE VAR VALUE: get dimension to be used for variable "//&
+      &  TRIM(td_var%c_name)//" in file "//TRIM(td_file%c_name))
+ 
+      il_start(:)=1
+      IF( PRESENT(id_start) ) il_start(:)=id_start(:)
+
+      il_count(:)=td_var%t_dim(:)%i_len
+      IF( PRESENT(id_count) ) il_count(:)=id_count(:)
+ 
+      ! use scale factor and offset
+      WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )
+         td_var%d_value(:,:,:,:) = &
+         &  (td_var%d_value(:,:,:,:)-td_var%d_ofs)/td_var%d_scf
+      END WHERE
+
+      jj=0
+      DO ji = 1, ip_maxdim
+         IF( td_var%t_dim(ji)%l_use )THEN
+            jj=jj+1
+            il_order(jj)=ji
+            il_shape(jj)=td_var%t_dim(ji)%i_len
+         ENDIF
+      ENDDO
+      ! dimension not use
+      DO ji = 1, ip_maxdim
+         IF( .NOT. td_var%t_dim(ji)%l_use )THEN
+            jj=jj+1
+            il_order(jj)=ji
+            il_shape(jj)=td_var%t_dim(ji)%i_len
+         ENDIF
+      ENDDO
+
+      ALLOCATE( dl_value( il_shape(1),il_shape(2),il_shape(3),il_shape(4) ) )
+
+      ! reshape array, so useless dimension won't be written
+      dl_value(:,:,:,:)=RESHAPE(source=td_var%d_value(:,:,:,:),&
+      &                         SHAPE = il_shape(:), &
+      &                         ORDER = il_order(:))
+
+      DO ji = 1, ip_maxdim
+         il_start_ord(il_order(ji))=il_start(ji)
+         il_count_ord(il_order(ji))=il_count(ji)
+      ENDDO
+
+      ! put value
+      CALL logger_debug( &
+      &  "IOM CDF WRITE VAR VALUE: put "//TRIM(td_var%c_name)//" value "//&
+      &  "in file "//TRIM(td_file%c_name))
+      il_status = NF90_PUT_VAR( td_file%i_id, td_var%i_id, dl_value(:,:,:,:), &
+      &                      start=il_start_ord(:), &
+      &                      count=il_count_ord(:) )
+      CALL iom_cdf__check(il_status,"IOM CDF WRITE VAR VALUE ("//&
+      &  TRIM(td_var%c_name)//") :" )
+
+      DEALLOCATE( dl_value )
+
+   END SUBROUTINE iom_cdf__write_var_value
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE iom_cdf
Index: /utils/tools_ticket2413/SIREN/src/iom_dom.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/iom_dom.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/iom_dom.f90	(revision 12863)
@@ -0,0 +1,754 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief This module allow to read domain (defined as domain structure) in a mpp files.
+!>
+!> @details
+!>    to read one variable in an mpp files over domain defined as domain structure:<br/>
+!> @code
+!>    tl_var=iom_dom_read_var( td_mpp, id_varid, td_dom ) 
+!> @endcode
+!>    or
+!> @code
+!>    tl_var=iom_dom_read_var( td_mpp, cd_name, td_dom ) 
+!> @endcode
+!>       - td_mpp is a mpp structure
+!>       - id_varid is a variable id
+!>       - cd_name is variable name or standard name
+!>       - td_dom is a domain structure
+!>
+!> @author
+!> J.Paul
+!>
+!> @date October, 2014 - Initial Version
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE iom_dom
+
+   USE netcdf                          ! nf90 library
+   USE global                          ! global parameter
+   USE kind                            ! F90 kind parameter
+   USE fct                             ! basic useful function
+   USE logger                          ! log file manager
+   USE dim                             ! dimension manager
+   USE att                             ! attribute manager
+   USE var                             ! variable manager
+   USE iom                             ! I/O manager
+   USE mpp                             ! mpp manager
+   USe dom                             ! domain manager
+   USE iom_mpp                         ! I/O mpp manager
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! function and subroutine
+   PUBLIC :: iom_dom_open                    !< open files composing mpp structure over domain to be used
+   PUBLIC :: iom_dom_read_var                !< read one variable in an mpp structure over domain to be used
+   PUBLIC :: iom_dom_close                   !< close file composing mpp structure over domain
+
+   PRIVATE :: iom_dom__read_var_id           ! read one variable in an mpp structure, given variable id
+   PRIVATE :: iom_dom__read_var_name         ! read one variable in an mpp structure, given variable name
+   PRIVATE :: iom_dom__read_var_value        ! read variable value in an mpp structure
+   PRIVATE :: iom_dom__no_pole_no_overlap    ! do not overlap north fold boundary or east-west boundary
+   PRIVATE :: iom_dom__no_pole_cyclic        ! do not overlap north fold boundary. However uses cyclic east-west boundary
+   PRIVATE :: iom_dom__no_pole_overlap       ! do not overlap north fold boundary. However overlaps east-west boundary
+!   PRIVATE :: iom_dom__pole_no_overlap       ! overlaps north fold boundary. However do not overlap east-west boundary
+!   PRIVATE :: iom_dom__pole_cyclic           ! overlaps north fold boundary and uses cyclic east-west boundary
+!   PRIVATE :: iom_dom__pole_overlap          ! overlaps north fold boundary and east-west boundary
+
+   INTERFACE iom_dom_read_var                   ! read one variable in an mpp structure
+      MODULE PROCEDURE iom_dom__read_var_id     ! given variable id
+      MODULE PROCEDURE iom_dom__read_var_name   ! given variable name 
+   END INTERFACE iom_dom_read_var
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_dom_open(td_mpp, td_dom, id_perio, id_ew)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine open files composing mpp structure 
+   !> over domain to be used.
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !
+   !> @param[inout] td_mpp mpp structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP) , INTENT(INOUT) :: td_mpp
+      TYPE(TDOM) , INTENT(IN)    :: td_dom
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_perio
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_ew
+
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( " IOM DOM OPEN: domain decomposition not define "//&
+         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
+
+      ELSE
+         ! get processor to be used
+         CALL mpp_get_use( td_mpp, td_dom%i_imin, td_dom%i_imax, &
+         &                         td_dom%i_jmin, td_dom%i_jmax )
+
+         CALL iom_mpp_open(td_mpp, id_perio, id_ew)
+
+      ENDIF
+
+   END SUBROUTINE iom_dom_open
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_dom_close(td_mpp)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine close files composing mpp structure.
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !
+   !> @param[in] td_mpp mpp structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      CALL iom_mpp_close(td_mpp)
+
+   END SUBROUTINE iom_dom_close
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION iom_dom__read_var_id(td_mpp, id_varid, td_dom) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function read variable value in opened mpp files,
+   !> given variable id and domain strcuture.
+   !>
+   !> @details
+   !> Optionally start indices and number of point to be read could be specify.
+   !> as well as East West ovelap of the global domain.
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !>
+   !> @param[in] td_mpp    mpp structure
+   !> @param[in] id_varid  variable id
+   !> @param[in] td_dom    domain structure
+   !> @return  variable structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP) , INTENT(IN) :: td_mpp
+      INTEGER(i4), INTENT(IN) :: id_varid
+      TYPE(TDOM) , INTENT(IN) :: td_dom
+
+      ! function
+      TYPE(TVAR)              :: tf_var
+
+      ! local variable
+      INTEGER(i4), DIMENSION(1) :: il_ind
+      !----------------------------------------------------------------
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error(" IOM DOM READ VAR: domain decomposition "//&
+            &              "not define in mpp strcuture "//TRIM(td_mpp%c_name))
+
+      ELSE
+
+         IF( ANY(td_mpp%t_proc(:)%i_id /= 0) )THEN
+            ! look for variable id
+            il_ind(:)=MINLOC( td_mpp%t_proc(1)%t_var(:)%i_id, &
+            &           mask=(td_mpp%t_proc(1)%t_var(:)%i_id==id_varid))
+            IF( il_ind(1) /= 0 )THEN
+
+               tf_var=var_copy(td_mpp%t_proc(1)%t_var(il_ind(1)))
+
+               !!! read variable value
+               CALL iom_dom__read_var_value(td_mpp, tf_var, td_dom)
+
+            ELSE
+               CALL logger_error( &
+                  &  " IOM DOM READ VAR: there is no variable with id "//&
+                  &  TRIM(fct_str(id_varid))//" in processor/file "//&
+                  &  TRIM(td_mpp%t_proc(1)%c_name))
+            ENDIF
+         ELSE
+            CALL logger_error(" IOM DOM READ VAR: can't read variable, mpp "//&
+               &              TRIM(td_mpp%c_name)//" not opened")
+         ENDIF
+
+      ENDIF
+
+   END FUNCTION iom_dom__read_var_id
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION iom_dom__read_var_name(td_mpp, cd_name, td_dom) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function read variable value in opened mpp files, 
+   !> given variable name or standard name, and domain structure.
+   !>
+   !> @details
+   !> Optionally start indices and number of point to be read could be specify.
+   !> as well as East West ovelap of the global domain.
+   !>
+   !> look first for variable name. If it doesn't
+   !> exist in file, look for variable standard name.<br/>
+   !> If variable name is not present, check variable standard name.<br/>
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !> @date May, 2019
+   !> - copy variable struct without array of value, then read array of value.
+   !>
+   !> @param[in] td_mpp    mpp structure
+   !> @param[in] cd_name   variable name
+   !> @param[in] td_dom    domain structure
+   !> @return  variable structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP),       INTENT(IN) :: td_mpp
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+      TYPE(TDOM)      , INTENT(IN) :: td_dom
+
+      ! function
+      TYPE(TVAR)                   :: tf_var
+
+      ! local variable
+      INTEGER(i4)       :: il_ind
+
+      !----------------------------------------------------------------
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( " IOM DOM READ VAR: domain decomposition not define "//&
+            &               " in mpp strcuture "//TRIM(td_mpp%c_name))
+
+      ELSE
+
+         il_ind=var_get_index( td_mpp%t_proc(1)%t_var(:), cd_name)
+         IF( il_ind /= 0 )THEN
+
+            tf_var=var_copy(td_mpp%t_proc(1)%t_var(il_ind), ld_value=.FALSE.)
+
+            !!! read variable value
+            CALL iom_dom__read_var_value( td_mpp, tf_var, td_dom )
+
+         ELSE
+
+            CALL logger_error( &
+               &  " IOM DOM READ VAR: there is no variable with "//&
+               &  "name or standard name "//TRIM(cd_name)//&
+               &  " in processor/file "//TRIM(td_mpp%t_proc(1)%c_name))
+         ENDIF
+
+      ENDIF
+ 
+   END FUNCTION iom_dom__read_var_name
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_dom__read_var_value(td_mpp, td_var, td_dom)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read variable value
+   !> in an mpp structure, given domain structure.
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !>
+   !> @todo
+   !> - handle north fold
+   !>
+   !> @param[in] td_mpp    mpp structure
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_dom    domain structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP),   INTENT(IN)    :: td_mpp
+      TYPE(TVAR),   INTENT(INOUT) :: td_var
+      TYPE(TDOM),   INTENT(IN)    :: td_dom
+
+      ! local variable
+      INTEGER(i4)                 :: il_status
+
+      TYPE(TATT)                  :: tl_att
+      TYPE(TMPP)                  :: tl_mpp
+      TYPE(TDOM)                  :: tl_dom
+
+      ! loop indices
+      INTEGER(i4)                 :: jk
+      !----------------------------------------------------------------
+
+      CALL logger_debug(" IOM DOM READ VAR VALUE: name "//&
+      &  TRIM(td_var%c_name)//" "//TRIM(td_var%c_point) )
+      CALL logger_debug(" IOM DOM READ VAR VALUE: ndim "//&
+      &  TRIM(fct_str(td_var%i_ndim)) )
+
+      ! copy mpp structure
+      tl_mpp=mpp_copy(td_mpp)
+      ! forced to keep same id
+      tl_mpp%t_proc(:)%i_id=td_mpp%t_proc(:)%i_id         
+
+      ! Allocate space to hold variable value in structure
+      IF( ASSOCIATED(td_var%d_value) )THEN
+         DEALLOCATE(td_var%d_value)   
+      ENDIF
+      
+      ! copy domain structure
+      tl_dom=dom_copy(td_dom)
+      DO jk=1,ip_maxdim
+         IF( .NOT. td_var%t_dim(jk)%l_use ) tl_dom%t_dim(jk)%i_len = 1
+      ENDDO
+
+      ! use domain dimension 
+      td_var%t_dim(1:2)%i_len=tl_dom%t_dim(1:2)%i_len
+
+      ALLOCATE(td_var%d_value( tl_dom%t_dim(1)%i_len, &
+      &                        tl_dom%t_dim(2)%i_len, &
+      &                        td_var%t_dim(3)%i_len, &
+      &                        td_var%t_dim(4)%i_len),&
+      &        stat=il_status)
+      IF(il_status /= 0 )THEN
+
+        CALL logger_error( &
+         &  " IOM DOM READ VAR VALUE: not enough space to put variable "//&
+         &  TRIM(td_var%c_name)//&
+         &  " in variable structure")
+
+      ENDIF
+      CALL logger_debug("IOM DOM READ VAR VALUE: shape ("//&
+      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=1)))//","//&
+      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=2)))//","//&
+      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=3)))//","//&
+      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=4)))//")" )         
+      ! FillValue by default
+      td_var%d_value(:,:,:,:)=td_var%d_fill
+
+      IF( tl_dom%i_perio0 < 3 .OR. &
+      &   tl_dom%i_jmax /= tl_dom%t_dim0(2)%i_len )THEN
+      ! no north pole
+
+         IF( (tl_dom%i_perio0 == 1 .OR. &
+         &    tl_dom%i_perio0 == 4 .OR. &
+         &    tl_dom%i_perio0 == 6) .AND. &
+         &   tl_dom%i_imin == 1 .AND. &
+         &   tl_dom%i_imax == tl_dom%t_dim0(1)%i_len )THEN
+         ! east west cyclic
+
+            CALL iom_dom__no_pole_cyclic(tl_mpp, td_var, tl_dom)
+
+         ELSEIF( tl_dom%i_imin <= tl_dom%i_imax )THEN
+         ! no east west overlap
+            
+            CALL iom_dom__no_pole_no_overlap(tl_mpp, td_var, tl_dom)
+
+            ! no more EW overlap in variable
+            td_var%i_ew=-1
+
+         ELSEIF( (tl_dom%i_perio0 == 1 .OR. &
+         &        tl_dom%i_perio0 == 4 .OR. &
+         &        tl_dom%i_perio0 == 6) .AND. &
+         &       tl_dom%i_imin > tl_dom%i_imax )THEN
+         ! east west overlap
+
+            CALL iom_dom__no_pole_overlap(tl_mpp, td_var, tl_dom)
+
+            ! no more EW overlap in variable
+            td_var%i_ew=-1
+
+         ELSE
+
+            CALL logger_fatal(" IOM DOM READ VAR VALUE: invalid domain definition.")
+
+         ENDIF
+
+      ELSE ! tl_dom%i_jmax == tl_dom%t_dim0(2)%i_len
+         ! north pole
+
+         CALL logger_error("IOM DOM READ VAR VALUE: "//&
+         &                 TRIM(fct_str(tl_dom%i_jmin))//" "//&
+         &                 TRIM(fct_str(tl_dom%i_jmax)) )
+         CALL logger_fatal("IOM DOM READ VAR VALUE: siren is not able to "//&
+         &                 "use north pole now, maybe in the next release")
+      !   IF( tl_dom%i_imin < tl_dom%i_imax )THEN
+      !   ! no east west overlap
+
+      !      CALL iom_dom__pole_no_overlap(tl_mpp, td_var, tl_dom)
+
+      !   ELSEIF(tl_dom%i_imin == tl_dom%i_imax)THEN
+      !   ! east west cyclic
+
+      !      CALL iom_dom__pole_cyclic(tl_mpp, td_var, tl_dom)
+
+      !    ELSE ! tl_dom%i_imin > tl_dom%i_imax
+      !    ! east west overlap
+
+      !      CALL iom_dom__pole_overlap(tl_mpp, td_var, tl_dom)
+
+      !   ENDIF
+      ENDIF
+
+      ! clean 
+      CALL mpp_clean(tl_mpp)
+      CALL dom_clean(tl_dom)
+
+      IF( td_var%t_dim(1)%l_use .AND. &
+      &   td_var%t_dim(1)%i_len == td_mpp%t_dim(1)%i_len )THEN
+         IF( td_mpp%i_ew >= 0 )THEN
+            tl_att=att_init("ew_overlap",td_mpp%i_ew)
+            CALL var_move_att(td_var,tl_att)
+            ! clean
+            CALL att_clean(tl_att)
+         ENDIF
+      ENDIF
+
+      ! force to change _FillValue to avoid mistake 
+      ! with dummy zero _FillValue
+      IF( td_var%d_fill == 0._dp )THEN
+         CALL var_chg_FillValue(td_var)
+      ENDIF      
+
+   END SUBROUTINE iom_dom__read_var_value
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_dom__no_pole_no_overlap(td_mpp, td_var, td_dom)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read variable value
+   !> in an mpp structure. 
+   !> @details
+   !> The output domain do not overlap
+   !> north fold boundary or east-west boundary.
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !>
+   !> @param[in] td_mpp    mpp structure
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_dom    domain structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP),  INTENT(IN)    :: td_mpp
+      TYPE(TVAR),  INTENT(INOUT) :: td_var
+      TYPE(TDOM),  INTENT(IN)    :: td_dom
+
+      ! local variable
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count
+
+      TYPE(TDOM)                :: tl_dom
+
+      ! loop indices
+      !----------------------------------------------------------------
+      
+      ! copy domain structure
+      tl_dom=dom_copy(td_dom)
+
+      ! change dimension length if not use
+      IF( .NOT. td_var%t_dim(1)%l_use )THEN 
+         tl_dom%i_imin=1 ; tl_dom%i_imax=1
+      ENDIF
+      IF( .NOT. td_var%t_dim(2)%l_use )THEN 
+         tl_dom%i_jmin=1 ; tl_dom%i_jmax=1
+      ENDIF
+
+      il_start(:)=(/tl_dom%i_imin,tl_dom%i_jmin,1,1/)
+
+      il_count(:)=(/tl_dom%i_imax-tl_dom%i_imin+1, &
+      &             tl_dom%i_jmax-tl_dom%i_jmin+1, &
+      &             td_var%t_dim(3)%i_len, &
+      &             td_var%t_dim(4)%i_len/)
+
+      td_var=iom_mpp_read_var(td_mpp, TRIM(td_var%c_name), &
+      &                       il_start(:), il_count(:) )
+
+      CALL dom_clean(tl_dom)
+
+   END SUBROUTINE iom_dom__no_pole_no_overlap
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_dom__no_pole_cyclic(td_mpp, td_var, td_dom)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read cyclic variable value
+   !> in an mpp structure. 
+   !> @details
+   !> The output domain do not overlap north fold boundary.
+   !> However it uses cyclic east-west boundary.
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !>
+   !> @param[in] td_mpp    mpp structure
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_dom    domain structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP),   INTENT(IN   ) :: td_mpp
+      TYPE(TVAR),   INTENT(INOUT) :: td_var
+      TYPE(TDOM),   INTENT(IN   ) :: td_dom
+
+      ! local variable
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count
+
+      TYPE(TDOM)                :: tl_dom
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! copy domain structure
+      tl_dom=dom_copy(td_dom)
+
+      ! cyclic domain
+      tl_dom%i_imin=1
+      tl_dom%i_imax=tl_dom%t_dim(1)%i_len
+
+      ! change dimension length if not use
+      IF( .NOT. td_var%t_dim(1)%l_use )THEN 
+         tl_dom%i_imin=1 ; tl_dom%i_imax=1
+      ENDIF
+      IF( .NOT. td_var%t_dim(2)%l_use )THEN 
+         tl_dom%i_jmin=1 ; tl_dom%i_jmax=1
+      ENDIF
+
+      il_start(:)=(/tl_dom%i_imin,tl_dom%i_jmin,1,1/)
+
+      il_count(:)=(/tl_dom%i_imax-tl_dom%i_imin+1, &
+      &             tl_dom%i_jmax-tl_dom%i_jmin+1, &
+      &             td_var%t_dim(3)%i_len, &
+      &             td_var%t_dim(4)%i_len /)
+
+      td_var=iom_mpp_read_var(td_mpp, TRIM(td_var%c_name), &
+      &                       il_start(:), il_count(:) )
+
+      ! clean
+      CALL dom_clean(tl_dom)
+
+   END SUBROUTINE iom_dom__no_pole_cyclic
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_dom__no_pole_overlap(td_mpp, td_var, td_dom)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read East West overlap variable value
+   !> in an mpp structure.
+   !> @details
+   !> The output domain do not overlap north fold boundary. 
+   !> However it overlaps east-west boundary. 
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !>
+   !> @param[in] td_mpp    mpp structure
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_dom    domain structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP),   INTENT(IN)    :: td_mpp
+      TYPE(TVAR),   INTENT(INOUT) :: td_var
+      TYPE(TDOM),   INTENT(IN),   OPTIONAL :: td_dom
+
+      ! local variable
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count
+
+      INTEGER(i4)               :: il_dim1
+      INTEGER(i4)               :: il_dim2
+
+      TYPE(TVAR)                :: tl_var1
+      TYPE(TVAR)                :: tl_var2
+
+      TYPE(TDOM)                :: tl_dom
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! copy domain structure
+      tl_dom=dom_copy(td_dom)
+
+      ! change dimension length if not use
+      IF( .NOT. td_var%t_dim(1)%l_use )THEN 
+         tl_dom%i_imin=1 ; tl_dom%i_imax=1
+      ENDIF
+      IF( .NOT. td_var%t_dim(2)%l_use )THEN 
+         tl_dom%i_jmin=1 ; tl_dom%i_jmax=1
+      ENDIF
+
+      ! get first part of domain
+      tl_var1=var_copy(td_var)
+      DEALLOCATE(tl_var1%d_value)
+
+      il_start(:)=(/tl_dom%i_imin,tl_dom%i_jmin,1,1/)
+
+      il_dim1 = td_mpp%t_dim(1)%i_len - td_mpp%i_ew - tl_dom%i_imin + 1
+
+      il_count(:)=(/il_dim1, &
+      &             tl_dom%i_jmax-tl_dom%i_jmin+1, &
+      &             td_var%t_dim(3)%i_len, &
+      &             td_var%t_dim(4)%i_len /)
+
+      ! dimension part 1
+      tl_var1%t_dim(:)%i_len=il_count(:)
+
+      ALLOCATE(tl_var1%d_value(tl_var1%t_dim(1)%i_len, &
+      &                        tl_var1%t_dim(2)%i_len, &
+      &                        tl_var1%t_dim(3)%i_len, &
+      &                        tl_var1%t_dim(4)%i_len) )
+
+      tl_var1=iom_mpp_read_var(td_mpp, TRIM(td_var%c_name), &
+      &                        il_start(:), il_count(:) )      
+
+      IF( td_var%t_dim(jp_I)%l_use )THEN
+         ! get second part of domain
+         tl_var2=var_copy(td_var)
+         DEALLOCATE(tl_var2%d_value)
+
+         il_start(:)=(/1,tl_dom%i_jmin,1,1/)
+
+         il_dim2 = tl_dom%i_imax
+
+         il_count(:)=(/il_dim2, &
+         &             tl_dom%i_jmax-tl_dom%i_jmin+1, &
+         &             td_var%t_dim(3)%i_len, &
+         &             td_var%t_dim(4)%i_len /)
+
+         ! dimension part 2
+         tl_var2%t_dim(:)%i_len=il_count(:)
+
+         ALLOCATE(tl_var2%d_value(tl_var2%t_dim(1)%i_len, &
+         &                        tl_var2%t_dim(2)%i_len, &
+         &                        tl_var2%t_dim(3)%i_len, &
+         &                        tl_var2%t_dim(4)%i_len) )
+
+         tl_var2=iom_mpp_read_var(td_mpp, TRIM(td_var%c_name), &
+         &                        il_start(:), il_count(:) ) 
+
+         ! concatenate both part
+         td_var=var_concat(tl_var1, tl_var2, jp_I)
+      
+         ! clean
+         CALL var_clean(tl_var1)
+         CALL var_clean(tl_var2)
+      ELSE
+         td_var=var_copy(tl_var1)
+         ! clean
+         CALL var_clean(tl_var1)
+      ENDIF
+
+      ! clean
+      CALL dom_clean(tl_dom)
+
+   END SUBROUTINE iom_dom__no_pole_overlap
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!   SUBROUTINE iom_dom__pole_no_overlap(td_mpp, td_var, td_dom)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read north fold variable value
+   !> in an mpp structure. 
+   !> @details
+   !> The output domain overlaps
+   !> north fold boundary. However it do not overlap east-west boundary.
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !>
+   !> @param[in] td_mpp    mpp structure
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_dom    domain structure
+   !-------------------------------------------------------------------
+!
+!      IMPLICIT NONE
+!
+!      ! Argument      
+!      TYPE(TMPP),   INTENT(IN)    :: td_mpp
+!      TYPE(TVAR),   INTENT(INOUT) :: td_var
+!      TYPE(TDOM),   INTENT(IN),   OPTIONAL :: td_dom
+!
+!      ! local variable
+!
+!      ! loop indices
+!      !----------------------------------------------------------------
+!
+!   END SUBROUTINE iom_dom__pole_no_overlap
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!   SUBROUTINE iom_dom__pole_cyclic(td_mpp, td_var, td_dom)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read semi global variable value
+   !> in an mpp structure. 
+   !> @details
+   !> The output domain overlaps north fold boundary.
+   !> and uses cyclic east-west boundary.
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !>
+   !> @param[in] td_mpp    mpp structure
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_dom    domain structure
+   !> @return variable structure completed 
+   !-------------------------------------------------------------------
+!
+!      IMPLICIT NONE
+!
+!      ! Argument      
+!      TYPE(TMPP),   INTENT(IN)    :: td_mpp
+!      TYPE(TVAR),   INTENT(INOUT) :: td_var
+!      TYPE(TDOM),   INTENT(IN),   OPTIONAL :: td_dom
+!
+!      ! local variable
+!
+!      ! loop indices
+!      !----------------------------------------------------------------
+!
+!   END SUBROUTINE iom_dom__pole_cyclic
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!   SUBROUTINE iom_dom__pole_overlap(td_mpp, td_var, td_dom)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read north fold East West overlap variable value
+   !> in an mpp structure. 
+   !> @details
+   !> The output domain overlaps north fold boundary. 
+   !> and east-west boundary. 
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !>
+   !> @param[in] td_mpp    mpp structure
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_dom    domain structure
+   !> @return variable structure completed 
+   !-------------------------------------------------------------------
+!
+!      IMPLICIT NONE
+!
+!      ! Argument      
+!      TYPE(TMPP),   INTENT(IN)    :: td_mpp
+!      TYPE(TVAR),   INTENT(INOUT) :: td_var
+!      TYPE(TDOM),   INTENT(IN),   OPTIONAL :: td_dom
+!
+!      ! local variable
+!
+!      ! loop indices
+!      !----------------------------------------------------------------
+!
+!   END SUBROUTINE iom_dom__pole_overlap
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE iom_dom
Index: /utils/tools_ticket2413/SIREN/src/iom_mpp.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/iom_mpp.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/iom_mpp.f90	(revision 12863)
@@ -0,0 +1,896 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief This module manage massively parallel processing Input/Output manager.
+!> Library to read/write mpp files.
+!>
+!> @details
+!>    to open mpp files (only file to be used (see mpp_get_use) 
+!>    will be open):<br/>
+!> @code
+!>    CALL iom_mpp_open(td_mpp)
+!> @endcode
+!>       - td_mpp is a mpp structure
+!>
+!>    to creates mpp files:<br/>
+!> @code
+!>    CALL iom_mpp_create(td_mpp)
+!> @endcode
+!>       - td_mpp is a mpp structure
+!>
+!>    to write in mpp files :<br/>
+!> @code
+!>    CALL  iom_mpp_write_file(td_mpp)
+!> @endcode
+!>       - td_mpp is a mpp structure
+!>
+!>    to close mpp files:<br/>
+!> @code
+!>    CALL iom_mpp_close(td_mpp)
+!> @endcode
+!>
+!>    to read one variable in an mpp files:<br/>
+!> @code
+!>    tl_var=iom_mpp_read_var( td_mpp, id_varid, [id_start, id_count] [,id_ew] ) 
+!> @endcode
+!>    or
+!> @code
+!>    tl_var=iom_mpp_read_var( td_mpp, cd_name, [id_start, id_count] [,id_ew] ) 
+!> @endcode
+!>       - td_mpp is a mpp structure
+!>       - id_varid is a variable id
+!>       - cd_name is variable name or standard name
+!>       - id_start is a integer(4) 1D array of index from which the data 
+!>          values will be read [optional]
+!>       - id_count is a integer(4) 1D array of the number of indices selected
+!>          along each dimension [optional]
+!>       - id_ew East West overlap [optional]
+!>
+!>    to fill variable value in mpp structure:<br/>
+!> @code
+!>    CALL iom_mpp_fill_var(td_mpp, id_varid, [id_start, id_count] [,id_ew] )
+!> @endcode
+!>    or<br/>
+!> @code
+!>    CALL iom_mpp_fill_var(td_mpp, cd_name, [id_start, id_count] [,id_ew] )
+!> @endcode
+!>       - td_mpp is mpp structure
+!>       - id_varid is variable id
+!>       - cd_name is variable name or standard name
+!>       - id_start is a integer(4) 1D array of index from which the data 
+!>          values will be read [optional]
+!>       - id_count is a integer(4) 1D array of the number of indices selected
+!>          along each dimension [optional]
+!>       - id_ew East West overlap [optional]
+!>
+!>    to fill all variable in mpp structure:<br/>
+!> @code
+!>    CALL iom_mpp_fill_var(td_mpp, [id_start, id_count] [,id_ew] )
+!> @endcode
+!>       - td_mpp is mpp structure
+!>       - id_start is a integer(4) 1D array of index from which the data 
+!>          values will be read [optional]
+!>       - id_count is a integer(4) 1D array of the number of indices selected
+!>          along each dimension [optional]
+!>       - id_ew East West overlap
+!>
+!>    to write files composong mpp strucutre:<br/>
+!> @code
+!>    CALL iom_mpp_write_file(td_mpp) 
+!> @endcode
+!>
+!> @author
+!> J.Paul
+!>
+!> @date November, 2013 - Initial Version
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE iom_mpp
+
+   USE netcdf                          ! nf90 library
+   USE global                          ! global parameter
+   USE kind                            ! F90 kind parameter
+   USE fct                             ! basic useful function
+   USE logger                          ! log file manager
+   USE dim                             ! dimension manager
+   USE att                             ! attribute manager
+   USE var                             ! variable manager
+   USE file                            ! file manager
+   USE iom                             ! I/O manager
+   USE mpp                             ! mpp manager
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! function and subroutine
+   PUBLIC :: iom_mpp_open                    !< open all files composing mpp structure
+   PUBLIC :: iom_mpp_create                  !< creates files composing mpp structure
+   PUBLIC :: iom_mpp_close                   !< close file composing mpp structure
+   PUBLIC :: iom_mpp_read_var                !< read one variable in an mpp structure
+   PUBLIC :: iom_mpp_write_file              !< write mpp structure in files
+
+   PRIVATE :: iom_mpp__read_var_id           ! read one variable in an mpp structure, given variable id
+   PRIVATE :: iom_mpp__read_var_name         ! read one variable in an mpp structure, given variable name
+   PRIVATE :: iom_mpp__read_var_value        ! read variable value in an mpp structure
+
+   INTERFACE iom_mpp_read_var                   ! read one variable in an mpp structure
+      MODULE PROCEDURE iom_mpp__read_var_id     ! given variable id
+      MODULE PROCEDURE iom_mpp__read_var_name   ! given variable name 
+   END INTERFACE iom_mpp_read_var
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_mpp_open(td_mpp, id_perio, id_ew)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine open files composing mpp structure to be used.
+   !> @details
+   !> If try to open a file in write mode that did not exist, create it.<br/>
+   !> 
+   !> If file already exist, get information about:
+   !> - the number of variables
+   !> - the number of dimensions
+   !> - the number of global attributes
+   !> - the ID of the unlimited dimension
+   !> - the file format
+   !> and finally read dimensions.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date August, 2017 
+   !> - handle use of domain decomposition for monoproc file
+   !>
+   !> @param[inout] td_mpp mpp structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP) , INTENT(INOUT)  :: td_mpp
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_perio
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_ew
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_name
+      INTEGER(i4) :: il_pid  
+      INTEGER(i4) :: il_impp 
+      INTEGER(i4) :: il_jmpp 
+      INTEGER(i4) :: il_lci  
+      INTEGER(i4) :: il_lcj  
+      INTEGER(i4) :: il_ldi  
+      INTEGER(i4) :: il_ldj  
+      INTEGER(i4) :: il_lei  
+      INTEGER(i4) :: il_lej  
+      LOGICAL     :: ll_ctr  
+      LOGICAL     :: ll_use  
+      LOGICAL     :: ll_create  
+      INTEGER(i4) :: il_iind 
+      INTEGER(i4) :: il_jind 
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( " IOM MPP OPEN: domain decomposition not define "//&
+         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
+
+      ELSE
+         ! 
+         td_mpp%i_id=1
+
+         ! if no processor file selected
+         ! force to open all files 
+         IF( .NOT. ANY( td_mpp%t_proc(:)%l_use ) )THEN
+            td_mpp%t_proc(:)%l_use=.TRUE.
+         ENDIF
+
+         ! add suffix to mpp name
+         td_mpp%c_name=file_add_suffix( TRIM(td_mpp%c_name), &
+                                      & TRIM(td_mpp%c_type) )
+
+         td_mpp%t_proc(:)%c_type=TRIM(td_mpp%c_type) 
+         IF( td_mpp%i_nproc > 1 .AND. td_mpp%l_usempp )THEN
+            DO ji=1,td_mpp%i_nproc
+               IF( td_mpp%t_proc(ji)%l_use )THEN
+
+                  SELECT CASE(TRIM(td_mpp%c_type))
+                  CASE('cdf')
+                     cl_name=TRIM( file_rename(td_mpp%c_name, ji-1) )
+                  CASE('dimg')
+                     cl_name=TRIM( file_rename(td_mpp%c_name, ji) )
+                  CASE DEFAULT
+                     CALL logger_fatal("IOM MPP OPEN: can not open file "//&
+                     &  "of type "//TRIM(td_mpp%c_type))
+                  END SELECT
+
+                  td_mpp%t_proc(ji)%c_name=TRIM(cl_name)
+
+                  CALL iom_open(td_mpp%t_proc(ji))
+
+               ENDIF
+            ENDDO
+         ELSE ! td_mpp%i_nproc == 1 
+               cl_name=TRIM( file_rename(td_mpp%c_name) )
+               td_mpp%t_proc(1)%c_name=TRIM(cl_name)
+
+               CALL iom_open(td_mpp%t_proc(1))
+
+               IF( .NOT. td_mpp%l_usempp )THEN
+                  ! copy file structure of first proc, except layout decomposition
+                  ! do not do it when creating output file.
+                  ll_create=( ALL(td_mpp%t_proc(:)%l_wrt) .AND. &
+                  &           ALL(td_mpp%t_proc(:)%l_use) )
+                  IF( .NOT. ll_create )THEN
+                     DO ji=2,td_mpp%i_nproc
+                        IF( td_mpp%t_proc(ji)%l_use )THEN
+                           il_pid  = td_mpp%t_proc(ji)%i_pid  
+                           il_impp = td_mpp%t_proc(ji)%i_impp 
+                           il_jmpp = td_mpp%t_proc(ji)%i_jmpp 
+                           il_lci  = td_mpp%t_proc(ji)%i_lci  
+                           il_lcj  = td_mpp%t_proc(ji)%i_lcj  
+                           il_ldi  = td_mpp%t_proc(ji)%i_ldi  
+                           il_ldj  = td_mpp%t_proc(ji)%i_ldj  
+                           il_lei  = td_mpp%t_proc(ji)%i_lei  
+                           il_lej  = td_mpp%t_proc(ji)%i_lej  
+                           ll_ctr  = td_mpp%t_proc(ji)%l_ctr  
+                           ll_use  = td_mpp%t_proc(ji)%l_use  
+                           il_iind = td_mpp%t_proc(ji)%i_iind 
+                           il_jind = td_mpp%t_proc(ji)%i_jind 
+
+                           td_mpp%t_proc(ji)=file_copy(td_mpp%t_proc(1))
+                           td_mpp%t_proc(ji)%i_id=td_mpp%t_proc(1)%i_id
+                           td_mpp%t_proc(ji)%l_def=.FALSE.
+
+                           td_mpp%t_proc(ji)%i_pid  = il_pid  
+                           td_mpp%t_proc(ji)%i_impp = il_impp 
+                           td_mpp%t_proc(ji)%i_jmpp = il_jmpp 
+                           td_mpp%t_proc(ji)%i_lci  = il_lci  
+                           td_mpp%t_proc(ji)%i_lcj  = il_lcj  
+                           td_mpp%t_proc(ji)%i_ldi  = il_ldi  
+                           td_mpp%t_proc(ji)%i_ldj  = il_ldj  
+                           td_mpp%t_proc(ji)%i_lei  = il_lei  
+                           td_mpp%t_proc(ji)%i_lej  = il_lej  
+                           td_mpp%t_proc(ji)%l_ctr  = ll_ctr  
+                           td_mpp%t_proc(ji)%l_use  = ll_use  
+                           td_mpp%t_proc(ji)%i_iind = il_iind 
+                           td_mpp%t_proc(ji)%i_jind = il_jind 
+                        ENDIF
+                     ENDDO
+                  ELSE
+                     ! keep file id
+                     DO ji=2,td_mpp%i_nproc
+                        IF( td_mpp%t_proc(ji)%l_use )THEN 
+                           td_mpp%t_proc(ji)%i_id=td_mpp%t_proc(1)%i_id
+                           td_mpp%t_proc(ji)%l_def=.FALSE.
+                        ENDIF
+                     ENDDO
+                  ENDIF
+               ENDIF
+
+         ENDIF
+
+         IF( PRESENT(id_ew) )THEN
+            td_mpp%i_ew=id_ew
+            ! add east west overlap to each variable
+            DO ji=1,td_mpp%i_nproc
+               WHERE(td_mpp%t_proc(ji)%t_var(:)%t_dim(1)%l_use)
+                  td_mpp%t_proc(ji)%t_var(:)%i_ew=td_mpp%i_ew
+               ENDWHERE
+            ENDDO
+         ENDIF
+
+         IF( PRESENT(id_perio) )THEN
+            td_mpp%i_perio=id_perio
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE iom_mpp_open
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_mpp_create(td_mpp)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine create files, composing mpp structure to be used,
+   !> in write mode.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_mpp mpp structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP), INTENT(INOUT)  :: td_mpp
+      !----------------------------------------------------------------
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( " IOM MPP CREATE: domain decomposition not define "//&
+         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
+
+      ELSE
+         ! forced to open in write mode
+         td_mpp%t_proc(:)%l_wrt=.TRUE.
+         td_mpp%t_proc(:)%l_use=.TRUE.
+         CALL iom_mpp_open(td_mpp)
+      ENDIF
+
+   END SUBROUTINE iom_mpp_create
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_mpp_close(td_mpp)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine close files composing mpp structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_mpp mpp structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( " IOM MPP CLOSE: domain decomposition not define "//&
+         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
+
+      ELSE
+         ! 
+         td_mpp%i_id=0         
+
+         IF( td_mpp%l_usempp )THEN
+            DO ji=1,td_mpp%i_nproc
+               IF( td_mpp%t_proc(ji)%i_id /= 0 )THEN
+                  CALL iom_close(td_mpp%t_proc(ji))
+               ENDIF
+            ENDDO
+         ELSE
+            IF( td_mpp%t_proc(1)%i_id /= 0 )THEN
+               CALL iom_close(td_mpp%t_proc(1))
+               td_mpp%t_proc(:)%i_id=0
+            ENDIF
+         ENDIF
+         td_mpp%t_proc(:)%l_use=.FALSE.
+
+      ENDIF
+
+   END SUBROUTINE iom_mpp_close
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION iom_mpp__read_var_id(td_mpp, id_varid, id_start, id_count) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function read variable value in opened mpp files,
+   !> given variable id.
+   !>
+   !> @details
+   !> Optionally start indices and number of point to be read could be specify.
+   !> as well as East West ovelap of the global domain.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date October, 2014
+   !> - use start and count array instead of domain structure.
+   !>
+   !> @param[in] td_mpp    mpp structure
+   !> @param[in] id_varid  variable id
+   !> @param[in] id_start  index in the variable from which the data values 
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !> @return  variable structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP),                INTENT(IN) :: td_mpp
+      INTEGER(i4),               INTENT(IN) :: id_varid
+      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count      
+
+      ! function
+      TYPE(TVAR)                            :: tf_var
+
+      ! local variable
+      INTEGER(i4), DIMENSION(1) :: il_ind
+      !----------------------------------------------------------------
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( " IOM MPP READ VAR: domain decomposition not define "//&
+         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
+
+      ELSEIF( td_mpp%i_id == 0 )THEN
+
+         CALL logger_error( " IOM MPP READ VAR: mpp structure not opened. "//&
+         &               " can not read variable in "//TRIM(td_mpp%c_name))   
+      
+      ELSE
+
+
+         IF( ANY(td_mpp%t_proc(:)%i_id /= 0) )THEN
+            ! look for variable id
+            il_ind(:)=MINLOC( td_mpp%t_proc(1)%t_var(:)%i_id, &
+            &           mask=(td_mpp%t_proc(1)%t_var(:)%i_id==id_varid))
+            IF( il_ind(1) /= 0 )THEN
+
+               tf_var=var_copy(td_mpp%t_proc(1)%t_var(il_ind(1)))
+
+               !!! read variable value
+               CALL iom_mpp__read_var_value(td_mpp, tf_var, id_start, id_count)
+
+            ELSE
+               CALL logger_error( &
+               &  " IOM MPP READ VAR: there is no variable with id "//&
+               &  TRIM(fct_str(id_varid))//" in processor/file "//&
+               &  TRIM(td_mpp%t_proc(1)%c_name))
+            ENDIF
+         ELSE
+            CALL logger_error(" IOM MPP READ VAR: can't read variable, mpp "//&
+            &  TRIM(td_mpp%c_name)//" not opened")
+         ENDIF
+
+      ENDIF
+
+   END FUNCTION iom_mpp__read_var_id
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION iom_mpp__read_var_name(td_mpp, cd_name, id_start, id_count) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function read variable value in opened mpp files, 
+   !> given variable name or standard name.
+   !>
+   !> @details
+   !> Optionally start indices and number of point to be read could be specify.
+   !> as well as East West ovelap of the global domain.
+   !>
+   !> look first for variable name. If it doesn't
+   !> exist in file, look for variable standard name.<br/>
+   !> If variable name is not present, check variable standard name.<br/>
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date October, 2014
+   !> - use start and count array instead of domain structure.
+   !>
+   !> @param[in] td_mpp    mpp structure
+   !> @param[in] cd_name   variable name
+   !> @param[in] id_start  index in the variable from which the data values 
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !> @return  variable structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP),                INTENT(IN) :: td_mpp
+      CHARACTER(LEN=*),          INTENT(IN) :: cd_name
+      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count
+
+      ! function
+      TYPE(TVAR)                            :: tf_var
+
+      ! local variable
+      INTEGER(i4)       :: il_ind
+      !----------------------------------------------------------------
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( " IOM MPP READ VAR: domain decomposition not define "//&
+         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
+
+      ELSEIF( td_mpp%i_id == 0 )THEN
+
+         CALL logger_error( " IOM MPP READ VAR: mpp structure not opened. "//&
+         &               " can not read variable in "//TRIM(td_mpp%c_name))   
+ 
+      ELSE
+
+            il_ind=var_get_index( td_mpp%t_proc(1)%t_var(:), cd_name)
+            IF( il_ind /= 0 )THEN
+
+               tf_var=var_copy(td_mpp%t_proc(1)%t_var(il_ind))
+
+               !!! read variable value
+               CALL iom_mpp__read_var_value( td_mpp, tf_var, id_start, id_count)
+
+            ELSE
+
+               CALL logger_fatal( &
+               &  " IOM MPP READ VAR: there is no variable with "//&
+               &  "name or standard name "//TRIM(cd_name)//&
+               &  " in processor/file "//TRIM(td_mpp%t_proc(1)%c_name))
+            ENDIF
+
+      ENDIF
+      
+   END FUNCTION iom_mpp__read_var_name
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_mpp__read_var_value(td_mpp, td_var, id_start, id_count)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read variable value
+   !> in an mpp structure.
+   !>
+   !> @details
+   !> Optionally start indices and number of point to be read could be specify.
+   !> as well as East West ovelap of the global domain.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date October, 2014
+   !> - use start and count array instead of domain structure.
+   !>
+   !> @param[in] td_mpp    mpp structure
+   !> @param[inout] td_var variable structure
+   !> @param[in] id_start  index in the variable from which the data values 
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP)               , INTENT(IN   ) :: td_mpp
+      TYPE(TVAR)               , INTENT(INOUT) :: td_var
+      INTEGER(i4), DIMENSION(:), INTENT(IN   ), OPTIONAL :: id_start
+      INTEGER(i4), DIMENSION(:), INTENT(IN   ), OPTIONAL :: id_count      
+
+      ! local variable
+      INTEGER(i4)                       :: il_status
+      INTEGER(i4), DIMENSION(4)         :: il_ind
+      INTEGER(i4)                       :: il_i1p
+      INTEGER(i4)                       :: il_i2p
+      INTEGER(i4)                       :: il_j1p
+      INTEGER(i4)                       :: il_j2p
+      INTEGER(i4)                       :: il_i1
+      INTEGER(i4)                       :: il_i2
+      INTEGER(i4)                       :: il_j1
+      INTEGER(i4)                       :: il_j2
+
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_end
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count      
+
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_strt
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_cnt      
+
+      TYPE(TATT)                        :: tl_att
+      TYPE(TVAR)                        :: tl_var
+
+      ! loop indices
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      il_start(:)=1
+      IF( PRESENT(id_start) ) il_start(:)=id_start(:)
+
+      il_count(:)=td_mpp%t_dim(:)%i_len
+      IF( PRESENT(id_count) ) il_count(:)=id_count(:)
+
+      CALL logger_debug("IOM MPP READ VAR VALUE: start "//&
+               &  TRIM(fct_str(il_start(jp_I)))//","//&
+               &  TRIM(fct_str(il_start(jp_J)))//","//&
+               &  TRIM(fct_str(il_start(jp_K)))//","//&
+               &  TRIM(fct_str(il_start(jp_L))) )
+      CALL logger_debug("IOM MPP READ VAR VALUE: count "//&
+               &  TRIM(fct_str(il_count(jp_I)))//","//&
+               &  TRIM(fct_str(il_count(jp_J)))//","//&
+               &  TRIM(fct_str(il_count(jp_K)))//","//&
+               &  TRIM(fct_str(il_count(jp_L))) )
+
+      !IF( td_mpp%l_usempp .AND. (PRESENT(id_start) .OR. PRESENT(id_count)))THEN
+      !   CALL logger_fatal("IOM MPP READ VAR VALUE: should not use"//&
+      !      &  " start or count arguments when usempp is False.")
+      !ENDIF
+
+      DO jk=1,ip_maxdim
+         IF( .NOT. td_var%t_dim(jk)%l_use )THEN
+            il_start(jk) = 1
+            il_count(jk) = 1
+         ENDIF
+
+         il_end(jk)=il_start(jk)+il_count(jk)-1
+      ENDDO
+
+      IF( ANY(il_end(:) > td_mpp%t_dim(:)%i_len) )THEN
+            CALL logger_debug("IOM MPP READ VAR VALUE: start + count "//&
+               &  TRIM(fct_str(il_end(jp_I)))//","//&
+               &  TRIM(fct_str(il_end(jp_J)))//","//&
+               &  TRIM(fct_str(il_end(jp_K)))//","//&
+               &  TRIM(fct_str(il_end(jp_L))) )
+            CALL logger_debug("IOM MPP READ VAR VALUE: dimension "//&
+               &  TRIM(fct_str(td_mpp%t_dim(jp_I)%i_len))//","//&
+               &  TRIM(fct_str(td_mpp%t_dim(jp_J)%i_len))//","//&
+               &  TRIM(fct_str(td_mpp%t_dim(jp_K)%i_len))//","//&
+               &  TRIM(fct_str(td_mpp%t_dim(jp_L)%i_len)) )
+            CALL logger_fatal("IOM MPP READ VAR VALUE: start + count "//&
+            &                 "exceed dimension bound.")
+      ENDIF
+
+      ! use domain dimension 
+      td_var%t_dim(:)%i_len=il_count(:)
+
+      ! Allocate space to hold variable value in structure
+      IF( ASSOCIATED(td_var%d_value) )THEN
+         DEALLOCATE(td_var%d_value)   
+      ENDIF
+
+      ALLOCATE(td_var%d_value( il_count(1), &
+      &                        il_count(2), &
+      &                        il_count(3), &
+      &                        il_count(4)),&
+      &        stat=il_status)
+      IF(il_status /= 0 )THEN
+
+        CALL logger_error( &
+         &  " IOM MPP READ VAR VALUE: not enough space to put variable "//&
+         &  TRIM(td_var%c_name)//&
+         &  " in variable structure")
+
+      ENDIF
+
+      CALL logger_debug("IOM MPP READ VAR VALUE: shape ("//&
+      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=1)))//","//&
+      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=2)))//","//&
+      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=3)))//","//&
+      &  TRIM(fct_str(SIZE(td_var%d_value(:,:,:,:),DIM=4)))//")" )
+      ! FillValue by default
+      td_var%d_value(:,:,:,:)=td_var%d_fill
+
+      ! read processor 
+      DO jk=1,td_mpp%i_nproc
+         IF( td_mpp%t_proc(jk)%l_use )THEN
+             
+            ! get processor indices
+            il_ind(:)=mpp_get_proc_index( td_mpp, jk )
+            il_i1p = il_ind(1)
+            il_i2p = il_ind(2)
+            il_j1p = il_ind(3)
+            il_j2p = il_ind(4)
+ 
+            IF( .NOT. td_var%t_dim(1)%l_use )THEN
+               il_i1p=il_start(1) ; il_i2p=il_end(1)
+            ENDIF
+            IF( .NOT. td_var%t_dim(2)%l_use )THEN
+               il_j1p=il_start(2) ; il_j2p=il_end(2)
+            ENDIF            
+            
+            il_i1=MAX(il_i1p, il_start(1))
+            il_i2=MIN(il_i2p, il_end(1))
+
+            il_j1=MAX(il_j1p, il_start(2))
+            il_j2=MIN(il_j2p, il_end(2))
+
+            IF( (il_i1<=il_i2).AND.(il_j1<=il_j2) )THEN
+               IF( td_mpp%l_usempp )THEN
+                  il_strt(:)=(/ il_i1-il_i1p+1, &
+                  &             il_j1-il_j1p+1, &
+                  &             1,1 /)
+               ELSE
+                  il_strt(:)=(/ il_i1, &
+                  &             il_j1, &
+                  &             1,1 /)
+               ENDIF
+
+               il_cnt(:)=(/ il_i2-il_i1+1,         &
+               &            il_j2-il_j1+1,         &
+               &            td_var%t_dim(3)%i_len, &
+               &            td_var%t_dim(4)%i_len /)
+
+               tl_var=iom_read_var( td_mpp%t_proc(jk), td_var%c_name,&
+               &                    il_strt(:), il_cnt(:) )
+               ! replace value in output variable structure
+               td_var%d_value( il_i1 - il_start(1) + 1 : &
+               &               il_i2 - il_start(1) + 1,  &
+               &               il_j1 - il_start(2) + 1 : &
+               &               il_j2 - il_start(2) + 1,  &
+               &               :,:) = tl_var%d_value(:,:,:,:)
+
+               ! clean
+               CALL var_clean(tl_var)
+            ENDIF
+
+         ENDIF
+      ENDDO
+
+      IF( td_var%t_dim(1)%l_use .AND. &
+      &   td_var%t_dim(1)%i_len == td_mpp%t_dim(1)%i_len )THEN
+         IF( td_mpp%i_ew >= 0 )THEN
+            tl_att=att_init("ew_overlap",td_mpp%i_ew)
+            CALL var_move_att(td_var,tl_att)
+            ! clean 
+            CALL att_clean(tl_att)
+         ENDIF
+      ENDIF
+
+      ! force to change _FillValue to avoid mistake 
+      ! with dummy zero _FillValue
+      IF( td_var%d_fill == 0._dp )THEN
+         CALL var_chg_FillValue(td_var)
+      ENDIF      
+
+   END SUBROUTINE iom_mpp__read_var_value
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_mpp_write_file(td_mpp, cd_dimorder)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write files composing mpp structure.
+   !>
+   !> @details
+   !> optionally, you could specify the dimension order (default 'xyzt')
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - add dimension order option 
+   !> @date August, 2017 
+   !> - handle use of domain decomposition for monoproc file
+   !>
+   !> @param[inout] td_mpp mpp structure
+   !> @param[in] cd_dimorder dimension order
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP)      , INTENT(INOUT) :: td_mpp
+      CHARACTER(LEN=*), INTENT(IN   ), OPTIONAL :: cd_dimorder
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( " MPP WRITE: domain decomposition not define "//&
+         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
+
+      ELSE
+         IF( td_mpp%l_usempp )THEN
+            DO ji=1, td_mpp%i_nproc
+               IF( td_mpp%t_proc(ji)%i_id /= 0 )THEN
+                  CALL logger_debug("MPP WRITE: proc "//TRIM(fct_str(ji)))
+                  CALL iom_write_file(td_mpp%t_proc(ji), cd_dimorder)
+               ELSE
+                  CALL logger_debug( " MPP WRITE: no id associated to file "//&
+                  &              TRIM(td_mpp%t_proc(ji)%c_name) )
+               ENDIF
+            ENDDO
+         ELSE
+            CALL iom_write_header(td_mpp%t_proc(1), cd_dimorder, td_mpp%t_dim(:))
+
+            CALL iom_mpp__write_var(td_mpp, cd_dimorder)
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE iom_mpp_write_file
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_mpp__write_var(td_mpp, cd_dimorder)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write variables from mpp structure in one output
+   !> file.
+   !>
+   !> @details
+   !> optionally, you could specify the dimension order (default 'xyzt')
+   !>
+   !> @author J.Paul
+   !> @date August, 2017 - Initial Version
+   !>
+   !> @param[inout] td_mpp mpp structure
+   !> @param[in] cd_dimorder dimension order
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP)      , INTENT(INOUT) :: td_mpp
+      CHARACTER(LEN=*), INTENT(IN   ), OPTIONAL :: cd_dimorder
+
+      ! local variable
+      INTEGER(i4), DIMENSION(4)         :: il_ind
+      INTEGER(i4)                       :: il_i1p
+      INTEGER(i4)                       :: il_i2p
+      INTEGER(i4)                       :: il_j1p
+      INTEGER(i4)                       :: il_j2p
+      INTEGER(i4)                       :: il_i1
+      INTEGER(i4)                       :: il_i2
+      INTEGER(i4)                       :: il_j1
+      INTEGER(i4)                       :: il_j2
+
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count     
+
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_strt
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_cnt      
+
+      REAL(dp)                          :: dl_fill
+
+      TYPE(TFILE)                       :: tl_file
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      ! write variable in file
+      DO jj = 1, td_mpp%i_nproc
+         
+         ! link
+         tl_file=td_mpp%t_proc(jj)
+         CALL logger_debug("IOM MPP WRITE: proc "//fct_str(jj))
+
+         ! get processor indices
+         il_ind(:)=mpp_get_proc_index( td_mpp, jj )
+         il_i1p = il_ind(1)
+         il_i2p = il_ind(2)
+         il_j1p = il_ind(3)
+         il_j2p = il_ind(4)
+      
+         IF( jj > 1 )THEN
+            ! force to use id from variable write on first proc
+            tl_file%t_var(:)%i_id=td_mpp%t_proc(1)%t_var(:)%i_id
+         ENDIF
+
+         DO ji = 1, tl_file%i_nvar
+
+            IF( jj > 1 )THEN
+               ! check _FillValue
+               dl_fill=td_mpp%t_proc(1)%t_var(ji)%d_fill
+               IF( tl_file%t_var(ji)%d_fill /= dl_fill )THEN
+                  CALL var_chg_FillValue( tl_file%t_var(ji), dl_fill )
+               ENDIF
+            ENDIF
+
+            il_start(:)=1
+            il_count(:)=td_mpp%t_dim(:)%i_len
+
+            IF( .NOT. tl_file%t_var(ji)%t_dim(1)%l_use )THEN
+               il_i1p=1 ; il_i2p=1
+               il_count(1) = 1
+            ENDIF
+            IF( .NOT. tl_file%t_var(ji)%t_dim(2)%l_use )THEN
+               il_j1p=1 ; il_j2p=1
+               il_count(2) = 1
+            ENDIF            
+            
+            il_i1=MAX(il_i1p, il_start(1))
+            il_i2=MIN(il_i2p, il_count(1))
+
+            il_j1=MAX(il_j1p, il_start(2))
+            il_j2=MIN(il_j2p, il_count(2))
+         
+            IF( (il_i1<=il_i2).AND.(il_j1<=il_j2) )THEN
+               il_strt(:)=(/ il_i1, &
+               &             il_j1, &
+               &             1,1 /)
+
+               il_cnt(:)=(/ il_i2-il_i1+1,         &
+               &            il_j2-il_j1+1,         &
+               &            tl_file%t_var(ji)%t_dim(3)%i_len, &
+               &            tl_file%t_var(ji)%t_dim(4)%i_len /)
+
+               CALL iom_write_var(tl_file, cd_dimorder, &
+               &                  id_start=il_strt(:), &
+               &                  id_count=il_cnt(:))
+            ENDIF
+
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE iom_mpp__write_var   
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE iom_mpp
Index: /utils/tools_ticket2413/SIREN/src/iom_rstdimg.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/iom_rstdimg.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/iom_rstdimg.f90	(revision 12863)
@@ -0,0 +1,1867 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief
+!> This module is a library to read/write dimg file.
+!>
+!> @details
+!>    to open dimg file (create file structure):<br/>
+!> @code
+!>    CALL iom_rstdimg_open(td_file)
+!> @endcode
+!>       - td_file is file structure (see file.f90)
+!>
+!>    to write in dimg file:<br/>
+!> @code
+!>    CALL  iom_rstdimg_write_file(td_file)
+!> @endcode
+!>
+!>    to close dimg file:<br/>
+!> @code
+!>    CALL iom_rstdimg_close(tl_file)
+!> @endcode
+!>
+!>    to read one dimension in dimg file:<br/>
+!> @code
+!>    tl_dim = iom_rstdimg_read_dim(tl_file, id_dimid)
+!> @endcode
+!>    or
+!> @code
+!>    tl_dim = iom_rstdimg_read_dim(tl_file, cd_name)
+!> @endcode
+!>       - id_dimid is dimension id<br/>
+!>       - cd_name is dimension name
+!>
+!>    to read one variable in dimg file:<br/>
+!> @code
+!>    tl_var = iom_rstdimg_read_var(td_file, id_varid, [id_start, id_count])
+!> @endcode
+!>    or
+!> @code
+!>    tl_var = iom_rstdimg_read_var(td_file, cd_name, [id_start, [id_count]])
+!> @endcode
+!>       - id_varid is variabale id
+!>       - cd_name is variabale name or standard name
+!>       - id_start is a integer(4) 1D array of index from which the data 
+!>          values will be read [optional]
+!>       - id_count is a integer(4) 1D array of the number of indices selected
+!>          along each dimension [optional]
+!>
+!>    to get sub domain decomppistion in a dimg file:<br/>
+!> @code
+!>    CALL iom_rstdimg_get_mpp(td_file)
+!> @endcode
+!>
+!> @author
+!> J.Paul
+!>
+!> @date November, 2013 - Initial Version
+!> @date August, 2017 
+!> - handle use of domain decomposition for monoproc file
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE iom_rstdimg
+
+   USE netcdf                          ! nf90 library
+   USE global                          ! global parameter
+   USE kind                            ! F90 kind parameter
+   USE fct                             ! basic useful function
+   USE logger                          ! log file manager
+   USE att                             ! attribute manager
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+   USE file                            ! file manager
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   PRIVATE ::  im_vnl !< variable name length 
+
+   ! function and subroutine
+   PUBLIC :: iom_rstdimg_open        !< open or create dimg file, return file structure
+   PUBLIC :: iom_rstdimg_close       !< close dimg file
+   PUBLIC :: iom_rstdimg_read_dim    !< read one dimension in an opened dimg file, return variable structure
+   PUBLIC :: iom_rstdimg_read_var    !< read one variable  in an opened dimg file, return dimension structure
+   PUBLIC :: iom_rstdimg_write_header!< write header in an opened dimg file
+   PUBLIC :: iom_rstdimg_write_var   !< write variable in an opened dimg file
+   PUBLIC :: iom_rstdimg_get_mpp     !< get sub domain decomppistion in a dimg file
+
+   PRIVATE :: iom_rstdimg__get_info        ! get global information in an opened dimg file
+   PRIVATE :: iom_rstdimg__get_file_var    ! read information about variable on an opened dimg file.
+   PRIVATE :: iom_rstdimg__get_file_var_0d ! put information about scalar variable in file structure
+   PRIVATE :: iom_rstdimg__get_file_var_1d ! put information about variable 1D in file structure
+   PRIVATE :: iom_rstdimg__get_file_var_2d ! put information about variable 2D in file structure
+   PRIVATE :: iom_rstdimg__get_file_var_3d ! put information about variable 3D in file structure
+   PRIVATE :: iom_rstdimg__read_dim_id     ! read dimension structure in an opened dimg file, given variable id.
+   PRIVATE :: iom_rstdimg__read_dim_name   ! read dimension structure in an opened dimg file, given variable name or standard name.
+   PRIVATE :: iom_rstdimg__read_var_id     ! read variable value in an opened dimg file, given variable id.
+   PRIVATE :: iom_rstdimg__read_var_name   ! read variable value in an opened dimg file, given variable name or standard name.
+   PRIVATE :: iom_rstdimg__read_var_value  ! read variable value in an opened dimg file, for variable 1,2,3d
+   PRIVATE :: iom_rstdimg__get_rec         ! compute record number before writing file
+   PRIVATE :: iom_rstdimg__write_header    ! write header in an opened dimg file
+   PRIVATE :: iom_rstdimg__write_var       ! write variables in an opened dimg file 
+
+   ! module variable
+   INTEGER(i4), PARAMETER :: im_vnl = 32 ! variable name length
+
+   INTERFACE iom_rstdimg_read_dim
+      MODULE PROCEDURE iom_rstdimg__read_dim_id
+      MODULE PROCEDURE iom_rstdimg__read_dim_name
+   END INTERFACE iom_rstdimg_read_dim
+
+   INTERFACE iom_rstdimg_read_var
+      MODULE PROCEDURE iom_rstdimg__read_var_id
+      MODULE PROCEDURE iom_rstdimg__read_var_name
+   END INTERFACE iom_rstdimg_read_var
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_rstdimg_open(td_file)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine open a dimg file in read or write mode.
+   !> @details
+   !> if try to open a file in write mode that did not exist, create it.<br/>
+   !> if file already exist, get information about:
+   !> - the number of variables
+   !> - the number of dimensions
+   !> - the number of global attributes
+   !> - the ID of the unlimited dimension
+   !> - the file format
+   !> Finally it read dimensions, and 'longitude' variable to compute East-West
+   !> overlap.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT)  :: td_file
+
+      ! local variable
+      LOGICAL           :: ll_exist
+      LOGICAL           :: ll_open
+
+      INTEGER(i4)       :: il_status
+      !----------------------------------------------------------------
+
+      ! check file existence
+      ! WARNING may be some issue with dimg file !!!
+      INQUIRE(FILE=TRIM(td_file%c_name), EXIST=ll_exist, OPENED=ll_open)
+      IF( .NOT. ll_exist .OR. TRIM(td_file%c_type) /= 'dimg' )THEN
+
+         IF( .NOT. td_file%l_wrt )THEN
+
+            CALL logger_fatal( " OPEN: can not open dimg file "//&
+            &               TRIM(td_file%c_name) )
+         
+         ELSE
+
+            CALL logger_info( " CREATE: dimg file "//TRIM(td_file%c_name) )
+
+            ! get free unit
+            td_file%i_id=fct_getunit()
+
+            OPEN( td_file%i_id, FILE=TRIM(td_file%c_name),&
+            &                         FORM='UNFORMATTED',              &
+            &                         ACCESS='DIRECT',                 &
+            &                         STATUS='NEW',                    &
+            &                         ACTION='WRITE',                  &
+            &                         RECL=8,                          &
+            &                         IOSTAT=il_status)
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_error("CREATE: dimg file "//&
+               &              TRIM(td_file%c_name))
+            ENDIF
+
+         ENDIF
+
+      ELSE
+
+         IF( ll_open )THEN
+
+            CALL logger_error( " OPEN: dimg file "//&
+            &                TRIM(td_file%c_name)//" already opened")
+
+         ELSE
+
+            ! get free unit
+            td_file%i_id=fct_getunit()
+
+            ! open temporary in read only mode
+            OPEN( td_file%i_id, FILE=TRIM(td_file%c_name),&
+            &                         FORM='UNFORMATTED',              &
+            &                         ACCESS='DIRECT',                 &
+            &                         STATUS='OLD',                    &
+            &                         ACTION='READ',                   &
+            &                         RECL=8,                          &
+            &                         IOSTAT=il_status)
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_error("OPEN: file "//TRIM(td_file%c_name))
+            ENDIF
+
+            ! get record length
+            READ( td_file%i_id, IOSTAT=il_status, &
+            &                         REC=1) td_file%i_recl
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_error("OPEN: read record length : "//&
+               &    TRIM(fct_str(td_file%i_recl))//" in file "//&
+               &    TRIM(td_file%c_name) )
+            ENDIF
+
+            CLOSE( td_file%i_id, IOSTAT=il_status )
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_error("OPEN: close file "//TRIM(td_file%c_name))
+            ENDIF
+
+            IF( .NOT. td_file%l_wrt )THEN
+
+               CALL logger_info( " OPEN: dimg file "//&
+               &              TRIM(td_file%c_name)//" in read only mode" )
+
+               ! open file in read mode
+               OPEN( td_file%i_id, FILE=TRIM(td_file%c_name),&
+               &                         FORM='UNFORMATTED',              &
+               &                         ACCESS='DIRECT',                 &
+               &                         STATUS='OLD',                    &
+               &                         ACTION='READ',                   &
+               &                         RECL=td_file%i_recl,    &
+               &                         IOSTAT=il_status)
+               CALL fct_err(il_status)
+               IF( il_status /= 0 )THEN
+                  CALL logger_debug("IOM RSTDIMG OPEN: open staus "//&
+                  &  TRIM(fct_str(il_status)))
+                  CALL logger_fatal("IOM RSTDIMG OPEN: file "//&
+                  &  TRIM(td_file%c_name)&
+                  &  //" with record length "//TRIM(fct_str(td_file%i_recl)))
+               ENDIF               
+
+            ELSE
+
+               CALL logger_info( " OPEN: dimg file "//&
+               &              TRIM(td_file%c_name)//&
+               &              " in read and write mode")
+
+               ! open file in read mode
+               OPEN( td_file%i_id, FILE=TRIM(td_file%c_name),&
+               &                         FORM='UNFORMATTED',              &
+               &                         ACCESS='DIRECT',                 &
+               &                         STATUS='OLD',                    &
+               &                         ACTION='READWRITE',              &
+               &                         RECL=td_file%i_recl,    &
+               &                         IOSTAT=il_status)
+               CALL fct_err(il_status)
+               IF( il_status /= 0 )THEN
+                  CALL logger_debug("IOM RSTDIMG OPEN: open staus "//&
+                  &  TRIM(fct_str(il_status)))
+                  CALL logger_error("IOM RSTDIMG  OPEN: file "//&
+                  & TRIM(td_file%c_name))
+               ENDIF        
+
+            ENDIF
+
+            ! get general information about file
+            CALL iom_rstdimg__get_info(td_file)
+
+            ! get domain decomposition in file
+            CALL iom_rstdimg_get_mpp(td_file)
+
+            ! get information about variables in file
+            CALL iom_rstdimg__get_file_var(td_file)
+
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE iom_rstdimg_open
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_rstdimg_close(td_file)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine close dimg file.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      !----------------------------------------------------------------
+
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " CLOSE: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE      
+         CALL logger_info( &
+         &  " CLOSE: file "//TRIM(td_file%c_name))
+
+         CLOSE( td_file%i_id, IOSTAT=il_status )
+         CALL fct_err(il_status)
+         IF( il_status /= 0 )THEN
+            CALL logger_error("CLOSE "//TRIM(td_file%c_name))
+         ENDIF
+
+         td_file%i_id = 0 
+
+      ENDIF
+
+   END SUBROUTINE iom_rstdimg_close
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_rstdimg__get_info(td_file)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine get global information in an opened dimg 
+   !> file.
+   !> @details
+   !> It gets the number of variables, the  domain decompistion, 
+   !> the record of the header.<br/>
+   !> It read dimensions, and add it to dimension structure inside 
+   !> file structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January,2019
+   !> - clean dimension structure
+   !>
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_recl                          ! record length 
+      INTEGER(i4) :: il_nx, il_ny, il_nz              ! x,y,z dimension 
+      INTEGER(i4) :: il_n0d, il_n1d, il_n2d, il_n3d   ! number of 0/1/2/3D variables 
+      INTEGER(i4) :: il_rhd                           ! record of the header infos
+
+      TYPE(TDIM)  :: tl_dim ! dimension structure 
+      !----------------------------------------------------------------
+
+      CALL logger_debug( &
+      &  " IOM RSTDIMG GET INFO: about dimg file "//TRIM(td_file%c_name))
+
+      ! read first record 
+      READ( td_file%i_id, IOSTAT=il_status, REC=1 )& 
+      &     il_recl,                         &
+      &     il_nx, il_ny, il_nz,             &
+      &     il_n0d, il_n1d, il_n2d, il_n3d,  &
+      &     il_rhd
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         CALL logger_debug(" READ status: "//TRIM(fct_str(il_status)))
+         CALL logger_fatal("IOM RSTDIMG GET INFO: read first line of "//&
+         &  TRIM(td_file%c_name))
+      ENDIF
+
+      td_file%c_type='dimg'
+
+      ! add dimension to file structure
+      tl_dim=dim_init('X', il_nx)
+      CALL file_move_dim(td_file, tl_dim)
+      tl_dim=dim_init('Y', il_ny)
+      CALL file_move_dim(td_file, tl_dim)
+      tl_dim=dim_init('Z', il_nz)
+      CALL file_move_dim(td_file, tl_dim)
+
+      ! reorder dimension to ('x','y','z','t')
+      ! actually fill unused dimension
+      CALL dim_reorder(td_file%t_dim)
+
+      ! save total number of variable 
+      td_file%i_n0d=il_n0d
+      td_file%i_n1d=il_n1d
+      td_file%i_n2d=il_n2d
+      td_file%i_n3d=il_n3d
+      td_file%i_nvar=il_n0d+il_n1d+il_n2d+il_n3d
+
+      ! record header infos
+      td_file%i_rhd=il_rhd
+
+      ! clean
+      CALL dim_clean(tl_dim)
+
+   END SUBROUTINE iom_rstdimg__get_info
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_rstdimg_get_mpp(td_file)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine get sub domain decomposition in a dimg file.
+   !> @details
+   !> domain decomposition informations are saved in attributes.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2016
+   !> - mismatch with "halo" indices
+   !>
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      TYPE(TATT)  :: tl_att
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_recl                          ! record length 
+      INTEGER(i4) :: il_nx, il_ny, il_nz              ! x,y,z dimension 
+      INTEGER(i4) :: il_n0d, il_n1d, il_n2d, il_n3d   ! number of 0/1/2/3D variables 
+      INTEGER(i4) :: il_iglo, il_jglo                 ! domain global size
+      INTEGER(i4) :: il_rhd                           ! record of the header infos
+      INTEGER(i4) :: il_niproc, il_njproc, il_nproc   ! domain decomposition
+      INTEGER(i4) :: il_area                          ! domain index
+
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_impp
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jmpp
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lci
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lcj
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldi
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldj
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lei
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lej
+      !----------------------------------------------------------------
+
+      CALL logger_debug( " IOM RSTDIMG GET MPP: dimg file "//&
+      &  TRIM(td_file%c_name))
+
+      ! read first record 
+      READ( td_file%i_id, IOSTAT=il_status, REC=1 )& 
+      &     il_recl,                         &
+      &     il_nx, il_ny, il_nz,             &
+      &     il_n0d, il_n1d, il_n2d, il_n3d,  &
+      &     il_rhd,                          &
+      &     il_niproc, il_njproc, il_nproc,  &
+      &     il_area,                         &
+      &     il_iglo, il_jglo
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         CALL logger_debug(" IOM RSTDIMG GET MPP: read status: "//&
+         &  TRIM(fct_str(il_status)))
+         CALL logger_error(" IOM RSTDIMG GET MPP: read first line of "//&
+         &  TRIM(td_file%c_name))
+      ENDIF
+
+      ! create attributes to save mpp value
+      tl_att=att_init( "DOMAIN_number_total", il_nproc)
+      CALL file_move_att(td_file, tl_att)
+
+      tl_att=att_init( "DOMAIN_I_number_total", il_niproc)
+      CALL file_move_att(td_file, tl_att)
+
+      tl_att=att_init( "DOMAIN_J_number_total", il_njproc)
+      CALL file_move_att(td_file, tl_att)
+
+      tl_att=att_init( "DOMAIN_number", il_area)
+      CALL file_move_att(td_file, tl_att)
+
+      tl_att=att_init( "DOMAIN_size_global", (/il_iglo, il_jglo/))
+      CALL file_move_att(td_file, tl_att)
+
+      ! allocate local variable
+      ALLOCATE( il_impp(il_nproc), il_jmpp(il_nproc),&
+      &         il_lci(il_nproc),  il_lcj(il_nproc), &
+      &         il_ldi(il_nproc),  il_ldj(il_nproc), &
+      &         il_lei(il_nproc),  il_lej(il_nproc), &
+      &         stat=il_status)
+      IF(il_status /= 0 )THEN
+
+         CALL logger_error( " IOM RSTDIMG GET MPP: not enough space to put "//&
+         &  "domain decomposition in file "//TRIM(td_file%c_name) )
+
+      ENDIF
+
+      ! read first record 
+      READ( td_file%i_id, IOSTAT=il_status, REC=1 )& 
+      &     il_recl,                         &
+      &     il_nx, il_ny, il_nz,             &
+      &     il_n0d, il_n1d, il_n2d, il_n3d,  &
+      &     il_rhd,                          &
+      &     il_niproc, il_njproc, il_nproc,  &
+      &     il_area,                         &
+      &     il_iglo, il_jglo,                &
+      &     il_lci(:), il_lcj(:),            &
+      &     il_ldi(:), il_ldj(:),            &
+      &     il_lei(:), il_lej(:),            &
+      &     il_impp(:),il_jmpp(:)
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         CALL logger_debug(" IOM RSTDIMG GET MPP: read status: "//&
+         &  TRIM(fct_str(il_status)))
+         CALL logger_fatal("IOM RSTDIMG GET MPP: read domain decomposition "//&
+         &           "on first line of "//TRIM(td_file%c_name))
+      ENDIF
+
+      tl_att=att_init( "SUBDOMAIN_I_left_bottom_indices", il_impp(:) )
+      CALL file_move_att(td_file, tl_att)
+      tl_att=att_init( "SUBDOMAIN_J_left_bottom_indices", il_jmpp(:) )
+      CALL file_move_att(td_file, tl_att)
+
+      tl_att=att_init( "SUBDOMAIN_I_dimensions", il_lci(:))
+      CALL file_move_att(td_file, tl_att)
+      tl_att=att_init( "SUBDOMAIN_J_dimensions", il_lcj(:))
+      CALL file_move_att(td_file, tl_att)
+
+      tl_att=att_init( "SUBDOMAIN_I_first_indoor_indices", il_ldi(:))
+      CALL file_move_att(td_file, tl_att)
+      tl_att=att_init( "SUBDOMAIN_J_first_indoor_indices", il_ldj(:))
+      CALL file_move_att(td_file, tl_att)
+
+      tl_att=att_init( "SUBDOMAIN_I_last_indoor_indices", il_lei(:))
+      CALL file_move_att(td_file, tl_att)
+      tl_att=att_init( "SUBDOMAIN_J_last_indoor_indices", il_lej(:))
+      CALL file_move_att(td_file, tl_att)
+
+      ! clean
+      CALL att_clean(tl_att)
+
+      DEALLOCATE( il_impp, il_jmpp,&
+      &           il_lci,  il_lcj, &
+      &           il_ldi,  il_ldj, &
+      &           il_lei,  il_lej  )
+
+   END SUBROUTINE iom_rstdimg_get_mpp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_rstdimg__get_file_var(td_file)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read information about variable on an 
+   !> opened dimg file.
+   !> @details
+   !> The variables structures inside file structure are then completed.
+   !> Variables no0d, no1d, no2d, no3d are deleted from file strucutre.
+   !> @note variable value are read only for scalar variable (0d).
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      CHARACTER(LEN=im_vnl), DIMENSION(:), ALLOCATABLE :: cl_name
+
+      REAL(dp)             , DIMENSION(:), ALLOCATABLE :: dl_value
+
+      INTEGER(i4)                                      :: il_status
+      INTEGER(i4)          , DIMENSION(:), ALLOCATABLE :: il_start
+      INTEGER(i4)          , DIMENSION(:), ALLOCATABLE :: il_count
+      !----------------------------------------------------------------
+
+      IF( td_file%i_nvar > 0 )THEN
+
+         ALLOCATE( il_start(4), il_count(4) )
+
+         il_start(1) = 1
+         il_count(1) = td_file%i_n0d
+         
+         il_start(2) = 1 + il_count(1)
+         il_count(2) = il_start(2) - 1 + td_file%i_n1d
+         
+         il_start(3) = 1 + il_count(2)
+         il_count(3) = il_start(3) - 1 + td_file%i_n2d
+         
+         il_start(4) = 1 + il_count(3)
+         il_count(4) = il_start(4) - 1 + td_file%i_n3d
+         
+         ALLOCATE( cl_name(td_file%i_nvar), dl_value(td_file%i_nvar) )
+
+         ! read first record 
+         READ( td_file%i_id, IOSTAT=il_status, REC=td_file%i_rhd )& 
+         & cl_name(il_start(1):il_count(1)), dl_value(il_start(1):il_count(1)),&
+         & cl_name(il_start(2):il_count(2)), dl_value(il_start(2):il_count(2)),&
+         & cl_name(il_start(3):il_count(3)), dl_value(il_start(3):il_count(3)),&
+         & cl_name(il_start(4):il_count(4)), dl_value(il_start(4):il_count(4))
+         CALL fct_err(il_status)
+         IF( il_status /= 0 )THEN
+            CALL logger_error("GET FILE: reading headers in file "//&
+            &   TRIM(td_file%c_name))
+         ENDIF
+
+         DEALLOCATE( il_start, il_count )
+
+         IF(ASSOCIATED(td_file%t_var))THEN
+            CALL var_clean(td_file%t_var(:))
+            DEALLOCATE(td_file%t_var)
+         ENDIF
+         ALLOCATE(td_file%t_var(td_file%i_nvar))
+
+         ! put information about variable 0D inside file structure
+         CALL iom_rstdimg__get_file_var_0d(td_file, cl_name(:), dl_value(:))
+
+         ! put information about variable 1D inside file structure
+         CALL iom_rstdimg__get_file_var_1d(td_file, cl_name(:), dl_value(:))
+
+         ! put information about variable 2D inside file structure
+         CALL iom_rstdimg__get_file_var_2d(td_file, cl_name(:), dl_value(:))
+
+         ! put information about variable 3D inside file structure
+         CALL iom_rstdimg__get_file_var_3d(td_file, cl_name(:), dl_value(:))
+
+         DEALLOCATE( cl_name, dl_value )
+
+         ! delete dummy variable
+         CALL file_del_var( td_file, 'no0d' )
+         CALL file_del_var( td_file, 'no1d' )
+         CALL file_del_var( td_file, 'no2d' )
+         CALL file_del_var( td_file, 'no3d' )
+
+      ELSE
+
+         CALL logger_debug( &
+         &  " GET FILE VAR: there is no variable in file "//&
+         &  TRIM(td_file%c_name))
+
+      ENDIF
+
+   END SUBROUTINE iom_rstdimg__get_file_var
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_rstdimg__get_file_var_0d(td_file, cd_name, dd_value)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine put informations about scalar variable 
+   !> inside file structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_file   file structure
+   !> @param[in] cd_name      array of variable name
+   !> @param[in] dd_value     array of variable value
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE),                         INTENT(INOUT) :: td_file
+      CHARACTER(LEN=im_vnl), DIMENSION(:), INTENT(IN)    :: cd_name
+      REAL(dp),              DIMENSION(:), INTENT(IN)    :: dd_value
+
+      ! local variable
+      TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! define same dimension as in file
+      tl_dim(:)=dim_copy(td_file%t_dim(:))
+      ! do not use any dimension
+      tl_dim(:)%l_use=.FALSE.
+      tl_dim(:)%i_len=1
+      
+      ! case scalar variable
+      DO ji = 1, td_file%i_n0d
+   
+         td_file%t_var(ji)=var_init( TRIM(cd_name(ji)), NF90_DOUBLE, &
+         &                           tl_dim(:), dd_fill=0._dp,       &
+         &                           id_id=ji, id_rec=1 )
+
+         ! get value of scalar
+         IF( ASSOCIATED(td_file%t_var(ji)%d_value) )THEN
+            DEALLOCATE(td_file%t_var(ji)%d_value)
+         ENDIF
+         ALLOCATE(td_file%t_var(ji)%d_value(1,1,1,1))
+
+         td_file%t_var(ji)%d_value(1,1,1,1)=dd_value(ji)
+
+      ENDDO
+
+      ! clean
+      CALL dim_clean(tl_dim(:))
+
+   END SUBROUTINE iom_rstdimg__get_file_var_0d
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_rstdimg__get_file_var_1d(td_file, cd_name, dd_value)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine put informations about variable 1D 
+   !> inside file structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2016
+   !>    - change right dimension struct 
+   !>
+   !> @param[inout] td_file   file structure
+   !> @param[in] cd_name      array of variable name
+   !> @param[in] dd_value     array of variable record
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE),                         INTENT(INOUT) :: td_file
+      CHARACTER(LEN=im_vnl), DIMENSION(:), INTENT(IN)    :: cd_name
+      REAL(dp),              DIMENSION(:), INTENT(IN)    :: dd_value
+
+      ! local variable
+      TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! case variable 1D
+      DO ji = td_file%i_n0d + 1, &
+      &       td_file%i_n0d + td_file%i_n1d
+
+         ! define same dimension as in file
+         tl_dim(:)=dim_copy(td_file%t_dim(:))
+         ! do not use X and Y dimension
+         tl_dim(1:2)%l_use=.FALSE.
+         tl_dim(1:2)%i_len=1
+      
+         td_file%t_var(ji)=var_init( TRIM(cd_name(ji)), NF90_DOUBLE, &
+         &                           tl_dim(:), dd_fill=0._dp,       &
+         &                           id_id=ji, id_rec=INT(dd_value(ji),i4) )
+
+         ! clean
+         CALL dim_clean(tl_dim(:))
+
+      ENDDO
+
+   END SUBROUTINE iom_rstdimg__get_file_var_1d
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_rstdimg__get_file_var_2d(td_file, cd_name, dd_value)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine put informations about variable 2D 
+   !> inside file structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_file   file structure
+   !> @param[in] cd_name      array of variable name
+   !> @param[in] dd_value     array of variable record
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE),                         INTENT(INOUT) :: td_file
+      CHARACTER(LEN=im_vnl), DIMENSION(:), INTENT(IN)    :: cd_name
+      REAL(dp),              DIMENSION(:), INTENT(IN)    :: dd_value
+
+      ! local variable
+      TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! case variable 2D (X,Y)
+      DO ji = td_file%i_n0d + td_file%i_n1d + 1 , &
+      &       td_file%i_n0d + td_file%i_n1d + td_file%i_n2d
+
+         ! define same dimension as in file
+         tl_dim(:)=dim_copy(td_file%t_dim(:))
+         ! do not use Z dimension
+         tl_dim(3)%l_use=.FALSE.
+         tl_dim(3)%i_len=1       
+
+         td_file%t_var(ji)=var_init( TRIM(cd_name(ji)), NF90_DOUBLE, &
+         &                           tl_dim(:), dd_fill=0._dp,       &
+         &                           id_id=ji, id_rec=INT(dd_value(ji),i4) )
+
+         ! clean
+         CALL dim_clean(tl_dim(:))
+
+      ENDDO
+
+   END SUBROUTINE iom_rstdimg__get_file_var_2d
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_rstdimg__get_file_var_3d(td_file, cd_name, dd_value)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine put informations about variable 3D 
+   !> inside file structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_file   file structure
+   !> @param[in] cd_name      array of variable name
+   !> @param[in] dd_value     array of variable record
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE),                         INTENT(INOUT) :: td_file
+      CHARACTER(LEN=im_vnl), DIMENSION(:), INTENT(IN)    :: cd_name
+      REAL(dp),              DIMENSION(:), INTENT(IN)    :: dd_value
+
+      ! local variable
+      TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! case variable 3D (X,Y,Z)
+      DO ji = td_file%i_n0d + td_file%i_n1d + td_file%i_n2d +1 , &
+      &       td_file%i_n0d + td_file%i_n1d + td_file%i_n2d + td_file%i_n3d
+
+         ! define same dimension as in file
+         tl_dim(:)=dim_copy(td_file%t_dim(:)) 
+
+         td_file%t_var(ji)=var_init( TRIM(cd_name(ji)), NF90_DOUBLE, &
+         &                           tl_dim(:), dd_fill=0._dp,       &
+         &                           id_id=ji, id_rec=INT(dd_value(ji),i4) )
+
+         ! clean
+         CALL dim_clean(tl_dim(:))
+
+      ENDDO
+
+   END SUBROUTINE iom_rstdimg__get_file_var_3d
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION iom_rstdimg__read_dim_id(td_file, id_dimid) &
+         & RESULT (tf_dim)
+   !-------------------------------------------------------------------
+   !> @brief This function read one dimension in an opened netcdf file, 
+   !> given dimension id.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] id_dimid  dimension id
+   !> @return  dimension structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(IN) :: td_file
+      INTEGER(i4), INTENT(IN) :: id_dimid
+
+      ! function
+      TYPE(TDIM)              :: tf_dim
+      !----------------------------------------------------------------
+
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " READ DIM: no id associated to dimg file "//TRIM(td_file%c_name))
+
+      ELSE      
+
+         tf_dim%i_id=id_dimid
+
+         CALL logger_debug( &
+         &  " READ DIM: dimension "//TRIM(fct_str(id_dimid))//&
+         &  " in file "//TRIM(td_file%c_name))
+
+         IF( id_dimid <= 4 )THEN
+            tf_dim=td_file%t_dim(id_dimid)
+         ELSE
+            CALL logger_error( &
+            &  " READ DIM: no dimension with id "//TRIM(fct_str(id_dimid))//&
+            &  " in file "//TRIM(td_file%c_name))
+         ENDIF
+
+      ENDIF
+
+   END FUNCTION iom_rstdimg__read_dim_id
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION iom_rstdimg__read_dim_name(td_file, cd_name) &
+         & RESULT (tf_dim)
+   !-------------------------------------------------------------------
+   !> @brief This function read one dimension in an opened netcdf file, 
+   !> given dimension name.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] cd_name   dimension name
+   !> @return  dimension structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE),      INTENT(IN) :: td_file
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+
+      ! function
+      TYPE(TDIM)                   :: tf_dim
+
+      ! local variable
+      INTEGER(i4) :: il_dimid
+      !----------------------------------------------------------------
+
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " READ DIM: no id associated to dimg file "//TRIM(td_file%c_name))
+
+      ELSE      
+
+         il_dimid=dim_get_id(td_file%t_dim(:), TRIM(cd_name))
+         IF( il_dimid /= 0 )THEN
+            tf_dim=iom_rstdimg_read_dim(td_file, il_dimid)
+         ELSE
+            CALL logger_error( &
+            &  " READ DIM: no dimension "//TRIM(cd_name)//&
+            &  " in file "//TRIM(td_file%c_name))
+         ENDIF
+
+      ENDIF
+
+   END FUNCTION iom_rstdimg__read_dim_name
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION iom_rstdimg__read_var_id(td_file, id_varid, id_start, id_count) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function read variable value in an opened 
+   !> dimg file, given variable id.
+   !> @details
+   !> Optionaly, start indices and number of indices selected along each dimension 
+   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] id_varid  variable id
+   !> @param[in] id_start  index in the variable from which the data values 
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !> @return  variable structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE),               INTENT(IN) :: td_file
+      INTEGER(i4),               INTENT(IN) :: id_varid
+      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count
+
+      ! function
+      TYPE(TVAR)                            :: tf_var
+
+      ! local variable
+      INTEGER(i4), DIMENSION(1) :: il_varid
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " READ VAR: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+
+         ! look for variable id
+         il_varid(:)=MINLOC(td_file%t_var(:)%i_id,mask=(td_file%t_var(:)%i_id==id_varid))
+         IF( il_varid(1) /= 0 )THEN
+
+            tf_var=var_copy(td_file%t_var(il_varid(1)))
+
+            IF( tf_var%i_ndim /= 0 )THEN
+               !!! read variable value
+               CALL iom_rstdimg__read_var_value( td_file, tf_var, id_start, id_count)
+            ELSE
+               CALL logger_debug( " READ VAR: variable 0d "//&
+               &               TRIM(td_file%t_var(il_varid(1))%c_name)//&
+               &               " should be already read ")
+            ENDIF            
+
+         ELSE
+            CALL logger_error( &
+            &  " READ VAR: there is no variable with id "//&
+            &  TRIM(fct_str(id_varid))//" in file "//TRIM(td_file%c_name))
+         ENDIF
+
+      ENDIF
+   END FUNCTION iom_rstdimg__read_var_id
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION iom_rstdimg__read_var_name(td_file, cd_name, id_start, id_count) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function read variable value in an opened 
+   !> dimg file, given variable name or standard name.
+   !> @details
+   !> Optionaly, start indices and number of indices selected along each dimension 
+   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
+   !>
+   !> look first for variable name. If it doesn't
+   !> exist in file, look for variable standard name.<br/>
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[in] cd_name   variable name or standard name 
+   !> @param[in] id_start  index in the variable from which the data values 
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !> @return  variable structure 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument 
+      TYPE(TFILE),                     INTENT(IN) :: td_file
+      CHARACTER(LEN=*),                INTENT(IN) :: cd_name
+      INTEGER(i4),      DIMENSION(:),  INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4),      DIMENSION(:),  INTENT(IN), OPTIONAL :: id_count
+
+      ! function
+      TYPE(TVAR)                                  :: tf_var
+
+      ! local variable
+      INTEGER(i4)       :: il_varid
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " READ VAR: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+
+         il_varid=var_get_index(td_file%t_var(:), cd_name)
+         IF( il_varid /= 0 )THEN
+
+            tf_var=var_copy(td_file%t_var(il_varid))
+
+            IF( td_file%t_var(il_varid)%i_ndim /= 0 )THEN
+               !!! read variable value
+               CALL iom_rstdimg__read_var_value( td_file, tf_var, id_start, id_count)
+            ELSE
+               CALL logger_debug( " READ VAR: variable 0d "//&
+               &               TRIM(td_file%t_var(il_varid)%c_name)//&
+               &               " should have been already read ")
+            ENDIF
+
+         ELSE
+
+            CALL logger_error( &
+            &  " READ VAR NAME: there is no variable with "//&
+            &  " name or standard name "//TRIM(cd_name)//&
+            &  " in file "//TRIM(td_file%c_name) )
+
+         ENDIF
+
+      ENDIF
+      
+   END FUNCTION iom_rstdimg__read_var_name
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_rstdimg__read_var_value(td_file, td_var, id_start, id_count)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read variable value in an opened dimg file, for
+   !> variable 1,2,3d.
+   !> @details
+   !> Optionaly,start indices and number of indices selected along each dimension 
+   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2016
+   !> - use temporary array to read value from file
+   !>
+   !> @param[in] td_file   file structure
+   !> @param[inout] td_var variable structure
+   !> @param[in] id_start  index in the variable from which the data values will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE),               INTENT(IN)    :: td_file
+      TYPE(TVAR) ,               INTENT(INOUT) :: td_var
+      INTEGER(i4), DIMENSION(:), INTENT(IN),  OPTIONAL :: id_start
+      INTEGER(i4), DIMENSION(:), INTENT(IN),  OPTIONAL :: id_count
+
+      ! local variable
+      INTEGER(i4)                                  :: il_status
+      INTEGER(i4)                                  :: il_tmp1, il_tmp2
+      INTEGER(i4), DIMENSION(ip_maxdim)            :: il_start
+      INTEGER(i4), DIMENSION(ip_maxdim)            :: il_count
+
+      REAL(dp),    DIMENSION(:,:,:)  , ALLOCATABLE :: dl_tmp
+      REAL(dp),    DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! check id_count and id_start optionals parameters...
+      IF( (       PRESENT(id_start)  .AND. (.NOT. PRESENT(id_count))) .OR. &
+          ((.NOT. PRESENT(id_start)) .AND.        PRESENT(id_count) ) )THEN
+         CALL logger_warn( &
+         &  " READ VAR VALUE: id_start and id_count should be both specify")
+      ENDIF
+
+      IF( PRESENT(id_start).AND.PRESENT(id_count) )THEN
+
+         IF( SIZE(id_start(:)) /= ip_maxdim .OR. &
+         &   SIZE(id_count(:)) /= ip_maxdim )THEN
+            CALL logger_error("READ VAR: dimension of array start or count "//&
+            &      " are invalid to read variable "//TRIM(td_var%c_name)//&
+            &      " in file "//TRIM(td_file%c_name) )
+         ENDIF
+
+         ! dimension order assume to be ('x','y','z','t')
+         il_start(:)=id_start(:)
+         il_count(:)=id_count(:)
+
+      ELSE
+
+         ! dimension order assume to be ('x','y','z','t')
+         il_start(:)=(/1,1,1,1/)
+         il_count(:)=td_var%t_dim(:)%i_len
+
+      ENDIF
+
+      ! check dimension
+      IF( .NOT. ALL(il_start(:)>=(/1,1,1,1/)) )THEN
+
+         CALL logger_error( " READ VAR VALUE: "//&
+         &               " start indices should be greater than or equal to 1")
+
+      ENDIF
+
+      IF(.NOT.ALL(il_start(:)+il_count(:)-1<=(/td_var%t_dim(1)%i_len,&
+         &                                     td_var%t_dim(2)%i_len,&
+         &                                     td_var%t_dim(3)%i_len,&
+         &                                     td_var%t_dim(4)%i_len &
+         &                                    /)) )THEN
+
+         CALL logger_error( " READ VAR VALUE: "//&
+         &               "start + count exceed variable dimension" )
+
+         DO ji = 1, ip_maxdim
+            il_tmp1=il_start(ji)+il_count(ji)-1
+            il_tmp2=td_var%t_dim(ji)%i_len
+            CALL logger_debug( &
+            &  " READ VAR VALUE: start + count - 1 "//TRIM(fct_str(il_tmp1))//&
+            &  " variable dimension"//TRIM(fct_str(il_tmp2)))
+         ENDDO
+
+      ELSE
+
+         ! Allocate space to hold variable value
+         ALLOCATE(dl_value( td_var%t_dim(1)%i_len, &
+         &                  td_var%t_dim(2)%i_len, &
+         &                  td_var%t_dim(3)%i_len, &
+         &                  td_var%t_dim(4)%i_len),&
+         &        stat=il_status)
+         IF(il_status /= 0 )THEN
+
+           CALL logger_error( &
+            &  " READ VAR VALUE: not enough space to put variable "//&
+            &  TRIM(td_var%c_name)//&
+            &  " in temporary array")
+
+         ENDIF
+
+         ! read values
+         CALL logger_trace( &
+         &  " READ VAR VALUE: get variable "//TRIM(td_var%c_name)//&
+         &  " in file "//TRIM(td_file%c_name))     
+
+         IF( ALL(td_var%t_dim(1:3)%l_use) )THEN
+            ! 3D variable (X,Y,Z)
+            ALLOCATE(dl_tmp( td_var%t_dim(1)%i_len, &
+            &                td_var%t_dim(2)%i_len, &
+            &                td_var%t_dim(4)%i_len) )           
+            DO ji=1,td_var%t_dim(3)%i_len
+               READ(td_file%i_id, IOSTAT=il_status, REC=td_var%i_rec +ji-1) &
+               &  dl_tmp(:,:,:)
+               CALL fct_err(il_status)
+               IF( il_status /= 0 )THEN
+                  CALL logger_error("READ VAR VALUE: reading 3D variable "//&
+                  &              TRIM(td_var%c_name))
+               ENDIF
+               dl_value(:,:,ji,:)=dl_tmp(:,:,:)
+            ENDDO
+            DEALLOCATE(dl_tmp)
+         ELSEIF( ALL(td_var%t_dim(1:2)%l_use) )THEN
+            ! 2D variable (X,Y)
+            READ(td_file%i_id, IOSTAT=il_status, REC=td_var%i_rec ) &
+            &  dl_value(:,:,:,:)
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_error("READ VAR VALUE: reading 2D variable "//&
+                  &            TRIM(td_var%c_name))
+            ENDIF
+         ELSEIF( td_var%t_dim(3)%l_use )THEN
+            ! 1D variable (Z)
+            READ(td_file%i_id, IOSTAT=il_status, REC=td_var%i_rec ) &
+            &  dl_value(:,:,:,:)
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_error("READ VAR VALUE: reading 1D variable "//&
+                  &            TRIM(td_var%c_name))
+            ENDIF
+         ENDIF
+ 
+         ! Allocate space to hold variable value in structure
+         IF( ASSOCIATED(td_var%d_value) )THEN
+            DEALLOCATE(td_var%d_value)   
+         ENDIF
+
+         ALLOCATE(td_var%d_value( il_count(1), &
+         &                        il_count(2), &
+         &                        il_count(3), &
+         &                        il_count(4)),&
+         &        stat=il_status)
+         IF(il_status /= 0 )THEN
+
+           CALL logger_error( &
+            &  " READ VAR VALUE: not enough space to put variable "//&
+            &  TRIM(td_var%c_name)//&
+            &  " in variable structure")
+
+         ENDIF
+         ! FillValue by default
+         td_var%d_value(:,:,:,:)=td_var%d_fill
+
+         ! new dimension length
+         td_var%t_dim(:)%i_len=il_count(:)
+
+         ! extract value 
+         td_var%d_value(:,:,:,:) = dl_value(il_start(1):il_start(1)+il_count(1)-1,&
+         &                                  il_start(2):il_start(2)+il_count(2)-1,&
+         &                                  il_start(3):il_start(3)+il_count(3)-1,&
+         &                                  il_start(4):il_start(4)+il_count(4)-1)
+
+         DEALLOCATE(dl_value)
+
+      ENDIF
+
+      ! force to change _FillValue to avoid mistake 
+      ! with dummy zero _FillValue
+      IF( td_var%d_fill == 0._dp )THEN
+         CALL var_chg_FillValue(td_var)
+      ENDIF
+
+      ! use scale factor and offset
+      WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )
+         td_var%d_value(:,:,:,:) = &
+         &  td_var%d_value(:,:,:,:)*td_var%d_scf + td_var%d_ofs
+      END WHERE
+
+   END SUBROUTINE iom_rstdimg__read_var_value
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_rstdimg_write_header(td_file)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write header of dimg file from file structure.
+   !>
+   !> @details
+   !> dimg file have to be already opened in write mode.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014
+   !> - use iom_rstdimg__get_rec
+   !> @date August, 2017
+   !> - split in write_header and write_var 
+   !>
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      INTEGER(i4)           :: il_status
+      INTEGER(i4)           :: il_ind
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " WRITE FILE: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+         IF( td_file%l_wrt )THEN
+
+            ! check dimension
+            IF( td_file%t_dim(jp_L)%l_use .AND. &
+            &   td_file%t_dim(jp_L)%i_len /= 1 )THEN
+               CALL logger_fatal("WRITE FILE: can not write dimg file with "//&
+               &  " several time step.")
+            ENDIF
+
+            ! close and open file with right record length
+            CALL iom_rstdimg_close(td_file)
+
+            ! compute record number to be used 
+            ! and add variable no0d, no1d,.. if need be
+            CALL iom_rstdimg__get_rec(td_file)
+
+            ! compute record length
+            il_ind=att_get_index(td_file%t_att(:),"DOMAIN_number_total")
+            IF( il_ind /= 0 )THEN
+               td_file%i_recl = MAX( &
+               &     td_file%t_dim(1)%i_len * td_file%t_dim(2)%i_len * 8, &
+               &     ( 8 * INT(td_file%t_att(il_ind)%d_value(1)) + 15 ) * 4 )
+            ELSE
+               td_file%i_recl = td_file%t_dim(1)%i_len * &
+               &                td_file%t_dim(2)%i_len * 8
+            ENDIF
+            ! check record length
+            IF( td_file%i_nvar*(im_vnl+dp) > td_file%i_recl )THEN
+               CALL logger_fatal("WRITE FILE: record length is too small. "//&
+               &  " Try to reduce the output number of processor.")
+            ENDIF
+
+            ! get free unit
+            td_file%i_id=fct_getunit()
+
+            OPEN( td_file%i_id, FILE=TRIM(td_file%c_name),&
+            &                         FORM='UNFORMATTED',              &
+            &                         ACCESS='DIRECT',                 &
+            &                         STATUS='REPLACE',                &
+            &                         ACTION='WRITE',                  &
+            &                         RECL=td_file%i_recl,             &
+            &                         IOSTAT=il_status)
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_error("WRITE FILE: REPLACE file "//TRIM(td_file%c_name)//&
+               &  " with record length "//TRIM(fct_str(td_file%i_recl)))
+            ELSE
+               CALL logger_debug("WRITE FILE: REPLACE file "//TRIM(td_file%c_name)//&
+               &  " with record length "//TRIM(fct_str(td_file%i_recl)))
+            ENDIF
+
+            ! write header
+            CALL iom_rstdimg__write_header(td_file)
+
+         ELSE
+
+            CALL logger_error( &
+            &  " WRITE FILE: try to write in file "//TRIM(td_file%c_name)//&
+            &  ", not opened in write mode")
+
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE iom_rstdimg_write_header
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_rstdimg_write_var(td_file)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write variable in dimg file from file structure.
+   !>
+   !> @details
+   !> dimg file have to be already opened in write mode.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2014
+   !> - use iom_rstdimg__get_rec
+   !> @date August, 2017
+   !> - split in write_header and write_var 
+   !>
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      !----------------------------------------------------------------
+      ! check if file opened
+      IF( td_file%i_id == 0 )THEN
+
+         CALL logger_error( &
+         &  " WRITE FILE: no id associated to file "//TRIM(td_file%c_name))
+
+      ELSE
+         IF( td_file%l_wrt )THEN
+
+            ! write variable in file
+            CALL iom_rstdimg__write_var(td_file) 
+
+         ELSE
+
+            CALL logger_error( &
+            &  " WRITE FILE: try to write in file "//TRIM(td_file%c_name)//&
+            &  ", not opened in write mode")
+
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE iom_rstdimg_write_var
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_rstdimg__get_rec(td_file)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute record number to be used.
+   !>
+   !> @details
+   !> Moreover it adds variable no0d, no1d, no2d and no3d if need be.
+   !>
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      INTEGER(i4) :: il_rec
+      TYPE(TVAR)  :: tl_var
+
+      INTEGER(i4), DIMENSION(:)    , ALLOCATABLE :: il_tmp1d
+      INTEGER(i4), DIMENSION(:,:)  , ALLOCATABLE :: il_tmp2d
+      INTEGER(i4), DIMENSION(:,:,:), ALLOCATABLE :: il_tmp3d
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! add dummy variable if necessary
+      IF( td_file%i_n0d == 0 )THEN
+         ! create var
+         tl_var=var_init('no0d')
+
+         CALL file_add_var( td_file, tl_var )
+      ENDIF
+
+      IF( td_file%i_n1d == 0 )THEN
+         ! create var
+         ALLOCATE( il_tmp1d( td_file%t_dim(3)%i_len ) )
+         il_tmp1d(:)=-1
+
+         tl_var=var_init( 'no1d', il_tmp1d(:)) 
+
+         DEALLOCATE( il_tmp1d )
+
+         CALL file_add_var( td_file, tl_var ) 
+      ENDIF
+ 
+      IF( td_file%i_n2d == 0 )THEN
+         ! create var
+         ALLOCATE( il_tmp2d( td_file%t_dim(1)%i_len, &
+         &                   td_file%t_dim(2)%i_len ) )
+         il_tmp2d(:,:)=-1
+
+         tl_var=var_init('no2d', il_tmp2d(:,:) )
+
+         DEALLOCATE( il_tmp2d )
+
+         CALL file_add_var( td_file, tl_var ) 
+
+      ENDIF
+ 
+      IF( td_file%i_n3d == 0 )THEN
+         ! create var
+         ALLOCATE( il_tmp3d( td_file%t_dim(1)%i_len, &
+         &                   td_file%t_dim(2)%i_len, &
+         &                   td_file%t_dim(3)%i_len ) )
+         il_tmp3d(:,:,:)=-1
+
+         tl_var=var_init('no3d', il_tmp3d(:,:,:) )
+
+         DEALLOCATE( il_tmp3d )
+
+         CALL file_add_var( td_file, tl_var ) 
+      ENDIF
+
+      ! clean
+      CALL var_clean(tl_var)
+
+      il_rec=2
+      DO ji=1,td_file%i_nvar
+         SELECT CASE(td_file%t_var(ji)%i_ndim)
+            CASE(0)
+               IF( INDEX(td_file%t_var(ji)%c_name, 'no0d' ) == 0 )THEN
+                  td_file%t_var(ji)%i_rec=il_rec
+                  il_rec = il_rec  + 0
+               ENDIF
+            CASE(1)
+               IF( INDEX(td_file%t_var(ji)%c_name, 'no1d' ) == 0 )THEN
+                  td_file%t_var(ji)%i_rec=il_rec
+                  il_rec = il_rec  + 1
+               ENDIF
+            CASE(2)
+               IF( INDEX(td_file%t_var(ji)%c_name, 'no2d' ) == 0 )THEN
+                  td_file%t_var(ji)%i_rec=il_rec
+                  il_rec = il_rec  + 1
+               ENDIF
+            CASE(3)
+               IF( INDEX(td_file%t_var(ji)%c_name, 'no3d' ) == 0 )THEN
+                  td_file%t_var(ji)%i_rec=il_rec
+                  il_rec = il_rec  + td_file%t_dim(3)%i_len
+               ENDIF
+         END SELECT
+      ENDDO
+      td_file%i_rhd  = il_rec
+
+   END SUBROUTINE iom_rstdimg__get_rec
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_rstdimg__write_header(td_file)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write header in an opened dimg 
+   !> file in write mode.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2016
+   !> - mismatch with "halo" indices
+   !>
+   !> @param[inout] td_file   file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_ind
+      INTEGER(i4) :: il_nproc
+      INTEGER(i4) :: il_niproc
+      INTEGER(i4) :: il_njproc
+      INTEGER(i4) :: il_area
+      INTEGER(i4) :: il_iglo
+      INTEGER(i4) :: il_jglo
+
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_impp
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jmpp
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lci
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lcj
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldi
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldj
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lei
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lej
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      ! check record length
+      IF( td_file%i_recl <= 8 )THEN
+         CALL logger_warn(" WRITE FILE: record length seems to be tiny!! &
+         & ("//TRIM(fct_str(td_file%i_recl))//")")
+      ENDIF
+
+      ! check dimension
+      IF( ANY(td_file%t_dim(1:3)%i_len <= 0 ) )THEN
+         CALL logger_error(" WRITE FILE: at least one dimension size is less &
+         &                than or equal to zero !! ")
+         DO ji=1,3
+            CALL logger_debug(" WRITE FILE: dimension "//&
+            &               TRIM(td_file%t_dim(ji)%c_name)//" : "//&
+            &               TRIM(fct_str(td_file%t_dim(ji)%i_len)) )
+         ENDDO
+      ENDIF
+
+      ! get domain decomposition
+      il_ind=att_get_index( td_file%t_att, "DOMAIN_number_total" )
+      il_nproc = 1
+      IF( il_ind /= 0 )THEN
+         il_nproc = INT(td_file%t_att(il_ind)%d_value(1))
+      ENDIF
+
+      il_ind=att_get_index( td_file%t_att, "DOMAIN_I_number_total" )
+      il_niproc = 0
+      IF( il_ind /= 0 )THEN
+         il_niproc = INT(td_file%t_att(il_ind)%d_value(1))
+      ENDIF
+
+      il_ind=att_get_index( td_file%t_att, "DOMAIN_J_number_total" )
+      il_njproc = 0
+      IF( il_ind /= 0 )THEN
+         il_njproc = INT(td_file%t_att(il_ind)%d_value(1))
+      ENDIF
+
+      ! check domain decomposition
+      IF( il_niproc  <= 0 .OR. &
+      &   il_njproc  <= 0 .OR. &
+      &   il_nproc <= 0 .OR. &
+      &   il_nproc > il_niproc * il_njproc )THEN
+      
+         CALL logger_error(" WRITE FILE: invalid domain splitting ")
+
+         CALL logger_debug(" WRITE FILE: niproc "//TRIM(fct_str(il_niproc)) )
+         CALL logger_debug(" WRITE FILE: njproc "//TRIM(fct_str(il_njproc)) )
+         CALL logger_debug(" WRITE FILE: nproc "//TRIM(fct_str(il_nproc)) )
+
+      ENDIF
+      
+      ! get domain number
+      il_ind=att_get_index( td_file%t_att, "DOMAIN_number" )
+      il_area = 0
+      IF( il_ind /= 0 )THEN
+         il_area = INT(td_file%t_att(il_ind)%d_value(1))
+      ENDIF
+
+      ! get domain global size
+      il_ind=att_get_index( td_file%t_att, "DOMAIN_size_global" )
+      il_iglo = 0
+      il_jglo = 0
+      IF( il_ind /= 0 )THEN
+         il_iglo = INT(td_file%t_att(il_ind)%d_value(1))
+         il_jglo = INT(td_file%t_att(il_ind)%d_value(2))
+      ENDIF
+
+      ! check domain global size
+      IF( il_iglo < td_file%t_dim(1)%i_len .OR. &
+      &   il_jglo < td_file%t_dim(2)%i_len )THEN
+         CALL logger_error(" WRITE FILE: invalid global domain ")
+
+         CALL logger_debug(" WRITE FILE: global domain : "//&
+         &              TRIM(fct_str(il_iglo))//" x "//&
+         &              TRIM(fct_str(il_jglo)) )
+         CALL logger_debug(" WRITE FILE: local domain : "//&
+         &              TRIM(fct_str(td_file%t_dim(1)%i_len))//" x "//&
+         &              TRIM(fct_str(td_file%t_dim(2)%i_len)) )
+      ENDIF
+
+      ! allocate local variable
+      ALLOCATE( il_impp(il_nproc), il_jmpp(il_nproc),&
+      &         il_lci(il_nproc),  il_lcj(il_nproc), &
+      &         il_ldi(il_nproc),  il_ldj(il_nproc), &
+      &         il_lei(il_nproc),  il_lej(il_nproc) )
+
+      ! get left bottom indices
+      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_I_left_bottom_indices" )
+      il_impp(:) = 0
+      IF( il_ind /= 0 )THEN
+         il_impp(:) = INT(td_file%t_att(il_ind)%d_value(:))
+      ENDIF
+
+      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_J_left_bottom_indices" )
+      il_jmpp(:) = 0
+      IF( il_ind /= 0 )THEN
+         il_jmpp(:) = INT(td_file%t_att(il_ind)%d_value(:))
+      ENDIF
+      
+      ! check left bottom indices
+      IF( ANY(il_impp(:)==0) .OR. ANY(il_jmpp(:)==0) )THEN
+         CALL logger_warn("WRITE FILE: no data for subdomain left bottom indices")
+      ENDIF
+
+      ! get subdomain dimensions
+      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_I_dimensions" )
+      il_lci(:) = 0
+      IF( il_ind /= 0 )THEN
+         il_lci(:) = INT(td_file%t_att(il_ind)%d_value(:))
+      ENDIF
+
+      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_J_dimensions" )
+      il_lcj(:) = 0
+      IF( il_ind /= 0 )THEN
+         il_lcj(:) = INT(td_file%t_att(il_ind)%d_value(:))
+      ENDIF
+
+      ! check subdomain dimension
+      IF( ANY(il_lci(:)==0) .OR. ANY(il_lcj(:)==0) )THEN
+         CALL logger_warn("WRITE FILE: no data for subdomain dimensions")
+      ENDIF
+
+      ! get first indoor indices
+      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_I_first_indoor_indices" )
+      il_ldi(:) = 0
+      IF( il_ind /= 0 )THEN
+         il_ldi(:) = INT(td_file%t_att(il_ind)%d_value(:))
+      ENDIF
+
+      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_J_first_indoor_indices" )
+      il_ldj(:) = 0
+      IF( il_ind /= 0 )THEN
+         il_ldj(:) = INT(td_file%t_att(il_ind)%d_value(:))
+      ENDIF
+      
+      ! check first indoor indices
+      IF( ANY(il_ldi(:)==0) .OR. ANY(il_ldj(:)==0) )THEN
+         CALL logger_warn("WRITE FILE: no data for subdomain first indoor indices")
+      ENDIF
+
+      ! get last indoor indices
+      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_I_last_indoor_indices" )
+      il_lei(:) = 0
+      IF( il_ind /= 0 )THEN
+         il_lei(:) = INT(td_file%t_att(il_ind)%d_value(:))
+      ENDIF
+
+      il_ind=att_get_index( td_file%t_att, "SUBDOMAIN_J_last_indoor_indices" )
+      il_lej(:) = 0
+      IF( il_ind /= 0 )THEN
+         il_lej(:) = INT(td_file%t_att(il_ind)%d_value(:))
+      ENDIF
+
+      ! check last indoor indices
+      IF( ANY(il_lei(:)==0) .OR. ANY(il_lej(:)==0) )THEN
+         CALL logger_warn("WRITE FILE: no data for subdomain last indoor indices")
+      ENDIF      
+
+      ! write file header
+      WRITE(td_file%i_id, IOSTAT=il_status, REC=1 )&
+      &  td_file%i_recl, &
+      &  td_file%t_dim(1)%i_len, &
+      &  td_file%t_dim(2)%i_len, &
+      &  td_file%t_dim(3)%i_len, &
+      &  td_file%i_n0d, &
+      &  td_file%i_n1d, &
+      &  td_file%i_n2d, &
+      &  td_file%i_n3d, &
+      &  td_file%i_rhd, &
+      &  il_niproc, il_njproc, il_nproc, &
+      &  il_area,                &
+      &  il_iglo, il_jglo,       &
+      &  il_lci(:), il_lcj(:),   &
+      &  il_ldi(:), il_ldj(:),   &
+      &  il_lei(:), il_lej(:),   &
+      &  il_impp(:), il_jmpp(:)
+
+      DEALLOCATE( il_impp, il_jmpp,&
+      &           il_lci,  il_lcj, &
+      &           il_ldi,  il_ldj, &
+      &           il_lei,  il_lej  )
+
+   END SUBROUTINE iom_rstdimg__write_header 
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE iom_rstdimg__write_var(td_file)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write variables in an opened dimg file.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015
+   !> - bug fix: do not use scale factor an offset for case no0d, no1d...
+   !>
+   !> @param[in] td_file file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE), INTENT(INOUT) :: td_file
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_rec
+
+      INTEGER(i4),            DIMENSION(:), ALLOCATABLE :: il_start
+      INTEGER(i4),            DIMENSION(:), ALLOCATABLE :: il_count
+      CHARACTER(LEN=im_vnl),  DIMENSION(:), ALLOCATABLE :: cl_name
+      REAL(dp),               DIMENSION(:), ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      ! reform name and record
+      ALLOCATE( cl_name(td_file%i_nvar), dl_value(td_file%i_nvar) )
+
+      DO ji=1,td_file%i_nvar
+
+         ! change FillValue to 0.
+         CALL var_chg_FillValue(td_file%t_var(ji),0._dp)
+
+         cl_name(ji)  = TRIM(td_file%t_var(ji)%c_name)
+         dl_value(ji) = REAL(td_file%t_var(ji)%i_rec,dp)
+         
+         SELECT CASE (TRIM(td_file%t_var(ji)%c_name))
+            CASE('no0d','no1d','no2d','no3d')
+            CASE DEFAULT
+               
+               ! use scale factor and offset
+               WHERE( td_file%t_var(ji)%d_value(:,:,:,:) /= &
+               &      td_file%t_var(ji)%d_fill )
+                  td_file%t_var(ji)%d_value(:,:,:,:) = &
+                  &   ( td_file%t_var(ji)%d_value(:,:,:,:) - &
+                  &     td_file%t_var(ji)%d_ofs ) / &
+                  &   td_file%t_var(ji)%d_scf
+               END WHERE
+
+               DO jk=1,td_file%t_var(ji)%t_dim(3)%i_len
+                  SELECT CASE (td_file%t_var(ji)%i_ndim)
+                     CASE(0)
+                        ! special case for 0d, value save in rec
+                        dl_value(ji)=td_file%t_var(ji)%d_value(1,1,1,1)
+                        il_rec = td_file%t_var(ji)%i_rec
+                     CASE(1,2)
+                        il_rec = td_file%t_var(ji)%i_rec
+                     CASE(3)
+                        il_rec = td_file%t_var(ji)%i_rec + jk -1
+                  END SELECT 
+                  WRITE( td_file%i_id, IOSTAT=il_status, REC=il_rec ) &
+                  &  td_file%t_var(ji)%d_value(:,:,jk,1)
+                  CALL fct_err(il_status)
+                  IF( il_status /= 0 )THEN
+                     CALL logger_error("IOM RSTDIMG WRITE VAR: can not "//&
+                     &  "write variable "//TRIM(td_file%t_var(ji)%c_name)//&
+                     &  " in record "//TRIM(fct_str(il_rec)))
+                  ENDIF
+               ENDDO
+            END SELECT
+
+      ENDDO
+
+      ALLOCATE( il_start(4), il_count(4) )
+
+      il_start(1) = 1
+      il_count(1) = td_file%i_n0d
+      
+      il_start(2) = 1 + il_count(1)
+      il_count(2) = il_start(2) - 1 + td_file%i_n1d
+      
+      il_start(3) = 1 + il_count(2)
+      il_count(3) = il_start(3) - 1 + td_file%i_n2d
+      
+      il_start(4) = 1 + il_count(3)
+      il_count(4) = il_start(4) - 1 + td_file%i_n3d
+
+      WRITE(td_file%i_id, IOSTAT=il_status, REC=td_file%i_rhd )&
+      &  cl_name(il_start(1):il_count(1)), dl_value(il_start(1):il_count(1)),&
+      &  cl_name(il_start(2):il_count(2)), dl_value(il_start(2):il_count(2)),&
+      &  cl_name(il_start(3):il_count(3)), dl_value(il_start(3):il_count(3)),&
+      &  cl_name(il_start(4):il_count(4)), dl_value(il_start(4):il_count(4))
+      CALL fct_err(il_status)
+      IF( il_status /= 0 )THEN
+         CALL logger_error("IOM RSTDIMG WRITE VAR: can not "//&
+         &  "write restart header in record "//TRIM(fct_str(td_file%i_rhd)))
+      ENDIF
+
+      ! clean
+      DEALLOCATE( cl_name, dl_value )
+      DEALLOCATE( il_start, il_count )
+
+   END SUBROUTINE iom_rstdimg__write_var
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE iom_rstdimg
Index: /utils/tools_ticket2413/SIREN/src/kind.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/kind.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/kind.f90	(revision 12863)
@@ -0,0 +1,45 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> This module defines the F90 kind parameter for common data types.
+!> 
+!>
+!> @author
+!> G. Madec
+! REVISION HISTORY:
+!> @date June, 2006 - Initial Version
+!> @date December, 2012 - G. Madec
+!>  - add a standard length of character strings
+!>
+!> @todo
+!> - check i8 max value
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE kind
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   !                                                                !!** Floating point **
+   ! SELECTED_REAL_KIND(P,R) returns the kind value of a real data type 
+   ! with decimal precision of at least P digits, exponent range of at least R
+   INTEGER, PUBLIC, PARAMETER ::   sp = SELECTED_REAL_KIND( 6, 37)   !< single precision (real 4)
+   INTEGER, PUBLIC, PARAMETER ::   dp = SELECTED_REAL_KIND(12,307)   !< double precision (real 8)
+   INTEGER, PUBLIC, PARAMETER ::   wp = dp                           !< working precision
+
+   !                                                                !!** Integer **
+   ! SELECTED_INT_KIND(R) return the kind value of the smallest integer type 
+   ! that can represent all values ranging ] -10^R , 10^R [
+   INTEGER, PUBLIC, PARAMETER ::   i1 = SELECTED_INT_KIND( 1)        !< single precision (integer 1) 
+   INTEGER, PUBLIC, PARAMETER ::   i2 = SELECTED_INT_KIND( 4)        !< single precision (integer 2) 
+   INTEGER, PUBLIC, PARAMETER ::   i4 = SELECTED_INT_KIND( 9)        !< single precision (integer 4) 
+   INTEGER, PUBLIC, PARAMETER ::   i8 = SELECTED_INT_KIND(14)        !< double precision (integer 8)
+   
+   !                                                                !!** Integer **
+   INTEGER, PUBLIC, PARAMETER ::   lc = 256                          !< Length of Character strings
+
+END MODULE kind
+
Index: /utils/tools_ticket2413/SIREN/src/lbc.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/lbc.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/lbc.f90	(revision 12863)
@@ -0,0 +1,825 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief
+!> This module groups lateral boundary conditions subroutine.
+!>
+!> @details
+!>
+!> @warning keep only non mpp case
+!>
+!> @author
+!> G. Madec
+!>
+!>  @date June, 1997 - Original code
+!> @date September, 2002
+!> - F90: Free form and module
+!>  @date Marsh, 2009
+!> - R. Benshila : External north fold treatment  
+!>  @date December, 2012
+!> - S.Mocavero, I. Epicoco : Add 'lbc_bdy_lnk' and lbc_obc_lnk' routine to optimize the BDY/OBC communications
+!> @date December, 2012
+!> - R. Bourdalle-Badie and G. Reffray : add a C1D case 
+!> @date January, 2015 
+!> - J.Paul : rewrite with SIREN coding rules
+!> @date Marsh, 2015 
+!> - J.Paul : add hide subroutine
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE lbc
+
+   USE kind                            ! F90 kind parameter
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! function and subroutine
+   PUBLIC :: lbc_lnk 
+   PUBLIC :: lbc_nfd  
+   PUBLIC :: lbc_hide  
+
+   PRIVATE :: lbc__lnk_3d
+   PRIVATE :: lbc__lnk_2d
+   PRIVATE :: lbc__nfd_3d
+   PRIVATE :: lbc__nfd_2d
+   PRIVATE :: lbc__hide_lnk_2d
+   PRIVATE :: lbc__hide_nfd
+   PRIVATE :: lbc__hide_nfd_2d
+
+   INTERFACE lbc_lnk
+      MODULE PROCEDURE   lbc__lnk_3d
+      MODULE PROCEDURE   lbc__lnk_2d
+   END INTERFACE
+
+   INTERFACE lbc_nfd
+      MODULE PROCEDURE   lbc__nfd_3d
+      MODULE PROCEDURE   lbc__nfd_2d
+   END INTERFACE
+
+   INTERFACE lbc_hide
+      MODULE PROCEDURE   lbc__hide_lnk_2d
+   END INTERFACE
+
+   INTERFACE lbc__hide_nfd
+      MODULE PROCEDURE   lbc__hide_nfd_2d
+   END INTERFACE
+    
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE lbc__lnk_3d(dd_array, cd_type, id_perio, dd_psgn, dd_fill)
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine set lateral boundary conditions on a 3D array (non mpp case) 
+   !>
+   !> @details
+   !>             dd_psign = -1 :    change the sign across the north fold
+   !>                      =  1 : no change of the sign across the north fold
+   !>                      =  0 : no change of the sign across the north fold and
+   !>                             strict positivity preserved: use inner row/column
+   !>                             for closed boundaries.
+   !> @author J.Paul 
+   !> - January, 2015- rewrite with SIREN coding rules 
+   !> 
+   !> @param[inout] dd_array  3D array 
+   !> @param[in] cd_type point grid
+   !> @param[in] id_perio NEMO periodicity of the grid
+   !> @param[in] dd_psgn 
+   !> @param[in] dd_fill   fillValue
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp), DIMENSION(:,:,:), INTENT(INOUT) :: dd_array
+      CHARACTER(LEN=*)          , INTENT(IN   ) :: cd_type
+      INTEGER(i4)               , INTENT(IN   ) :: id_perio
+      REAL(dp),                   INTENT(IN   ) :: dd_psgn
+      REAL(dp),                   INTENT(IN   ), OPTIONAL :: dd_fill
+
+      ! local variable
+      REAL(dp)    :: dl_fill
+
+      INTEGER(i4) :: il_jpi
+      INTEGER(i4) :: il_jpj
+      INTEGER(i4) :: il_jpim1
+      !----------------------------------------------------------------
+      IF( PRESENT( dd_fill ) ) THEN   ;   dl_fill = dd_fill      ! set FillValue (zero by default)
+      ELSE                            ;   dl_fill = 0._dp
+      ENDIF
+
+      il_jpi=SIZE(dd_array(:,:,:),DIM=1)
+      il_jpj=SIZE(dd_array(:,:,:),DIM=2)
+
+      il_jpim1=il_jpi-1
+      !
+      !                                     ! East-West boundaries
+      !                                     ! ====================
+      SELECT CASE ( id_perio )
+      !
+      CASE ( 1 , 4 , 6 )                       !**  cyclic east-west
+         dd_array(    1 ,:,:) = dd_array(il_jpim1,:,:)            ! all points
+         dd_array(il_jpi,:,:) = dd_array(     2  ,:,:)
+         !
+      CASE DEFAULT                             !**  East closed  --  West closed
+         SELECT CASE ( TRIM(cd_type) )
+         CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+            dd_array(    1 ,:,:) = dl_fill
+            dd_array(il_jpi,:,:) = dl_fill
+         CASE ( 'F' )                               ! F-point
+            dd_array(il_jpi,:,:) = dl_fill
+         END SELECT
+         !
+      END SELECT
+      !
+      !                                     ! North-South boundaries
+      !                                     ! ======================
+      SELECT CASE ( id_perio )
+      !
+      CASE ( 2 )                               !**  South symmetric  --  North closed
+         SELECT CASE ( TRIM(cd_type) )
+         CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
+            dd_array(:,    1 ,:) = dd_array(:,3,:)
+            dd_array(:,il_jpj,:) = dl_fill
+         CASE ( 'V' , 'F' )                         ! V-, F-points
+            dd_array(:,    1 ,:) = dd_psgn * dd_array(:,2,:)
+            dd_array(:,il_jpj,:) = dl_fill
+         END SELECT
+         !
+      CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
+         SELECT CASE ( TRIM(cd_type) )                    ! South : closed
+         CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
+            dd_array(:, 1 ,:) = dl_fill
+         END SELECT
+         !                                          ! North fold
+         CALL lbc_nfd( dd_array(:,:,:), cd_type, id_perio, dd_psgn )
+         !
+      CASE DEFAULT                             !**  North closed  --  South closed
+         SELECT CASE ( cd_type )
+         CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+            dd_array(:,    1 ,:) = dl_fill
+            dd_array(:,il_jpj,:) = dl_fill
+         CASE ( 'F' )                               ! F-point
+            dd_array(:,il_jpj,:) = dl_fill
+         END SELECT
+         !
+      END SELECT
+
+   END SUBROUTINE lbc__lnk_3d
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE lbc__lnk_2d(dd_array, cd_type, id_perio, dd_psgn, dd_fill)
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine set lateral boundary conditions on a 2D array (non mpp case) 
+   !>
+   !> @details
+   !>             dd_psign = -1 :    change the sign across the north fold
+   !>                      =  1 : no change of the sign across the north fold
+   !>                      =  0 : no change of the sign across the north fold and
+   !>                             strict positivity preserved: use inner row/column
+   !>                             for closed boundaries.
+   !> @author J.Paul 
+   !> - January, 2015- rewrite with SIREN coding rules
+   !> 
+   !> @param[inout] dd_array  2D array 
+   !> @param[in] cd_type point grid
+   !> @param[in] id_perio NEMO periodicity of the grid
+   !> @param[in] dd_psgn 
+   !> @param[in] dd_fill   fillValue
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp), DIMENSION(:,:), INTENT(INOUT) :: dd_array
+      CHARACTER(LEN=*)        , INTENT(IN   ) :: cd_type
+      INTEGER(i4)             , INTENT(IN   ) :: id_perio
+      REAL(dp)                , INTENT(IN   ) :: dd_psgn
+      REAL(dp)                , INTENT(IN   ), OPTIONAL :: dd_fill
+
+      ! local variable
+      REAL(dp)    :: dl_fill
+
+      INTEGER(i4) :: il_jpi
+      INTEGER(i4) :: il_jpj
+      INTEGER(i4) :: il_jpim1
+      !----------------------------------------------------------------
+      IF( PRESENT( dd_fill ) ) THEN   ;   dl_fill = dd_fill      ! set FillValue (zero by default)
+      ELSE                            ;   dl_fill = 0._dp
+      ENDIF
+
+      il_jpi=SIZE(dd_array(:,:),DIM=1)
+      il_jpj=SIZE(dd_array(:,:),DIM=2)
+
+      il_jpim1=il_jpi-1
+
+      !
+      !                                     ! East-West boundaries
+      !                                     ! ====================
+      SELECT CASE ( id_perio )
+      !
+      CASE ( 1 , 4 , 6 )                       !** cyclic east-west
+         dd_array(    1 ,:) = dd_array(il_jpim1,:)               ! all points
+         dd_array(il_jpi,:) = dd_array(     2  ,:)
+         !
+      CASE DEFAULT                             !** East closed  --  West closed
+         SELECT CASE ( TRIM(cd_type) )
+         CASE ( 'T' , 'U' , 'V' , 'W' )            ! T-, U-, V-, W-points
+            dd_array(    1 ,:) = dl_fill
+            dd_array(il_jpi,:) = dl_fill
+         CASE ( 'F' )                              ! F-point
+            dd_array(il_jpi,:) = dl_fill
+         END SELECT
+         !
+      END SELECT
+      !
+      !                                     ! North-South boundaries
+      !                                     ! ======================
+      SELECT CASE ( id_perio )
+      !
+      CASE ( 2 )                               !**  South symmetric  --  North closed
+         SELECT CASE ( TRIM(cd_type) )
+         CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
+            dd_array(:,   1  ) = dd_array(:,3)
+            dd_array(:,il_jpj) = dl_fill
+         CASE ( 'V' , 'F' )                         ! V-, F-points
+            dd_array(:,   1  ) = dd_psgn * dd_array(:,2)
+            dd_array(:,il_jpj) = dl_fill
+         END SELECT
+         !
+      CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
+         SELECT CASE ( TRIM(cd_type) )                    ! South : closed
+         CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
+            dd_array(:, 1 ) = dl_fill
+         END SELECT
+         !                                          ! North fold
+         CALL lbc_nfd( dd_array(:,:), cd_type, id_perio, dd_psgn )
+         !
+      CASE DEFAULT                             !**  North closed  --  South closed
+         SELECT CASE ( TRIM(cd_type) )
+         CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+            dd_array(:,   1  ) = dl_fill
+            dd_array(:,il_jpj) = dl_fill
+         CASE ( 'F' )                               ! F-point
+            dd_array(:,il_jpj) = dl_fill
+         END SELECT
+         !
+      END SELECT
+
+   END SUBROUTINE lbc__lnk_2d
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE lbc__nfd_3d(dd_array, cd_type, id_perio, dd_psgn)
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine manage 3D lateral boundary condition : 
+   !> North fold treatment without processor exchanges. 
+   !>
+   !> @warning keep only non mpp case
+   !>
+   !> @author J.Paul 
+   !> - January, 2015- rewrite with SIREN coding rules
+   !> 
+   !> @param[inout] dd_array  3D array 
+   !> @param[in] cd_type point grid
+   !> @param[in] id_perio NEMO periodicity of the grid
+   !> @param[in] dd_psgn 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp), DIMENSION(:,:,:), INTENT(INOUT) :: dd_array
+      CHARACTER(LEN=*)          , INTENT(IN   ) :: cd_type
+      INTEGER(i4)               , INTENT(IN   ) :: id_perio
+      REAL(dp)                  , INTENT(IN   ) :: dd_psgn
+
+      ! local variable
+      INTEGER(i4) :: il_jpi
+      INTEGER(i4) :: il_jpj
+      INTEGER(i4) :: il_jpk
+      INTEGER(i4) :: il_jpim1
+      INTEGER(i4) :: il_jpjm1
+
+      INTEGER(i4) :: ijt
+      INTEGER(i4) :: iju
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+      
+      il_jpi=SIZE(dd_array(:,:,:),DIM=1)
+      il_jpj=SIZE(dd_array(:,:,:),DIM=2)
+      il_jpk=SIZE(dd_array(:,:,:),DIM=3)
+
+      il_jpim1=il_jpi-1
+      il_jpjm1=il_jpj-1
+
+      DO jk = 1, il_jpk
+         !
+         SELECT CASE ( id_perio )
+         !
+         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
+            !
+            SELECT CASE ( TRIM(cd_type) )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO ji = 2, il_jpi
+                  ijt = il_jpi-ji+2
+                  dd_array(ji,il_jpj,jk) = dd_psgn * dd_array(ijt,il_jpj-2,jk)
+               END DO
+               dd_array(1,il_jpj,jk) = dd_psgn * dd_array(3,il_jpj-2,jk)
+               DO ji = il_jpi/2+1, il_jpi
+                  ijt = il_jpi-ji+2
+                  dd_array(ji,il_jpjm1,jk) = dd_psgn * dd_array(ijt,il_jpjm1,jk)
+               END DO
+            CASE ( 'U' )                               ! U-point
+               DO ji = 1, il_jpi-1
+                  iju = il_jpi-ji+1
+                  dd_array(ji,il_jpj,jk) = dd_psgn * dd_array(iju,il_jpj-2,jk)
+               END DO
+               dd_array(   1  ,il_jpj,jk) = dd_psgn * dd_array(    2   ,il_jpj-2,jk)
+               dd_array(il_jpi,il_jpj,jk) = dd_psgn * dd_array(il_jpi-1,il_jpj-2,jk) 
+               DO ji = il_jpi/2, il_jpi-1
+                  iju = il_jpi-ji+1
+                  dd_array(ji,il_jpjm1,jk) = dd_psgn * dd_array(iju,il_jpjm1,jk)
+               END DO
+            CASE ( 'V' )                               ! V-point
+               DO ji = 2, il_jpi
+                  ijt = il_jpi-ji+2
+                  dd_array(ji,il_jpj-1,jk) = dd_psgn * dd_array(ijt,il_jpj-2,jk)
+                  dd_array(ji,il_jpj  ,jk) = dd_psgn * dd_array(ijt,il_jpj-3,jk)
+               END DO
+               dd_array(1,il_jpj,jk) = dd_psgn * dd_array(3,il_jpj-3,jk) 
+            CASE ( 'F' )                               ! F-point
+               DO ji = 1, il_jpi-1
+                  iju = il_jpi-ji+1
+                  dd_array(ji,il_jpj-1,jk) = dd_psgn * dd_array(iju,il_jpj-2,jk)
+                  dd_array(ji,il_jpj  ,jk) = dd_psgn * dd_array(iju,il_jpj-3,jk)
+               END DO
+               dd_array(   1  ,il_jpj,jk) = dd_psgn * dd_array(    2   ,il_jpj-3,jk)
+               dd_array(il_jpi,il_jpj,jk) = dd_psgn * dd_array(il_jpi-1,il_jpj-3,jk) 
+            END SELECT
+            !
+         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
+            !
+            SELECT CASE ( TRIM(cd_type) )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO ji = 1, il_jpi
+                  ijt = il_jpi-ji+1
+                  dd_array(ji,il_jpj,jk) = dd_psgn * dd_array(ijt,il_jpj-1,jk)
+               END DO
+            CASE ( 'U' )                               ! U-point
+               DO ji = 1, il_jpi-1
+                  iju = il_jpi-ji
+                  dd_array(ji,il_jpj,jk) = dd_psgn * dd_array(iju,il_jpj-1,jk)
+               END DO
+               dd_array(il_jpi,il_jpj,jk) = dd_psgn * dd_array(1,il_jpj-1,jk)
+            CASE ( 'V' )                               ! V-point
+               DO ji = 1, il_jpi
+                  ijt = il_jpi-ji+1
+                  dd_array(ji,il_jpj,jk) = dd_psgn * dd_array(ijt,il_jpj-2,jk)
+               END DO
+               DO ji = il_jpi/2+1, il_jpi
+                  ijt = il_jpi-ji+1
+                  dd_array(ji,il_jpjm1,jk) = dd_psgn * dd_array(ijt,il_jpjm1,jk)
+               END DO
+            CASE ( 'F' )                               ! F-point
+               DO ji = 1, il_jpi-1
+                  iju = il_jpi-ji
+                  dd_array(ji,il_jpj  ,jk) = dd_psgn * dd_array(iju,il_jpj-2,jk)
+               END DO
+               dd_array(il_jpi,il_jpj,jk) = dd_psgn * dd_array(1,il_jpj-2,jk)
+               DO ji = il_jpi/2+1, il_jpi-1
+                  iju = il_jpi-ji
+                  dd_array(ji,il_jpjm1,jk) = dd_psgn * dd_array(iju,il_jpjm1,jk)
+               END DO
+            END SELECT
+            !
+         CASE DEFAULT                           ! *  closed : the code probably never go through
+            !
+            SELECT CASE ( TRIM(cd_type))
+            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+               dd_array(:, 1  ,jk) = 0.e0
+               dd_array(:,il_jpj,jk) = 0.e0
+            CASE ( 'F' )                               ! F-point
+               dd_array(:,il_jpj,jk) = 0.e0
+            END SELECT
+            !
+         END SELECT     !  id_perio
+         !
+      END DO
+
+   END SUBROUTINE lbc__nfd_3d
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE lbc__nfd_2d(dd_array, cd_type, id_perio, dd_psgn)
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine manage 2D lateral boundary condition : 
+   !> North fold treatment without processor exchanges. 
+   !>
+   !> @warning keep only non mpp case
+   !> @warning do not use additional halos
+   !>
+   !> @author J.Paul 
+   !> - January, 2015- rewrite with SIREN coding rules
+   !> 
+   !> @param[inout] dd_array  2D array 
+   !> @param[in] cd_type point grid
+   !> @param[in] id_perio NEMO periodicity of the grid
+   !> @param[in] dd_psgn 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp), DIMENSION(:,:), INTENT(INOUT) :: dd_array
+      CHARACTER(LEN=*)        , INTENT(IN   ) :: cd_type
+      INTEGER(i4)             , INTENT(IN   ) :: id_perio
+      REAL(dp)                , INTENT(IN   ) :: dd_psgn
+
+      ! local variable
+      INTEGER(i4) :: il_jpi
+      INTEGER(i4) :: il_jpj
+      INTEGER(i4) :: il_jpim1
+      INTEGER(i4) :: il_jpjm1
+
+      INTEGER(i4) :: ijt
+      INTEGER(i4) :: iju
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      il_jpi=SIZE(dd_array(:,:),DIM=1)
+      il_jpj=SIZE(dd_array(:,:),DIM=2)
+
+      il_jpim1=il_jpi-1
+      il_jpjm1=il_jpj-1
+
+      SELECT CASE ( id_perio )
+      !
+      CASE ( 3, 4 )                       ! *  North fold  T-point pivot
+         !
+         SELECT CASE ( TRIM(cd_type) )
+         !
+         CASE ( 'T' , 'W' )                               ! T- , W-points
+            DO ji = 2, il_jpi
+               ijt=il_jpi-ji+2
+               dd_array(ji,il_jpj) = dd_psgn * dd_array(ijt,il_jpj-2)
+            END DO
+            dd_array(1,il_jpj)   = dd_psgn * dd_array(3,il_jpj-2)
+            dd_array(1,il_jpj-1) = dd_psgn * dd_array(3,il_jpj-1)
+            DO ji = il_jpi/2+1, il_jpi
+               ijt=il_jpi-ji+2
+               dd_array(ji,il_jpj-1) = dd_psgn * dd_array(ijt,il_jpj-1)
+            END DO
+         CASE ( 'U' )                                     ! U-point
+            DO ji = 1, il_jpi-1
+               iju = il_jpi-ji+1
+               dd_array(ji,il_jpj) = dd_psgn * dd_array(iju,il_jpj-2)
+            END DO
+            dd_array(   1  ,il_jpj  ) = dd_psgn * dd_array(    2   ,il_jpj-2)
+            dd_array(il_jpi,il_jpj  ) = dd_psgn * dd_array(il_jpi-1,il_jpj-2)
+            dd_array(1     ,il_jpj-1) = dd_psgn * dd_array(il_jpi  ,il_jpj-1)   
+            DO ji = il_jpi/2, il_jpi-1
+               iju = il_jpi-ji+1
+               dd_array(ji,il_jpjm1) = dd_psgn * dd_array(iju,il_jpjm1)
+            END DO
+         CASE ( 'V' )                                     ! V-point
+            DO ji = 2, il_jpi
+               ijt = il_jpi-ji+2
+               dd_array(ji,il_jpj) = dd_psgn * dd_array(ijt,il_jpj-3)
+            END DO
+            dd_array( 1 ,il_jpj)   = dd_psgn * dd_array( 3 ,il_jpj-3) 
+         CASE ( 'F' )                                     ! F-point
+            DO ji = 1, il_jpi-1
+               iju = il_jpi-ji+1
+               dd_array(ji,il_jpj) = dd_psgn * dd_array(iju,il_jpj-3)
+            END DO
+            dd_array(   1  ,il_jpj)   = dd_psgn * dd_array(    2   ,il_jpj-3)
+            dd_array(il_jpi,il_jpj)   = dd_psgn * dd_array(il_jpi-1,il_jpj-3)
+            dd_array(il_jpi,il_jpj-1) = dd_psgn * dd_array(il_jpi-1,il_jpj-2)      
+            dd_array(   1  ,il_jpj-1) = dd_psgn * dd_array(    2   ,il_jpj-2)      
+         CASE ( 'I' )                                     ! ice U-V point (I-point)
+            dd_array(2,il_jpj) = dd_psgn * dd_array(3,il_jpj-1)
+            DO ji = 3, il_jpi
+               iju = il_jpi - ji + 3
+               dd_array(ji,il_jpj) = dd_psgn * dd_array(iju,il_jpj-1)
+            END DO
+         CASE ( 'J' )                                     ! first ice U-V point
+            dd_array(2,il_jpj) = dd_psgn * dd_array(3,il_jpj-1)
+            DO ji = 3, il_jpi
+               iju = il_jpi - ji + 3
+               dd_array(ji,il_jpj) = dd_psgn * dd_array(iju,il_jpj-1)
+            END DO
+         CASE ( 'K' )                                     ! second ice U-V point
+            dd_array(2,il_jpj) = dd_psgn * dd_array(3,il_jpj-1)
+            DO ji = 3, il_jpi
+               iju = il_jpi - ji + 3
+               dd_array(ji,il_jpj) = dd_psgn * dd_array(iju,il_jpj-1)
+            END DO
+         END SELECT
+         !
+      CASE ( 5, 6 )                        ! *  North fold  F-point pivot
+         !
+         SELECT CASE ( TRIM(cd_type) )
+         CASE ( 'T' , 'W' )                               ! T-, W-point
+            DO ji = 1, il_jpi
+               ijt = il_jpi-ji+1
+               dd_array(ji,il_jpj) = dd_psgn * dd_array(ijt,il_jpj-1)
+            END DO
+         CASE ( 'U' )                                     ! U-point
+            DO ji = 1, il_jpi-1
+               iju = il_jpi-ji
+               dd_array(ji,il_jpj) = dd_psgn * dd_array(iju,il_jpj-1)
+            END DO
+            dd_array(il_jpi,il_jpj) = dd_psgn * dd_array(1,il_jpj-1)
+         CASE ( 'V' )                                     ! V-point
+            DO ji = 1, il_jpi
+               ijt = il_jpi-ji+1
+               dd_array(ji,il_jpj) = dd_psgn * dd_array(ijt,il_jpj-2)
+            END DO
+            DO ji = il_jpi/2+1, il_jpi
+               ijt = il_jpi-ji+1
+               dd_array(ji,il_jpjm1) = dd_psgn * dd_array(ijt,il_jpjm1)
+            END DO
+         CASE ( 'F' )                               ! F-point
+            DO ji = 1, il_jpi-1
+               iju = il_jpi-ji
+               dd_array(ji,il_jpj) = dd_psgn * dd_array(iju,il_jpj-2)
+            END DO
+            dd_array(il_jpi,il_jpj) = dd_psgn * dd_array(1,il_jpj-2)
+            DO ji = il_jpi/2+1, il_jpi-1
+               iju = il_jpi-ji
+               dd_array(ji,il_jpjm1) = dd_psgn * dd_array(iju,il_jpjm1)
+            END DO
+         CASE ( 'I' )                                  ! ice U-V point (I-point)
+            dd_array( 2 ,il_jpj) = 0.e0
+            DO ji = 2 , il_jpi-1
+               ijt = il_jpi - ji + 2
+               dd_array(ji,il_jpj)= 0.5 * ( dd_array(ji,il_jpj-1) + dd_psgn * dd_array(ijt,il_jpj-1) )
+            END DO
+         CASE ( 'J' )                                  ! first ice U-V point
+            dd_array( 2 ,il_jpj) = 0.e0
+            DO ji = 2 , il_jpi-1
+               ijt = il_jpi - ji + 2
+               dd_array(ji,il_jpj)= dd_array(ji,il_jpj-1)
+            END DO
+         CASE ( 'K' )                                  ! second ice U-V point
+            dd_array( 2 ,il_jpj) = 0.e0
+            DO ji = 2 , il_jpi-1
+               ijt = il_jpi - ji + 2
+               dd_array(ji,il_jpj)= dd_array(ijt,il_jpj-1)
+            END DO
+         END SELECT
+         !
+      CASE DEFAULT                           ! *  closed : the code probably never go through
+         !
+         SELECT CASE ( TRIM(cd_type) )
+         CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
+            dd_array(:, 1    ) = 0.e0
+            dd_array(:,il_jpj) = 0.e0
+         CASE ( 'F' )                                   ! F-point
+            dd_array(:,il_jpj) = 0.e0
+         CASE ( 'I' )                                   ! ice U-V point
+            dd_array(:, 1    ) = 0.e0
+            dd_array(:,il_jpj) = 0.e0
+         CASE ( 'J' )                                   ! first ice U-V point
+            dd_array(:, 1    ) = 0.e0
+            dd_array(:,il_jpj) = 0.e0
+         CASE ( 'K' )                                   ! second ice U-V point
+            dd_array(:, 1    ) = 0.e0
+            dd_array(:,il_jpj) = 0.e0
+         END SELECT
+         !
+      END SELECT
+
+   END SUBROUTINE lbc__nfd_2d
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE lbc__hide_lnk_2d(dd_array, cd_type, id_perio, dd_psgn, dd_fill)
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine hide lateral boundary conditions on a 2D array (non mpp case) 
+   !>
+   !> @details
+   !>             dd_psign = -1 :    change the sign across the north fold
+   !>                      =  1 : no change of the sign across the north fold
+   !>                      =  0 : no change of the sign across the north fold and
+   !>                             strict positivity preserved: use inner row/column
+   !>                             for closed boundaries.
+   !> @author J.Paul 
+   !> - Marsh, 2015- initial version
+   !> 
+   !> @param[inout] dd_array  2D array 
+   !> @param[in] cd_type point grid
+   !> @param[in] id_perio NEMO periodicity of the grid
+   !> @param[in] dd_psgn 
+   !> @param[in] dd_fill   fillValue
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp), DIMENSION(:,:), INTENT(INOUT) :: dd_array
+      CHARACTER(LEN=*)        , INTENT(IN   ) :: cd_type
+      INTEGER(i4)             , INTENT(IN   ) :: id_perio
+      REAL(dp)                , INTENT(IN   ) :: dd_psgn
+      REAL(dp)                , INTENT(IN   ), OPTIONAL :: dd_fill
+
+      ! local variable
+      REAL(dp)    :: dl_fill
+
+      INTEGER(i4) :: il_jpi
+      INTEGER(i4) :: il_jpj
+      INTEGER(i4) :: il_jpim1
+      !----------------------------------------------------------------
+      IF( PRESENT( dd_fill ) ) THEN   ;   dl_fill = dd_fill      ! set FillValue (zero by default)
+      ELSE                            ;   dl_fill = 0._dp
+      ENDIF
+
+      il_jpi=SIZE(dd_array(:,:),DIM=1)
+      il_jpj=SIZE(dd_array(:,:),DIM=2)
+
+      il_jpim1=il_jpi-1
+
+      !
+      !                                     ! East-West boundaries
+      !                                     ! ====================
+      SELECT CASE ( id_perio )
+      !
+      CASE ( 1 , 4 , 6 )                       !** cyclic east-west
+         dd_array(    1 ,:) = dl_fill               ! all points
+         dd_array(il_jpi,:) = dl_fill
+         !
+      CASE DEFAULT                             !** East closed  --  West closed
+         SELECT CASE ( TRIM(cd_type) )
+         CASE ( 'T' , 'U' , 'V' , 'W' )            ! T-, U-, V-, W-points
+            dd_array(    1 ,:) = dl_fill
+            dd_array(il_jpi,:) = dl_fill
+         CASE ( 'F' )                              ! F-point
+            dd_array(il_jpi,:) = dl_fill
+         END SELECT
+         !
+      END SELECT
+      !
+      !                                     ! North-South boundaries
+      !                                     ! ======================
+      SELECT CASE ( id_perio )
+      !
+      CASE ( 2 )                               !**  South symmetric  --  North closed
+         SELECT CASE ( TRIM(cd_type) )
+         CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
+            dd_array(:,   1  ) = dl_fill
+            dd_array(:,il_jpj) = dl_fill
+         CASE ( 'V' , 'F' )                         ! V-, F-points
+            dd_array(:,   1  ) = dl_fill
+            dd_array(:,il_jpj) = dl_fill
+         END SELECT
+         !
+      CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
+         SELECT CASE ( TRIM(cd_type) )                    ! South : closed
+         CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
+            dd_array(:, 1 ) = dl_fill
+         END SELECT
+         !                                          ! North fold
+         CALL lbc__hide_nfd( dd_array(:,:), cd_type, id_perio, dd_psgn, &
+         &                   dd_fill=dl_fill )
+         !
+      CASE DEFAULT                             !**  North closed  --  South closed
+         SELECT CASE ( TRIM(cd_type) )
+         CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+            dd_array(:,   1  ) = dl_fill
+            dd_array(:,il_jpj) = dl_fill
+         CASE ( 'F' )                               ! F-point
+            dd_array(:,il_jpj) = dl_fill
+         END SELECT
+         !
+      END SELECT
+
+   END SUBROUTINE lbc__hide_lnk_2d
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE lbc__hide_nfd_2d(dd_array, cd_type, id_perio, dd_psgn, dd_fill)
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine manage 2D lateral boundary condition : 
+   !> hide North fold treatment without processor exchanges. 
+   !>
+   !> @warning keep only non mpp case
+   !> @warning do not use additional halos
+   !>
+   !> @author J.Paul 
+   !> - Marsh, 2015- initial version
+   !> 
+   !> @param[inout] dd_array  2D array 
+   !> @param[in] cd_type point grid
+   !> @param[in] id_perio NEMO periodicity of the grid
+   !> @param[in] dd_psgn 
+   !> @param[in] dd_fill 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp), DIMENSION(:,:), INTENT(INOUT) :: dd_array
+      CHARACTER(LEN=*)        , INTENT(IN   ) :: cd_type
+      INTEGER(i4)             , INTENT(IN   ) :: id_perio
+      REAL(dp)                , INTENT(IN   ) :: dd_psgn
+      REAL(dp)                , INTENT(IN   ), OPTIONAL :: dd_fill
+
+      ! local variable
+      REAL(dp)    :: dl_fill
+
+      INTEGER(i4) :: il_jpi
+      INTEGER(i4) :: il_jpj
+      INTEGER(i4) :: il_jpim1
+      INTEGER(i4) :: il_jpjm1
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      IF( PRESENT( dd_fill ) ) THEN   ;   dl_fill = dd_fill      ! set FillValue (zero by default)
+      ELSE                            ;   dl_fill = 0._dp
+      ENDIF
+
+      il_jpi=SIZE(dd_array(:,:),DIM=1)
+      il_jpj=SIZE(dd_array(:,:),DIM=2)
+
+      il_jpim1=il_jpi-1
+      il_jpjm1=il_jpj-1
+
+      SELECT CASE ( id_perio )
+      !
+      CASE ( 3, 4 )                       ! *  North fold  T-point pivot
+         !
+         SELECT CASE ( TRIM(cd_type) )
+         !
+         CASE ( 'T' , 'W' )                               ! T- , W-points
+            DO ji = 2, il_jpi
+               dd_array(ji,il_jpj) = dl_fill
+            END DO
+            dd_array(1,il_jpj)   = dl_fill
+            DO ji = il_jpi/2+2, il_jpi
+               dd_array(ji,il_jpj-1) = dl_fill
+            END DO
+         CASE ( 'U' )                                     ! U-point
+            DO ji = 1, il_jpi-1
+               dd_array(ji,il_jpj) = dl_fill
+            END DO
+            dd_array(   1  ,il_jpj  ) = dl_fill 
+            dd_array(il_jpi,il_jpj  ) = dl_fill
+            dd_array(1     ,il_jpj-1) = dl_fill
+            DO ji = il_jpi/2+1, il_jpi-1
+               dd_array(ji,il_jpjm1) = dl_fill
+            END DO
+         CASE ( 'V' )                                     ! V-point
+            DO ji = 2, il_jpi
+               dd_array(ji,il_jpj) = dl_fill
+            END DO
+            dd_array( 1 ,il_jpj)   = dl_fill 
+         CASE ( 'F' )                                     ! F-point
+            DO ji = 1, il_jpi-1
+               dd_array(ji,il_jpj) = dl_fill
+            END DO
+            dd_array(   1  ,il_jpj)   = dl_fill
+            dd_array(il_jpi,il_jpj)   = dl_fill
+            dd_array(il_jpi,il_jpj-1) = dl_fill 
+            dd_array(   1  ,il_jpj-1) = dl_fill
+         END SELECT
+         !
+      CASE ( 5, 6 )                        ! *  North fold  F-point pivot
+         !
+         SELECT CASE ( TRIM(cd_type) )
+         CASE ( 'T' , 'W' )                               ! T-, W-point
+            DO ji = 1, il_jpi
+               dd_array(ji,il_jpj) = dl_fill
+            END DO
+         CASE ( 'U' )                                     ! U-point
+            DO ji = 1, il_jpi-1
+               dd_array(ji,il_jpj) = dl_fill
+            END DO
+            dd_array(il_jpi,il_jpj) = dl_fill
+         CASE ( 'V' )                                     ! V-point
+            DO ji = 1, il_jpi
+               dd_array(ji,il_jpj) = dl_fill
+            END DO
+            DO ji = il_jpi/2+2, il_jpi
+               dd_array(ji,il_jpjm1) = dl_fill
+            END DO
+         CASE ( 'F' )                               ! F-point
+            DO ji = 1, il_jpi-1
+               dd_array(ji,il_jpj) = dl_fill
+            END DO
+            dd_array(il_jpi,il_jpj) = dl_fill
+            DO ji = il_jpi/2+2, il_jpi-1
+               dd_array(ji,il_jpjm1) = dl_fill
+            END DO
+         END SELECT
+         !
+      CASE DEFAULT                           ! *  closed : the code probably never go through
+         !
+         SELECT CASE ( TRIM(cd_type) )
+         CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
+            dd_array(:, 1    ) = dl_fill
+            dd_array(:,il_jpj) = dl_fill
+         CASE ( 'F' )                                   ! F-point
+            dd_array(:,il_jpj) = dl_fill
+         END SELECT
+         !
+      END SELECT
+
+   END SUBROUTINE lbc__hide_nfd_2d
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE lbc
Index: /utils/tools_ticket2413/SIREN/src/logger.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/logger.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/logger.f90	(revision 12863)
@@ -0,0 +1,789 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief This module manage log file.
+!> @details
+!> This module create log file and fill it depending of verbosity.
+!>
+!> verbosity could be choosen between :
+!>    - trace : Most detailed information.
+!>    - debug : Detailed information on the flow through the system.
+!>    - info  : Interesting runtime events (startup/shutdown).
+!>    - warning: Use of deprecated APIs, poor use of API, 'almost' errors, 
+!> other runtime situations that are undesirable or unexpected, 
+!> but not necessarily "wrong". 
+!>    - error : Other runtime errors or unexpected conditions.
+!>    - fatal : Severe errors that cause premature termination.
+!>    - none  : to not create and write any information in logger file.<br />
+!>       @warn in this case only FATAL ERROR will be detected.<br />
+!>
+!> @note default verbosity is warning
+!>
+!> If total number of error exceeded maximum number 
+!> authorized, program stop.
+!>
+!> to open/create logger file:<br/>
+!> @code
+!>    CALL logger_open(cd_file, [cd_verbosity,] [id_maxerror,] [id_loggerid])
+!> @endcode
+!> - cd_file is logger file name
+!> - cd_verbosity is verbosity to be used [optional, default 'warning']
+!> - id_loggerid is file id [optional, use only to flush]
+!> - id_maxerror is the maximum number of error authorized before program stop [optional, default 5]
+!>
+!> to close logger file:<br/>
+!> @code
+!> CALL logger_close()
+!> @endcode
+!>
+!> to clean logger file:<br/>
+!> @code
+!> CALL logger_clean()
+!> @endcode
+!>
+!> to write header in logger file:<br/>
+!> @code
+!> CALL logger_header()
+!> @endcode
+!>
+!> to write footer in logger file:<br/>
+!> @code
+!> CALL logger_footer()
+!> @endcode
+!>
+!> to flushing output:<br/>
+!> @code
+!> CALL logger_flush()
+!> @endcode
+!>
+!> to write TRACE message in logger file:<br/>
+!> @code
+!> CALL logger_trace(cd_msg [,ld_flush])
+!> @endcode
+!>    - cd_msg is TRACE message
+!>    - ld_flush to flush output [optional]
+!>
+!> to write DEBUG message in logger file:<br/>
+!> @code
+!> CALL logger_debug(cd_msg [,ld_flush])
+!> @endcode
+!>    - cd_msg is DEBUG message
+!>    - ld_flush to flush output [optional]
+!>
+!> to write INFO message in logger file:<br/>
+!> @code
+!> CALL logger_info(cd_msg [,ld_flush])
+!> @endcode
+!>    - cd_msg is INFO message
+!>    - ld_flush to flush output [optional]
+!>
+!> to write WARNING message in logger file:<br/>
+!> @code
+!> CALL logger_warn(cd_msg [,ld_flush])
+!> @endcode
+!>    - cd_msg is WARNING message
+!>    - ld_flush to flush output [optional]
+!>
+!> to write ERROR message in logger file:<br/>
+!> @code
+!> CALL logger_error(cd_msg [,ld_flush])
+!> @endcode
+!>    - cd_msg is ERROR message
+!>    - ld_flush to flush output [optional]
+!>
+!> to write FATAL message in logger file:<br/>
+!> @code
+!> CALL logger_fatal(cd_msg)
+!> @endcode
+!>    - cd_msg is FATAL message
+!>
+!> Examples :<br />
+!> @code
+!>   CALL logger_open('loggerfile.txt','info')
+!>
+!>   CALL logger_header()
+!>   CALL logger_debug('une info de debug')
+!>   CALL logger_info('une info')
+!>   CALL logger_warn('un warning')
+!>   CALL logger_error('une erreur')
+!>   CALL logger_footer()
+!>   CALL logger_close()
+!>   CALL logger_clean()
+!> @endcode
+!>
+!> @code
+!>   CALL logger_open('loggerfile.txt')
+!>
+!>   CALL logger_header()
+!>   CALL logger_debug('une info de debug')
+!>   CALL logger_info('une info')
+!>   CALL logger_warn('un warning')
+!>   CALL logger_error('une erreur')
+!>   CALL logger_footer()
+!>   CALL logger_close()
+!>   CALL logger_clean()
+!> @endcode
+!>
+!> @author
+!> J.Paul
+!>
+!> @date November, 2013 - Initial Version
+!> @date February, 2015
+!> - check verbosity validity
+!> - add 'none' verbosity level to not used logger file
+!> @date January, 2016
+!> - add logger_clean subroutine
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE logger
+
+   USE kind                            ! F90 kind parameter
+   USE fct                             ! basic useful function
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   PRIVATE :: TLOGGER            !< logger structure
+
+   PRIVATE :: tm_logger          !< logger structure
+   PRIVATE :: im_nverbosity      !< number of log level
+   PRIVATE :: cm_verbosity       !< verbosity array
+
+   ! function and subroutine
+   PUBLIC :: logger_open        !< create a log file with given verbosity
+   PUBLIC :: logger_close       !< close log file
+   PUBLIC :: logger_clean       !< clean log structure
+   PUBLIC :: logger_header      !< write header on log file
+   PUBLIC :: logger_footer      !< write footer on log file
+   PUBLIC :: logger_flush       !< flushing output
+   PUBLIC :: logger_trace       !< write trace    message in log file
+   PUBLIC :: logger_debug       !< write debug    message in log file 
+   PUBLIC :: logger_info        !< write info     message in log file
+   PUBLIC :: logger_warn        !< write warning  message in log file
+   PUBLIC :: logger_error       !< write error    message in log file
+   PUBLIC :: logger_fatal       !< write fatal    message in log file, and stop
+
+   PRIVATE :: logger__write     ! cut message to get maximum of 80 character by line in log file
+   PRIVATE :: logger__check_verb! check verbosity validity
+
+   TYPE TLOGGER   !< logger structure
+      INTEGER(i4)       :: i_id = 0                 !< log file id
+      LOGICAL           :: l_use=.TRUE.             !< use logger or not
+      CHARACTER(LEN=lc) :: c_name                   !< log file name
+      CHARACTER(LEN=lc) :: c_verbosity = "warning"  !< verbosity choose
+      CHARACTER(LEN=lc) :: c_verb = ""              !< array of "verbosities" to used 
+      INTEGER(i4)       :: i_nerror   = 0           !< number of error
+      INTEGER(i4)       :: i_nfatal   = 0           !< number of fatal error
+      INTEGER(i4)       :: i_maxerror = 5           !< maximum number of error before stoping program
+   END TYPE TLOGGER   
+
+   !  module variable
+   INTEGER(i4), PARAMETER :: im_nverbosity=7     !< number of log level
+   CHARACTER(len=*), DIMENSION(im_nverbosity), PARAMETER :: cm_verbosity= & !< verbosity array 
+   &               (/ 'trace   ',&
+   &                  'debug   ',&
+   &                  'info    ',& 
+   &                  'warning ',&
+   &                  'error   ',&
+   &                  'fatal   ',&
+   &                  'none    '/)
+
+   TYPE(TLOGGER), SAVE :: tm_logger      !< logger structure
+                                                 
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE logger_open(cd_file, cd_verbosity, id_maxerror, id_logid)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine create a log file with default verbosity
+   !> ('warning').
+   !> @details
+   !> Optionally verbosity could be change to 
+   !> ('trace','debug','info',warning','error','fatal').<br/>
+   !> Optionally maximum number of error allowed could be change.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] cd_file      log file name
+   !> @param[in] cd_verbosity log file verbosity
+   !> @param[in] id_maxerror  maximum number of error
+   !> @param[in] id_logid     log file id (use to flush)
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(len=*), INTENT(IN) :: cd_file                ! log file name
+      CHARACTER(len=*), INTENT(IN), OPTIONAL :: cd_verbosity ! log file verbosity
+      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_maxerror  ! log max error
+      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_logid     ! log file id
+
+      ! local variable
+      INTEGER(i4) :: il_status
+
+      LOGICAL     :: ll_valid
+
+      ! loop
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! if present, change verbosity value
+      IF( PRESENT(cd_verbosity) )THEN
+         ll_valid=logger__check_verb(TRIM(ADJUSTL(cd_verbosity)))
+         IF( ll_valid )THEN
+            tm_logger%c_verbosity=TRIM(ADJUSTL(cd_verbosity))
+         ENDIF
+      ENDIF
+
+      IF( TRIM(tm_logger%c_verbosity) == 'none' ) tm_logger%l_use=.FALSE.
+      
+      IF( tm_logger%l_use )THEN
+
+         ! get id if not already define
+         IF( PRESENT(id_logid) )THEN
+            tm_logger%i_id=id_logid
+         ELSE
+            tm_logger%i_id=fct_getunit()
+         ENDIF
+
+         ! open log file
+         OPEN( tm_logger%i_id, &
+         &     STATUS="unknown",    &
+         &     FILE=TRIM(ADJUSTL(cd_file)),  &
+         &     ACTION="write",      &
+         &     POSITION="append",   &
+         &     IOSTAT=il_status)
+         CALL fct_err(il_status)
+
+         ! keep filename
+         tm_logger%c_name=TRIM(ADJUSTL(cd_file))
+
+         ! compute "tab" of verbosity to be used
+         IF( TRIM(ADJUSTL(tm_logger%c_verb)) == "" )THEN
+            DO ji=im_nverbosity,1,-1
+               tm_logger%c_verb = &
+               &  TRIM(tm_logger%c_verb)//" "//TRIM(ADJUSTL(cm_verbosity(ji)))
+               IF( TRIM(tm_logger%c_verbosity) == TRIM(cm_verbosity(ji)) )THEN
+                  EXIT
+               ENDIF
+            ENDDO
+         ENDIF
+
+         IF( PRESENT(id_maxerror) )THEN
+            tm_logger%i_maxerror=id_maxerror
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE logger_open
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE logger_close()
+   !-------------------------------------------------------------------
+   !> @brief This subroutine close a log file.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+
+      ! local variable
+      INTEGER(i4)   :: il_status
+      !----------------------------------------------------------------
+
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            !tm_logger%i_id = 0
+            CLOSE( tm_logger%i_id, &
+            &      IOSTAT=il_status)      
+            CALL fct_err(il_status)
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_close')
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE logger_close
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE logger_clean()
+   !-------------------------------------------------------------------
+   !> @brief This subroutine clean a log structure.
+   !>
+   !> @author J.Paul
+   !> @date January, 2016 - Initial Version
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+
+      ! local variable
+      TYPE(TLOGGER) :: tl_logger
+      !----------------------------------------------------------------
+
+      tm_logger = tl_logger
+
+   END SUBROUTINE logger_clean
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   !-------------------------------------------------------------------
+   !> @brief This subroutine flushing output into log file.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !-------------------------------------------------------------------
+   SUBROUTINE logger_flush()
+
+      IMPLICIT NONE
+      
+      !----------------------------------------------------------------
+
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            CALL logger_close()
+            CALL logger_open( tm_logger%c_name, tm_logger%c_verbosity, &
+            &                 tm_logger%i_maxerror, tm_logger%i_id )     
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_flush')
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE logger_flush
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   RECURSIVE SUBROUTINE logger_header()
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write header on log file.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+
+      ! local variable
+      INTEGER(i4)       :: il_status
+      !----------------------------------------------------------------
+
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            WRITE( tm_logger%i_id,    &
+               &   FMT='(4(a/))',     &
+               &   IOSTAT=il_status ) &
+               &   "--------------------------------------------------",&
+               &   "INIT     : verbosity "//TRIM(tm_logger%c_verbosity),&
+               &   "INIT     : max error "//TRIM(fct_str(tm_logger%i_maxerror)), &
+               &   "--------------------------------------------------"
+            CALL fct_err(il_status)
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_header')
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE logger_header
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE logger_footer()
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write footer on log file.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! local variable
+      INTEGER(i4)       :: il_status
+      !----------------------------------------------------------------
+
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            WRITE( tm_logger%i_id,    &
+               &   FMT='(4(/a))',     &
+               &   IOSTAT=il_status ) &
+               &   "--------------------------------------------------",&
+               &   "END      : log ended ",              &
+               &   "END      : "//TRIM(fct_str(tm_logger%i_nerror))//   &
+               &   " ERROR detected ",                                  &
+               &   "END      : "//TRIM(fct_str(tm_logger%i_nfatal))//   &
+               &   " FATAL detected ",                                  &
+               &   "--------------------------------------------------"
+            CALL fct_err(il_status)
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_footer')
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE logger_footer
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE logger_trace(cd_msg, ld_flush)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write trace message on log file.
+   !> @details
+   !> Optionally you could flush output.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] cd_msg    message to write
+   !> @param[in] ld_flush  flushing ouput
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN)  :: cd_msg
+      LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
+      !----------------------------------------------------------------
+
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            IF( INDEX(TRIM(tm_logger%c_verb),'trace')/=0 )THEN
+
+               CALL logger__write("TRACE   :",cd_msg)
+
+               IF( PRESENT(ld_flush) )THEN
+                  IF( ld_flush )THEN
+                     CALL logger_flush()
+                  ENDIF
+               ENDIF      
+            ENDIF
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_trace')
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE logger_trace
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE logger_debug(cd_msg, ld_flush)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write debug message on log file.
+   !> @details
+   !> Optionally you could flush output.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] cd_msg    message to write
+   !> @param[in] ld_flush  flushing ouput
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN)  :: cd_msg
+      LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
+      !----------------------------------------------------------------
+
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            IF( INDEX(TRIM(tm_logger%c_verb),'debug')/=0 )THEN
+
+               CALL logger__write("DEBUG   :",cd_msg)
+
+               IF( PRESENT(ld_flush) )THEN
+                  IF( ld_flush )THEN
+                     CALL logger_flush()
+                  ENDIF
+               ENDIF      
+            ENDIF
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_debug')
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE logger_debug
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE logger_info(cd_msg, ld_flush)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write info message on log file.
+   !> @details
+   !> Optionally you could flush output.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] cd_msg    message to write
+   !> @param[in] ld_flush  flushing ouput
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN)  :: cd_msg
+      LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
+      !----------------------------------------------------------------
+
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            IF( INDEX(TRIM(tm_logger%c_verb),'info')/=0 )THEN
+
+               CALL logger__write("INFO    :",cd_msg)
+
+               IF( PRESENT(ld_flush) )THEN
+                  IF( ld_flush )THEN
+                     CALL logger_flush()
+                  ENDIF
+               ENDIF      
+            ENDIF
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_info')
+         ENDIF
+      ENDIF
+   END SUBROUTINE logger_info
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE logger_warn(cd_msg, ld_flush)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write warning message on log file.
+   !> @details
+   !> Optionally you could flush output.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] cd_msg    message to write
+   !> @param[in] ld_flush  flushing ouput
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN)  :: cd_msg
+      LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
+      !----------------------------------------------------------------
+
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            IF( INDEX(TRIM(tm_logger%c_verb),'warn')/=0 )THEN
+
+               CALL logger__write("WARNING :",cd_msg)
+
+               IF( PRESENT(ld_flush) )THEN
+                  IF( ld_flush )THEN
+                     CALL logger_flush()
+                  ENDIF
+               ENDIF      
+            ENDIF
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_warn')
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE logger_warn
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE logger_error(cd_msg, ld_flush)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write error message on log file.
+   !> @details
+   !> Optionally you could flush output.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] cd_msg    message to write
+   !> @param[in] ld_flush  flushing ouput
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN)  :: cd_msg
+      LOGICAL,          INTENT(IN), OPTIONAL :: ld_flush
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_nerror
+      !----------------------------------------------------------------
+
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            ! increment the error number
+            tm_logger%i_nerror=tm_logger%i_nerror+1
+
+            IF( INDEX(TRIM(tm_logger%c_verb),'error')/=0 )THEN
+
+               CALL logger__write("ERROR   :",cd_msg)
+
+               IF( PRESENT(ld_flush) )THEN
+                  IF( ld_flush )THEN
+                     CALL logger_flush()
+                  ENDIF
+               ENDIF      
+            ENDIF
+
+            IF( tm_logger%i_nerror >= tm_logger%i_maxerror )THEN
+               WRITE(cl_nerror,*) tm_logger%i_maxerror
+               CALL logger_fatal(&
+               &  'Error count reached limit of '//TRIM(ADJUSTL(cl_nerror)) )
+            ENDIF
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_error')
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE logger_error
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   RECURSIVE SUBROUTINE logger_fatal(cd_msg)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine write fatal error message on log file, 
+   !> close log file and stop process.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September, 2015
+   !> - stop program for FATAL ERROR if verbosity is none
+   !>
+   !> @param[in] cd_msg message to write
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),           INTENT(IN) :: cd_msg
+      !----------------------------------------------------------------
+
+      IF( tm_logger%l_use )THEN
+         IF( tm_logger%i_id /= 0 )THEN
+            IF( INDEX(TRIM(tm_logger%c_verb),'fatal')/=0 )THEN
+               ! increment the error number
+               tm_logger%i_nfatal=tm_logger%i_nfatal+1
+
+               CALL logger__write("FATAL   :",cd_msg)
+
+               CALL logger_footer()
+               CALL logger_close()
+
+               WRITE(*,*) 'FATAL ERROR, see ',TRIM(tm_logger%c_name)
+               STOP
+            ENDIF
+         ELSE
+             CALL logger_open('logger.log')
+             CALL logger_header()
+             CALL logger_fatal('you must have create logger to use logger_fatal')
+         ENDIF
+      ELSE
+         PRINT *,"FATAL ERROR :"//TRIM(cd_msg)
+         STOP
+      ENDIF
+
+   END SUBROUTINE logger_fatal
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE logger__write(cd_verb, cd_msg)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine cut message to get maximum of 80 character 
+   !> by line in log file.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] cd_verb   verbosity of the message to write
+   !> @param[in] cd_msg    message to write
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),           INTENT(IN) :: cd_verb
+      CHARACTER(LEN=*),           INTENT(IN) :: cd_msg
+
+      ! local variable
+      INTEGER(i4)       :: il_status
+      INTEGER(i4)       :: il_verb
+      INTEGER(i4)       :: il_msg
+      CHARACTER(LEN=lc) :: cl_verb
+      CHARACTER(LEN=lc) :: cl_msg
+      CHARACTER(LEN=lc) :: cl_tmp
+      !----------------------------------------------------------------
+
+      cl_verb=TRIM(ADJUSTL(cd_verb))
+      cl_msg=TRIM(ADJUSTL(cd_msg))
+
+      il_verb=LEN_TRIM(cl_verb)
+      il_msg=LEN_TRIM(cl_msg)
+      DO WHILE( il_verb + il_msg > 78 )
+         cl_tmp=TRIM(cl_verb)//' '//TRIM(cl_msg(1:78-il_verb))
+
+         WRITE( tm_logger%i_id,  &
+         &      FMT=*,           &
+         &      IOSTAT=il_status &
+         &      ) TRIM(cl_tmp)
+         CALL fct_err(il_status)
+
+
+         cl_msg=cl_msg(78-il_verb+1:il_msg)
+         cl_verb="        :"
+
+         il_msg=LEN_TRIM(cl_msg)
+
+      ENDDO
+
+      cl_tmp=TRIM(cl_verb)//' '//TRIM(cl_msg)
+      WRITE( tm_logger%i_id,  &
+      &      FMT=*,           &
+      &      IOSTAT=il_status &
+      &      ) TRIM(cl_tmp)
+      CALL fct_err(il_status)
+
+   END SUBROUTINE logger__write
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION logger__check_verb(cd_verb) &
+         & RESULT (lf_show)
+   !-------------------------------------------------------------------
+   !> @brief This function check validity of verbosity.
+   !>
+   !> @author J.Paul
+   !> @date February, 2015 - Initial Version
+   !>
+   !> @param[in] cd_verb   verbosity of the message to write
+   !> @return verbosity is valid or not
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_verb
+
+      !function
+      LOGICAL                      :: lf_show
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      lf_show=.FALSE.
+
+      DO ji=1,im_nverbosity
+         IF( TRIM(cd_verb) == TRIM(cm_verbosity(ji)) )THEN
+            lf_show=.TRUE.
+            EXIT
+         ENDIF
+      ENDDO
+
+      IF( .NOT. lf_show )THEN
+         CALL logger_open('logger.log')
+         CALL logger_header()
+         CALL logger_fatal('LOGGER : invalid verbosity, check namelist.'//&
+         &                 ' default one will be used.')
+         CALL logger_footer()
+      ENDIF
+
+   END FUNCTION logger__check_verb
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE logger
+
Index: /utils/tools_ticket2413/SIREN/src/math.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/math.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/math.f90	(revision 12863)
@@ -0,0 +1,1450 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief
+!> This module groups some useful mathematical function.
+!>
+!> @details
+!>
+!>    to compute the mean of an array:<br/>
+!> @code
+!>    dl_value=math_mean( dl_value, dd_fill )
+!> @endcode
+!>       - dl_value is 1D or 2D array
+!>       - dd_fill is FillValue
+!>
+!>    to compute the median of an array:<br/>
+!> @code
+!>    dl_value=math_median( dl_value, dd_fill )
+!> @endcode
+!>       - dl_value is 1D or 2D array
+!>       - dd_fill is FillValue
+!>
+!>    to compute the mean without extremum of an array:<br/>
+!> @code
+!>    dl_value=math_mwe( dl_value, id_next, dd_fill )
+!> @endcode
+!>       - dl_value is 1D or 2D array
+!>       - id_next is the number of extremum to be removed
+!>       - dd_fill is FillValue
+!>
+!>    to sort an 1D array:<br/>
+!> @code
+!>    CALL math_QsortC(dl_value)
+!> @endcode
+!>       - dl_value is 1D array
+!>
+!>    to correct phase angles to produce smoother phase:<br/>
+!> @code
+!>    CALL math_unwrap(dl_value, [dl_discont])
+!> @endcode
+!>       - dl_value is 1D array
+!>       - dl_discont maximum discontinuity between values, default pi
+!>
+!>    to compute simple operation
+!> @code
+!>    dl_res=math_compute(cl_var)
+!> @endcode
+!>       - cl_var operation to compute (string of character)
+!>       - dl_res result of the operation, real(dp)
+!>
+!>    to compute first derivative of 1D array:<br/>
+!> @code
+!>    dl_value(:)=math_deriv_1D( dd_value(:), dd_fill, [ld_discont] )
+!> @endcode
+!>       - dd_value is 1D array of variable
+!>       - dd_fill is FillValue of variable
+!>       - ld_discont is logical to take into account longitudinal 
+!>         East-West discontinuity [optional]
+!>
+!>    to compute first derivative of 2D array:<br/>
+!> @code
+!>    dl_value(:,:)=math_deriv_2D( dd_value(:,:), dd_fill, cd_dim, 
+!>                  [ld_discont] )
+!> @endcode
+!>       - dd_value is 2D array of variable
+!>       - dd_fill is FillValue of variable
+!>       - cd_dim is character to compute derivative on first (I) or
+!>         second (J) dimension
+!>       - ld_discont is logical to take into account longitudinal 
+!>         East-West discontinuity [optional]
+!>
+!>    to compute first derivative of 3D array:<br/>
+!> @code
+!>    dl_value(:,:,:)=math_deriv_3D( dd_value(:,:,:), dd_fill, cd_dim,
+!>                    [ld_discont] )
+!> @endcode
+!>       - dd_value is 3D array of variable
+!>       - dd_fill is FillValue of variable
+!>       - cd_dim is character to compute derivative on first (I), second (J),
+!>         or third (K) dimension
+!>       - ld_discont is logical to take into account longitudinal East-West 
+!>         discontinuity [optional]
+!>
+!>
+!> @author
+!> J.Paul
+!>
+!> @date January, 2015 - Initial version
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE math
+
+   USE kind                            ! F90 kind parameter
+   USE global                          ! global variable
+   USE phycst                          ! physical constant
+   USE fct                             ! basic useful function
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! function and subroutine
+   PUBLIC :: math_mean      !< return mean of an array
+   PUBLIC :: math_median    !< return median of an array
+   PUBLIC :: math_mwe       !< return mean without extremum of an array
+   PUBLIC :: math_QsortC    !< sort an 1D array
+   PUBLIC :: math_unwrap    !< correct phase angles to produce smoother phase
+   PUBLIC :: math_compute   !< compute simple operation
+   PUBLIC :: math_deriv_1D  !< compute first derivative of 1D array 
+   PUBLIC :: math_deriv_2D  !< compute first derivative of 2D array 
+   PUBLIC :: math_deriv_3D  !< compute first derivative of 3D array
+   PUBLIC :: math_ortho     !< compute orthodome distance
+   PUBLIC :: math_euclid    !< compute euclidian distance
+
+   PRIVATE :: math__Partition
+   PRIVATE :: math__mean_1d
+   PRIVATE :: math__mean_2d
+   PRIVATE :: math__median_1d
+   PRIVATE :: math__median_2d
+   PRIVATE :: math__mwe_1d
+   PRIVATE :: math__mwe_2d
+   PRIVATE :: math__parentheses
+
+
+   INTERFACE math_mean
+      MODULE PROCEDURE math__mean_1d ! return mean of an array 1D
+      MODULE PROCEDURE math__mean_2d ! return mean of an array 2D
+   END INTERFACE math_mean
+
+   INTERFACE math_median
+      MODULE PROCEDURE math__median_1d ! return median of an array 1D
+      MODULE PROCEDURE math__median_2d ! return median of an array 2D
+   END INTERFACE math_median
+
+   INTERFACE math_mwe
+      MODULE PROCEDURE math__mwe_1d ! return mean without extremum of an array 1D
+      MODULE PROCEDURE math__mwe_2d ! return mean without extremum of an array 2D
+   END INTERFACE math_mwe
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION math__mean_1d(dd_array, dd_fill) &
+         & RESULT (df_mean)
+   !------------------------------------------------------------------- 
+   !> @brief This function compute the mean of a 1D array. 
+   !>
+   !> @author J.Paul 
+   !> @date January, 2015 - Initial Version 
+   !>
+   !> @param[in] dd_array  1D array 
+   !> @param[in] dd_fill   fillValue
+   !> @return mean value, real(dp)
+   !------------------------------------------------------------------- 
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp), DIMENSION(:), INTENT(IN) :: dd_array
+      REAL(dp),               INTENT(IN), OPTIONAL :: dd_fill
+
+      ! function
+      REAL(dp)                           :: df_mean
+
+      ! local variable
+      INTEGER(i4)  :: il_count
+      REAL(dp)     :: dl_sum
+      REAL(dp)     :: dl_count
+      !----------------------------------------------------------------
+      
+      IF( PRESENT(dd_fill) )THEN
+         il_count=COUNT(dd_array(:)/=dd_fill)
+         IF( il_count > 0 )THEN
+            dl_sum  =SUM ( dd_array(:), dd_array(:)/= dd_fill )
+            dl_count=REAL( il_count, dp)
+
+            df_mean=dl_sum/dl_count
+         ELSE
+            df_mean=dd_fill
+         ENDIF
+      ELSE
+         il_count=SIZE(dd_array(:))
+         IF( il_count > 0 )THEN
+            dl_sum  =SUM ( dd_array(:) )
+            dl_count=REAL( il_count, dp)
+
+            df_mean=dl_sum/dl_count
+         ELSE
+            df_mean=0
+         ENDIF
+      ENDIF
+
+   END FUNCTION math__mean_1d
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION math__mean_2d(dd_array, dd_fill) &
+         & RESULT (df_mean)
+   !------------------------------------------------------------------- 
+   !> @brief This function compute the mean of a 2D array. 
+   !>
+   !> @author J.Paul 
+   !> @date January, 2015 - Initial Version 
+   !>
+   !> @param[in] dd_array  2D array 
+   !> @param[in] dd_fill   fillValue
+   !> @return mean value, real(dp)
+   !------------------------------------------------------------------- 
+      
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_array
+      REAL(dp),                 INTENT(IN), OPTIONAL :: dd_fill
+
+      ! function
+      REAL(dp)                             :: df_mean
+
+      ! local variable
+      INTEGER(i4)                         :: il_count
+
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_list
+      !----------------------------------------------------------------
+
+      IF( PRESENT(dd_fill)  )THEN
+         il_count=COUNT(dd_array(:,:)/=dd_fill)
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=PACK(dd_array(:,:),dd_array(:,:)/=dd_fill)
+         ELSE
+            df_mean=dd_fill
+         ENDIF
+      ELSE
+         il_count=SIZE(dd_array)
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=PACK(dd_array(:,:), MASK=.TRUE.)
+         ELSE
+            df_mean=0
+         ENDIF
+      ENDIF
+
+      IF( ALLOCATED(dl_list) )THEN
+         df_mean=math_mean(dl_list(:))
+         DEALLOCATE( dl_list )
+      ENDIF
+
+   END FUNCTION math__mean_2d
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION math__median_1d(dd_array, dd_fill) &
+         & RESULT (df_median)
+   !------------------------------------------------------------------- 
+   !> @brief This function compute the median of a 1D array. 
+   !>
+   !> @author J.Paul 
+   !> @date January, 2015 - Initial Version 
+   !>
+   !> @param[in] dd_array  1D array 
+   !> @param[in] dd_fill   fillValue
+   !> @return median value, real(dp)
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp), DIMENSION(:), INTENT(IN) :: dd_array
+      REAL(dp),               INTENT(IN), OPTIONAL :: dd_fill
+
+      ! function
+      REAL(dp)                           :: df_median
+
+      ! local variable
+      INTEGER(i4)                         :: il_count
+
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_list
+      !----------------------------------------------------------------
+      
+      IF( PRESENT(dd_fill)  )THEN
+         il_count=COUNT(dd_array(:)/=dd_fill)
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=PACK(dd_array(:),dd_array(:)/=dd_fill)
+         ELSE
+            df_median=dd_fill
+         ENDIF
+      ELSE
+         il_count=SIZE(dd_array(:))
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=dd_array(:)
+         ELSE
+            df_median=0
+         ENDIF
+      ENDIF
+
+      IF( ALLOCATED(dl_list) )THEN
+         CALL math_QsortC(dl_list(:))
+
+         IF( MOD(il_count,2) == 0 )THEN
+            df_median=(dl_list(il_count/2+1)+dl_list(il_count/2))/2_dp
+         ELSE
+            df_median=dl_list(il_count/2+1)
+         ENDIF
+
+         DEALLOCATE(dl_list)
+      ENDIF
+
+   END FUNCTION math__median_1d
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION math__median_2d(dd_array, dd_fill) &
+         & RESULT (df_median)
+   !------------------------------------------------------------------- 
+   !> @brief This function compute the median of a 2D array. 
+   !> 
+   !> @author J.Paul 
+   !> @date January, 2015 - Initial Version 
+   !>
+   !> @param[in] dd_array  2D array 
+   !> @param[in] dd_fill   fillValue
+   !> @return median value, real(dp)
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_array
+      REAL(dp),                 INTENT(IN), OPTIONAL :: dd_fill
+
+      ! funtion
+      REAL(dp)                             :: df_median
+      
+      ! local variable
+      INTEGER(i4)                         :: il_count
+
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_list
+      !----------------------------------------------------------------
+      
+      IF( PRESENT(dd_fill)  )THEN
+         il_count=COUNT(dd_array(:,:)/=dd_fill)
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=PACK(dd_array(:,:),dd_array(:,:)/=dd_fill)
+         ELSE
+            df_median=dd_fill
+         ENDIF
+      ELSE
+         il_count=SIZE(dd_array(:,:))
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=PACK(dd_array(:,:), MASK=.TRUE.)
+         ELSE
+            df_median=0
+         ENDIF
+      ENDIF
+
+      IF( ALLOCATED(dl_list) )THEN
+         df_median=math_median(dl_list(:))
+         DEALLOCATE(dl_list)
+      ENDIF
+
+   END FUNCTION math__median_2d
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION math__mwe_1d(dd_array, id_next, dd_fill) &
+         & RESULT (df_mwe)
+   !------------------------------------------------------------------- 
+   !> @brief This function compute the mean without extremum of a 1D array. 
+   !> 
+   !> @author J.Paul 
+   !> @date January, 2015 - Initial Version 
+   !>
+   !> @param[in] dd_array  1D array 
+   !> @param[in] id_next   number of extremum to be removed
+   !> @param[in] dd_fill   fillValue
+   !> @return median value, real(dp)
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+      
+      ! Argument
+      REAL(dp), DIMENSION(:), INTENT(IN) :: dd_array
+      INTEGER(i4)           , INTENT(IN), OPTIONAL :: id_next
+      REAL(dp),               INTENT(IN), OPTIONAL :: dd_fill
+
+      ! function
+      REAL(dp)                           :: df_mwe
+
+      ! local variable
+      INTEGER(i4)                         :: il_next
+      INTEGER(i4)                         :: il_count
+      INTEGER(i4)                         :: il_size
+
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_list
+      !----------------------------------------------------------------
+
+      il_next=2
+      IF( PRESENT(id_next) ) il_next=id_next
+      
+      il_size=SIZE(dd_array(:))
+      IF( PRESENT(dd_fill)  )THEN
+         il_count=COUNT(dd_array(:)/=dd_fill)
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=PACK(dd_array(:),dd_array(:)/=dd_fill)
+         ELSE
+            df_mwe=dd_fill
+         ENDIF
+      ELSE
+         il_count=SIZE(dd_array(:))
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=dd_array(:)
+         ELSE
+            df_mwe=0
+         ENDIF
+      ENDIF
+
+      IF( ALLOCATED(dl_list) )THEN
+         CALL math_QsortC(dl_list(:))
+
+         IF( il_count == il_size )THEN
+            ! no fillValue
+            df_mwe=math_mean(dl_list(il_next+1:il_size-il_next))
+         ELSEIF( il_count > il_size-2*il_next )THEN
+            ! remove one extremum each side
+            df_mwe=math_mean(dl_list(2:il_size-1))
+         ELSE ! il_count <= il_size-2*il_next
+            ! more than 2*il_next fillValue
+            ! compute mean only
+            df_mwe=math_mean(dl_list(:))
+         ENDIF
+
+         DEALLOCATE(dl_list)
+      ENDIF
+
+   END FUNCTION math__mwe_1d
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION math__mwe_2d(dd_array, id_next, dd_fill) &
+         & RESULT (df_mwe)
+   !------------------------------------------------------------------- 
+   !> @brief This function compute the mean without extremum of a 2D array. 
+   !>
+   !> @author J.Paul 
+   !> @date January, 2015 - Initial Version 
+   !>
+   !> @param[in] dd_array  2D array 
+   !> @param[in] id_next   number of extremum to be removed
+   !> @param[in] dd_fill   fillValue
+   !> @return median value, real(dp)
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp), DIMENSION(:,:), INTENT(IN) :: dd_array
+      INTEGER(i4)             , INTENT(IN), OPTIONAL :: id_next
+      REAL(dp),                 INTENT(IN), OPTIONAL :: dd_fill
+
+      ! function
+      REAL(dp)                             :: df_mwe
+
+      ! local variable
+      INTEGER(i4)                         :: il_count
+
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_list
+      !----------------------------------------------------------------
+      
+      IF( PRESENT(dd_fill)  )THEN
+         il_count=COUNT(dd_array(:,:)/=dd_fill)
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=PACK(dd_array(:,:),dd_array(:,:)/=dd_fill)
+
+            df_mwe=math_mwe(dl_list(:), id_next)
+         ELSE
+            df_mwe=dd_fill
+         ENDIF
+      ELSE
+         il_count=SIZE(dd_array(:,:))
+         IF( il_count > 0 )THEN
+            ALLOCATE( dl_list(il_count) )
+            dl_list(:)=PACK(dd_array(:,:), MASK=.TRUE.)
+
+            df_mwe=math_mwe(dl_list(:), id_next)
+         ELSE
+            df_mwe=0
+         ENDIF
+      ENDIF
+
+      IF( ALLOCATED(dl_list) ) DEALLOCATE(dl_list)
+
+   END FUNCTION math__mwe_2d
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE RECURSIVE SUBROUTINE math_QsortC(dd_array)
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine sort a 1D array. 
+   !>
+   !> @details
+   !> Recursive Fortran 95 quicksort routine
+   !> sorts real numbers into ascending numerical order
+   !> Author: Juli Rew, SCD Consulting (juliana@ucar.edu), 9/03
+   !> Based on algorithm from Cormen et al., Introduction to Algorithms,
+   !> 1997 printing
+   !> 
+   !> @author J.Paul 
+   !> @date January, 2015 - Rewrite with SIREN coding rules 
+   !>
+   !> @param[inout] dd_array  1D array 
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_array
+
+      ! local variable
+      INTEGER(i4) :: il_iq
+      !----------------------------------------------------------------
+     
+      IF( SIZE(dd_array(:)) > 1 )THEN
+         CALL math__Partition(dd_array, il_iq)
+         CALL math_QsortC(dd_array(:il_iq-1))
+         CALL math_QsortC(dd_array(il_iq:))
+      ENDIF
+
+   END SUBROUTINE math_QsortC
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE SUBROUTINE math__Partition(dd_array, id_marker)
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine partition a 1D array. 
+   !>
+   !> @details
+   !> Author: Juli Rew, SCD Consulting (juliana@ucar.edu), 9/03
+   !> Based on algorithm from Cormen et al., Introduction to Algorithms,
+   !> 1997 printing
+   !> 
+   !> @author J.Paul 
+   !> @date January, 2015 - Rewrite with SIREN coding rules 
+   !> @date November, 2017
+   !> - use the correct loop index to look for element bigger than pivot point.
+   !>
+   !> @param[inout] dd_array  1D array 
+   !> @param[in] id_marker 
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)   , DIMENSION(:), INTENT(INOUT) :: dd_array
+      INTEGER(i4),               INTENT(  OUT) :: id_marker
+
+      ! local variable
+      REAL(dp)    :: dl_temp
+      REAL(dp)    :: dl_x     ! pivot point
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      dl_x = dd_array(1)
+      ji= 0
+      jj= SIZE(dd_array(:)) + 1
+
+      DO 
+         jj=jj-1
+         DO
+            IF( dd_array(jj) <= dl_x ) EXIT
+            jj=jj-1
+         ENDDO
+         ji=ji+1
+         DO
+            IF( dd_array(ji) >= dl_x ) EXIT
+            ji=ji+1
+         ENDDO
+         IF( ji < jj )THEN
+            ! exchange dd_array(ji) and dd_array(jj)
+            dl_temp= dd_array(ji)
+            dd_array(ji) = dd_array(jj)
+            dd_array(jj) = dl_temp
+         ELSEIF( ji==jj )THEN
+            id_marker=ji+1
+            RETURN
+         ELSE
+            id_marker=ji
+            RETURN
+         ENDIF
+      ENDDO
+
+   END SUBROUTINE math__Partition
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE SUBROUTINE math_unwrap(dd_array, dd_discont)
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine correct phase angles to produce smoother 
+   !> phase plots. 
+   !>
+   !> @details
+   !> This code is based on numpy unwrap function
+   !>
+   !> Unwrap by changing deltas between values to 2*pi complement.
+   !>
+   !> Unwrap radian phase `dd_array` by changing absolute jumps greater than
+   !> `dd_discont` to their 2*pi complement.
+   !>
+   !> @note If the discontinuity in `dd_array` is smaller than ``pi``, 
+   !> but larger than `dd_discont`, no unwrapping is done because taking
+   !> the 2*pi complement would only make the discontinuity larger.
+   !>
+   !> @author J.Paul 
+   !> @date Marsh, 2015 - Rewrite in fortran, with SIREN coding rules 
+   !>
+   !> @param[inout] dd_array  1D array 
+   !> @param[in] dd_discont maximum discontinuity between values, default pi
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+      
+      ! Argument
+      REAL(dp)   , DIMENSION(:), INTENT(INOUT) :: dd_array
+      REAL(dp)   ,               INTENT(IN   ), OPTIONAL :: dd_discont
+
+      ! local variable
+      INTEGER(i4)                         :: il_size
+
+      REAL(dp)                            :: dl_discont
+
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_diff
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_mod
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_correct
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      dl_discont=dp_pi
+      IF( PRESENT(dd_discont) ) dl_discont=dd_discont
+
+      il_size=SIZE(dd_array)
+      ALLOCATE(dl_diff(il_size-1))
+      DO ji=1,il_size-1
+         dl_diff(ji)=dd_array(ji+1)-dd_array(ji)
+      ENDDO
+
+      ALLOCATE(dl_mod(il_size-1))
+      DO ji=1,il_size-1
+         dl_mod(ji) = MOD(dl_diff(ji) + dp_pi, 2*dp_pi) - dp_pi
+      ENDDO
+
+      WHERE( (dl_mod(:) == -dp_pi) .AND. (dl_diff(:) > 0._dp ) )
+         dl_mod(:)=dp_pi
+      END WHERE
+
+      ALLOCATE(dl_correct(il_size-1))
+      dl_correct(:)=dl_mod(:)-dl_diff(:)
+
+      DEALLOCATE(dl_mod)
+
+      WHERE( ABS(dl_diff(:)) < dl_discont )
+         dl_correct(:)=0._dp
+      END WHERE
+
+      DEALLOCATE(dl_diff)
+      
+      ALLOCATE(dl_tmp(il_size))
+      dl_tmp(:)=dd_array(:)
+
+      DO ji=1,il_size-1
+         dd_array(ji+1)=dl_tmp(ji+1)+SUM(dl_correct(1:ji))
+      ENDDO
+
+      DEALLOCATE(dl_correct)
+      DEALLOCATE(dl_tmp)
+
+   END SUBROUTINE math_unwrap
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   RECURSIVE FUNCTION math_compute(cd_var) &
+         &  RESULT(df_res)
+   !------------------------------------------------------------------- 
+   !> @brief This function compute simple operation 
+   !>
+   !> @details
+   !> - operation should be write as a string of character.
+   !> - operators allowed are : +,-,*,/ 
+   !> - to ordered operation you should use parentheses
+   !>
+   !> exemples: '1e6/(16/122)', '(3/2)*(2+1)' 
+   !>
+   !> @author J.Paul 
+   !> @date June, 2015 - initial version
+   !>
+   !> @param[in] cd_var operation to compute (string of character)  
+   !> @return result of the operation, real(dp)
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+      
+      ! Argument      
+      CHARACTER(LEN=*), INTENT(IN) :: cd_var
+   
+      ! fucntion
+      REAL(dp)                     :: df_res
+
+      ! local variables
+      CHARACTER(LEN=lc) :: cl_var
+      CHARACTER(LEN=lc) :: cl_str1
+      CHARACTER(LEN=lc) :: cl_str2
+   
+      INTEGER(i4)       :: il_ind
+      ! loop indices
+      !----------------------------------------------------------------
+   
+   
+      IF(fct_is_real(cd_var))THEN
+         READ(cd_var,*) df_res
+      ELSE
+      
+   
+         CALL math__parentheses(cd_var, cl_var)
+         
+         IF(fct_is_real(cl_var))THEN
+            READ(cl_var,*) df_res
+         ELSE
+            il_ind=SCAN(TRIM(cl_var),'*')
+            IF( il_ind /= 0 )THEN
+               cl_str1=cl_var(1:il_ind-1)
+               cl_str2=cl_var(il_ind+1:)
+               df_res=math_compute(cl_str1)*math_compute(cl_str2)
+            ELSE
+               il_ind=SCAN(TRIM(cl_var),'/')
+               IF( il_ind /= 0 )THEN
+                  cl_str1=cl_var(1:il_ind-1)
+                  cl_str2=cl_var(il_ind+1:)
+                  df_res=math_compute(cl_str1)/math_compute(cl_str2)
+               ELSE
+                  il_ind=SCAN(TRIM(cl_var),'+')
+                  IF( il_ind /= 0 )THEN
+                     cl_str1=cl_var(1:il_ind-1)
+                     cl_str2=cl_var(il_ind+1:)
+                     df_res=math_compute(cl_str1)+math_compute(cl_str2)
+                  ELSE
+                     il_ind=SCAN(TRIM(cl_var),'-')
+                     IF( il_ind /= 0 )THEN
+                        cl_str1=cl_var(1:il_ind-1)
+                        cl_str2=cl_var(il_ind+1:)
+                        df_res=math_compute(cl_str1)-math_compute(cl_str2)
+                     ELSE
+                        df_res=dp_fill
+                     ENDIF
+                  ENDIF
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDIF
+   
+   END FUNCTION math_compute
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE math__parentheses(cd_varin, cd_varout)
+   !------------------------------------------------------------------- 
+   !> @brief This subroutine replace sub string inside parentheses
+   !> by the value of the operation inside.
+   !>
+   !> @details
+   !> exemple : 
+   !> - '2.6+(3/2)' => '2.6+1.5000'
+   !>
+   !> @author J.Paul 
+   !> @date June, 2015 - initial version
+   !> 
+   !> @param[in] cd_varin  string of character with operation inside
+   !> parentheses 
+   !> @param[out] cd_varout string of character with result of 
+   !> operation inside parentheses
+   !-------------------------------------------------------------------   
+      
+      IMPLICIT NONE
+      
+      ! Argument      
+      CHARACTER(LEN=*) , INTENT(IN)  :: cd_varin
+      CHARACTER(LEN=lc), INTENT(OUT) :: cd_varout
+      
+      ! local variables
+      CHARACTER(LEN=lc)     :: cl_cpt
+      INTEGER(i4)           :: il_ind
+      INTEGER(i4)           :: il_count
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      il_ind=INDEX(cd_varin,'(')
+      IF( il_ind /= 0 )THEN
+         il_count=0
+         DO ji=il_ind+1,LEN(cd_varin)
+            IF( cd_varin(ji:ji) == '(' )THEN
+               il_count=il_count+1
+            ELSEIF( cd_varin(ji:ji) == ')' )THEN
+               IF( il_count == 0 )THEN
+                  WRITE(cl_cpt,*) math_compute(cd_varin(il_ind+1:ji-1))
+                  cd_varout=TRIM(cd_varin(1:il_ind-1))//TRIM(ADJUSTL(cl_cpt))//&
+                     &        TRIM(cd_varin(ji+1:))
+                  EXIT
+               ELSE
+                  il_count=il_count-1
+               ENDIF
+            ENDIF
+         ENDDO
+      ELSE
+         cd_varout=TRIM(cd_varin)
+      ENDIF
+   
+   END SUBROUTINE math__parentheses
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION math_deriv_1D(dd_value, dd_fill, ld_discont) &
+         & RESULT (df_deriv)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function compute derivative of 1D array.
+   !> 
+   !> @details 
+   !> optionaly you could specify to take into account east west discontinuity
+   !> (-180° 180° or 0° 360° for longitude variable)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] dd_value     1D array of variable to be extrapolated
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[in] ld_discont   logical to take into account east west discontinuity 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)   , DIMENSION(:), INTENT(IN) :: dd_value
+      REAL(dp)                 , INTENT(IN) :: dd_fill
+      LOGICAL                  , INTENT(IN), OPTIONAL :: ld_discont
+
+      ! function
+      REAL(dp), DIMENSION(SIZE(dd_value,DIM=1) ) :: df_deriv
+
+      ! local variable
+      INTEGER(i4)                            :: il_imin
+      INTEGER(i4)                            :: il_imax
+      INTEGER(i4), DIMENSION(1)              :: il_shape
+
+      REAL(dp)                               :: dl_min
+      REAL(dp)                               :: dl_max
+      REAL(dp)   , DIMENSION(:), ALLOCATABLE :: dl_value
+
+      LOGICAL                                :: ll_discont
+
+      ! loop indices
+      INTEGER(i4) :: ji
+
+      INTEGER(i4) :: i1
+      INTEGER(i4) :: i2
+      !----------------------------------------------------------------
+      ! init
+      df_deriv(:)=dd_fill
+
+      ll_discont=.FALSE.
+      IF( PRESENT(ld_discont) ) ll_discont=ld_discont
+
+      il_shape(:)=SHAPE(dd_value(:))
+
+      ALLOCATE( dl_value(3))
+
+      ! compute derivative in i-direction
+      DO ji=1,il_shape(1)
+         
+            il_imin=MAX(ji-1,1)
+            il_imax=MIN(ji+1,il_shape(1))
+
+            IF( il_imin==ji-1 .AND. il_imax==ji+1 )THEN
+               i1=1  ; i2=3
+            ELSEIF( il_imin==ji .AND. il_imax==ji+1 )THEN
+               i1=1  ; i2=2
+            ELSEIF( il_imin==ji-1 .AND. il_imax==ji )THEN
+               i1=2  ; i2=3
+            ENDIF
+
+            dl_value(i1:i2)=dd_value(il_imin:il_imax)
+            IF( il_imin == 1 )THEN
+               dl_value(:)=EOSHIFT( dl_value(:), &
+               &                    DIM=1,         &
+               &                    SHIFT=-1,      &
+               &                    BOUNDARY=dl_value(1) )
+            ENDIF
+            IF( il_imax == il_shape(1) )THEN
+               dl_value(:)=EOSHIFT( dl_value(:), &
+               &                    DIM=1,         &
+               &                    SHIFT=1,       &
+               &                    BOUNDARY=dl_value(3))
+            ENDIF
+
+            IF( ll_discont )THEN
+               dl_min=MINVAL( dl_value(:), dl_value(:)/=dd_fill )
+               dl_max=MAXVAL( dl_value(:), dl_value(:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_value(:) < 0._dp ) 
+                     dl_value(:) = dl_value(:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_value(:) > 180._dp ) 
+                     dl_value(:) = dl_value(:)-180._dp
+                  END WHERE
+               ENDIF
+            ENDIF
+
+         IF( dl_value( 2) /= dd_fill .AND. & ! ji
+         &   dl_value( 3) /= dd_fill .AND. & ! ji+1
+         &   dl_value( 1) /= dd_fill )THEN   ! ji-1
+
+            df_deriv(ji)= (dl_value(3) - dl_value(1)) / REAL(il_imax-il_imin,dp)
+
+         ENDIF
+
+      ENDDO
+
+      DEALLOCATE( dl_value )
+
+   END FUNCTION math_deriv_1D
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION math_deriv_2D(dd_value, dd_fill, cd_dim, ld_discont) &
+         & RESULT (df_deriv)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function compute derivative of 2D array.
+   !> you have to specify in which direction derivative have to be computed:
+   !> first (I) or second (J) dimension. 
+   !>
+   !> @details 
+   !> optionaly you could specify to take into account east west discontinuity
+   !> (-180° 180° or 0° 360° for longitude variable)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] dd_value     2D array of variable to be extrapolated
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[in] cd_dim       compute derivative on first (I) or second (J) dimension 
+   !> @param[in] ld_discont   logical to take into account east west discontinuity 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)   , DIMENSION(:,:), INTENT(IN) :: dd_value
+      REAL(dp)                   , INTENT(IN) :: dd_fill
+      CHARACTER(LEN=*)           , INTENT(IN) :: cd_dim
+      LOGICAL                    , INTENT(IN), OPTIONAL :: ld_discont
+
+      ! function
+      REAL(dp), DIMENSION(SIZE(dd_value,DIM=1), &
+         &                SIZE(dd_value,DIM=2) ) :: df_deriv
+
+      ! local variable
+      INTEGER(i4)                              :: il_imin
+      INTEGER(i4)                              :: il_imax
+      INTEGER(i4)                              :: il_jmin
+      INTEGER(i4)                              :: il_jmax
+      INTEGER(i4), DIMENSION(2)                :: il_shape
+
+      REAL(dp)                                 :: dl_min
+      REAL(dp)                                 :: dl_max
+      REAL(dp)   , DIMENSION(:,:), ALLOCATABLE :: dl_value
+
+      LOGICAL                                  :: ll_discont
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+
+      INTEGER(i4) :: i1
+      INTEGER(i4) :: i2
+
+      INTEGER(i4) :: j1
+      INTEGER(i4) :: j2
+      !----------------------------------------------------------------
+      ! init
+      df_deriv(:,:)=dd_fill
+
+      ll_discont=.FALSE.
+      IF( PRESENT(ld_discont) ) ll_discont=ld_discont
+
+      il_shape(:)=SHAPE(dd_value(:,:))
+
+      SELECT CASE(TRIM(fct_upper(cd_dim)))
+
+      CASE('I')
+
+         ALLOCATE( dl_value(3,il_shape(2)) )
+         ! compute derivative in i-direction
+         DO ji=1,il_shape(1)
+
+            ! init
+            dl_value(:,:)=dd_fill
+            
+            il_imin=MAX(ji-1,1)
+            il_imax=MIN(ji+1,il_shape(1))
+
+            IF( il_imin==ji-1 .AND. il_imax==ji+1 )THEN
+               i1=1  ; i2=3
+            ELSEIF( il_imin==ji .AND. il_imax==ji+1 )THEN
+               i1=1  ; i2=2
+            ELSEIF( il_imin==ji-1 .AND. il_imax==ji )THEN
+               i1=2  ; i2=3
+            ENDIF
+
+            dl_value(i1:i2,:)=dd_value(il_imin:il_imax,:)
+            IF( il_imin == 1 )THEN
+               dl_value(:,:)=EOSHIFT( dl_value(:,:), &
+                  &                   DIM=1,         &
+                  &                   SHIFT=-1,      &
+                  &                   BOUNDARY=dl_value(1,:) )
+            ENDIF
+            IF( il_imax == il_shape(1) )THEN
+               dl_value(:,:)=EOSHIFT( dl_value(:,:), &
+                  &                   DIM=1,         &
+                  &                   SHIFT=1,       &
+                  &                   BOUNDARY=dl_value(3,:))
+            ENDIF
+
+            IF( ll_discont )THEN
+               dl_min=MINVAL( dl_value(:,:), dl_value(:,:)/=dd_fill )
+               dl_max=MAXVAL( dl_value(:,:), dl_value(:,:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_value(:,:) < 0_dp ) 
+                     dl_value(:,:) = dl_value(:,:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_value(:,:) > 180 ) 
+                     dl_value(:,:) = dl_value(:,:)-180._dp
+                  END WHERE
+               ENDIF
+            ENDIF
+            
+            WHERE( dl_value(2,:) /= dd_fill .AND. &  ! ji
+               &   dl_value(3,:) /= dd_fill .AND. &  ! ji+1
+               &   dl_value(1,:) /= dd_fill )        ! ji-1
+
+               df_deriv(ji,:)= (dl_value(3,:) - dl_value(1,:)) / REAL(il_imax-il_imin,dp)
+
+            END WHERE
+
+         ENDDO
+
+      CASE('J')
+
+         ALLOCATE( dl_value(il_shape(1),3) )
+         ! compute derivative in j-direction
+         DO jj=1,il_shape(2)
+         
+            il_jmin=MAX(jj-1,1)
+            il_jmax=MIN(jj+1,il_shape(2))
+
+            IF( il_jmin==jj-1 .AND. il_jmax==jj+1 )THEN
+               j1=1  ; j2=3
+            ELSEIF( il_jmin==jj .AND. il_jmax==jj+1 )THEN
+               j1=1  ; j2=2
+            ELSEIF( il_jmin==jj-1 .AND. il_jmax==jj )THEN
+               j1=2  ; j2=3
+            ENDIF
+
+            dl_value(:,j1:j2)=dd_value(:,il_jmin:il_jmax)
+            IF( il_jmin == 1 )THEN
+               dl_value(:,:)=EOSHIFT( dl_value(:,:), &
+                  &                   DIM=2,         &
+                  &                   SHIFT=-1,      &
+                  &                   BOUNDARY=dl_value(:,1))
+            ENDIF
+            IF( il_jmax == il_shape(2) )THEN
+               dl_value(:,:)=EOSHIFT( dl_value(:,:), &
+                  &                   DIM=2,         &
+                  &                   SHIFT=1,       &
+                  &                   BOUNDARY=dl_value(:,3))
+            ENDIF
+
+            IF( ll_discont )THEN
+               dl_min=MINVAL( dl_value(:,:), dl_value(:,:)/=dd_fill )
+               dl_max=MAXVAL( dl_value(:,:), dl_value(:,:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_value(:,:) < 0_dp ) 
+                     dl_value(:,:) = dl_value(:,:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_value(:,:) > 180 ) 
+                     dl_value(:,:) = dl_value(:,:)-180._dp
+                  END WHERE
+               ENDIF
+            ENDIF
+
+            WHERE( dl_value(:, 2) /= dd_fill .AND. & ! jj
+               &   dl_value(:, 3) /= dd_fill .AND. & ! jj+1
+               &   dl_value(:, 1) /= dd_fill )       ! jj-1
+
+               df_deriv(:,jj)= (dl_value(:,3) - dl_value(:,1)) / REAL(il_jmax-il_jmin,dp)         
+
+            END WHERE
+
+         ENDDO
+         
+      END SELECT
+
+      DEALLOCATE( dl_value )
+
+   END FUNCTION math_deriv_2D
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   PURE FUNCTION math_deriv_3D(dd_value, dd_fill, cd_dim, ld_discont) &
+         & RESULT (df_deriv)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function compute derivative of 3D array.
+   !> you have to specify in which direction derivative have to be computed:
+   !> first (I), second (J) or third (K) dimension.
+   !> 
+   !> @details 
+   !> optionaly you could specify to take into account east west discontinuity
+   !> (-180° 180° or 0° 360° for longitude variable)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] dd_value  3D array of variable to be extrapolated
+   !> @param[in] dd_fill      FillValue of variable
+   !> @param[in] cd_dim       compute derivative on first (I) second (J) or third (K) dimension   
+   !> @param[in] ld_discont   logical to take into account east west discontinuity
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp)        , DIMENSION(:,:,:), INTENT(IN) :: dd_value
+      REAL(dp)                          , INTENT(IN) :: dd_fill
+      CHARACTER(LEN=*)                  , INTENT(IN) :: cd_dim
+      LOGICAL                           , INTENT(IN), OPTIONAL :: ld_discont
+
+      ! function
+      REAL(dp), DIMENSION(SIZE(dd_value,DIM=1), &
+      &                   SIZE(dd_value,DIM=2), &
+      &                   SIZE(dd_value,DIM=3)) :: df_deriv
+
+      ! local variable
+      INTEGER(i4)                                :: il_imin
+      INTEGER(i4)                                :: il_imax
+      INTEGER(i4)                                :: il_jmin
+      INTEGER(i4)                                :: il_jmax
+      INTEGER(i4)                                :: il_kmin
+      INTEGER(i4)                                :: il_kmax
+      INTEGER(i4), DIMENSION(3)                  :: il_shape
+
+      REAL(dp)                                   :: dl_min
+      REAL(dp)                                   :: dl_max
+      REAL(dp)   , DIMENSION(:,:,:), ALLOCATABLE :: dl_value
+
+      LOGICAL                                    :: ll_discont
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+
+      INTEGER(i4) :: i1
+      INTEGER(i4) :: i2
+
+      INTEGER(i4) :: j1
+      INTEGER(i4) :: j2
+      
+      INTEGER(i4) :: k1
+      INTEGER(i4) :: k2      
+      !----------------------------------------------------------------
+      ! init
+      df_deriv(:,:,:)=dd_fill
+
+      ll_discont=.FALSE.
+      IF( PRESENT(ld_discont) ) ll_discont=ld_discont
+
+      il_shape(:)=SHAPE(dd_value(:,:,:))
+
+
+      SELECT CASE(TRIM(fct_upper(cd_dim)))
+
+      CASE('I')
+
+         ALLOCATE( dl_value(3,il_shape(2),il_shape(3)) )
+         ! compute derivative in i-direction
+         DO ji=1,il_shape(1)
+            
+            il_imin=MAX(ji-1,1)
+            il_imax=MIN(ji+1,il_shape(1))
+
+            IF( il_imin==ji-1 .AND. il_imax==ji+1 )THEN
+               i1=1  ; i2=3
+            ELSEIF( il_imin==ji .AND. il_imax==ji+1 )THEN
+               i1=1  ; i2=2
+            ELSEIF( il_imin==ji-1 .AND. il_imax==ji )THEN
+               i1=2  ; i2=3
+            ENDIF
+
+            dl_value(i1:i2,:,:)=dd_value(il_imin:il_imax,:,:)
+            IF( il_imin == 1 )THEN
+               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
+                  &                     DIM=1,         &
+                  &                     SHIFT=-1,      &
+                  &                     BOUNDARY=dl_value(1,:,:) )
+            ENDIF
+            IF( il_imax == il_shape(1) )THEN
+               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
+                  &                     DIM=1,         &
+                  &                     SHIFT=1,       &
+                  &                     BOUNDARY=dl_value(3,:,:))
+            ENDIF
+
+            IF( ll_discont )THEN
+               dl_min=MINVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
+               dl_max=MAXVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_value(:,:,:) < 0_dp ) 
+                     dl_value(:,:,:) = dl_value(:,:,:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_value(:,:,:) > 180 ) 
+                     dl_value(:,:,:) = dl_value(:,:,:)-180._dp
+                  END WHERE
+               ENDIF
+            ENDIF
+
+            WHERE( dl_value(2,:,:) /= dd_fill .AND. & ! ji
+               &   dl_value(3,:,:) /= dd_fill .AND. & !ji+1 
+               &   dl_value(1,:,:) /= dd_fill )       !ji-1
+
+               df_deriv(ji,:,:)= (dl_value(3,:,:) - dl_value(1,:,:)) / REAL(il_imax-il_imin,dp)
+
+            END WHERE
+
+         ENDDO
+
+      CASE('J')
+
+         ALLOCATE( dl_value(il_shape(1),3,il_shape(3)) )
+         ! compute derivative in j-direction
+         DO jj=1,il_shape(2)
+         
+            il_jmin=MAX(jj-1,1)
+            il_jmax=MIN(jj+1,il_shape(2))
+
+            IF( il_jmin==jj-1 .AND. il_jmax==jj+1 )THEN
+               j1=1  ; j2=3
+            ELSEIF( il_jmin==jj .AND. il_jmax==jj+1 )THEN
+               j1=1  ; j2=2
+            ELSEIF( il_jmin==jj-1 .AND. il_jmax==jj )THEN
+               j1=2  ; j2=3
+            ENDIF
+
+            dl_value(:,j1:j2,:)=dd_value(:,il_jmin:il_jmax,:)
+            IF( il_jmin == 1 )THEN
+               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
+                  &                     DIM=2,         &
+                  &                     SHIFT=-1,      &
+                  &                     BOUNDARY=dl_value(:,1,:) )
+            ENDIF
+            IF( il_jmax == il_shape(2) )THEN
+               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
+                  &                     DIM=2,         &
+                  &                     SHIFT=1,       &
+                  &                     BOUNDARY=dl_value(:,3,:))
+            ENDIF
+
+            IF( ll_discont )THEN
+               dl_min=MINVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
+               dl_max=MAXVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_value(:,:,:) < 0_dp ) 
+                     dl_value(:,:,:) = dl_value(:,:,:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_value(:,:,:) > 180 ) 
+                     dl_value(:,:,:) = dl_value(:,:,:)-180._dp
+                  END WHERE
+               ENDIF
+            ENDIF
+
+            WHERE( dl_value(:, 2,:) /= dd_fill .AND. & ! jj
+               &   dl_value(:, 3,:) /= dd_fill .AND. & ! jj+1
+               &   dl_value(:, 1,:) /= dd_fill )       ! jj-1
+
+               df_deriv(:,jj,:)= (dl_value(:,3,:) - dl_value(:,1,:)) / REAL(il_jmax - il_jmin,dp)         
+
+            END WHERE
+
+         ENDDO
+         
+      CASE('K')
+
+         ALLOCATE( dl_value(il_shape(1),il_shape(2),3) )
+         ! compute derivative in k-direction
+         DO jk=1,il_shape(3)
+
+            il_kmin=MAX(jk-1,1)
+            il_kmax=MIN(jk+1,il_shape(3))
+
+            IF( il_kmin==jk-1 .AND. il_kmax==jk+1 )THEN
+               k1=1  ; k2=3
+            ELSEIF( il_kmin==jk .AND. il_kmax==jk+1 )THEN
+               k1=1  ; k2=2
+            ELSEIF( il_kmin==jk-1 .AND. il_kmax==jk )THEN
+               k1=2  ; k2=3
+            ENDIF
+
+            dl_value(:,:,k1:k2)=dd_value(:,:,il_kmin:il_kmax)
+            IF( il_kmin == 1 )THEN
+               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
+                  &                     DIM=3,         &
+                  &                     SHIFT=-1,      &
+                  &                     BOUNDARY=dl_value(:,:,1) )
+            ENDIF
+            IF( il_kmax == il_shape(3) )THEN
+               dl_value(:,:,:)=EOSHIFT( dl_value(:,:,:), &
+                  &                     DIM=3,         &
+                  &                     SHIFT=1,       &
+                  &                     BOUNDARY=dl_value(:,:,3))
+            ENDIF
+
+            IF( ll_discont )THEN
+               dl_min=MINVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
+               dl_max=MAXVAL( dl_value(:,:,:), dl_value(:,:,:)/=dd_fill )
+               IF( dl_min < -170_dp .AND. dl_max > 170_dp )THEN
+                  WHERE( dl_value(:,:,:) < 0_dp ) 
+                     dl_value(:,:,:) = dl_value(:,:,:)+360._dp
+                  END WHERE
+               ELSEIF( dl_min < 10_dp .AND. dl_max > 350_dp )THEN
+                  WHERE( dl_value(:,:,:) > 180 ) 
+                     dl_value(:,:,:) = dl_value(:,:,:)-180._dp
+                  END WHERE
+               ENDIF
+            ENDIF         
+
+            WHERE( dl_value(:,:,2) /= dd_fill .AND. & ! jk
+               &   dl_value(:,:,3) /= dd_fill .AND. & ! jk+1
+               &   dl_value(:,:,1) /= dd_fill )       ! jk-1
+
+               df_deriv(:,:,jk)= (dl_value(:,:,3) - dl_value(:,:,1)) / REAL(il_kmax-il_kmin,dp)         
+
+            END WHERE
+
+         ENDDO
+
+      END SELECT
+
+      DEALLOCATE( dl_value )
+
+   END FUNCTION math_deriv_3D
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION math_ortho(dd_latm) &
+         &  RESULT(df_ortho)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function compute orthodome distance between opposite point of a cell
+   !> of one degree.
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date April, 2017 - Initial Version
+   !>
+   !> @param[in] dd_latm   mean latitude of the cell
+   !> @return orthodome distance
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp), TARGET :: dd_latm
+      
+      ! function
+      REAL(dp)         :: df_ortho
+      
+      ! local
+      REAL(dp) :: dl_dlat
+      REAL(dp) :: dl_dlon
+      REAL(dp) :: dl_lat1
+      REAL(dp) :: dl_lat2
+      REAL(dp) :: dl_tmp
+      !----------------------------------------------------------------
+
+      ! one degree cell
+      dl_dlat= 1._dp * dp_deg2rad
+      dl_dlon= 1._dp * dp_deg2rad
+
+      ! 
+      dl_lat1 = (dd_latm - 0.5_dp) * dp_deg2rad
+      dl_lat2 = (dd_latm + 0.5_dp) * dp_deg2rad
+
+      dl_tmp = SQRT( SIN(dl_dlat*0.5)**2 + &
+         &           COS(dl_lat1)*COS(dl_lat2)*SIN(dl_dlon*0.5)**2 )
+
+      df_ortho= 2* dp_rearth * ASIN( dl_tmp )
+
+   END FUNCTION math_ortho
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION math_euclid(dd_lonm,dd_latm) &
+         & RESULT(df_euclid)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function compute euclidian distance between opposite point of a cell
+   !> of one degree, center on (lonm,latm).
+   !> 
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date April, 2017 - Initial Version
+   !>
+   !> @param[in] dd_lonm   mean longitude of the cell
+   !> @param[in] dd_latm   mean latitude of the cell
+   !> @return orthodome distance
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp), TARGET :: dd_lonm
+      REAL(dp), TARGET :: dd_latm
+      
+      ! function
+      REAL(dp)         :: df_euclid
+      
+      ! local
+      REAL(dp) :: dl_lata
+      REAL(dp) :: dl_lona
+      REAL(dp) :: dl_latb
+      REAL(dp) :: dl_lonb
+      REAL(dp) :: xa,ya,za
+      REAL(dp) :: xb,yb,zb
+      !----------------------------------------------------------------
+
+      dl_lata=(dd_latm-0.5)*dp_deg2rad
+      dl_lona=(dd_lonm-0.5)*dp_deg2rad
+
+      xa = dp_rearth * COS(dl_lata) * COS(dl_lona)
+      ya = dp_rearth * COS(dl_lata) * SIN(dl_lona)
+      za = dp_rearth * SIN(dl_lata)
+
+      dl_latb=(dd_latm+0.5)*dp_deg2rad
+      dl_lonb=(dd_lonm+0.5)*dp_deg2rad
+
+      xb = dp_rearth * COS(dl_latb) * COS(dl_lonb)
+      yb = dp_rearth * COS(dl_latb) * SIN(dl_lonb)
+      zb = dp_rearth * SIN(dl_latb)
+
+      df_euclid = ((xb-xa)**2 + (yb-ya)**2 + (zb-za)**2)
+
+   END FUNCTION math_euclid
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE math
Index: /utils/tools_ticket2413/SIREN/src/merge_bathy.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/merge_bathy.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/merge_bathy.f90	(revision 12863)
@@ -0,0 +1,1198 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @file
+!> @brief 
+!> this program merges bathymetry file at boundaries.
+!>
+!> @details
+!> @section sec1 method
+!> coarse grid bathymetry is interpolated on fine grid 
+!> (nearest interpolation method is used).<br/>  
+!> then fine bathymetry and refined coarse bathymetry are merged at boundaries.<br/>
+!>    @f[BathyFine= Weight * BathyCoarse + (1-Weight)*BathyFine@f]
+!> the weight function used is :<br/>
+!>       @f[Weight = 0.5 + 0.5*COS( \frac{\pi*dist}{width} )@f]<br/>
+!> with
+!> - dist : number of point to border 
+!> - width : boundary size
+!>
+!> @section sec2 how to
+!> USAGE: merge_bathy merge_bathy.nam [-v] [-h]<br/>
+!>    - positional arguments:<br/>
+!>       - merge_bathy.nam<br/>
+!>          namelist of merge_bathy
+!>          @note
+!>             a template of the namelist could be created running (in templates directory):
+!>             @code{.sh}
+!>                python create_templates.py merge_bathy
+!>             @endcode
+!>
+!>    - optional arguments:<br/>
+!>       - -h, --help<br/>
+!>          show this help message (and exit)<br/>
+!>       - -v, --version<br/>
+!>          show Siren's version   (and exit)
+!>
+!> @section sec_merge merge_bathy.nam
+!>    merge_bathy.nam contains 7 namelists:
+!>       - **namlog** to set logger parameters
+!>       - **namcfg** to set configuration file parameters
+!>       - **namsrc** to set source/coarse grid parameters
+!>       - **namtgt** to set target/fine grid parameters
+!>       - **namnst** to set sub domain and nesting paramters
+!>       - **nambdy** to set boundary parameters
+!>       - **namout** to set output parameters
+!>
+!>    here after, each sub-namelist parameters is detailed.
+!>    @note 
+!>       default values are specified between brackets
+!>
+!> @subsection sublog namlog
+!>    the logger sub-namelist parameters are :
+!>
+!>    - **cn_logfile** [@a merge_bathy.log]<br/>
+!>       logger filename
+!>
+!>    - **cn_verbosity** [@a warning]<br/>
+!>       verbosity level, choose between :
+!>          - trace
+!>          - debug
+!>          - info
+!>          - warning
+!>          - error
+!>          - fatal
+!>          - none
+!>
+!>    - **in_maxerror** [@a 5]<br/> 
+!>       maximum number of error allowed
+!>
+!> @subsection subcfg namcfg
+!>    the configuration sub-namelist parameters are : 
+!>
+!>    - **cn_varcfg** [@a ./cfg/variable.cfg]<br/>
+!>       path to the variable configuration file.<br/>
+!>       the variable configuration file defines standard name, 
+!>       default interpolation method, axis,... 
+!>       to be used for some known variables.<br/> 
+!>
+!>    - **cn_dimcfg** [@a ./cfg/dimension.cfg]<br/> 
+!>       path to the dimension configuration file.<br/> 
+!>       the dimension configuration file defines dimensions allowed.<br/> 
+!>
+!>    - **cn_dumcfg** [@a ./cfg/dummy.cfg]<br/> 
+!>       path to the useless (dummy) configuration file.<br/>
+!>       the dummy configuration file defines useless 
+!>       dimension or variable. these dimension(s) or variable(s) will not be
+!>       processed.<br/>
+!>
+!> @subsection subsrc namsrc 
+!>    the source/coarse grid sub-namelist parameters are :
+!>
+!>    - **cn_bathy0** [@a ]<br/> 
+!>       path to the bathymetry file
+!>       @warning 
+!>          variable name must be __Bathymetry__ here.
+!>
+!>    - **in_perio0** [@a ]<br/> 
+!>       NEMO periodicity index<br/> 
+!>       the NEMO periodicity could be choose between 0 to 6:
+!>       <dl>
+!>          <dt>in_perio=0</dt>
+!>          <dd>standard regional model</dd>
+!>          <dt>in_perio=1</dt>
+!>          <dd>east-west cyclic model</dd>
+!>          <dt>in_perio=2</dt>
+!>          <dd>model with symmetric boundary condition across the equator</dd>
+!>          <dt>in_perio=3</dt>
+!>          <dd>regional model with North fold boundary and T-point pivot</dd>
+!>          <dt>in_perio=4</dt>
+!>          <dd>global model with a T-point pivot.<br/>
+!>          example: ORCA2, ORCA025, ORCA12</dd>
+!>          <dt>in_perio=5</dt>
+!>          <dd>regional model with North fold boundary and F-point pivot</dd>
+!>          <dt>in_perio=6</dt>
+!>          <dd>global model with a F-point pivot<br/>
+!>          example: ORCA05</dd>
+!>          </dd>
+!>       </dl>
+!>       @sa For more information see @ref md_src_docsrc_6_perio
+!>       and Model Boundary Condition paragraph in the 
+!>       [NEMO documentation](https://forge.ipsl.jussieu.fr/nemo/chrome/site/doc/NEMO/manual/pdf/NEMO_manual.pdf)
+!>
+!> @subsection subtgt namtgt 
+!>    the target/fine grid sub-namelist parameters are :
+!>
+!>    - **cn_bathy1** [@a ]<br/> 
+!>       path to bathymetry file
+!>       @warning 
+!>          variable name must be __Bathymetry__ here.
+!>
+!>    - **in_perio1** [@a ]<br/>
+!>       NEMO periodicity index (see above)
+!>    @note if the fine/target coordinates file (cn_coord1) was created by SIREN, you do
+!>    not need to fill this parameter. SIREN will read it on the global attributes of
+!>    the coordinates file.
+!>
+!> @subsection subnst namnst 
+!>    the nesting sub-namelist parameters are (default value are specified between brackets):
+!>    - **in_rhoi**  [@a 1]<br/> 
+!>       refinement factor in i-direction
+!>
+!>    - **in_rhoj**  [@a 1]<br/> 
+!>       refinement factor in j-direction
+!>
+!>    @note 
+!>       coarse grid indices will be deduced from fine grid
+!>       coordinate file.
+!>
+!> @subsection subbdy nambdy
+!>    the boundary sub-namelist parameters are :
+!>
+!>    - **ln_north** [@a .TRUE.]<br/> 
+!>       logical to use north boundary or not
+!>    - **ln_south** [@a .TRUE.]<br/>
+!>       logical to use south boundary or not
+!>    - **ln_east**  [@a .TRUE.]<br/>
+!>       logical to use east boundary or not
+!>    - **ln_west**  [@a .TRUE.]<br/>
+!>       logical to use west  boundary or not
+!>    <br/> <br/>
+!>    - **cn_north** [@a ]<br/>
+!>       north boundary indices on fine grid<br/>
+!>    - **cn_south** [@a ]<br/>
+!>       south boundary indices on fine grid<br/>
+!>    - **cn_east**  [@a ]<br/>
+!>       east  boundary indices on fine grid<br/>
+!>    - **cn_west**  [@a ]<br/>
+!>       west  boundary indices on fine grid<br/>
+!>
+!>       *cn_north* is a string character defining boundary
+!>       segmentation.<br/>
+!>       segments are separated by '|'.<br/>
+!>       each segments of the boundary is composed of:
+!>          - indice of velocity (orthogonal to boundary .ie. 
+!>             for north boundary, J-indice). 
+!>          - indice of segment start (I-indice for north boundary) 
+!>          - indice of segment end   (I-indice for north boundary)<br/>
+!>             indices must be separated by ':' .<br/>
+!>          - optionally, boundary size could be added between '(' and ')' 
+!>          in the first segment defined.
+!>             @note 
+!>                boundary size is the same for all segments of one boundary.
+!>
+!>       Examples:
+!>          - cn_north='index1,first1:last1(width)'
+!>          - cn_north='index1(width),first1:last1|index2,first2:last2'
+!>
+!>       @image html  boundary_50.png 
+!>       <center>@image latex boundary_50.png
+!>       </center>
+!>
+!>    - **in_ncrs**  [@a 2]<br/> 
+!>       number of point(s) with coarse value save at boundaries
+!>
+!>    - **ln_oneseg** [@a .TRUE.]<br/>
+!>       logical to use only one segment for each boundary or not
+!>
+!> @subsection subout namout 
+!>    the output sub-namelist parameter is :
+!>
+!>    - **cn_fileout** [@a bathy_merged.nc]<br/>
+!>       output bathymetry filename
+!>
+!> <hr>
+!> @author J.Paul
+!>
+!> @date November, 2013 - Initial Version
+!> @date Sepember, 2014 
+!> - add header for user
+!> @date July, 2015 
+!> - extrapolate all land points
+!> - add attributes with boundary string character (as in namelist)
+!> @date September, 2015
+!> - manage useless (dummy) variable, attributes, and dimension
+!> @date October, 2016
+!> - allow to choose the number of boundary point with coarse grid value.
+!> - dimension to be used select from configuration file
+!> @date January, 2019
+!> - add url path to global attributes of output file(s)
+!> @date February, 2019
+!> - rename sub namelist namcrs to namsrc
+!> - rename sub namelist namfin to namtgt
+!> @date May, 2019
+!> - create and clean file structure to avoid memory leaks
+!> @date Ocober, 2019
+!> - add help and version optional arguments
+!>
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+PROGRAM merge_bathy
+
+   USE netcdf                          ! nf90 library
+   USE global                          ! global variable
+   USE phycst                          ! physical constant
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+   USE date                            ! date manager
+   USE att                             ! attribute manager
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+   USE file                            ! file manager
+   USE boundary                        ! boundary manager
+   USE iom                             ! I/O manager
+   USE grid                            ! grid manager
+   USE extrap                          ! extrapolation manager
+   USE interp                          ! interpolation manager
+   USE filter                          ! filter manager
+   USE mpp                             ! MPP manager
+   USE dom                             ! domain manager
+   USE iom_mpp                         ! MPP I/O manager
+   USE iom_dom                         ! DOM I/O manager
+
+   IMPLICIT NONE
+
+   ! parameters
+   CHARACTER(LEN=lc), PARAMETER  :: cp_myname = "merge_bathy"
+
+   ! local variable
+   CHARACTER(LEN=lc)                                  :: cl_arg
+   CHARACTER(LEN=lc)                                  :: cl_namelist
+   CHARACTER(LEN=lc)                                  :: cl_date
+   CHARACTER(LEN=lc)                                  :: cl_tmp
+   CHARACTER(LEN=lc)                                  :: cl_url
+   CHARACTER(LEN=lc)                                  :: cl_errormsg
+
+   INTEGER(i4)                                        :: il_narg
+   INTEGER(i4)                                        :: il_status
+   INTEGER(i4)                                        :: il_fileid
+   INTEGER(i4)                                        :: il_attind
+   INTEGER(i4)                                        :: il_imin0
+   INTEGER(i4)                                        :: il_imax0
+   INTEGER(i4)                                        :: il_jmin0
+   INTEGER(i4)                                        :: il_jmax0
+   INTEGER(i4)                                        :: il_shift
+   INTEGER(i4)      , DIMENSION(ip_maxdim)            :: il_rho
+   INTEGER(i4)      , DIMENSION(2,2)                  :: il_ind
+
+   LOGICAL                                            :: ll_exist
+
+   REAL(dp)                                           :: dl_fill
+   REAL(dp)         , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_refined
+   REAL(dp)         , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_weight
+
+   TYPE(TMPP)                                         :: tl_bathy0
+   TYPE(TMPP)                                         :: tl_bathy1
+
+   TYPE(TFILE)                                        :: tl_file
+   TYPE(TFILE)                                        :: tl_fileout
+   
+   TYPE(TATT)                                         :: tl_att
+   
+   TYPE(TVAR)                                         :: tl_var
+   TYPE(TVAR)                                         :: tl_lon
+   TYPE(TVAR)                                         :: tl_lat
+   
+   TYPE(TDIM)       , DIMENSION(ip_maxdim)            :: tl_dim
+   
+   TYPE(TBDY)       , DIMENSION(ip_ncard)             :: tl_bdy
+
+   ! loop indices
+   INTEGER(i4) :: ji
+   INTEGER(i4) :: jk
+   INTEGER(i4) :: jl
+
+   ! namelist variable
+   ! namlog
+   CHARACTER(LEN=lc)                       :: cn_logfile = 'merge_bathy.log' 
+   CHARACTER(LEN=lc)                       :: cn_verbosity = 'warning' 
+   INTEGER(i4)                             :: in_maxerror = 5
+
+   ! namcfg
+   CHARACTER(LEN=lc)                       :: cn_varcfg = './cfg/variable.cfg' 
+   CHARACTER(LEN=lc)                       :: cn_dimcfg = './cfg/dimension.cfg'
+   CHARACTER(LEN=lc)                       :: cn_dumcfg = './cfg/dummy.cfg'
+
+   ! namsrc
+   CHARACTER(LEN=lc)                       :: cn_bathy0 = '' 
+   INTEGER(i4)                             :: in_perio0 = -1
+
+   ! namtgt
+   CHARACTER(LEN=lc)                       :: cn_bathy1 = '' 
+   INTEGER(i4)                             :: in_perio1 = -1
+
+!   ! namvar
+!   CHARACTER(LEN=lc), DIMENSION(ip_maxvar) :: cn_varinfo = ''
+
+   ! namnst
+   INTEGER(i4)                             :: in_rhoi  = 1
+   INTEGER(i4)                             :: in_rhoj  = 1
+
+   ! nambdy
+   LOGICAL                                 :: ln_north = .TRUE.
+   LOGICAL                                 :: ln_south = .TRUE.
+   LOGICAL                                 :: ln_east  = .TRUE.
+   LOGICAL                                 :: ln_west  = .TRUE.
+   CHARACTER(LEN=lc)                       :: cn_north = ''
+   CHARACTER(LEN=lc)                       :: cn_south = ''
+   CHARACTER(LEN=lc)                       :: cn_east  = ''
+   CHARACTER(LEN=lc)                       :: cn_west  = ''
+   INTEGER(i4)                             :: in_ncrs  = 2
+   LOGICAL                                 :: ln_oneseg= .TRUE.
+
+   ! namout
+   CHARACTER(LEN=lc)                       :: cn_fileout = 'bathy_merged.nc' 
+   !-------------------------------------------------------------------
+
+   NAMELIST /namlog/ &   !< logger namelist
+   &  cn_logfile,    &   !< log file
+   &  cn_verbosity,  &   !< log verbosity
+   &  in_maxerror        !< logger maximum error
+
+   NAMELIST /namcfg/ &   !< configuration namelist
+   &  cn_varcfg, &       !< variable configuration file
+   &  cn_dimcfg, &       !< dimension configuration file
+   &  cn_dumcfg          !< dummy configuration file
+
+   NAMELIST /namsrc/ &   !< source/coarse grid namelist
+   &  cn_bathy0,  &      !< bathymetry file
+   &  in_perio0          !< periodicity index
+   
+   NAMELIST /namtgt/ &   !< target/fine grid namelist
+   &  cn_bathy1,     &   !< bathymetry file
+   &  in_perio1          !< periodicity index
+ 
+!   NAMELIST /namvar/ &  !< variable namelist
+!   &  cn_varinfo        !< list of variable and interpolation 
+!                        !< method to be used. 
+!                        !< (ex: 'votemper|linear','vosaline|cubic' ) 
+   
+   NAMELIST /namnst/ &  !< nesting namelist
+   &  in_rhoi,    &     !< refinement factor in i-direction
+   &  in_rhoj           !< refinement factor in j-direction
+
+   NAMELIST /nambdy/ &  !< boundary namelist
+   &  ln_north,   &     !< use north boundary
+   &  ln_south,   &     !< use south boundary
+   &  ln_east ,   &     !< use east  boundary
+   &  ln_west ,   &     !< use west  boundary
+   &  cn_north,   &     !< north boundary indices on fine grid
+   &  cn_south,   &     !< south boundary indices on fine grid
+   &  cn_east ,   &     !< east  boundary indices on fine grid
+   &  cn_west ,   &     !< west  boundary indices on fine grid
+   &  in_ncrs,    &     !< number of point with coarse value save at boundaries 
+   &  ln_oneseg         !< use only one segment for each boundary or not
+
+   NAMELIST /namout/ &  !< output namelist
+   &  cn_fileout        !< fine grid merged bathymetry file   
+   !-------------------------------------------------------------------
+
+   !
+   ! Initialisation
+   ! --------------
+   !
+   il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec
+
+   ! Traitement des arguments fournis
+   ! --------------------------------
+   IF( il_narg /= 1 )THEN
+      WRITE(cl_errormsg,*) ' ERROR : one argument is needed '
+      CALL fct_help(cp_myname,cl_errormsg) 
+      CALL EXIT(1)
+   ELSE
+
+      CALL GET_COMMAND_ARGUMENT(1,cl_arg) !f03 intrinsec
+      SELECT CASE (cl_arg)
+         CASE ('-v', '--version')
+
+            CALL fct_version(cp_myname)
+            CALL EXIT(0)
+
+         CASE ('-h', '--help')
+
+            CALL fct_help(cp_myname)
+            CALL EXIT(0)
+
+         CASE DEFAULT
+
+            cl_namelist=cl_arg
+
+            ! read namelist
+            INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist)
+            IF( ll_exist )THEN
+
+               il_fileid=fct_getunit()
+
+               OPEN( il_fileid, FILE=TRIM(cl_namelist),  &
+               &                FORM='FORMATTED',        &
+               &                ACCESS='SEQUENTIAL',     &
+               &                STATUS='OLD',            &
+               &                ACTION='READ',           &
+               &                IOSTAT=il_status)
+               CALL fct_err(il_status)
+               IF( il_status /= 0 )THEN
+                  WRITE(cl_errormsg,*) " ERROR : error opening "//TRIM(cl_namelist)
+                  CALL fct_help(cp_myname,cl_errormsg) 
+                  CALL EXIT(1)
+               ENDIF
+
+               READ( il_fileid, NML = namlog )
+               ! define log file
+               CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror)
+               CALL logger_header()
+
+               READ( il_fileid, NML = namcfg )
+               ! get variable extra information
+               CALL var_def_extra(TRIM(cn_varcfg))
+
+               ! get dimension allowed
+               CALL dim_def_extra(TRIM(cn_dimcfg))
+
+               ! get dummy variable
+               CALL var_get_dummy(TRIM(cn_dumcfg))
+               ! get dummy dimension
+               CALL dim_get_dummy(TRIM(cn_dumcfg))
+               ! get dummy attribute
+               CALL att_get_dummy(TRIM(cn_dumcfg))
+
+               READ( il_fileid, NML = namsrc )
+               READ( il_fileid, NML = namtgt )
+!               READ( il_fileid, NML = namvar )
+!               ! add user change in extra information
+!               CALL var_chg_extra(cn_varinfo)
+
+               READ( il_fileid, NML = namnst )
+               READ( il_fileid, NML = nambdy )
+
+               READ( il_fileid, NML = namout )
+
+               CLOSE( il_fileid, IOSTAT=il_status )
+               CALL fct_err(il_status)
+               IF( il_status /= 0 )THEN
+                  CALL logger_error("MERGE BATHY: ERROR closing "//TRIM(cl_namelist))
+               ENDIF
+
+            ELSE
+
+               WRITE(cl_errormsg,*) " ERROR : can't find "//TRIM(cl_namelist)
+               CALL fct_help(cp_myname,cl_errormsg) 
+               CALL EXIT(1)
+
+            ENDIF
+
+      END SELECT
+   ENDIF
+
+   ! open files
+   IF( TRIM(cn_bathy0) /= '' )THEN
+      tl_file=file_init(TRIM(cn_bathy0))
+      tl_bathy0=mpp_init( tl_file, id_perio=in_perio0)
+      ! clean
+      CALL file_clean(tl_file)
+      CALL grid_get_info(tl_bathy0)
+   ELSE
+      CALL logger_fatal("MERGE BATHY: can not find coarse grid bathymetry "//&
+      &  "file. check namelist")
+   ENDIF
+
+   IF( TRIM(cn_bathy1) /= '' )THEN
+      tl_file=file_init(TRIM(cn_bathy1))
+      tl_bathy1=mpp_init( tl_file, id_perio=in_perio1)
+      ! clean
+      CALL file_clean(tl_file)
+      CALL grid_get_info(tl_bathy1)
+   ELSE
+      CALL logger_fatal("MERGE BATHY: can not find fine grid bathymetry "//&
+      &  "file. check namelist")
+   ENDIF
+
+   ! check
+   ! check output file do not already exist
+   INQUIRE(FILE=TRIM(cn_fileout), EXIST=ll_exist)
+   IF( ll_exist )THEN
+      CALL logger_fatal("CREATE BATHY: output file "//TRIM(cn_fileout)//&
+      &  " already exist.")
+   ENDIF
+
+   ! check namelist
+   ! check refinament factor
+   il_rho(:)=1
+   IF( in_rhoi < 1 .OR. in_rhoj < 1 )THEN
+      CALL logger_error("MERGE BATHY: invalid refinement factor."//&
+      &  " check namelist "//TRIM(cl_namelist))
+   ELSE
+      il_rho(jp_I)=in_rhoi
+      il_rho(jp_J)=in_rhoj
+   ENDIF
+
+   ! check domain indices
+   ! compute coarse grid indices around fine grid
+   il_ind(:,:)=grid_get_coarse_index(tl_bathy0, tl_bathy1, &
+   &                                 id_rho=il_rho(:) )
+
+   il_imin0=il_ind(1,1) ; il_imax0=il_ind(1,2)
+   il_jmin0=il_ind(2,1) ; il_jmax0=il_ind(2,2)
+
+   ! check domain validity
+   CALL grid_check_dom(tl_bathy0, il_imin0, il_imax0, il_jmin0, il_jmax0)
+
+   ! check coincidence between coarse and fine grid
+   CALL grid_check_coincidence( tl_bathy0, tl_bathy1, &
+   &                            il_imin0, il_imax0, &
+   &                            il_jmin0, il_jmax0, &
+   &                            il_rho(:) )
+
+   ! open mpp files
+   CALL iom_mpp_open(tl_bathy1)
+
+   ! read or compute boundary
+   tl_var=iom_mpp_read_var(tl_bathy1,'Bathymetry')
+
+   ! close mpp files
+   CALL iom_mpp_close(tl_bathy1)
+
+   tl_bdy(:)=boundary_init(tl_var, ln_north, ln_south, ln_east, ln_west, &
+   &                               cn_north, cn_south, cn_east, cn_west, &
+   &                               ln_oneseg ) 
+
+   ! get boundary on coarse grid
+   ! define refined bathymetry array (for coarse grid)
+   dl_fill=tl_var%d_fill
+   ALLOCATE( dl_refined(tl_var%t_dim(1)%i_len, &
+   &                    tl_var%t_dim(2)%i_len, &
+   &                    tl_var%t_dim(3)%i_len, &
+   &                    tl_var%t_dim(4)%i_len) )
+
+   dl_refined(:,:,:,:)=dl_fill
+
+   ! define weight array
+   ALLOCATE( dl_weight(tl_var%t_dim(1)%i_len, &
+   &                   tl_var%t_dim(2)%i_len, &
+   &                   1,1) )
+
+   dl_weight(:,:,:,:)=dl_fill 
+
+   ! compute coarse grid refined bathymetry on boundary.
+   DO jk=1,ip_ncard
+      CALL merge_bathy_get_boundary(tl_bathy0, tl_bathy1, tl_bdy(jk), &
+      &                             il_rho(:), in_ncrs,                      &
+      &                             dl_refined(:,:,:,:), dl_weight(:,:,:,:), &
+      &                             dl_fill)
+
+   ENDDO
+
+   ! merge bathy on boundary
+   DO jl=1,tl_var%t_dim(4)%i_len
+      DO jk=1,tl_var%t_dim(3)%i_len
+         WHERE(    dl_refined(:,:,jk,jl) /= dl_fill .AND. &
+         &      tl_var%d_value(:,:,jk,jl)/= tl_var%d_fill )
+            tl_var%d_value(:,:,jk,jl)=  &
+            &           dl_weight(:,:,1,1) *    dl_refined(:,:,jk,jl) + &
+            &        (1-dl_weight(:,:,1,1))*tl_var%d_value(:,:,jk,jl)
+         ELSE WHERE( dl_refined(:,:,jk,jl)== dl_fill .AND. &
+         &           dl_weight(:,:,1,1)  /= dl_fill )
+         ! to keep coarse grid mask on boundary
+            tl_var%d_value(:,:,jk,jl)=dl_fill
+         END WHERE
+      ENDDO
+   ENDDO
+
+   DEALLOCATE(dl_refined)
+
+   ! create file
+   tl_fileout=file_init(TRIM(cn_fileout),id_perio=in_perio1)
+
+   ! add dimension
+   tl_dim(:)=dim_copy(tl_var%t_dim(:))
+
+   DO ji=1,ip_maxdim
+      IF( tl_dim(ji)%l_use ) CALL file_add_dim(tl_fileout, tl_dim(ji))
+   ENDDO
+
+   ! add variables
+   IF( ALL( tl_dim(1:2)%l_use ) )THEN
+      ! open mpp files
+      CALL iom_mpp_open(tl_bathy1)
+
+      ! add longitude
+      tl_lon=iom_mpp_read_var(tl_bathy1,'longitude')
+      CALL file_add_var(tl_fileout, tl_lon)
+      CALL var_clean(tl_lon)
+
+      ! add latitude
+      tl_lat=iom_mpp_read_var(tl_bathy1,'latitude')
+      CALL file_add_var(tl_fileout, tl_lat)
+      CALL var_clean(tl_lat)
+
+      ! close mpp files
+      CALL iom_mpp_close(tl_bathy1)      
+   ENDIF
+
+   CALL file_add_var(tl_fileout, tl_var)
+   CALL var_clean(tl_var)
+
+   ! only 2 first dimension to be used
+   tl_dim(:)=dim_copy(tl_fileout%t_dim(:))
+   tl_dim(3:4)%l_use=.FALSE.
+   tl_var=var_init('weight',dl_weight(:,:,:,:),td_dim=tl_dim(:),dd_fill=dl_fill)
+   CALL file_add_var(tl_fileout, tl_var)
+   CALL var_clean(tl_var)
+
+   ! add some attribute
+   tl_att=att_init("Created_by","SIREN merge_bathy")
+   CALL file_add_att(tl_fileout, tl_att)
+
+   !add source url
+   cl_url=fct_split(fct_split(cp_url,2,'$'),2,'URL:')
+   tl_att=att_init("SIREN_url",cl_url)
+   CALL file_add_att(tl_fileout, tl_att)
+
+   ! add date of creation
+   cl_date=date_print(date_now())
+   tl_att=att_init("Creation_date",cl_date)
+   CALL file_add_att(tl_fileout, tl_att)
+
+   tl_att=att_init("coarse_grid_source_file",TRIM(fct_basename(tl_bathy0%c_name)))
+   CALL file_add_att(tl_fileout, tl_att)
+
+   tl_att=att_init("fine_grid_source_file",TRIM(fct_basename(tl_bathy1%c_name)))
+   CALL file_add_att(tl_fileout, tl_att)
+
+   ! add attribute periodicity
+   il_attind=0
+   IF( ASSOCIATED(tl_fileout%t_att) )THEN
+      il_attind=att_get_index(tl_fileout%t_att(:),'periodicity')
+   ENDIF
+   IF( tl_bathy1%i_perio >= 0 .AND. il_attind == 0 )THEN
+      tl_att=att_init('periodicity',tl_bathy1%i_perio)
+      CALL file_add_att(tl_fileout,tl_att)
+   ENDIF
+
+   il_attind=0
+   IF( ASSOCIATED(tl_fileout%t_att) )THEN
+      il_attind=att_get_index(tl_fileout%t_att(:),'ew_overlap')
+   ENDIF
+   IF( tl_bathy1%i_ew >= 0 .AND. il_attind == 0 )THEN
+      tl_att=att_init('ew_overlap',tl_bathy1%i_ew)
+      CALL file_add_att(tl_fileout,tl_att)
+   ENDIF
+
+
+   IF( tl_bdy(jp_north)%l_use )THEN
+      ! add shift on north boundary
+      ! boundary compute on T point but express on U or V point
+      il_shift=1
+
+      cl_tmp=TRIM(fct_str(tl_bdy(jp_north)%t_seg(1)%i_index-il_shift))//','//&
+         &   TRIM(fct_str(tl_bdy(jp_north)%t_seg(1)%i_first))//':'//&
+         &   TRIM(fct_str(tl_bdy(jp_north)%t_seg(1)%i_last))//&
+         &   '('//TRIM(fct_str(tl_bdy(jp_north)%t_seg(1)%i_width))//')'
+      DO ji=2,tl_bdy(jp_north)%i_nseg
+         cl_tmp=TRIM(cl_tmp)//'|'//&
+            &   TRIM(fct_str(tl_bdy(jp_north)%t_seg(ji)%i_index-il_shift))//','//&
+            &   TRIM(fct_str(tl_bdy(jp_north)%t_seg(ji)%i_first))//':'//&
+            &   TRIM(fct_str(tl_bdy(jp_north)%t_seg(ji)%i_last))
+      ENDDO
+      tl_att=att_init("bdy_north",TRIM(cl_tmp))
+      CALL file_add_att(tl_fileout, tl_att)
+   ENDIF
+
+   IF( tl_bdy(jp_south)%l_use )THEN
+      
+      cl_tmp=TRIM(fct_str(tl_bdy(jp_south)%t_seg(1)%i_index))//','//&
+         &   TRIM(fct_str(tl_bdy(jp_south)%t_seg(1)%i_first))//':'//&
+         &   TRIM(fct_str(tl_bdy(jp_south)%t_seg(1)%i_last))//&
+         &   '('//TRIM(fct_str(tl_bdy(jp_south)%t_seg(1)%i_width))//')'
+      DO ji=2,tl_bdy(jp_south)%i_nseg
+         cl_tmp=TRIM(cl_tmp)//'|'//&
+            &   TRIM(fct_str(tl_bdy(jp_south)%t_seg(ji)%i_index))//','//&
+            &   TRIM(fct_str(tl_bdy(jp_south)%t_seg(ji)%i_first))//':'//&
+            &   TRIM(fct_str(tl_bdy(jp_south)%t_seg(ji)%i_last))
+      ENDDO
+
+      tl_att=att_init("bdy_south",TRIM(cl_tmp))
+      CALL file_add_att(tl_fileout, tl_att)
+   ENDIF
+
+   IF( tl_bdy(jp_east)%l_use )THEN
+      ! add shift on east boundary
+      ! boundary compute on T point but express on U or V point
+      il_shift=1
+
+      cl_tmp=TRIM(fct_str(tl_bdy(jp_east)%t_seg(1)%i_index-il_shift))//','//&
+         &   TRIM(fct_str(tl_bdy(jp_east)%t_seg(1)%i_first))//':'//&
+         &   TRIM(fct_str(tl_bdy(jp_east)%t_seg(1)%i_last))//&
+         &   '('//TRIM(fct_str(tl_bdy(jp_east)%t_seg(1)%i_width))//')'
+      DO ji=2,tl_bdy(jp_east)%i_nseg
+         cl_tmp=TRIM(cl_tmp)//'|'//&
+            &   TRIM(fct_str(tl_bdy(jp_east)%t_seg(ji)%i_index-il_shift))//','//&
+            &   TRIM(fct_str(tl_bdy(jp_east)%t_seg(ji)%i_first))//':'//&
+            &   TRIM(fct_str(tl_bdy(jp_east)%t_seg(ji)%i_last))
+      ENDDO
+
+      tl_att=att_init("bdy_east",TRIM(cl_tmp))
+      CALL file_add_att(tl_fileout, tl_att)
+   ENDIF
+
+   IF( tl_bdy(jp_west)%l_use )THEN
+
+      cl_tmp=TRIM(fct_str(tl_bdy(jp_west)%t_seg(1)%i_index))//','//&
+         &   TRIM(fct_str(tl_bdy(jp_west)%t_seg(1)%i_first))//':'//&
+         &   TRIM(fct_str(tl_bdy(jp_west)%t_seg(1)%i_last))//&
+         &   '('//TRIM(fct_str(tl_bdy(jp_west)%t_seg(1)%i_width))//')'
+      DO ji=2,tl_bdy(jp_west)%i_nseg
+         cl_tmp=TRIM(cl_tmp)//'|'//&
+            &   TRIM(fct_str(tl_bdy(jp_west)%t_seg(ji)%i_index))//','//&
+            &   TRIM(fct_str(tl_bdy(jp_west)%t_seg(ji)%i_first))//':'//&
+            &   TRIM(fct_str(tl_bdy(jp_west)%t_seg(ji)%i_last))
+      ENDDO
+
+      tl_att=att_init("bdy_west",TRIM(cl_tmp))
+      CALL file_add_att(tl_fileout, tl_att)
+   ENDIF
+
+   ! create file
+   CALL iom_create(tl_fileout)
+
+   ! write file
+   CALL iom_write_file(tl_fileout)
+
+   ! close file
+   CALL iom_close(tl_fileout)
+
+   ! clean
+   CALL att_clean(tl_att)
+   CALL file_clean(tl_fileout)
+   CALL mpp_clean(tl_bathy1)
+   CALL mpp_clean(tl_bathy0)
+   DEALLOCATE(dl_weight)
+   CALL boundary_clean(tl_bdy(:))
+   CALL var_clean_extra()
+
+   ! close log file
+   CALL logger_footer()
+   CALL logger_close()
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE merge_bathy_get_boundary(td_bathy0, td_bathy1, td_bdy, &
+         &                             id_rho, id_ncrs,              &
+         &                             dd_refined, dd_weight, dd_fill)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine compute refined bathymetry on boundary from coarse grid.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_bathy0       coarse grid bathymetry file structure 
+   !> @param[in] td_bathy1       fine grid bathymetry file structure
+   !> @param[in] td_bdy          boundary structure
+   !> @param[in] id_rho          array of refinement factor
+   !> @param[in] id_ncrs         number of point with coarse value save at boundaries
+   !> @param[inout] dd_refined   array of refined bathymetry 
+   !> @param[inout] dd_weight    array of weight
+   !> @param[in] dd_fill         fillValue
+   !>
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP)                     , INTENT(IN   ) :: td_bathy0
+      TYPE(TMPP)                     , INTENT(IN   ) :: td_bathy1
+      TYPE(TBDY)                     , INTENT(IN   ) :: td_bdy
+      INTEGER(i4), DIMENSION(:)      , INTENT(IN   ) :: id_rho
+      INTEGER(i4)                    , INTENT(IN   ) :: id_ncrs
+      REAL(dp)   , DIMENSION(:,:,:,:), INTENT(INOUT) :: dd_refined
+      REAL(dp)   , DIMENSION(:,:,:,:), INTENT(INOUT) :: dd_weight
+      REAL(dp)                       , INTENT(IN   ) :: dd_fill  
+
+      ! local variable
+      INTEGER(i4) :: il_imin1
+      INTEGER(i4) :: il_imax1
+      INTEGER(i4) :: il_jmin1
+      INTEGER(i4) :: il_jmax1
+      
+      INTEGER(i4) :: il_imin0
+      INTEGER(i4) :: il_imax0
+      INTEGER(i4) :: il_jmin0
+      INTEGER(i4) :: il_jmax0
+
+      INTEGER(i4) :: il_width
+
+      INTEGER(i4), DIMENSION(2,2)         :: il_offset
+      INTEGER(i4), DIMENSION(2,2)         :: il_ind
+
+      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_tmp1d
+      REAL(dp)   , DIMENSION(:,:)    , ALLOCATABLE :: dl_tmp2d
+      REAL(dp)   , DIMENSION(:,:)    , ALLOCATABLE :: dl_wseg
+
+      TYPE(TVAR) :: tl_var0
+      TYPE(TVAR) :: tl_lon1
+      TYPE(TVAR) :: tl_lat1
+
+      TYPE(TMPP)  :: tl_bathy1
+      TYPE(TMPP)  :: tl_bathy0
+
+      TYPE(TDOM)  :: tl_dom1
+      TYPE(TDOM)  :: tl_dom0
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      IF( td_bdy%l_use )THEN
+         DO jl=1,td_bdy%i_nseg
+            ! get boundary definition
+            SELECT CASE(TRIM(td_bdy%c_card))
+            CASE('north')
+
+               il_imin1=td_bdy%t_seg(jl)%i_first
+               il_imax1=td_bdy%t_seg(jl)%i_last 
+               il_jmin1=td_bdy%t_seg(jl)%i_index-(td_bdy%t_seg(jl)%i_width-1)
+               il_jmax1=td_bdy%t_seg(jl)%i_index
+
+               ! do not used grid point to compute 
+               ! boundaries indices (cf create_boundary)
+               ! as Bathymetry always on T point
+
+            CASE('south')
+
+               il_imin1=td_bdy%t_seg(jl)%i_first
+               il_imax1=td_bdy%t_seg(jl)%i_last 
+               il_jmin1=td_bdy%t_seg(jl)%i_index
+               il_jmax1=td_bdy%t_seg(jl)%i_index+(td_bdy%t_seg(jl)%i_width-1)
+
+            CASE('east')
+
+               il_imin1=td_bdy%t_seg(jl)%i_index-(td_bdy%t_seg(jl)%i_width-1)
+               il_imax1=td_bdy%t_seg(jl)%i_index
+               il_jmin1=td_bdy%t_seg(jl)%i_first
+               il_jmax1=td_bdy%t_seg(jl)%i_last 
+
+               ! do not used grid point to compute 
+               ! boundaries indices (cf create_boundary)
+               ! as Bathymetry always on T point
+
+            CASE('west')
+
+               il_imin1=td_bdy%t_seg(jl)%i_index
+               il_imax1=td_bdy%t_seg(jl)%i_index+(td_bdy%t_seg(jl)%i_width-1)
+               il_jmin1=td_bdy%t_seg(jl)%i_first
+               il_jmax1=td_bdy%t_seg(jl)%i_last 
+
+            END SELECT
+
+            ! -read fine grid domain
+            tl_bathy1=mpp_copy(td_bathy1)
+
+            ! compute domain
+            tl_dom1=dom_init( tl_bathy1,         &
+            &                 il_imin1, il_imax1,&
+            &                 il_jmin1, il_jmax1,&
+            &                 TRIM(td_bdy%c_card))
+
+            ! add extra band to fine grid domain (if possible)
+            ! to avoid dimension of one and so be able to compute offset
+            CALL dom_add_extra(tl_dom1, id_rho(jp_I), id_rho(jp_J))
+
+            ! open mpp files over domain
+            CALL iom_dom_open(tl_bathy1, tl_dom1)
+
+            ! read variable value on domain
+            tl_lon1=iom_dom_read_var(tl_bathy1,'longitude',tl_dom1)
+            tl_lat1=iom_dom_read_var(tl_bathy1,'latitude' ,tl_dom1)
+
+            ! close mpp files
+            CALL iom_dom_close(tl_bathy1)
+
+            ! clean structure
+            CALL mpp_clean(tl_bathy1)
+
+            ! get coarse grid indices
+            il_ind(:,:)=grid_get_coarse_index(td_bathy0, tl_lon1, tl_lat1, &
+            &                                 id_rho=id_rho(:))
+
+            il_imin0=il_ind(1,1)
+            il_imax0=il_ind(1,2)
+
+            il_jmin0=il_ind(2,1)
+            il_jmax0=il_ind(2,2)
+
+            ! read coarse grid bathymetry on domain
+            tl_bathy0=mpp_copy(td_bathy0)
+
+            ! compute domain
+            tl_dom0=dom_init( tl_bathy0,         &
+            &                 il_imin0, il_imax0,&
+            &                 il_jmin0, il_jmax0 )
+
+            il_offset(:,:)= grid_get_fine_offset(tl_bathy0,         &
+            &                                    il_imin0, il_jmin0,&
+            &                                    il_imax0, il_jmax0,&
+            &                                    tl_lon1%d_value(:,:,1,1), &
+            &                                    tl_lat1%d_value(:,:,1,1), &
+            &                                    id_rho=id_rho(:))
+
+            ! clean
+            CALL var_clean(tl_lon1)
+            CALL var_clean(tl_lat1)
+
+            ! add extra band (if possible) to compute interpolation
+            CALL dom_add_extra(tl_dom0)
+
+            ! open mpp files over domain
+            CALL iom_dom_open(tl_bathy0, tl_dom0)
+
+            ! read variable value on domain
+            tl_var0=iom_dom_read_var(tl_bathy0,'Bathymetry',tl_dom0)
+
+            ! force to use nearest interpolation
+            tl_var0%c_interp(1)='nearest'
+
+            ! close mpp files
+            CALL iom_dom_close(tl_bathy0)
+
+            ! clean structure
+            CALL mpp_clean(tl_bathy0)
+
+            ! interpolate variable
+            CALL merge_bathy_interp( tl_var0,         &
+            &                        id_rho(:),       &
+            &                        il_offset(:,:) )
+
+            ! remove extraband added to domain
+            CALL dom_del_extra( tl_var0, tl_dom0, id_rho(:) )
+
+            ! remove extraband added to domain
+            CALL dom_clean_extra( tl_dom0 )
+
+            ! remove extraband added to fine grid domain
+            CALL dom_del_extra( tl_var0, tl_dom1 )
+
+            ! remove extraband added to fine grid domain
+            CALL dom_clean_extra( tl_dom1 )
+
+            ! fill refined array
+            dd_refined( il_imin1:il_imax1, &
+            &           il_jmin1:il_jmax1, &
+            &           :,: )= tl_var0%d_value(:,:,:,:)
+
+            ! clean
+            CALL var_clean(tl_var0)
+
+            ! compute weight function
+            ALLOCATE( dl_tmp1d(td_bdy%t_seg(jl)%i_width) )
+
+            SELECT CASE(TRIM(td_bdy%c_card))
+            CASE('north')
+
+
+               ! save n coarse point
+               il_width=td_bdy%t_seg(jl)%i_width-id_ncrs
+               ! compute "distance"
+               dl_tmp1d(:)=(/(ji,ji=il_width,1,-1),(0,ji=1,id_ncrs)/)
+
+               ! compute weight on segment
+               dl_tmp1d(:)= 0.5 + 0.5*COS( (dp_pi*dl_tmp1d(:)) / &
+               &                           (il_width) )
+
+               ALLOCATE( dl_wseg(tl_dom1%t_dim(1)%i_len, &
+               &                 tl_dom1%t_dim(2)%i_len) )
+               dl_wseg(:,:)=dd_fill
+               dl_wseg(:,:)=SPREAD( dl_tmp1d(:), &
+               &                    DIM=1,       &
+               &                    NCOPIES=tl_dom1%t_dim(1)%i_len )
+
+            CASE('south')
+
+               ! save n coarse point
+               il_width=td_bdy%t_seg(jl)%i_width-id_ncrs
+               ! compute "distance"
+               dl_tmp1d(:)=(/(0,ji=1,id_ncrs),(ji,ji=1,il_width)/)
+
+               ! compute weight on segment
+               dl_tmp1d(:)= 0.5 + 0.5*COS( (dp_pi*dl_tmp1d(:)) / &
+               &                           (il_width) )
+
+               ALLOCATE( dl_wseg(tl_dom1%t_dim(1)%i_len, &
+               &                 tl_dom1%t_dim(2)%i_len) )
+               dl_wseg(:,:)=dd_fill
+               dl_wseg(:,:)=SPREAD( dl_tmp1d(:), &
+               &                    DIM=1,       &
+               &                    NCOPIES=tl_dom1%t_dim(1)%i_len )
+
+            CASE('east')
+
+               ! save n coarse point
+               il_width=td_bdy%t_seg(jl)%i_width-id_ncrs
+               ! compute "distance"
+               dl_tmp1d(:)=(/(ji,ji=il_width,1,-1),(0,ji=1,id_ncrs)/)
+
+               ! compute weight on segment
+               dl_tmp1d(:)= 0.5 + 0.5*COS( (dp_pi*dl_tmp1d(:)) / &
+               &                           (il_width) )
+
+               ALLOCATE( dl_wseg(tl_dom1%t_dim(1)%i_len, &
+               &                 tl_dom1%t_dim(2)%i_len) )
+               dl_wseg(:,:)=dd_fill
+               dl_wseg(:,:)=SPREAD( dl_tmp1d(:), &
+               &                    DIM=2,       &
+               &                    NCOPIES=tl_dom1%t_dim(2)%i_len )
+
+            CASE('west')
+
+               ! save n coarse point
+               il_width=td_bdy%t_seg(jl)%i_width-id_ncrs
+               ! compute "distance"
+               dl_tmp1d(:)=(/(0,ji=1,id_ncrs),(ji,ji=1,il_width)/)
+
+               ! compute weight on segment
+               dl_tmp1d(:)= 0.5 + 0.5*COS( (dp_pi*dl_tmp1d(:)) / &
+               &                           (il_width) )
+
+               ALLOCATE( dl_wseg(tl_dom1%t_dim(1)%i_len, &
+               &                 tl_dom1%t_dim(2)%i_len) )
+               dl_wseg(:,:)=dd_fill
+               dl_wseg(:,:)=SPREAD( dl_tmp1d(:), &
+               &                    DIM=2,       &
+               &                    NCOPIES=tl_dom1%t_dim(2)%i_len )
+
+            END SELECT
+
+            DEALLOCATE( dl_tmp1d )
+
+            ! fill weight array
+            ALLOCATE( dl_tmp2d( tl_dom1%t_dim(1)%i_len, &
+            &                   tl_dom1%t_dim(2)%i_len) )
+
+            dl_tmp2d(:,:)=dd_weight( il_imin1:il_imax1, &
+            &                        il_jmin1:il_jmax1, &
+            &                        1,1 )
+
+            WHERE( dl_tmp2d(:,:) == dd_fill )
+               dl_tmp2d(:,:)= dl_wseg(:,:)
+            ELSE WHERE
+               dl_tmp2d(:,:)= MAX( dl_tmp2d(:,:), dl_wseg(:,:) )
+            END WHERE
+
+            dd_weight( il_imin1:il_imax1, &
+            &          il_jmin1:il_jmax1, &
+            &          1,1 ) = dl_tmp2d(:,:)
+
+            DEALLOCATE( dl_wseg )
+            DEALLOCATE( dl_tmp2d )
+
+         ENDDO
+      ENDIF
+   END SUBROUTINE merge_bathy_get_boundary
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE merge_bathy_interp(td_var, id_rho, id_offset, id_iext, id_jext)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine interpolate variable.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure
+   !> @param[in] id_rho    array of refinment factor
+   !> @param[in] id_offset array of offset between fine and coarse grid
+   !> @param[in] id_iext   i-direction size of extra bands (default=im_minext) 
+   !> @param[in] id_jext   j-direction size of extra bands (default=im_minext)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) ,                 INTENT(INOUT) :: td_var
+      INTEGER(i4), DIMENSION(:)  , INTENT(IN   ) :: id_rho
+      INTEGER(i4), DIMENSION(:,:), INTENT(IN   ) :: id_offset
+      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_iext
+      INTEGER(i4),                 INTENT(IN   ), OPTIONAL :: id_jext
+
+      ! local variable
+      TYPE(TVAR)  :: tl_mask
+
+      INTEGER(i1), DIMENSION(:,:,:,:), ALLOCATABLE :: bl_mask
+
+      INTEGER(i4) :: il_iext
+      INTEGER(i4) :: il_jext
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      !WARNING: two extrabands are required for cubic interpolation
+      il_iext=3
+      IF( PRESENT(id_iext) ) il_iext=id_iext
+
+      il_jext=3
+      IF( PRESENT(id_jext) ) il_jext=id_jext
+
+      IF( il_iext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
+         CALL logger_warn("MERGE BATHY INTERP: at least extrapolation "//&
+         &  "on two points are required with cubic interpolation ")
+         il_iext=2
+      ENDIF
+
+      IF( il_jext < 2 .AND. td_var%c_interp(1) == 'cubic' )THEN
+         CALL logger_warn("MERGE BATHY INTERP: at least extrapolation "//&
+         &  "on two points are required with cubic interpolation ")
+         il_jext=2
+      ENDIF
+
+      ! work on mask
+      ! create mask
+      ALLOCATE(bl_mask(td_var%t_dim(1)%i_len, &
+      &                td_var%t_dim(2)%i_len, &
+      &                td_var%t_dim(3)%i_len, &
+      &                td_var%t_dim(4)%i_len) )
+
+      bl_mask(:,:,:,:)=1
+      WHERE(td_var%d_value(:,:,:,:)==td_var%d_fill) bl_mask(:,:,:,:)=0      
+
+      SELECT CASE(TRIM(td_var%c_point))
+      CASE DEFAULT ! 'T'
+         tl_mask=var_init('tmask',bl_mask(:,:,:,:),td_dim=td_var%t_dim(:),&
+         &                id_ew=td_var%i_ew )
+      CASE('U','V','F')
+         CALL logger_fatal("MERGE BATHY INTERP: can not computed "//&
+         &                 "interpolation on "//TRIM(td_var%c_point)//&
+         &                 " grid point (variable "//TRIM(td_var%c_name)//&
+         &                 "). check namelist.")
+      END SELECT
+
+      DEALLOCATE(bl_mask)
+
+      ! interpolate mask
+      CALL interp_fill_value( tl_mask, id_rho(:),  &
+      &                       id_offset=id_offset(:,:) )
+
+      ! work on variable
+      ! add extraband
+      CALL extrap_add_extrabands(td_var, il_iext, il_iext)
+
+      ! extrapolate variable
+      CALL extrap_fill_value( td_var )
+
+      ! interpolate Bathymetry
+      CALL interp_fill_value( td_var, id_rho(:), &
+      &                       id_offset=id_offset(:,:) )
+
+      ! remove extraband
+      CALL extrap_del_extrabands(td_var, il_iext*id_rho(jp_I), il_jext*id_rho(jp_J))
+
+      ! keep original mask 
+      WHERE( tl_mask%d_value(:,:,:,:) == 0 )
+         td_var%d_value(:,:,:,:)=td_var%d_fill
+      END WHERE
+
+   END SUBROUTINE merge_bathy_interp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END PROGRAM merge_bathy
Index: /utils/tools_ticket2413/SIREN/src/mpp.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/mpp.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/mpp.f90	(revision 12863)
@@ -0,0 +1,4450 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief
+!> This module manage massively parallel processing.
+!>
+!> @details
+!> define type TMPP:<br/>
+!> @code
+!> TYPE(TMPP) :: tl_mpp
+!> @endcode
+!>
+!>    to initialise a mpp structure:<br/>
+!> @code
+!>    tl_mpp=mpp_init( cd_file, id_mask, 
+!>                       [id_niproc,] [id_njproc,] [id_nproc,]
+!>                       [id_preci,] [id_precj,] 
+!>                       [cd_type,] [id_ew])
+!> @endcode
+!> or
+!> @code
+!>    tl_mpp=mpp_init( cd_file, td_var, 
+!>                      [id_niproc,] [id_njproc,] [id_nproc,]
+!>                      [id_preci,] [id_precj,]
+!>                      [cd_type] )
+!> @endcode
+!> or
+!> @code
+!>    tl_mpp=mpp_init( td_file [,id_ew] )
+!> @endcode
+!>       - cd_file is the filename of the global domain file, in which 
+!>         MPP will be done (example: Bathymetry) 
+!>       - td_file is the file structure of one processor file composing an MPP
+!>       - id_mask is the 2D mask of global domain [optional]
+!>       - td_var is a variable structure (on T-point) from global domain file.
+!>         mask of the domain will be computed using FillValue [optional]
+!>       - id_niproc is the number of processor following I-direction to be used
+!>         [optional]
+!>       - id_njproc is the number of processor following J-direction to be used 
+!>         [optional]
+!>       - id_nproc is the total number of processor to be used [optional]
+!>       - id_preci is the size of the overlap region following I-direction [optional]
+!>       - id_precj is the size of the overlap region following J-direction [optional]
+!>       - cd_type is the type of files composing MPP [optional]
+!>       - id_ew is east-west overlap [optional]<br/> 
+!>  
+!>    to get mpp name:<br/>
+!>    - tl_mpp\%c_name
+!>
+!>    to get the total number of processor:<br/>
+!>    - tl_mpp\%i_nproc
+!>
+!>    to get the number of processor following I-direction:<br/>
+!>    - tl_mpp\%i_niproc
+!>
+!>    to get the number of processor following J-direction:<br/>
+!>    - tl_mpp\%i_njproc
+!>
+!>    to get the length of the overlap region following I-direction:<br/>
+!>    - tl_mpp\%i_preci
+!>
+!>    to get the length of the overlap region following J-direction:<br/>
+!>    - tl_mpp\%i_precj
+!>
+!>    to get the type of files composing mpp structure:<br/>
+!>    - tl_mpp\%c_type
+!>
+!>    to get the type of the global domain:<br/>
+!>    - tl_mpp\%c_dom
+!>
+!>    MPP dimensions (global domain)<br/>
+!>    to get the number of dimensions to be used in mpp strcuture:<br/>
+!>    - tl_mpp\%i_ndim
+!>
+!>    to get the array of dimension structure (4 elts) associated to the
+!>    mpp structure:<br/>
+!>    - tl_mpp\%t_dim(:)
+!>
+!>    MPP processor (files composing domain)<br/>
+!>    - tl_mpp\%t_proc(:)
+!>
+!>    to clean a mpp structure:<br/>
+!> @code
+!>    CALL mpp_clean(tl_mpp)
+!> @endcode
+!>
+!>    to print information about mpp:<br/>
+!> @code
+!>    CALL mpp_print(tl_mpp)
+!> @endcode
+!>
+!>    to add variable to mpp:<br/>
+!> @code
+!>    CALL mpp_add_var(td_mpp, td_var)
+!> @endcode
+!>       - td_var is a variable structure
+!>
+!>    to add dimension to mpp:<br/>
+!> @code
+!>    CALL mpp_add_dim(td_mpp, td_dim)
+!> @endcode
+!>       - td_dim is a dimension structure
+!>
+!>    to add attribute to mpp:<br/>
+!> @code
+!>    CALL mpp_add_att(td_mpp, td_att)
+!> @endcode
+!>       - td_att is a attribute structure
+!>
+!>    to delete variable from mpp:<br/>
+!> @code
+!>    CALL mpp_del_var(td_mpp, td_var)
+!> @endcode
+!>    or
+!> @code
+!>    CALL mpp_del_var(td_mpp, cd_name)
+!> @endcode
+!>       - td_var is a variable structure
+!>       - cd_name is variable name or standard name
+!>
+!>    to delete dimension from mpp:<br/>
+!> @code
+!>    CALL mpp_del_dim(td_mpp, td_dim)
+!> @endcode
+!>       - td_dim is a dimension structure
+!>
+!>    to delete attribute from mpp:<br/>
+!> @code
+!>    CALL mpp_del_att(td_mpp, td_att)
+!> @endcode
+!>    or
+!> @code
+!>    CALL mpp_del_att(td_mpp, cd_name)
+!> @endcode
+!>       - td_att is a attribute structure
+!>       - cd_name is attribute name
+!>
+!>    to overwrite variable to mpp:<br/>
+!> @code
+!>    CALL mpp_move_var(td_mpp, td_var)
+!> @endcode
+!>       - td_var is a variable structure
+!>
+!>    to overwrite dimension to mpp:<br/>
+!> @code
+!>    CALL mpp_move_dim(td_mpp, td_dim)
+!> @endcode
+!>       - td_dim is a dimension structure
+!>
+!>    to overwrite attribute to mpp:<br/>
+!> @code
+!>    CALL mpp_move_att(td_mpp, td_att)
+!> @endcode
+!>       - td_att is a attribute structure
+!>
+!>    to determine domain decomposition type:<br/>
+!> @code
+!>    CALL mpp_get_dom(td_mpp)
+!> @endcode
+!>
+!>    to get processors to be used:<br/>
+!> @code
+!>    CALL mpp_get_use( td_mpp, id_imin, id_imax, & 
+!>    &                         id_jmin, id_jmax )
+!> @endcode
+!>       - id_imin 
+!>       - id_imax 
+!>       - id_jmin 
+!>       - id_jmax 
+!>
+!>    to get sub domains which form global domain contour:<br/>
+!> @code
+!>    CALL mpp_get_contour( td_mpp ) 
+!> @endcode
+!>
+!>    to get global domain indices of one processor:<br/>
+!> @code
+!>    il_ind(1:4)=mpp_get_proc_index( td_mpp, id_procid )
+!> @endcode
+!>       - il_ind(1:4) are global domain indices (i1,i2,j1,j2)
+!>       - id_procid is the processor id
+!>
+!>    to get the processor domain size:<br/>
+!> @code
+!>    il_size(1:2)=mpp_get_proc_size( td_mpp, id_procid )
+!> @endcode
+!>       - il_size(1:2) are the size of domain following I and J
+!>       - id_procid is the processor id
+!>
+!> @author
+!>  J.Paul
+!>
+!> @date November, 2013 - Initial Version
+!> @date November, 2014 
+!> - Fix memory leaks bug
+!> @date October, 2015
+!> - improve way to compute domain layout
+!> @date January, 2016
+!> - allow to print layout file (use lm_layout, hard coded)
+!> - add mpp__compute_halo and mpp__read_halo
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!>
+!> @todo
+!> - ECRIRE ET TESTER add_proc_array pour optimiser codes (voir old/MO_mpp.f90)
+!----------------------------------------------------------------------
+MODULE mpp
+
+   USE global                          ! global parameter
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+   USE dim                             ! dimension manager
+   USE att                             ! attribute manager
+   USE var                             ! variable manager
+   USE file                            ! file manager
+   USE iom                             ! I/O manager 
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   PUBLIC  :: TMPP       !< mpp structure
+   PRIVATE :: TLAY       !< domain layout structure
+
+   ! function and subroutine
+   PUBLIC :: mpp_copy           !< copy mpp structure
+   PUBLIC :: mpp_init           !< initialise mpp structure
+   PUBLIC :: mpp_clean          !< clean mpp strcuture
+   PUBLIC :: mpp_print          !< print information about mpp structure
+   PUBLIC :: mpp_add_var        !< split/add one variable strucutre in mpp structure
+   PUBLIC :: mpp_add_dim        !< add one dimension to mpp structure
+   PUBLIC :: mpp_add_att        !< add one attribute strucutre in mpp structure
+   PUBLIC :: mpp_del_var        !< delete one variable strucutre in mpp structure
+   PUBLIC :: mpp_del_dim        !< delete one dimension strucutre in mpp structure
+   PUBLIC :: mpp_del_att        !< delete one attribute strucutre in mpp structure
+   PUBLIC :: mpp_move_var       !< overwrite variable structure in mpp structure
+   PUBLIC :: mpp_move_dim       !< overwrite one dimension strucutre in mpp structure
+   PUBLIC :: mpp_move_att       !< overwrite one attribute strucutre in mpp structure
+   PUBLIC :: mpp_recombine_var  !< recombine variable from mpp structure
+   PUBLIC :: mpp_get_index      !< return index of mpp 
+
+   PUBLIC :: mpp_get_dom        !< determine domain decomposition type (full, overlap, noverlap)
+   PUBLIC :: mpp_get_use        !< get sub domains to be used (which cover "zoom domain")
+   PUBLIC :: mpp_get_contour    !< get sub domains which form global domain contour
+   PUBLIC :: mpp_get_proc_index !< get processor domain indices
+   PUBLIC :: mpp_get_proc_size  !< get processor domain size
+
+   PRIVATE :: mpp__add_proc            ! add proc strucutre in mpp structure
+   PRIVATE :: mpp__add_proc_unit       ! add one proc strucutre in mpp structure
+   PRIVATE :: mpp__add_proc_arr        ! add array of proc strucutre in mpp structure
+   PRIVATE :: mpp__del_proc            ! delete one proc strucutre in mpp structure
+   PRIVATE :: mpp__del_proc_id         ! delete one proc strucutre in mpp structure, given procesor id
+   PRIVATE :: mpp__del_proc_str        ! delete one proc strucutre in mpp structure, given procesor file structure 
+   PRIVATE :: mpp__move_proc           ! overwrite proc strucutre in mpp structure
+   PRIVATE :: mpp__create_layout       ! create mpp structure using domain layout
+   PRIVATE :: mpp__optimiz             ! compute optimum domain decomposition
+   PRIVATE :: mpp__check_dim           ! check mpp structure dimension with proc or variable dimension
+   PRIVATE :: mpp__check_proc_dim      ! check if processor and mpp structure use same dimension
+   PRIVATE :: mpp__check_var_dim       ! check if variable  and mpp structure use same dimension
+   PRIVATE :: mpp__del_var_name        ! delete variable in mpp structure, given variable name
+   PRIVATE :: mpp__del_var_mpp         ! delete all variable in mpp structure
+   PRIVATE :: mpp__del_var_str         ! delete variable in mpp structure, given variable structure
+   PRIVATE :: mpp__del_att_name        ! delete variable in mpp structure, given variable name
+   PRIVATE :: mpp__del_att_str         ! delete variable in mpp structure, given variable structure
+   PRIVATE :: mpp__split_var           ! extract variable part that will be written in processor 
+   PRIVATE :: mpp__copy_unit           ! copy mpp structure
+   PRIVATE :: mpp__copy_arr            ! copy array of mpp structure
+   PRIVATE :: mpp__get_use_unit        ! get sub domains to be used (which cover "zoom domain")
+   PRIVATE :: mpp__init_mask           ! initialise mpp structure, given mask array
+   PRIVATE :: mpp__init_var            ! initialise mpp structure, given variable strcuture
+   PRIVATE :: mpp__init_file           ! initialise a mpp structure, given file structure 
+   PRIVATE :: mpp__init_file_cdf       ! initialise a mpp structure with cdf file
+   PRIVATE :: mpp__init_file_rstdimg   ! initialise a mpp structure with rstdimg file
+   PRIVATE :: mpp__clean_unit          ! clean mpp strcuture
+   PRIVATE :: mpp__clean_arr           ! clean array of mpp strcuture
+   PRIVATE :: mpp__compute_halo        ! compute subdomain indices defined with halo 
+   PRIVATE :: mpp__read_halo           ! read subdomain indices defined with halo
+
+   PRIVATE :: layout__init             ! initialise domain layout structure
+   PRIVATE :: layout__copy             ! clean domain layout structure
+   PRIVATE :: layout__clean            ! copy  domain layout structure
+
+   TYPE TMPP !< mpp structure
+      ! general 
+      CHARACTER(LEN=lc)                  :: c_name = ''   !< base name 
+      INTEGER(i4)                        :: i_id   = 0    !< mpp id
+
+      INTEGER(i4)                        :: i_niproc = 0  !< number of processors following i
+      INTEGER(i4)                        :: i_njproc = 0  !< number of processors following j
+      INTEGER(i4)                        :: i_nproc  = 0  !< total number of proccessors used
+      INTEGER(i4)                        :: i_preci = 1   !< i-direction overlap region length
+      INTEGER(i4)                        :: i_precj = 1   !< j-direction overlap region length
+      INTEGER(i4)                        :: i_ew    = -1  !< east-west overlap
+      INTEGER(i4)                        :: i_perio = -1  !< NEMO periodicity index
+      INTEGER(i4)                        :: i_pivot = -1  !< NEMO pivot point index F(0),T(1)
+
+      CHARACTER(LEN=lc)                  :: c_type = ''   !< type of the files (cdf, cdf4, dimg)
+      CHARACTER(LEN=lc)                  :: c_dom  = ''   !< type of domain (full, noextra, nooverlap)
+
+      INTEGER(i4)                        :: i_ndim = 0    !< number of dimensions used in mpp
+      TYPE(TDIM),  DIMENSION(ip_maxdim)  :: t_dim         !< global domain dimension
+
+      TYPE(TFILE), DIMENSION(:), POINTER :: t_proc => NULL()  !< files/processors composing mpp
+
+      LOGICAL                            :: l_usempp = .TRUE. !< use mpp decomposition for writing netcdf
+   END TYPE
+
+   TYPE TLAY !< domain layout structure
+      INTEGER(i4)                          :: i_niproc = 0  !< number of processors following i
+      INTEGER(i4)                          :: i_njproc = 0  !< number of processors following j
+      INTEGER(i4)                          :: i_nland  = 0       !< number of land processors
+      INTEGER(i4)                          :: i_nsea   = 0       !< number of sea  processors
+      INTEGER(i4)                          :: i_mean   = 0       !< mean sea point per proc
+      INTEGER(i4)                          :: i_min    = 0       !< min  sea point per proc
+      INTEGER(i4)                          :: i_max    = 0       !< max  sea point per proc
+      INTEGER(i4), DIMENSION(:,:), POINTER :: i_msk   => NULL()  !< sea/land processor mask 
+      INTEGER(i4), DIMENSION(:,:), POINTER :: i_impp  => NULL()  !< i-indexes for mpp-subdomain left bottom 
+      INTEGER(i4), DIMENSION(:,:), POINTER :: i_jmpp  => NULL()  !< j-indexes for mpp-subdomain left bottom 
+      INTEGER(i4), DIMENSION(:,:), POINTER :: i_lci   => NULL()  !< i-dimensions of subdomain 
+      INTEGER(i4), DIMENSION(:,:), POINTER :: i_lcj   => NULL()  !< j-dimensions of subdomain 
+   END TYPE
+
+   ! module variable
+   INTEGER(i4) :: im_psize  = 2000        !< processor dimension length for huge file 
+
+   INTEGER(i4) :: im_iumout = 44
+   LOGICAL     :: lm_layout =.FALSE.
+
+   INTERFACE mpp_get_use
+      MODULE PROCEDURE mpp__get_use_unit 
+   END INTERFACE mpp_get_use
+
+   INTERFACE mpp__add_proc
+      MODULE PROCEDURE mpp__add_proc_unit 
+      MODULE PROCEDURE mpp__add_proc_arr
+   END INTERFACE mpp__add_proc
+
+   INTERFACE mpp_clean
+      MODULE PROCEDURE mpp__clean_unit 
+      MODULE PROCEDURE mpp__clean_arr
+   END INTERFACE mpp_clean
+
+   INTERFACE mpp__check_dim
+      MODULE PROCEDURE mpp__check_proc_dim !< check if processor and mpp structure use same dimension
+      MODULE PROCEDURE mpp__check_var_dim  !< check if variable  and mpp structure use same dimension
+   END INTERFACE mpp__check_dim
+
+   INTERFACE mpp__del_proc
+      MODULE PROCEDURE mpp__del_proc_id
+      MODULE PROCEDURE mpp__del_proc_str
+   END INTERFACE mpp__del_proc
+
+   INTERFACE mpp_del_var
+      MODULE PROCEDURE mpp__del_var_name
+      MODULE PROCEDURE mpp__del_var_str
+      MODULE PROCEDURE mpp__del_var_mpp
+   END INTERFACE mpp_del_var
+
+   INTERFACE mpp_del_att
+      MODULE PROCEDURE mpp__del_att_name
+      MODULE PROCEDURE mpp__del_att_str
+   END INTERFACE mpp_del_att
+
+   INTERFACE mpp_init
+      MODULE PROCEDURE mpp__init_mask
+      MODULE PROCEDURE mpp__init_var
+      MODULE PROCEDURE mpp__init_file
+   END INTERFACE mpp_init
+
+   INTERFACE mpp_copy
+      MODULE PROCEDURE mpp__copy_unit  ! copy mpp structure
+      MODULE PROCEDURE mpp__copy_arr   ! copy array of mpp structure
+   END INTERFACE
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION mpp__copy_unit(td_mpp) &
+         &  RESULT(tf_mpp)      
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy mpp structure in another one
+   !> @details 
+   !> mpp file are copied in a temporary array, 
+   !> so input and output mpp structure do not point on the same 
+   !> "memory cell", and so on are independant. 
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> structure (ex: tl_file=file_copy(file_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2014
+   !> - use function instead of overload assignment operator 
+   !> (to avoid memory leak)
+   !> @date January, 2019
+   !> - clean file structure
+   !>
+   !> @param[in] td_mpp   mpp structure
+   !> @return copy of input mpp structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP), INTENT(IN)  :: td_mpp
+
+      ! function
+      TYPE(TMPP)              :: tf_mpp
+
+      ! local variable
+      TYPE(TFILE) :: tl_file
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      CALL logger_trace("MPP COPY: "//TRIM(td_mpp%c_name)//" in "//&
+      &  TRIM(tf_mpp%c_name))
+
+      ! copy mpp variable
+      tf_mpp%c_name     = TRIM(td_mpp%c_name)
+      tf_mpp%i_id       = td_mpp%i_id
+      tf_mpp%i_niproc   = td_mpp%i_niproc
+      tf_mpp%i_njproc   = td_mpp%i_njproc
+      tf_mpp%i_nproc    = td_mpp%i_nproc
+      tf_mpp%i_preci    = td_mpp%i_preci
+      tf_mpp%i_precj    = td_mpp%i_precj
+      tf_mpp%c_type     = TRIM(td_mpp%c_type)
+      tf_mpp%c_dom      = TRIM(td_mpp%c_dom)
+      tf_mpp%i_ndim     = td_mpp%i_ndim
+      tf_mpp%i_ew       = td_mpp%i_ew
+      tf_mpp%i_perio    = td_mpp%i_perio
+      tf_mpp%i_pivot    = td_mpp%i_pivot
+      tf_mpp%l_usempp   = td_mpp%l_usempp
+
+      ! copy dimension
+      tf_mpp%t_dim(:) = dim_copy(td_mpp%t_dim(:))
+      
+      ! copy file structure
+      IF( ASSOCIATED(tf_mpp%t_proc) )THEN
+         CALL file_clean(tf_mpp%t_proc(:))
+         DEALLOCATE(tf_mpp%t_proc)
+      ENDIF
+      IF( ASSOCIATED(td_mpp%t_proc) .AND. tf_mpp%i_nproc > 0 )THEN
+         ALLOCATE( tf_mpp%t_proc(tf_mpp%i_nproc) )
+         DO ji=1,tf_mpp%i_nproc
+            tl_file = file_copy(td_mpp%t_proc(ji))
+            tf_mpp%t_proc(ji) = file_copy(tl_file)
+         ENDDO
+         ! clean
+         CALL file_clean(tl_file)
+      ENDIF
+
+   END FUNCTION mpp__copy_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION mpp__copy_arr(td_mpp) &
+         &  RESULT(tf_mpp)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy an array of mpp structure in another one
+   !> @details 
+   !> mpp file are copied in a temporary array, 
+   !> so input and output mpp structure do not point on the same 
+   !> "memory cell", and so on are independant. 
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> structure (ex: tl_file=file_copy(file_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2014
+   !>    - use function instead of overload assignment operator 
+   !> (to avoid memory leak)
+   !>
+   !> @param[in] td_mpp   mpp structure
+   !> @return copy of input array of mpp structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP), DIMENSION(:),  INTENT(IN)  :: td_mpp
+
+      ! function
+      TYPE(TMPP), DIMENSION(SIZE(td_mpp(:))) :: tf_mpp
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=1,SIZE(td_mpp(:))
+         tf_mpp(ji)=mpp_copy(td_mpp(ji))
+      ENDDO
+
+   END FUNCTION mpp__copy_arr
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE mpp_print(td_mpp)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine print some information about mpp strucutre.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_mpp mpp structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP), INTENT(IN) :: td_mpp
+
+      ! local variable
+      INTEGER(i4), PARAMETER :: ip_freq = 4
+      INTEGER(i4), PARAMETER :: ip_min  = 5
+
+      INTEGER(i4)                              :: il_min
+      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_proc
+      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_lci
+      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_lcj
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      INTEGER(i4) :: jm
+      !----------------------------------------------------------------
+
+      WRITE(*,'((a,a),2(/3x,a,a),9(/3x,a,i0))')&
+      &  "MPP : ",TRIM(td_mpp%c_name), &
+      &  " type   : ",TRIM(td_mpp%c_type), &
+      &  " dom    : ",TRIM(td_mpp%c_dom), &
+      &  " nproc  : ",td_mpp%i_nproc, &
+      &  " niproc : ",td_mpp%i_niproc, &
+      &  " njproc : ",td_mpp%i_njproc, &
+      &  " preci  : ",td_mpp%i_preci, &
+      &  " precj  : ",td_mpp%i_precj, &
+      &  " ndim   : ",td_mpp%i_ndim,  &
+      &  " overlap: ",td_mpp%i_ew, &
+      &  " perio  : ",td_mpp%i_perio, &
+      &  " pivot  : ",td_mpp%i_pivot
+
+      ! print dimension
+      IF(  td_mpp%i_ndim /= 0 )THEN
+         WRITE(*,'(/a)') " MPP dimension"
+         DO ji=1,ip_maxdim
+            IF( td_mpp%t_dim(ji)%l_use )THEN
+               CALL dim_print(td_mpp%t_dim(ji))
+            ENDIF
+         ENDDO
+      ENDIF
+
+      ! print file
+      IF( td_mpp%i_nproc /= 0 .AND. ASSOCIATED(td_mpp%t_proc) )THEN
+         IF( ALL( td_mpp%t_proc(:)%i_iind==0 ) .OR. &
+         &   ALL( td_mpp%t_proc(:)%i_jind==0 ) )THEN
+
+            il_min=MIN(td_mpp%i_nproc,ip_min)
+            DO ji=1,il_min
+               CALL file_print(td_mpp%t_proc(ji))
+               WRITE(*,'((a),(/3x,a,i0),2(/3x,a,a),4(/3x,a,i0,a,i0)/)')&
+               &  " Domain decomposition : ", &
+               &  " id          : ",td_mpp%t_proc(ji)%i_pid, &
+               &  " used        : ",TRIM(fct_str(td_mpp%t_proc(ji)%l_use)), &
+               &  " contour     : ",TRIM(fct_str(td_mpp%t_proc(ji)%l_ctr)), &
+               &  " left-bottom : ",td_mpp%t_proc(ji)%i_impp,', ',&
+               &  td_mpp%t_proc(ji)%i_jmpp, &
+               &  " dimension   : ",td_mpp%t_proc(ji)%i_lci,' x ',&
+               &  td_mpp%t_proc(ji)%i_lcj, &
+               &  " first indoor indices : ",td_mpp%t_proc(ji)%i_ldi,', ',&
+               &  td_mpp%t_proc(ji)%i_ldj, &
+               &  " last  indoor indices : ",td_mpp%t_proc(ji)%i_lei,', ',&
+               &  td_mpp%t_proc(ji)%i_lej
+
+            ENDDO
+            IF( td_mpp%i_nproc > ip_min )THEN
+               WRITE(*,'(a)') "...etc" 
+            ENDIF
+
+            IF( td_mpp%t_proc(1)%i_nvar > 0 )THEN
+               WRITE(*,'(/a)') " Variable(s) used : "
+               DO ji=1,td_mpp%t_proc(1)%i_nvar
+                  WRITE(*,'(3x,a)') TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name) 
+               ENDDO
+            ENDIF
+
+         ELSE
+
+            il_min=MIN(td_mpp%i_nproc,ip_min)
+            DO ji=1,il_min
+               CALL file_print(td_mpp%t_proc(ji))
+               WRITE(*,'((a, a),(/3x,a,i0),(/3x,a,a),4(/3x,a,i0,a,i0)/)')&
+               &  " Domain decomposition : ",TRIM(td_mpp%t_proc(ji)%c_name),&
+               &  " id          : ",td_mpp%t_proc(ji)%i_pid, &
+               &  " used        : ",TRIM(fct_str(td_mpp%t_proc(ji)%l_use)),&
+               &  " left-bottom : ",td_mpp%t_proc(ji)%i_impp,', ',&
+               &  td_mpp%t_proc(ji)%i_jmpp, &
+               &  " dimension   : ",td_mpp%t_proc(ji)%i_lci,' x ',&
+               &  td_mpp%t_proc(ji)%i_lcj, &
+               &  " first indoor indices : ",td_mpp%t_proc(ji)%i_ldi,',',&
+               &  td_mpp%t_proc(ji)%i_ldj, &
+               &  " last  indoor indices : ",td_mpp%t_proc(ji)%i_lei,', ',&
+               &  td_mpp%t_proc(ji)%i_lej
+
+            ENDDO
+            IF( td_mpp%i_nproc > ip_min )THEN
+               WRITE(*,'(a)') "...etc" 
+            ENDIF
+            
+            IF( td_mpp%t_proc(1)%i_nvar > 0 )THEN
+               WRITE(*,'(/a)') " Variable(s) used : "
+               DO ji=1,td_mpp%t_proc(1)%i_nvar
+                  WRITE(*,'(3x,a)') TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name)
+               ENDDO
+            ENDIF
+
+            IF( td_mpp%l_usempp )THEN
+               ALLOCATE( il_proc(td_mpp%i_niproc,td_mpp%i_njproc) )
+               ALLOCATE( il_lci(td_mpp%i_niproc,td_mpp%i_njproc) )
+               ALLOCATE( il_lcj(td_mpp%i_niproc,td_mpp%i_njproc) )
+               il_proc(:,:)=-1
+               il_lci(:,:) =-1
+               il_lcj(:,:) =-1
+
+               DO jk=1,td_mpp%i_nproc
+                  ji=td_mpp%t_proc(jk)%i_iind
+                  jj=td_mpp%t_proc(jk)%i_jind
+                  il_proc(ji,jj)=jk-1
+                  il_lci(ji,jj)=td_mpp%t_proc(jk)%i_lci
+                  il_lcj(ji,jj)=td_mpp%t_proc(jk)%i_lcj
+               ENDDO
+
+               jl = 1
+               DO jk = 1,(td_mpp%i_niproc-1)/ip_freq+1
+                  jm = MIN(td_mpp%i_niproc, jl+ip_freq-1)
+                  WRITE(*,*)
+                  WRITE(*,9401) (ji, ji = jl,jm)
+                  WRITE(*,9400) ('***', ji = jl,jm-1)
+                  DO jj = 1, td_mpp%i_njproc
+                     WRITE(*,9403) ('   ', ji = jl,jm-1)
+                     WRITE(*,9402) jj, ( il_lci(ji,jj), il_lcj(ji,jj), ji = jl,jm)
+                     WRITE(*,9404) (il_proc(ji,jj), ji= jl,jm)
+                     WRITE(*,9403) ('   ', ji = jl,jm-1)
+                     WRITE(*,9400) ('***', ji = jl,jm-1)
+                  ENDDO
+                  jl = jl+ip_freq
+               ENDDO
+         
+               DEALLOCATE( il_proc )
+               DEALLOCATE( il_lci )
+               DEALLOCATE( il_lcj )
+            ENDIF
+
+         ENDIF
+      ELSE
+         WRITE(*,'(/a)') " Domain decomposition : none"
+      ENDIF
+
+9400   FORMAT('     ***',20('*************',a3))
+9403   FORMAT('     *     ',20('         *   ',a3))
+9401   FORMAT('        ',20('   ',i3,'          '))
+9402   FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
+9404   FORMAT('     *  ',20('      ',i3,'   *   '))
+
+   END SUBROUTINE mpp_print
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION mpp__init_mask(cd_file, id_mask,                   &
+         &                 id_niproc, id_njproc, id_nproc,     &
+         &                 id_preci, id_precj,                 &
+         &                 cd_type, id_ew, id_perio, id_pivot, &
+         &                 td_dim, ld_usempp)                  &
+         & RESULT(tf_mpp)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function initialise mpp structure, given file name, 
+   !> and optionaly mask and number of processor following I and J
+   !> @detail
+   !> - If no total number of processor is defined (id_nproc), optimize 
+   !> the domain decomposition (look for the domain decomposition with 
+   !> the most land processor to remove)
+   !> - length of the overlap region (id_preci, id_precj) could be specify
+   !> in I and J direction (default value is 1)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !> @date September, 2015
+   !> - allow to define dimension with array of dimension structure
+   !> @date January, 2016
+   !> - use RESULT to rename output
+   !> - mismatch with "halo" indices
+   !>
+   !> @param[in] cd_file   file name of one file composing mpp domain
+   !> @param[in] id_mask   domain mask
+   !> @param[in] id_niproc number of processors following i
+   !> @param[in] id_njproc number of processors following j
+   !> @param[in] id_nproc  total number of processors
+   !> @param[in] id_preci  i-direction overlap region
+   !> @param[in] id_precj  j-direction overlap region
+   !> @param[in] cd_type   type of the files (cdf, cdf4, dimg)
+   !> @param[in] id_ew     east-west overlap
+   !> @param[in] id_perio  NEMO periodicity index
+   !> @param[in] id_pivot  NEMO pivot point index F(0),T(1)
+   !> @param[in] td_dim    array of dimension structure
+   !> @return mpp structure
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),                  INTENT(IN) :: cd_file
+      INTEGER(i4), DIMENSION(:,:),       INTENT(IN) :: id_mask
+      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_niproc
+      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_njproc
+      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_nproc
+      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_preci
+      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_precj
+      CHARACTER(LEN=*),                  INTENT(IN), OPTIONAL :: cd_type
+      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_ew
+      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_perio
+      INTEGER(i4),                       INTENT(IN), OPTIONAL :: id_pivot
+      TYPE(TDIM) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: td_dim
+      LOGICAL                          , INTENT(IN), OPTIONAL :: ld_usempp
+
+      ! function
+      TYPE(TMPP)                                   :: tf_mpp
+
+      ! local variable
+      CHARACTER(LEN=lc)                            :: cl_type
+
+      INTEGER(i4)      , DIMENSION(2)              :: il_shape
+      INTEGER(i4)                                  :: il_niproc
+      INTEGER(i4)                                  :: il_njproc
+
+      TYPE(TDIM)                                   :: tl_dim
+
+      TYPE(TATT)                                   :: tl_att
+
+      TYPE(TLAY)                                   :: tl_lay
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! clean mpp
+      CALL mpp_clean(tf_mpp)
+
+      ! check type
+      cl_type=''
+      IF( PRESENT(cd_type) ) cl_type=TRIM(ADJUSTL(cd_type))
+
+      IF( TRIM(cl_type) /= '' )THEN
+         SELECT CASE(TRIM(cd_type))
+            CASE('cdf')
+               tf_mpp%c_type='cdf'
+            CASE('dimg')
+               tf_mpp%c_type='dimg'
+            CASE DEFAULT
+               CALL logger_warn("MPP INIT: type "//TRIM(cd_type)//&
+                  &             " unknown. type dimg will be used for mpp "//&
+                  &             TRIM(tf_mpp%c_name) )
+               tf_mpp%c_type='dimg'
+         END SELECT
+      ELSE
+         tf_mpp%c_type=TRIM(file_get_type(cd_file))
+      ENDIF
+
+      ! get mpp name
+      tf_mpp%c_name=TRIM(file_rename(cd_file))
+
+      ! get global domain dimension
+      il_shape(:)=SHAPE(id_mask)
+
+      IF( PRESENT(td_dim) )THEN
+         DO ji=1,ip_maxdim
+            IF( td_dim(ji)%l_use )THEN
+               CALL mpp_add_dim(tf_mpp, td_dim(ji))
+            ENDIF
+         ENDDO
+      ELSE
+         tl_dim=dim_init('X',il_shape(1))
+         CALL mpp_add_dim(tf_mpp, tl_dim)
+
+         tl_dim=dim_init('Y',il_shape(2))
+         CALL mpp_add_dim(tf_mpp, tl_dim)
+
+         ! clean
+         CALL dim_clean(tl_dim)
+      ENDIF
+
+      IF( (       PRESENT(id_niproc)  .AND. (.NOT. PRESENT(id_njproc))) .OR. &
+          ((.NOT. PRESENT(id_niproc)) .AND.        PRESENT(id_njproc) ) )THEN
+          CALL logger_warn( "MPP INIT: number of processors following I and J "//&
+          & "should be both specified")
+      ELSE
+         ! get number of processors following I and J
+         IF( PRESENT(id_niproc) ) tf_mpp%i_niproc=id_niproc
+         IF( PRESENT(id_njproc) ) tf_mpp%i_njproc=id_njproc
+      ENDIF
+
+      ! get maximum number of processors to be used
+      IF( PRESENT(id_nproc) ) tf_mpp%i_nproc = id_nproc
+
+      ! get overlap region length
+      IF( PRESENT(id_preci) ) tf_mpp%i_preci= id_preci
+      IF( PRESENT(id_precj) ) tf_mpp%i_precj= id_precj
+
+      ! east-west overlap
+      IF( PRESENT(id_ew) ) tf_mpp%i_ew= id_ew
+      ! NEMO periodicity
+      IF( PRESENT(id_perio) ) tf_mpp%i_perio= id_perio
+      IF( PRESENT(id_pivot) ) tf_mpp%i_pivot= id_pivot
+      !
+      IF( PRESENT(ld_usempp) ) tf_mpp%l_usempp = ld_usempp
+
+      IF( tf_mpp%i_nproc  /= 0 .AND. &
+      &   tf_mpp%i_niproc /= 0 .AND. &
+      &   tf_mpp%i_njproc /= 0 .AND. &
+      &   tf_mpp%i_nproc  >  tf_mpp%i_niproc * tf_mpp%i_njproc )THEN
+
+         CALL logger_error("MPP INIT: invalid domain decomposition ")
+         CALL logger_debug("MPP INIT: "// &
+            &              TRIM(fct_str(tf_mpp%i_nproc))//" > "//&
+            &              TRIM(fct_str(tf_mpp%i_niproc))//" x "//&
+            &              TRIM(fct_str(tf_mpp%i_njproc)) )
+
+      ELSE
+         IF( lm_layout )THEN
+            OPEN(im_iumout,FILE='processor.layout')
+            WRITE(im_iumout,*)
+            WRITE(im_iumout,*) ' optimisation de la partition'
+            WRITE(im_iumout,*) ' ----------------------------'
+            WRITE(im_iumout,*)
+         ENDIF
+
+         IF( tf_mpp%i_niproc /= 0 .AND. tf_mpp%i_njproc /= 0 .AND. &
+           &(tf_mpp%i_niproc  > 1 .OR.  tf_mpp%i_njproc  > 1) )THEN
+
+            ! compute domain layout
+            tl_lay=layout__init(tf_mpp, id_mask, &
+               &                tf_mpp%i_niproc, tf_mpp%i_njproc)
+            ! create mpp domain layout
+            CALL mpp__create_layout( tf_mpp, tl_lay )
+
+            ! clean
+            CALL layout__clean( tl_lay )
+
+         ELSEIF( tf_mpp%i_nproc  > 1 )THEN
+
+            ! optimiz
+            CALL mpp__optimiz( tf_mpp, id_mask, tf_mpp%i_nproc )
+
+         ELSE
+
+            CALL logger_warn("MPP INIT: number of processor to be used "//&
+            &                "not specify. force output on one file.")
+            ! number of proc to get proc size close to im_psize
+            il_niproc=INT(il_shape(jp_I)/im_psize)+1
+            il_njproc=INT(il_shape(jp_J)/im_psize)+1
+         
+            tf_mpp%l_usempp=.FALSE.
+            tl_lay=layout__init( tf_mpp, id_mask,  &
+                               & il_niproc, il_njproc )
+
+            ! create mpp domain layout
+            CALL mpp__create_layout( tf_mpp, tl_lay )
+
+            ! clean
+            CALL layout__clean( tl_lay )
+
+         ENDIF
+
+         CALL logger_info("MPP INIT: domain decoposition : "//&
+         &  'niproc('//TRIM(fct_str(tf_mpp%i_niproc))//') * '//&
+         &  'njproc('//TRIM(fct_str(tf_mpp%i_njproc))//') = '//&
+         &  'nproc('//TRIM(fct_str(tf_mpp%i_nproc))//')' )
+
+         ! get domain type
+         CALL mpp_get_dom( tf_mpp )
+
+         DO ji=1,tf_mpp%i_nproc
+
+            ! get processor size
+            il_shape(:)=mpp_get_proc_size( tf_mpp, ji )
+
+            tl_dim=dim_init('X',il_shape(1))
+            CALL file_move_dim(tf_mpp%t_proc(ji), tl_dim)
+
+            tl_dim=dim_init('Y',il_shape(2))
+            CALL file_move_dim(tf_mpp%t_proc(ji), tl_dim)            
+
+            IF( PRESENT(td_dim) )THEN
+               IF( td_dim(jp_K)%l_use )THEN
+                  CALL file_move_dim(tf_mpp%t_proc(ji), td_dim(jp_K))
+               ENDIF
+               IF( td_dim(jp_L)%l_use )THEN
+                  CALL file_move_dim(tf_mpp%t_proc(ji), td_dim(jp_L))
+               ENDIF
+            ENDIF
+            ! add type
+            tf_mpp%t_proc(ji)%c_type=TRIM(tf_mpp%c_type)
+
+            ! clean
+            CALL dim_clean(tl_dim)
+
+         ENDDO
+
+         ! add global attribute
+         tl_att=att_init("DOMAIN_number_total",tf_mpp%i_nproc)
+         CALL mpp_add_att(tf_mpp, tl_att)
+
+         tl_att=att_init("DOMAIN_LOCAL",TRIM(tf_mpp%c_dom))
+         CALL mpp_add_att(tf_mpp, tl_att)
+
+         tl_att=att_init("DOMAIN_I_number_total",tf_mpp%i_niproc)
+         CALL mpp_add_att(tf_mpp, tl_att)
+
+         tl_att=att_init("DOMAIN_J_number_total",tf_mpp%i_njproc)
+         CALL mpp_add_att(tf_mpp, tl_att)
+
+         tl_att=att_init("DOMAIN_size_global",tf_mpp%t_dim(1:2)%i_len)
+         CALL mpp_add_att(tf_mpp, tl_att)
+
+         CALL mpp__compute_halo(tf_mpp) 
+      ENDIF
+
+   END FUNCTION mpp__init_mask
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION mpp__init_var(cd_file, td_var,               &
+         &                id_niproc, id_njproc, id_nproc,&
+         &                id_preci, id_precj, cd_type,   &
+         &                id_perio, id_pivot, ld_usempp) &
+         &  RESULT(tf_mpp)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function initialise mpp structure, given variable strcuture 
+   !> and optionaly number of processor following I and J
+   !> @detail
+   !> - If no total number of processor is defined (id_nproc), optimize 
+   !> the domain decomposition (look for the domain decomposition with 
+   !> the most land processor to remove)
+   !> - length of the overlap region (id_preci, id_precj) could be specify
+   !> in I and J direction (default value is 1)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[in] cd_file   file name of one file composing mpp domain
+   !> @param[in] td_var    variable structure
+   !> @param[in] id_niproc number of processors following i
+   !> @param[in] id_njproc number of processors following j
+   !> @param[in] id_nproc  total number of processors
+   !> @param[in] id_preci  i-direction overlap region
+   !> @param[in] id_precj  j-direction overlap region
+   !> @param[in] cd_type   type of the files (cdf, cdf4, dimg)
+   !> @param[in] id_perio  NEMO periodicity index
+   !> @param[in] id_pivot  NEMO pivot point index F(0),T(1)
+   !> @return mpp structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_file
+      TYPE(TVAR),       INTENT(IN) :: td_var
+      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_niproc
+      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_njproc
+      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_nproc
+      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_preci
+      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_precj
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_type
+      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_perio
+      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_pivot
+      LOGICAL,          INTENT(IN), OPTIONAL :: ld_usempp
+     
+      ! function
+      TYPE(TMPP)                   :: tf_mpp
+
+      ! local variable
+      INTEGER(i4), DIMENSION(:,:,:), ALLOCATABLE :: il_mask
+      !----------------------------------------------------------------
+
+      IF( ASSOCIATED(td_var%d_value) )THEN
+         ALLOCATE( il_mask(td_var%t_dim(1)%i_len, &
+         &                 td_var%t_dim(2)%i_len, &
+         &                 td_var%t_dim(3)%i_len) )
+         il_mask(:,:,:)=var_get_mask(td_var)
+         
+         CALL logger_info("MPP INIT: mask compute from variable "//&
+            &             TRIM(td_var%c_name))
+         tf_mpp = mpp_init( cd_file, il_mask(:,:,1),       &
+            &               id_niproc, id_njproc, id_nproc,&
+            &               id_preci, id_precj, cd_type,   &
+            &               id_ew=td_var%i_ew,             &
+            &               id_perio=id_perio, id_pivot=id_pivot,&
+            &               ld_usempp=ld_usempp)
+
+         DEALLOCATE(il_mask)
+      ELSE
+         CALL logger_error("MPP INIT: variable value not define.")
+      ENDIF
+
+   END FUNCTION mpp__init_var
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION mpp__init_file(td_file, id_ew, id_perio, id_pivot) &
+         & RESULT(tf_mpp)
+   !-------------------------------------------------------------------
+   !> @brief This function initalise a mpp structure given file structure. 
+   !> @details 
+   !> It reads restart dimg files, or some netcdf files.
+   !>
+   !> @warning 
+   !>  netcdf file must contains some attributes:
+   !>    - DOMAIN_number_total 
+   !>    - DOMAIN_size_global
+   !>    - DOMAIN_number
+   !>    - DOMAIN_position_first
+   !>    - DOMAIN_position_last
+   !>    - DOMAIN_halo_size_start
+   !>    - DOMAIN_halo_size_end
+   !>  or the file is assume to be no mpp file.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2016
+   !> - mismatch with "halo" indices, use mpp__compute_halo
+   !> @date Marsh, 2017
+   !> - netcdf proc indices from zero to N-1
+   !> - copy file periodicity to mpp structure 
+   !> @date August, 2017
+   !> - force to use domain decomposition to enhance read of monoproc file
+   !>
+   !> @param[in] td_file   file strcuture
+   !> @param[in] id_ew     east-west overlap
+   !> @param[in] id_perio  NEMO periodicity index
+   !> @param[in] id_pivot  NEMO pivot point index F(0),T(1)
+   !> @return mpp structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TFILE), INTENT(IN)           :: td_file
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_ew
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_perio
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_pivot
+
+      ! function
+      TYPE(TMPP)                        :: tf_mpp
+
+      ! local variable
+      INTEGER(i4)                               :: il_nproc
+      INTEGER(i4)                               :: il_attid
+      INTEGER(i4), DIMENSION(2)                 :: il_shape
+
+      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE  :: il_mask
+      INTEGER(i4), DIMENSION(ip_maxdim)         :: il_dim
+      INTEGER(i4)                               :: il_niproc
+      INTEGER(i4)                               :: il_njproc
+
+      TYPE(TDIM)                                :: tl_dim
+
+      TYPE(TATT)                                :: tl_att
+
+      TYPE(TFILE)                               :: tl_file
+
+      TYPE(TMPP)                                :: tl_mpp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! clean mpp
+      CALL mpp_clean(tf_mpp)
+
+      ! check file type
+      SELECT CASE( TRIM(td_file%c_type) )
+         CASE('cdf')
+            ! need to read all file to get domain decomposition
+            tl_file=file_copy(td_file)
+
+            ! open file
+            CALL iom_open(tl_file)
+
+            ! read first file domain decomposition
+            tl_mpp=mpp__init_file_cdf(tl_file)
+
+            ! get number of processor/file to be read
+            il_nproc = 1
+            il_attid = 0
+
+            IF( ASSOCIATED(tl_file%t_att) )THEN
+               il_attid=att_get_id( tl_file%t_att, "DOMAIN_number_total" )
+            ENDIF
+            IF( il_attid /= 0 )THEN
+               il_nproc = INT(tl_file%t_att(il_attid)%d_value(1))
+            ENDIF
+
+            ! close file
+            CALL iom_close(tl_file)
+
+            IF( il_nproc /= 1 )THEN
+               DO ji=1,il_nproc
+
+                  ! clean mpp strcuture
+                  CALL mpp_clean(tl_mpp)
+ 
+                  ! get filename (from 0 to n-1) 
+                  tl_file=file_rename(td_file,ji-1)
+ 
+                  ! open file
+                  CALL iom_open(tl_file)
+
+                  ! read domain decomposition
+                  tl_mpp = mpp__init_file_cdf(tl_file)
+                  IF( ji == 1 )THEN
+                     tf_mpp=mpp_copy(tl_mpp)
+                  ELSE
+                     IF( ANY( tf_mpp%t_dim(1:2)%i_len /= &
+                              tl_mpp%t_dim(1:2)%i_len) )THEN
+
+                        CALL logger_error("MPP INIT READ: dimension from file "//&
+                        &     TRIM(tl_file%c_name)//" and mpp strcuture "//&
+                        &     TRIM(tf_mpp%c_name)//"differ ")
+
+                     ELSE
+
+                        ! add processor to mpp strcuture
+                        CALL mpp__add_proc(tf_mpp, tl_mpp%t_proc(1))
+
+                     ENDIF
+                  ENDIF
+
+                  ! close file
+                  CALL iom_close(tl_file)
+
+               ENDDO
+               IF( tf_mpp%i_nproc /= il_nproc )THEN
+                  CALL logger_error("MPP INIT READ: some processors can't be added &
+                  &               to mpp structure")
+               ENDIF
+
+            ELSE
+
+               ! force to use domain decomposition to enhance read of input
+
+               ! create pseudo mask 
+               il_dim(:)=tl_mpp%t_dim(:)%i_len
+               ALLOCATE(il_mask(il_dim(jp_I),il_dim(jp_J)))
+               il_mask(:,:)=1
+
+               ! number of proc to get proc size close to im_psize
+               il_niproc=INT(il_dim(jp_I)/im_psize)+1
+               il_njproc=INT(il_dim(jp_J)/im_psize)+1
+
+               ! compute domain layout
+               ! output will be written on one file
+               tf_mpp=mpp_init(tl_mpp%c_name, il_mask, il_niproc, il_njproc,&
+                  &            id_perio=tl_file%i_perio, &   
+                  &            ld_usempp=.FALSE. )
+
+               ! add var
+               DO ji=1,tl_mpp%t_proc(1)%i_nvar
+                  CALL mpp_add_var(tf_mpp, tl_mpp%t_proc(1)%t_var(ji))
+               ENDDO
+
+            ENDIF
+
+            ! mpp type
+            tf_mpp%c_type=TRIM(td_file%c_type)
+
+            ! mpp domain type
+            CALL mpp_get_dom(tf_mpp)
+
+            ! create some attributes for domain decomposition (use with dimg file)
+            tl_att=att_init( "DOMAIN_number_total", tf_mpp%i_nproc )
+            CALL mpp_move_att(tf_mpp, tl_att)
+
+            CALL mpp__compute_halo(tf_mpp)
+ 
+            ! clean
+            CALL mpp_clean(tl_mpp)
+            CALL att_clean(tl_att)
+
+         CASE('dimg')
+            ! domain decomposition could be read in one file
+
+            tl_file=file_copy(td_file)
+            ! open file
+            CALL logger_debug("MPP INIT READ: open file "//TRIM(tl_file%c_name))
+            CALL iom_open(tl_file)
+
+            CALL logger_debug("MPP INIT READ: read mpp structure ")
+            ! read mpp structure
+            tf_mpp=mpp__init_file_rstdimg(tl_file)
+
+            ! mpp type
+            tf_mpp%c_type=TRIM(td_file%c_type)
+
+            ! mpp domain type
+            CALL logger_debug("MPP INIT READ: mpp_get_dom ")
+            CALL mpp_get_dom(tf_mpp)
+
+            ! get processor size
+            CALL logger_debug("MPP INIT READ: get processor size ")
+            DO ji=1,tf_mpp%i_nproc
+
+               il_shape(:)=mpp_get_proc_size( tf_mpp, ji )
+
+               tl_dim=dim_init('X',il_shape(1))
+               CALL file_add_dim(tf_mpp%t_proc(ji), tl_dim)
+
+               tl_dim=dim_init('Y',il_shape(2))
+               CALL file_add_dim(tf_mpp%t_proc(ji), tl_dim)            
+
+               ! clean
+               CALL dim_clean(tl_dim)
+
+            ENDDO
+
+            ! close file
+            CALL iom_close(tl_file)
+
+         CASE DEFAULT
+            CALL logger_error("MPP INIT READ: invalid type for file "//&
+            &              TRIM(tl_file%c_name))
+      END SELECT
+
+      ! east west overlap
+      IF( PRESENT(id_ew) ) tf_mpp%i_ew=id_ew
+      ! NEMO periodicity
+      IF( PRESENT(id_perio) )THEN
+         tf_mpp%i_perio= id_perio
+         SELECT CASE(id_perio)
+         CASE(3,4)
+            tf_mpp%i_pivot=1
+         CASE(5,6)
+            tf_mpp%i_pivot=0
+         CASE DEFAULT
+            tf_mpp%i_pivot=1
+         END SELECT
+      ENDIF
+
+      IF( PRESENT(id_pivot) ) tf_mpp%i_pivot= id_pivot
+
+      ! clean 
+      CALL file_clean(tl_file)
+
+   END FUNCTION mpp__init_file
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION mpp__init_file_cdf(td_file) &
+         &  RESULT(tf_mpp)
+   !-------------------------------------------------------------------
+   !> @brief This function initalise a mpp structure, 
+   !> reading some netcdf files.
+   !>
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - add only use dimension in MPP structure
+   !> @date January, 2016
+   !> - mismatch with "halo" indices, use mpp__read_halo
+   !>
+   !> @param[in] td_file   file strcuture
+   !> @return mpp structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TFILE), INTENT(IN) :: td_file
+
+      ! function
+      TYPE(TMPP)              :: tf_mpp
+
+      ! local variable
+      INTEGER(i4) :: il_attid  ! attribute id
+      
+      LOGICAL     :: ll_exist
+      LOGICAL     :: ll_open
+
+      TYPE(TATT)  :: tl_att
+
+      TYPE(TDIM)  :: tl_dim
+      
+      TYPE(TFILE) :: tl_proc
+      !----------------------------------------------------------------
+
+      CALL logger_trace("MPP INIT READ: netcdf file "//TRIM(td_file%c_name))
+
+      INQUIRE( FILE=TRIM(td_file%c_name), EXIST=ll_exist, OPENED=ll_open )
+      ! ll_open do not work for netcdf file, return always FALSE
+      IF( ll_exist )THEN
+
+         IF( td_file%i_id == 0 )THEN
+            CALL logger_info(" id "//TRIM(fct_str(td_file%i_id))) 
+            CALL logger_error("MPP INIT READ: netcdf file "//&
+               &  TRIM(td_file%c_name)//" not opened")
+         ELSE
+
+            ! get mpp name
+            tf_mpp%c_name=TRIM( file_rename(td_file%c_name) )
+
+            ! add type
+            tf_mpp%c_type="cdf"
+
+            ! global domain size
+            il_attid = 0
+            IF( ASSOCIATED(td_file%t_att) )THEN
+               il_attid=att_get_id( td_file%t_att, "DOMAIN_size_global" )
+            ENDIF
+            IF( il_attid /= 0 )THEN
+               tl_dim=dim_init('X',INT(td_file%t_att(il_attid)%d_value(1)))
+               CALL mpp_add_dim(tf_mpp,tl_dim)
+
+               tl_dim=dim_init('Y',INT(td_file%t_att(il_attid)%d_value(2)))
+               CALL mpp_add_dim(tf_mpp,tl_dim)
+            ELSE ! assume only one file (not mpp)
+               tl_dim=dim_init( td_file%t_dim(1)%c_name, td_file%t_dim(1)%i_len)
+               CALL mpp_add_dim(tf_mpp,tl_dim)
+
+               tl_dim=dim_init( td_file%t_dim(2)%c_name, td_file%t_dim(2)%i_len)
+               CALL mpp_add_dim(tf_mpp,tl_dim)
+            ENDIF
+
+            IF( td_file%t_dim(3)%l_use )THEN
+               tl_dim=dim_init( td_file%t_dim(3)%c_name, td_file%t_dim(3)%i_len)
+               CALL mpp_add_dim(tf_mpp,tl_dim)
+            ENDIF
+
+            IF( td_file%t_dim(4)%l_use )THEN
+               tl_dim=dim_init( td_file%t_dim(4)%c_name, td_file%t_dim(4)%i_len)
+               CALL mpp_add_dim(tf_mpp,tl_dim)
+            ENDIF
+
+            ! initialise file/processor
+            tl_proc=file_copy(td_file)
+
+            ! processor id
+            il_attid = 0
+            IF( ASSOCIATED(td_file%t_att) )THEN
+               il_attid=att_get_id( td_file%t_att, "DOMAIN_number" )
+            ENDIF
+            IF( il_attid /= 0 )THEN
+               tl_proc%i_pid = INT(td_file%t_att(il_attid)%d_value(1))
+            ELSE
+               tl_proc%i_pid = 1
+            ENDIF
+
+            ! processor dimension
+            tl_proc%t_dim(:)=dim_copy(td_file%t_dim(:))
+
+            CALL mpp__read_halo(tl_proc, tf_mpp%t_dim(:) )
+
+            ! add attributes
+            tl_att=att_init( "DOMAIN_size_global", tf_mpp%t_dim(:)%i_len)
+            CALL file_move_att(tl_proc, tl_att)
+
+            tl_att=att_init( "DOMAIN_number", tl_proc%i_pid )
+            CALL file_move_att(tl_proc, tl_att)
+
+            ! add processor to mpp structure
+            CALL mpp__add_proc(tf_mpp, tl_proc)
+
+            ! clean 
+            CALL file_clean(tl_proc)
+            CALL dim_clean(tl_dim)
+            CALL att_clean(tl_att)
+         ENDIF
+
+      ELSE
+
+         CALL logger_error("MPP INIT READ: netcdf file "//TRIM(td_file%c_name)//&
+         &  " do not exist")
+
+      ENDIF
+
+   END FUNCTION mpp__init_file_cdf
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION mpp__init_file_rstdimg(td_file) &
+         &  RESULT(tf_mpp)
+   !-------------------------------------------------------------------
+   !> @brief This function initalise a mpp structure, 
+   !> reading one dimg restart file.
+   !>
+   !> @details 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2016
+   !> - mismatch with "halo" indices, use mpp__compute_halo
+   !> @date January,2019
+   !> - clean file structure
+   !>
+   !> @param[in] td_file   file strcuture
+   !> @return mpp structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TFILE), INTENT(IN) :: td_file
+
+      ! function
+      TYPE(TMPP)              :: tf_mpp
+
+      ! local variable
+      INTEGER(i4)       :: il_status
+      INTEGER(i4)       :: il_recl                          ! record length 
+      INTEGER(i4)       :: il_nx, il_ny, il_nz              ! x,y,z dimension 
+      INTEGER(i4)       :: il_n0d, il_n1d, il_n2d, il_n3d   ! number of 0/1/2/3D variables 
+      INTEGER(i4)       :: il_iglo, il_jglo                 ! domain global size
+      INTEGER(i4)       :: il_rhd                           ! record of the header infos
+      INTEGER(i4)       :: il_pni, il_pnj, il_pnij          ! domain decomposition
+      INTEGER(i4)       :: il_area                          ! domain index
+
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lci
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldi
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lei
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_impp
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lcj
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldj
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lej
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jmpp
+
+      LOGICAL           ::  ll_exist
+      LOGICAL           ::  ll_open
+
+      CHARACTER(LEN=lc) :: cl_file
+
+      TYPE(TDIM)        :: tl_dim ! dimension structure
+      TYPE(TATT)        :: tl_att
+      TYPE(TFILE)       :: tl_proc
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      INQUIRE( FILE=TRIM(td_file%c_name), EXIST=ll_exist, OPENED=ll_open)
+      IF( ll_exist )THEN
+
+         IF( .NOT. ll_open )THEN
+            CALL logger_error("MPP INIT READ: dimg file "//TRIM(td_file%c_name)//&
+            &  " not opened")
+         ELSE
+
+            ! read first record 
+            READ( td_file%i_id, IOSTAT=il_status, REC=1 )& 
+               &  il_recl,                         &
+               &  il_nx, il_ny, il_nz,             &
+               &  il_n0d, il_n1d, il_n2d, il_n3d,  &
+               &  il_rhd,                          &
+               &  il_pni, il_pnj, il_pnij,         &
+               &  il_area
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_error("MPP INIT READ: read first line header of "//&
+               &              TRIM(td_file%c_name))
+            ENDIF
+
+            ! get mpp name
+            tf_mpp%c_name=TRIM( file_rename(td_file%c_name) )
+
+            ! add type
+            tf_mpp%c_type="dimg"
+
+            ! number of processors to be read
+            tf_mpp%i_nproc  = il_pnij
+            tf_mpp%i_niproc = il_pni
+            tf_mpp%i_njproc = il_pnj
+
+            IF( ASSOCIATED(tf_mpp%t_proc) )THEN
+               CALL file_clean(tf_mpp%t_proc(:))
+               DEALLOCATE(tf_mpp%t_proc)
+            ENDIF
+            ALLOCATE( tf_mpp%t_proc(il_pnij) , stat=il_status )
+
+            ALLOCATE(il_lci (il_pnij))
+            ALLOCATE(il_lcj (il_pnij))
+            ALLOCATE(il_ldi (il_pnij))
+            ALLOCATE(il_ldj (il_pnij))
+            ALLOCATE(il_lei (il_pnij))
+            ALLOCATE(il_lej (il_pnij))
+            ALLOCATE(il_impp(il_pnij))
+            ALLOCATE(il_jmpp(il_pnij))
+
+            tl_proc=file_copy(td_file)
+            ! remove dimension from file
+            CALL dim_clean(tl_proc%t_dim(:))
+            ! initialise file/processors
+            DO ji=1,tf_mpp%i_nproc
+               tf_mpp%t_proc(ji)=file_copy(tl_proc)
+            ENDDO
+
+            IF( il_status /= 0 )THEN
+               CALL logger_error("MPP INIT READ: not enough space to read domain &
+               &              decomposition in file "//TRIM(td_file%c_name))
+            ENDIF
+
+            ! read first record 
+            READ( td_file%i_id, IOSTAT=il_status, REC=1 )& 
+               &  il_recl,                         &
+               &  il_nx, il_ny, il_nz,             &
+               &  il_n0d, il_n1d, il_n2d, il_n3d,  &
+               &  il_rhd,                          &
+               &  il_pni, il_pnj, il_pnij,         &
+               &  il_area,                         &
+               &  il_iglo, il_jglo,                &
+               &  il_lci(1:il_pnij),               &
+               &  il_lcj(1:il_pnij),               &
+               &  il_ldi(1:il_pnij),               &
+               &  il_ldj(1:il_pnij),               &
+               &  il_lei(1:il_pnij),               &
+               &  il_lej(1:il_pnij),               &
+               &  il_impp(1:il_pnij),              &
+               &  il_jmpp(1:il_pnij)
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_error("MPP INIT READ: read first line of "//&
+               &              TRIM(td_file%c_name))
+            ENDIF
+
+            tf_mpp%t_proc(1:il_pnij)%i_lci = il_lci (1:il_pnij)
+            tf_mpp%t_proc(1:il_pnij)%i_lcj = il_lcj (1:il_pnij) 
+            tf_mpp%t_proc(1:il_pnij)%i_ldi = il_ldi (1:il_pnij) 
+            tf_mpp%t_proc(1:il_pnij)%i_ldj = il_ldj (1:il_pnij) 
+            tf_mpp%t_proc(1:il_pnij)%i_lei = il_lei (1:il_pnij) 
+            tf_mpp%t_proc(1:il_pnij)%i_lej = il_lej (1:il_pnij) 
+            tf_mpp%t_proc(1:il_pnij)%i_impp= il_impp(1:il_pnij)
+            tf_mpp%t_proc(1:il_pnij)%i_jmpp= il_jmpp(1:il_pnij)
+
+            DEALLOCATE(il_lci) 
+            DEALLOCATE(il_lcj) 
+            DEALLOCATE(il_ldi) 
+            DEALLOCATE(il_ldj) 
+            DEALLOCATE(il_lei) 
+            DEALLOCATE(il_lej) 
+            DEALLOCATE(il_impp)
+            DEALLOCATE(il_jmpp)
+
+            ! global domain size
+            tl_dim=dim_init('X',il_iglo)
+            CALL mpp_add_dim(tf_mpp,tl_dim)
+            tl_dim=dim_init('Y',il_jglo)
+            CALL mpp_add_dim(tf_mpp,tl_dim)
+
+            tl_dim=dim_init('Z',il_nz)
+            CALL mpp_add_dim(tf_mpp,tl_dim)
+
+            DO ji=1,tf_mpp%i_nproc
+
+               ! get file name
+               cl_file =  file_rename(td_file%c_name,ji)
+               tf_mpp%t_proc(ji)%c_name = TRIM(cl_file)
+               ! update processor id
+               tf_mpp%t_proc(ji)%i_pid=ji
+
+               ! add attributes
+               tl_att=att_init( "DOMAIN_number", ji )
+               CALL file_move_att(tf_mpp%t_proc(ji), tl_att) 
+
+            ENDDO
+ 
+            ! add type
+            tf_mpp%t_proc(:)%c_type="dimg"
+
+            ! add attributes
+            tl_att=att_init("DOMAIN_size_global", tf_mpp%t_dim(:)%i_len)
+            CALL mpp_move_att(tf_mpp, tl_att)
+
+            tl_att=att_init("DOMAIN_number_total", tf_mpp%i_nproc)
+            CALL mpp_move_att(tf_mpp, tl_att)
+
+            tl_att=att_init("DOMAIN_I_number_total", tf_mpp%i_niproc)
+            CALL mpp_move_att(tf_mpp, tl_att)
+
+            tl_att=att_init("DOMAIN_J_number_total", tf_mpp%i_njproc)
+            CALL mpp_move_att(tf_mpp, tl_att)
+
+            CALL mpp_get_dom( tf_mpp )
+
+            CALL mpp__compute_halo( tf_mpp )
+
+            ! clean
+            CALL dim_clean(tl_dim)
+            CALL att_clean(tl_att)
+            CALL file_clean(tl_proc)
+         ENDIF
+
+      ELSE
+
+         CALL logger_error("MPP INIT READ: dimg file "//TRIM(td_file%c_name)//&
+         &  " do not exist")
+
+      ENDIF
+
+   END FUNCTION mpp__init_file_rstdimg
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION mpp__check_proc_dim(td_mpp, td_proc) &
+         & RESULT(lf_check)
+   !-------------------------------------------------------------------
+   !> @brief This function check if variable and mpp structure use same
+   !> dimension.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_mpp    mpp structure
+   !> @param[in] td_proc   processor structure
+   !> @return dimension of processor and mpp structure agree (or not)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP),  INTENT(IN) :: td_mpp
+      TYPE(TFILE), INTENT(IN) :: td_proc
+
+      !function
+      LOGICAL                 :: lf_check
+
+      ! local variable
+      INTEGER(i4) :: il_isize !< i-direction maximum sub domain size 
+      INTEGER(i4) :: il_jsize !< j-direction maximum sub domain size
+      !----------------------------------------------------------------
+
+      lf_check=.TRUE.
+      ! check used dimension 
+      IF( td_mpp%i_niproc /= 0 .AND. td_mpp%i_njproc /= 0 )THEN
+         ! check with maximum size of sub domain
+         il_isize = ( td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci + &
+            &        (td_mpp%i_niproc-1) ) / td_mpp%i_niproc + 2*td_mpp%i_preci
+         il_jsize = ( td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj + &
+            &        (td_mpp%i_njproc-1) ) / td_mpp%i_njproc + 2*td_mpp%i_precj
+
+         IF( il_isize < td_proc%i_lci .OR.                     &
+            &il_jsize < td_proc%i_lcj )THEN
+
+            lf_check=.FALSE.
+
+            CALL logger_error( "MPP CHECK DIM: processor and mpp dimension differ" )
+
+         ENDIF
+
+      ELSE
+         ! check with global domain size
+         IF( td_mpp%t_dim(1)%i_len < td_proc%i_lci .OR.                     &
+            &td_mpp%t_dim(2)%i_len < td_proc%i_lcj )THEN
+
+            lf_check=.FALSE.
+
+            CALL logger_error( "MPP CHECK DIM: processor and mpp dimension differ" )
+
+         ENDIF
+      ENDIF
+
+   END FUNCTION mpp__check_proc_dim
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE mpp_add_var(td_mpp, td_var)
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine add variable in all files of mpp structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !> @date January, 2019
+   !> - do not split variable on domain decomposition, if only one procesor 
+   !>
+   !> @param[inout] td_mpp mpp strcuture
+   !> @param[in]    td_var variable strcuture
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+
+      ! local variable
+      INTEGER(i4) :: il_varid
+      TYPE(TVAR)  :: tl_var
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( "MPP ADD VAR: processor decomposition not "//&
+         &  "define for mpp "//TRIM(td_mpp%c_name))
+
+      ELSE
+         ! check if variable exist
+         IF( TRIM(td_var%c_name) == '' .AND. &
+         &   TRIM(td_var%c_stdname) == '' )THEN
+            CALL logger_error("MPP ADD VAR: variable not define ")
+         ELSE
+            ! check if variable already in mpp structure
+            il_varid=0
+            IF( ASSOCIATED(td_mpp%t_proc(1)%t_var) )THEN
+               il_varid=var_get_index( td_mpp%t_proc(1)%t_var(:), &
+               &                       td_var%c_name, td_var%c_stdname )
+            ENDIF
+
+            IF( il_varid /= 0 )THEN
+
+               DO ji=1,td_mpp%t_proc(1)%i_nvar
+                  CALL logger_debug( " MPP ADD VAR: in mpp structure : &
+                  &  variable "//TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name)//&
+                  &  ", standard name "//&
+                  &  TRIM(td_mpp%t_proc(1)%t_var(ji)%c_stdname) )
+               ENDDO
+               CALL logger_error( " MPP ADD VAR: variable "//TRIM(td_var%c_name)//&
+               &  ", standard name "//TRIM(td_var%c_stdname)//&
+               &  ", already in mpp "//TRIM(td_mpp%c_name) )
+
+            ELSE
+ 
+               CALL logger_info( &
+               &  " MPP ADD VAR: add variable "//TRIM(td_var%c_name)//&
+               &  ", standard name "//TRIM(td_var%c_stdname)//&
+               &  ", in mpp "//TRIM(td_mpp%c_name) )
+               ! check used dimension 
+               IF( mpp__check_dim(td_mpp, td_var) )THEN
+ 
+                  ! check variable dimension expected
+                  CALL var_check_dim(td_var)
+
+                  ! update dimension if need be
+                  DO ji=1,ip_maxdim
+                     IF( td_var%t_dim(ji)%l_use .AND. &
+                     &   .NOT. td_mpp%t_dim(ji)%l_use )THEN
+                        CALL mpp_add_dim(td_mpp,td_var%t_dim(ji))
+                     ENDIF
+                  ENDDO
+
+                  ! add variable in each processor
+                  IF( td_mpp%i_nproc == 1 )THEN
+                     CALL file_add_var(td_mpp%t_proc(1), td_var)
+                  ELSE
+                     DO ji=1,td_mpp%i_nproc
+                        ! split variable on domain decomposition
+                        tl_var=mpp__split_var(td_mpp, td_var, ji)
+
+                        CALL file_add_var(td_mpp%t_proc(ji), tl_var)
+
+                        ! clean
+                        CALL var_clean(tl_var)
+                     ENDDO
+                  ENDIF
+
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE mpp_add_var
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION mpp__split_var(td_mpp, td_var, id_procid) &
+         & RESULT(tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function extract, from variable structure, part that will 
+   !> be written in processor id_procid.<br/>
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_mpp    mpp structure
+   !> @param[in] td_var    variable structure
+   !> @param[in] id_procid processor id
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP),  INTENT(IN) :: td_mpp
+      TYPE(TVAR),  INTENT(IN) :: td_var
+      INTEGER(i4), INTENT(IN) :: id_procid
+
+      ! function
+      TYPE(TVAR)              :: tf_var
+   
+      ! local variable
+      TYPE(TDIM)  :: tl_dim
+
+      INTEGER(i4), DIMENSION(4) :: il_ind
+      INTEGER(i4), DIMENSION(2) :: il_size
+      INTEGER(i4) :: il_i1
+      INTEGER(i4) :: il_i2
+      INTEGER(i4) :: il_j1
+      INTEGER(i4) :: il_j2
+      !----------------------------------------------------------------
+
+      ! copy mpp
+      tf_var=var_copy(td_var, ld_value=.FALSE.)
+
+      ! get processor indices
+      il_ind(:)=mpp_get_proc_index( td_mpp, id_procid )
+      il_i1 = il_ind(1)
+      il_i2 = il_ind(2)
+      il_j1 = il_ind(3)
+      il_j2 = il_ind(4)
+
+      IF( .NOT. td_var%t_dim(1)%l_use )THEN
+         il_i1=1 
+         il_i2=1 
+      ENDIF
+
+      IF( .NOT. td_var%t_dim(2)%l_use )THEN
+         il_j1=1 
+         il_j2=1 
+      ENDIF      
+
+      IF( ASSOCIATED(td_var%d_value) )THEN
+         ! remove value over global domain from pointer
+         !CALL var_del_value( tf_var )
+
+         ! get processor dimension
+         il_size(:)=mpp_get_proc_size( td_mpp, id_procid )
+
+         ! define new dimension in variable structure 
+         IF( td_var%t_dim(1)%l_use )THEN
+            tl_dim=dim_init( TRIM(td_var%t_dim(1)%c_name), il_size(1) )
+            CALL var_move_dim( tf_var, tl_dim )
+         ENDIF
+         IF( td_var%t_dim(2)%l_use )THEN
+            tl_dim=dim_init( TRIM(td_var%t_dim(2)%c_name), il_size(2) )
+            CALL var_move_dim( tf_var, tl_dim )      
+         ENDIF
+
+         ! add variable value on processor
+         CALL var_add_value( tf_var, &
+            &                td_var%d_value(il_i1:il_i2, il_j1:il_j2, :, :) )
+   
+      ELSE
+
+         tf_var%t_dim(jp_I)%i_len=il_i2-il_i1+1
+         tf_var%t_dim(jp_J)%i_len=il_j2-il_j1+1
+
+      ENDIF
+
+   END FUNCTION mpp__split_var
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE mpp__del_var_mpp(td_mpp)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine delete all variable in mpp strcuture.
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial version
+   !>
+   !> @param[inout] td_mpp mpp strcuture
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      CALL logger_info( &
+      &  "MPP CLEAN VAR: reset all variable "//&
+      &  "in mpp strcuture "//TRIM(td_mpp%c_name) )
+
+      IF( ASSOCIATED(td_mpp%t_proc) )THEN
+         DO ji=td_mpp%t_proc(1)%i_nvar,1,-1
+            CALL mpp_del_var(td_mpp, td_mpp%t_proc(1)%t_var(ji))
+         ENDDO
+      ENDIF
+
+   END SUBROUTINE mpp__del_var_mpp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE mpp__del_var_str(td_mpp, td_var)
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine delete variable in mpp structure, given variable
+   !> structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_mpp mpp strcuture
+   !> @param[in]    td_var variable strcuture
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+      TYPE(TVAR), INTENT(IN)    :: td_var
+
+      ! local variable
+      INTEGER(i4)       :: il_varid
+      CHARACTER(LEN=lc) :: cl_name
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( "MPP DEL VAR: domain decomposition not define "//&
+         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
+
+      ELSE
+
+         ! check if variable already in mpp structure
+         il_varid = 0
+         IF( ASSOCIATED(td_mpp%t_proc(1)%t_var) )THEN
+            il_varid=var_get_index( td_mpp%t_proc(1)%t_var(:), &
+            &                       td_var%c_name, td_var%c_stdname )
+         ENDIF
+         IF( il_varid == 0 )THEN
+            CALL logger_error( &
+            &  "MPP DEL VAR: no variable "//TRIM(td_var%c_name)//&
+            &  ", in mpp structure "//TRIM(td_mpp%c_name) )
+
+            DO ji=1,td_mpp%t_proc(1)%i_nvar
+               CALL logger_debug( "MPP DEL VAR: in mpp structure : &
+               &  variable : "//TRIM(td_mpp%t_proc(1)%t_var(ji)%c_name)//&
+               &  ", standard name "//&
+               &  TRIM(td_mpp%t_proc(1)%t_var(ji)%c_stdname) )
+            ENDDO
+
+         ELSE
+
+            cl_name=TRIM(td_var%c_name)
+            DO ji=1,td_mpp%i_nproc
+               CALL file_del_var(td_mpp%t_proc(ji), TRIM(cl_name)) 
+            ENDDO
+
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE mpp__del_var_str
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE mpp__del_var_name(td_mpp, cd_name)
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine delete variable in mpp structure, given variable name.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !> @date February, 2015 
+   !> - define local variable structure to avoid mistake with pointer
+   !> @date January, 2019
+   !> - clean variable strcuture
+   !>
+   !> @param[inout] td_mpp    mpp strcuture
+   !> @param[in]    cd_name   variable name
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP)      , INTENT(INOUT) :: td_mpp
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+
+      ! local variable
+      INTEGER(i4)       :: il_varid
+      TYPE(TVAR)        :: tl_var
+      !----------------------------------------------------------------
+
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( "MPP DEL VAR: domain decomposition not define "//&
+         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
+
+      ELSE
+
+         IF( td_mpp%t_proc(1)%i_nvar == 0 )THEN
+            CALL logger_debug( "MPP DEL VAR NAME: no variable associated to mpp &
+            &                 structure "//TRIM(td_mpp%c_name) )
+         ELSE
+
+            ! get the variable id, in file variable structure
+            il_varid=0
+            IF( ASSOCIATED(td_mpp%t_proc(1)%t_var) )THEN
+               il_varid=var_get_index( td_mpp%t_proc(1)%t_var(:), &
+               &                       cd_name )
+            ENDIF
+
+            IF( il_varid == 0 )THEN
+
+               CALL logger_warn( &
+               &  "MPP DEL VAR : there is no variable with name "//&
+               &  "or standard name "//TRIM(ADJUSTL(cd_name))//&
+               &  " in mpp structure "//TRIM(td_mpp%c_name))
+
+            ELSE
+
+               tl_var=var_copy(td_mpp%t_proc(1)%t_var(il_varid))
+               CALL mpp_del_var(td_mpp, tl_var)
+               ! clean
+               CALL var_clean(tl_var)
+            ENDIF
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE mpp__del_var_name
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE mpp_move_var(td_mpp, td_var)
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine overwrite variable in mpp structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_mpp mpp strcuture
+   !> @param[in]    td_var variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+      TYPE(TVAR), INTENT(IN)    :: td_var
+
+      !local variable
+      TYPE(TVAR) :: tl_var
+      !----------------------------------------------------------------
+
+      ! copy variablie
+      tl_var=var_copy(td_var)
+
+      ! remove processor
+      CALL mpp_del_var(td_mpp, tl_var)
+
+      ! add processor
+      CALL mpp_add_var(td_mpp, tl_var)
+
+      ! clean 
+      CALL var_clean(tl_var)
+
+   END SUBROUTINE mpp_move_var
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE mpp__add_proc_unit(td_mpp, td_proc)
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine add processor to mpp structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !> @date January, 2019
+   !> - deallocate file structure whatever happens 
+   !
+   !> @param[inout] td_mpp    mpp strcuture
+   !> @param[in]    td_proc   processor strcuture
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP) , INTENT(INOUT) :: td_mpp
+      TYPE(TFILE), INTENT(IN)    :: td_proc
+
+      ! local variable
+      INTEGER(i4)                                  :: il_status
+      INTEGER(i4)                                  :: il_procid
+      INTEGER(i4)      , DIMENSION(1)              :: il_ind
+
+      TYPE(TFILE)      , DIMENSION(:), ALLOCATABLE :: tl_proc
+
+      CHARACTER(LEN=lc)                            :: cl_name
+      !----------------------------------------------------------------
+
+      ! check file name
+      cl_name=TRIM( file_rename(td_proc%c_name) )
+      IF( TRIM(cl_name) /=  TRIM(td_mpp%c_name) )THEN
+         CALL logger_warn("MPP ADD PROC: processor name do not match mpp name")
+      ENDIF
+
+      il_procid=0
+      IF( ASSOCIATED(td_mpp%t_proc) )THEN
+         ! check if processor already in mpp structure
+         il_ind(:)=MINLOC( td_mpp%t_proc(:)%i_pid, &
+                     mask=(td_mpp%t_proc(:)%i_pid==td_proc%i_pid) )
+         il_procid=il_ind(1)
+      ENDIF
+
+      IF( il_procid /= 0 )THEN
+
+            CALL logger_error( &
+            &  "MPP ADD PROC: processor "//TRIM(fct_str(td_proc%i_pid))//&
+            &  ", already in mpp structure " )
+
+      ELSE
+ 
+         CALL logger_trace("MPP ADD PROC: add processor "//&
+         &               TRIM(fct_str(td_mpp%i_nproc+1))//" in mpp structure")
+
+         IF( td_mpp%i_nproc > 0 )THEN
+            ! 
+            il_ind(:)=MAXLOC( td_mpp%t_proc(:)%i_pid, &
+                        mask=(td_mpp%t_proc(:)%i_pid < td_proc%i_pid) )
+            il_procid=il_ind(1)
+
+            ! already other processor in mpp structure
+            ALLOCATE( tl_proc(td_mpp%i_nproc), stat=il_status )
+            IF(il_status /= 0 )THEN
+
+               CALL logger_error( "MPP ADD PROC: not enough space to put processor &
+               &               in mpp structure")
+
+            ELSE
+               ! save temporary mpp structure
+               tl_proc(:)=file_copy(td_mpp%t_proc(:))
+
+               CALL file_clean( td_mpp%t_proc(:) )
+               DEALLOCATE(td_mpp%t_proc)
+               ALLOCATE( td_mpp%t_proc(td_mpp%i_nproc+1), stat=il_status)
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( "MPP ADD PROC: not enough space to put "//&
+                  &  "processor in mpp structure ")
+
+               ENDIF
+
+               ! copy processor in mpp before
+               ! processor with lower id than new processor
+               td_mpp%t_proc( 1:il_procid ) = file_copy(tl_proc( 1:il_procid ))
+
+               ! processor with greater id than new processor
+               td_mpp%t_proc( il_procid+1 : td_mpp%i_nproc+1 ) = &
+               &              file_copy(tl_proc( il_procid : td_mpp%i_nproc ))
+
+               ! clean
+               CALL file_clean(tl_proc(:))
+            ENDIF
+            DEALLOCATE(tl_proc)
+
+         ELSE
+            
+            ! no processor in mpp structure
+            IF( ASSOCIATED(td_mpp%t_proc) )THEN
+               CALL file_clean(td_mpp%t_proc(:))
+               DEALLOCATE(td_mpp%t_proc)
+            ENDIF
+            ALLOCATE( td_mpp%t_proc(td_mpp%i_nproc+1), stat=il_status )
+            IF(il_status /= 0 )THEN
+
+               CALL logger_error( "MPP ADD PROC: not enough space to put "//&
+               &  "processor in mpp structure " )
+
+            ENDIF
+         ENDIF
+
+         ! check dimension
+         IF( ANY(td_mpp%t_dim(1:2)%i_len < td_proc%t_dim(1:2)%i_len) )THEN
+            CALL logger_error( "MPP ADD PROC: mpp structure and new processor "//&
+            &  " dimension differ. ")
+            CALL logger_debug("MPP ADD PROC: mpp dimension ("//&
+            &  TRIM(fct_str(td_mpp%t_dim(1)%i_len))//","//&
+            &  TRIM(fct_str(td_mpp%t_dim(2)%i_len))//")" )
+            CALL logger_debug("MPP ADD PROC: processor dimension ("//&
+            &  TRIM(fct_str(td_proc%t_dim(1)%i_len))//","//&
+            &  TRIM(fct_str(td_proc%t_dim(2)%i_len))//")" )
+         ELSE
+            td_mpp%i_nproc=td_mpp%i_nproc+1
+
+            ! add new processor
+            td_mpp%t_proc(td_mpp%i_nproc)=file_copy(td_proc)
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE mpp__add_proc_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE mpp__add_proc_arr(td_mpp, td_proc)
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine add array of processor to mpp structure.
+   !>    @note mpp structure should be empty
+   !>
+   !> @author J.Paul
+   !> @date August, 2017 - Initial version
+   !>
+   !> @param[inout] td_mpp    mpp strcuture
+   !> @param[in]    td_proc   array of processor strcuture
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP)               , INTENT(INOUT) :: td_mpp
+      TYPE(TFILE), DIMENSION(:), INTENT(IN   ) :: td_proc
+
+      ! local variable
+      INTEGER(i4)                                  :: il_status
+      INTEGER(i4)                                  :: il_nproc
+
+      CHARACTER(LEN=lc)                            :: cl_name
+      !----------------------------------------------------------------
+
+      ! check file name
+      cl_name=TRIM( file_rename(td_proc(1)%c_name) )
+      IF( TRIM(cl_name) /=  TRIM(td_mpp%c_name) )THEN
+         CALL logger_warn("MPP ADD PROC: processor name do not match mpp name")
+      ENDIF
+
+      IF( ASSOCIATED(td_mpp%t_proc) )THEN
+            CALL logger_error( &
+            &  "MPP ADD PROC: some processor(s) already in mpp structure " )
+
+      ELSE
+ 
+         CALL logger_trace("MPP ADD PROC: add array of processor "//&
+         &                 " in mpp structure")
+
+         il_nproc=SIZE(td_proc)
+         ALLOCATE( td_mpp%t_proc(il_nproc), stat=il_status )
+         IF(il_status /= 0 )THEN
+            CALL logger_error( "MPP ADD PROC: not enough space to put "//&
+            &  "processor in mpp structure " )
+         ENDIF
+
+         ! check dimension
+         IF( ANY(td_mpp%t_dim(1:2)%i_len < td_proc(1)%t_dim(1:2)%i_len) )THEN
+            CALL logger_error( "MPP ADD PROC: mpp structure and new processor "//&
+            &  " dimension differ. ")
+            CALL logger_debug("MPP ADD PROC: mpp dimension ("//&
+            &  TRIM(fct_str(td_mpp%t_dim(1)%i_len))//","//&
+            &  TRIM(fct_str(td_mpp%t_dim(2)%i_len))//")" )
+            CALL logger_debug("MPP ADD PROC: processor dimension ("//&
+            &  TRIM(fct_str(td_proc(1)%t_dim(1)%i_len))//","//&
+            &  TRIM(fct_str(td_proc(1)%t_dim(2)%i_len))//")" )
+         ELSE
+            td_mpp%i_nproc=il_nproc
+
+            ! add new processor
+            td_mpp%t_proc(:)=file_copy(td_proc(:))
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE mpp__add_proc_arr   
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE mpp__del_proc_id(td_mpp, id_procid)
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine delete processor in mpp structure, given processor id.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !> @date January, 2019
+   !> - clean file structure
+   !>
+   !> @param[inout] td_mpp    mpp strcuture
+   !> @param[in]    id_procid processor id
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP),   INTENT(INOUT) :: td_mpp
+      INTEGER(i4),  INTENT(IN)    :: id_procid
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_procid
+      INTEGER(i4), DIMENSION(1) :: il_ind
+      TYPE(TFILE), DIMENSION(:), ALLOCATABLE :: tl_proc
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      il_ind(:)=MINLOC(td_mpp%t_proc(:)%i_pid,td_mpp%t_proc(:)%i_pid==id_procid)
+      il_procid=il_ind(1)
+      IF( il_procid == 0 )THEN
+         CALL logger_error("MPP DEL PROC: no processor "//&
+         &                 TRIM(fct_str(id_procid))//&
+         &                 " associated to mpp structure")
+      ELSE
+         CALL logger_trace("DEL PROC: remove processor "//&
+         &                 TRIM(fct_str(id_procid)))
+
+         IF( td_mpp%i_nproc > 1 )THEN
+            ALLOCATE( tl_proc(td_mpp%i_nproc-1), stat=il_status )
+            IF(il_status /= 0 )THEN
+               CALL logger_error( "MPP DEL PROC: not enough space to put &
+               &  processor in temporary mpp structure")
+
+            ELSE
+
+               ! save temporary processor's mpp structure
+               IF( il_procid > 1 )THEN
+                  tl_proc(1:il_procid-1)=file_copy(td_mpp%t_proc(1:il_procid-1))
+               ENDIF
+
+               IF( il_procid < td_mpp%i_nproc )THEN
+                  tl_proc(il_procid:)=file_copy(td_mpp%t_proc(il_procid+1:))
+               ENDIF
+
+               ! new number of processor in mpp
+               td_mpp%i_nproc=td_mpp%i_nproc-1
+
+               CALL file_clean( td_mpp%t_proc(:) )
+               DEALLOCATE(td_mpp%t_proc)
+               ALLOCATE( td_mpp%t_proc(td_mpp%i_nproc), stat=il_status )
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( "MPP DEL PROC: not enough space &
+                  &  to put processors in mpp structure " )
+
+               ELSE
+
+                  ! copy processor in mpp before
+                  td_mpp%t_proc(:)=file_copy(tl_proc(:))
+
+                  ! update processor id
+                  td_mpp%t_proc( il_procid : td_mpp%i_nproc )%i_pid = &
+                  &     td_mpp%t_proc( il_procid : td_mpp%i_nproc )%i_pid - 1
+
+               ENDIF
+            ENDIF
+            ! clean
+            CALL file_clean( tl_proc(:) )
+            DEALLOCATE(tl_proc)
+         ELSE
+            CALL file_clean( td_mpp%t_proc(:) )
+            DEALLOCATE(td_mpp%t_proc)
+
+            ! new number of processor in mpp
+            td_mpp%i_nproc=td_mpp%i_nproc-1
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE mpp__del_proc_id
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE mpp__del_proc_str(td_mpp, td_proc)
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine delete processor in mpp structure, given processor
+   !>    structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_mpp : mpp strcuture
+   !> @param[in]    td_proc : file/processor structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP),   INTENT(INOUT) :: td_mpp
+      TYPE(TFILE),  INTENT(IN)    :: td_proc
+      !----------------------------------------------------------------
+
+      IF( td_proc%i_pid >= 0 )THEN
+         CALL mpp__del_proc( td_mpp, td_proc%i_pid )
+      ELSE
+         CALL logger_error("MPP DEL PROC: processor not defined")
+      ENDIF
+
+   END SUBROUTINE mpp__del_proc_str
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE mpp__move_proc(td_mpp, td_proc)
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine overwrite processor in mpp structure.
+   !>
+   !> @detail
+   !>
+   !> @author J.Paul
+   !> @date Nov, 2013 - Initial version
+   !>
+   !> @param[inout] td_mpp    mpp strcuture
+   !> @param[in]    id_procid processor id
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP),  INTENT(INOUT) :: td_mpp
+      TYPE(TFILE), INTENT(IN)    :: td_proc
+      !----------------------------------------------------------------
+
+      ! remove processor
+      CALL mpp__del_proc(td_mpp, td_proc)
+
+      ! add processor
+      CALL mpp__add_proc(td_mpp, td_proc)
+
+   END SUBROUTINE mpp__move_proc
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE mpp_add_dim(td_mpp, td_dim)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add a dimension structure in a mpp 
+   !> structure.
+   !> Do not overwrite, if dimension already in mpp structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - rewrite the same as way var_add_dim
+   !>
+   !> @param[inout] td_mpp mpp structure
+   !> @param[in] td_dim    dimension structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+      TYPE(TDIM), INTENT(IN)    :: td_dim
+
+      ! local variable
+      INTEGER(i4) :: il_ind
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( td_mpp%i_ndim <= ip_maxdim )THEN
+
+         ! check if dimension already used in mpp structure
+         il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname))
+         IF( il_ind == 0 )THEN
+            CALL logger_warn( &
+            &  " MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//&
+            &  ", short name "//TRIM(td_dim%c_sname)//&
+            &  ", will not be added in mpp "//TRIM(td_mpp%c_name) )
+         ELSEIF( td_mpp%t_dim(il_ind)%l_use )THEN
+            CALL logger_error( &
+            &  " MPP ADD DIM: dimension "//TRIM(td_dim%c_name)//&
+            &  ", short name "//TRIM(td_dim%c_sname)//&
+            &  ", already used in mpp "//TRIM(td_mpp%c_name) )
+         ELSE
+
+            ! back to disorder dimension array 
+            CALL dim_disorder(td_mpp%t_dim(:))
+
+            ! add new dimension
+            td_mpp%t_dim(td_mpp%i_ndim+1)=dim_copy(td_dim)
+
+            ! update number of attribute
+            td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use)
+
+         ENDIF
+         ! reorder dimension to ('x','y','z','t')
+         CALL dim_reorder(td_mpp%t_dim(:))
+
+      ELSE
+         CALL logger_error( &
+         &  "MPP ADD DIM: too much dimension in mpp "//&
+         &  TRIM(td_mpp%c_name)//" ("//TRIM(fct_str(td_mpp%i_ndim))//")")
+      ENDIF
+
+   END SUBROUTINE mpp_add_dim
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE mpp_del_dim(td_mpp, td_dim)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine delete a dimension structure in a mpp 
+   !> structure.<br/>
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - rewrite the same as way var_del_dim
+   !>
+   !> @param[inout] td_mpp mpp structure
+   !> @param[in] td_dim    dimension structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+      TYPE(TDIM), INTENT(IN)    :: td_dim
+
+      ! local variable
+      INTEGER(i4) :: il_ind
+      TYPE(TDIM)  :: tl_dim
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( td_mpp%i_ndim <= ip_maxdim )THEN
+
+         CALL logger_trace( &
+         &  " MPP DEL DIM: delete dimension "//TRIM(td_dim%c_name)//&
+         &  ", short name "//TRIM(td_dim%c_sname)//&
+         &  ", in mpp "//TRIM(td_mpp%c_name) )
+         
+         ! check if dimension already in variable structure
+         il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname))
+
+         ! replace dimension by empty one
+         td_mpp%t_dim(il_ind)=dim_copy(tl_dim)
+
+         ! update number of dimension
+         td_mpp%i_ndim=COUNT(td_mpp%t_dim(:)%l_use)
+
+         ! reorder dimension to ('x','y','z','t')
+         CALL dim_reorder(td_mpp%t_dim)
+
+      ELSE
+         CALL logger_error( &
+         &  " MPP DEL DIM: too much dimension in mpp "//&
+         &  TRIM(td_mpp%c_name)//" ("//TRIM(fct_str(td_mpp%i_ndim))//")")
+      ENDIF
+
+   END SUBROUTINE mpp_del_dim
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE mpp_move_dim(td_mpp, td_dim)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine move a dimension structure 
+   !> in mpp structure.
+   !> @warning dimension order may have changed
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_mpp mpp structure
+   !> @param[in] td_dim    dimension structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+      TYPE(TDIM), INTENT(IN)    :: td_dim
+
+      ! local variable
+      INTEGER(i4) :: il_ind
+      INTEGER(i4) :: il_dimid
+      !----------------------------------------------------------------
+
+      IF( td_mpp%i_ndim <= ip_maxdim )THEN
+
+         ! check if dimension already in mpp structure
+         il_ind=dim_get_index(td_mpp%t_dim(:), td_dim%c_name, td_dim%c_sname)
+         IF( il_ind /= 0 )THEN
+
+            il_dimid=td_mpp%t_dim(il_ind)%i_id
+            ! replace dimension
+            td_mpp%t_dim(il_ind)=dim_copy(td_dim)
+            td_mpp%t_dim(il_ind)%i_id=il_dimid
+            td_mpp%t_dim(il_ind)%l_use=.TRUE.
+
+         ELSE
+            CALL mpp_add_dim(td_mpp, td_dim)
+         ENDIF
+
+      ELSE
+         CALL logger_error( &
+         &  "MPP MOVE DIM: too much dimension in mpp "//&
+         &  TRIM(td_mpp%c_name)//" ("//TRIM(fct_str(td_mpp%i_ndim))//")")
+      ENDIF
+
+   END SUBROUTINE mpp_move_dim
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE mpp_add_att(td_mpp, td_att)
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine add global attribute to mpp structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_mpp mpp strcuture
+   !> @param[in]    td_att attribute strcuture
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+      TYPE(TATT), INTENT(IN)    :: td_att
+
+      ! local variable
+      INTEGER(i4) :: il_attid
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_error( "MPP ADD ATT: domain decomposition not define "//&
+         &               "for mpp "//TRIM(td_mpp%c_name))
+
+      ELSE
+         ! check if variable exist
+         IF( TRIM(td_att%c_name) == '' )THEN
+            CALL logger_error("MPP ADD ATT: attribute not define ")
+         ELSE
+            ! check if attribute already in mpp structure
+            il_attid=0
+            IF( ASSOCIATED(td_mpp%t_proc(1)%t_att) )THEN
+               il_attid=att_get_index( td_mpp%t_proc(1)%t_att(:), &
+               &                    td_att%c_name )
+            ENDIF
+            IF( il_attid /= 0 )THEN
+
+               CALL logger_error( " MPP ADD ATT: attribute "//&
+               &                 TRIM(td_att%c_name)//&
+               &                 ", already in mpp "//TRIM(td_mpp%c_name) )
+
+               DO ji=1,td_mpp%t_proc(1)%i_natt
+                  CALL logger_debug( " MPP ADD ATT: in mpp structure : &
+                  &  attribute "//TRIM(td_mpp%t_proc(1)%t_att(ji)%c_name) )
+               ENDDO
+
+            ELSE
+            
+               CALL logger_info( &
+               &  " MPP ADD ATT: add attribute "//TRIM(td_att%c_name)//&
+               &  ", in mpp "//TRIM(td_mpp%c_name) )
+
+               ! add attribute in each processor
+               DO ji=1,td_mpp%i_nproc
+
+                  CALL file_add_att(td_mpp%t_proc(ji), td_att)
+
+               ENDDO
+
+            ENDIF
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE mpp_add_att
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE mpp__del_att_str(td_mpp, td_att)
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine delete attribute in mpp structure, given attribute
+   !> structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_mpp mpp strcuture
+   !> @param[in]    td_att attribute strcuture
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+      TYPE(TATT), INTENT(IN)    :: td_att
+
+      ! local variable
+      INTEGER(i4)       :: il_attid
+      CHARACTER(LEN=lc) :: cl_name
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_warn( "MPP DEL VAR: domain decomposition not define "//&
+         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
+
+      ELSE
+
+         ! check if attribute already in mpp structure
+         il_attid=0
+         IF( ASSOCIATED(td_mpp%t_proc(1)%t_att) )THEN
+            il_attid=att_get_index( td_mpp%t_proc(1)%t_att(:), &
+            &                    td_att%c_name )
+         ENDIF
+         IF( il_attid == 0 )THEN
+            CALL logger_warn( &
+            &  "MPP DEL VAR: no attribute "//TRIM(td_att%c_name)//&
+            &  ", in mpp structure "//TRIM(td_mpp%c_name) )
+
+            IF( ASSOCIATED(td_mpp%t_proc(1)%t_att) )THEN
+               DO ji=1,td_mpp%t_proc(1)%i_natt
+                  CALL logger_debug( "MPP DEL ATT: in mpp structure : &
+                  &  attribute : "//TRIM(td_mpp%t_proc(1)%t_att(ji)%c_name) )
+               ENDDO
+            ENDIF
+
+         ELSE
+
+            cl_name=TRIM(td_att%c_name)
+            CALL logger_debug( "MPP DEL ATT: delete in mpp structure : &
+            &  attribute : "//TRIM(cl_name) )
+            DO ji=1,td_mpp%i_nproc
+               CALL file_del_att(td_mpp%t_proc(ji), TRIM(cl_name)) 
+            ENDDO
+
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE mpp__del_att_str
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE mpp__del_att_name(td_mpp, cd_name)
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine delete attribute in mpp structure, given attribute name.
+   !>
+   !> @detail
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !> @date February, 2015 
+   !> - define local attribute structure to avoid mistake with pointer
+   !> @date January, 2019
+   !> - clean attributes structure
+   !>
+   !> @param[inout] td_mpp    mpp strcuture
+   !> @param[in]    cd_name   attribute name
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP)       , INTENT(INOUT) :: td_mpp
+      CHARACTER(LEN=*) , INTENT(IN   ) :: cd_name
+
+      ! local variable
+      INTEGER(i4) :: il_attid
+      TYPE(TATT)  :: tl_att
+      !----------------------------------------------------------------
+
+      ! check if mpp exist
+      IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
+
+         CALL logger_warn( "MPP DEL ATT: domain decomposition not define "//&
+         &               " in mpp strcuture "//TRIM(td_mpp%c_name))
+
+      ELSE
+
+         IF( td_mpp%t_proc(1)%i_natt == 0 )THEN
+            CALL logger_debug( "MPP DEL ATT NAME: no attribute associated to mpp &
+            &                 structure "//TRIM(td_mpp%c_name) )
+         ELSE
+
+            ! get the attribute id, in file variable structure
+            il_attid=0
+            IF( ASSOCIATED(td_mpp%t_proc(1)%t_att) )THEN
+               il_attid=att_get_id( td_mpp%t_proc(1)%t_att(:), &
+               &                    cd_name )
+            ENDIF
+
+            IF( il_attid == 0 )THEN
+
+               CALL logger_debug( &
+               &  "MPP DEL ATT : there is no attribute with "//&
+               &  "name "//TRIM(cd_name)//" in mpp structure "//&
+               &  TRIM(td_mpp%c_name))
+
+            ELSE
+
+               tl_att=att_copy(td_mpp%t_proc(1)%t_att(il_attid))
+               CALL mpp_del_att(td_mpp, tl_att) 
+               ! clean
+               CALL att_clean(tl_att)
+            ENDIF
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE mpp__del_att_name
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE mpp_move_att(td_mpp, td_att)
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine overwrite attribute in mpp structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_mpp mpp strcuture
+   !> @param[in]    td_att attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+      TYPE(TATT), INTENT(IN)    :: td_att
+
+      !local variable
+      TYPE(TATT)  :: tl_att
+      !----------------------------------------------------------------
+
+      ! copy variable
+      tl_att=att_copy(td_att)
+
+      ! remove processor
+      CALL mpp_del_att(td_mpp, tl_att)
+
+      ! add processor
+      CALL mpp_add_att(td_mpp, tl_att)
+
+      ! clean
+      CALL att_clean(tl_att)
+
+   END SUBROUTINE mpp_move_att
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION layout__init(td_mpp, id_mask, id_niproc, id_njproc) &
+         & RESULT(tf_lay)
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This function initialise domain layout
+   !> 
+   !> @detail
+   !> Domain layout is first computed, with domain dimension, overlap between subdomain,
+   !> and the number of processors following I and J.
+   !> Then the number of sea/land processors is compute with mask
+   !>
+   !> @author J.Paul
+   !> @date October, 2015 - Initial version
+   !> @date October, 2016
+   !> - compare index to tf_lay number of proc instead of td_mpp (bug fix)
+   !>
+   !> @param[in] td_mpp mpp strcuture
+   !> @param[in] id_mask   sub domain mask (sea=1, land=0)
+   !> @pâram[in] id_niproc number of processors following I
+   !> @pâram[in] id_njproc number of processors following J
+   !> @return domain layout structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP)                 , INTENT(IN) :: td_mpp
+      INTEGER(i4), DIMENSION(:,:), INTENT(IN) :: id_mask
+      INTEGER(i4)                , INTENT(IN) :: id_niproc
+      INTEGER(i4)                , INTENT(IN) :: id_njproc
+
+      ! function
+      TYPE(TLAY)                              :: tf_lay
+
+      ! local variable
+      INTEGER(i4) :: ii1, ii2
+      INTEGER(i4) :: ij1, ij2
+
+      INTEGER(i4) :: il_ldi
+      INTEGER(i4) :: il_ldj
+      INTEGER(i4) :: il_lei
+      INTEGER(i4) :: il_lej
+
+      INTEGER(i4) :: il_isize !< i-direction maximum sub domain size 
+      INTEGER(i4) :: il_jsize !< j-direction maximum sub domain size
+      INTEGER(i4) :: il_resti !<  
+      INTEGER(i4) :: il_restj !<  
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      ! intialise
+      tf_lay%i_niproc=id_niproc
+      tf_lay%i_njproc=id_njproc
+
+      CALL logger_info( "MPP COMPUTE LAYOUT: compute domain layout with "//&
+         &              TRIM(fct_str(tf_lay%i_niproc))//" x "//&
+         &              TRIM(fct_str(tf_lay%i_njproc))//" processors")
+
+      ! maximum size of sub domain
+      il_isize = ((td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci + (tf_lay%i_niproc-1))/ &
+         &         tf_lay%i_niproc) + 2*td_mpp%i_preci
+      il_jsize = ((td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj + (tf_lay%i_njproc-1))/ &
+         &         tf_lay%i_njproc) + 2*td_mpp%i_precj
+
+      il_resti = MOD(td_mpp%t_dim(1)%i_len - 2*td_mpp%i_preci, tf_lay%i_niproc)
+      il_restj = MOD(td_mpp%t_dim(2)%i_len - 2*td_mpp%i_precj, tf_lay%i_njproc)
+      IF( il_resti == 0 ) il_resti = tf_lay%i_niproc
+      IF( il_restj == 0 ) il_restj = tf_lay%i_njproc
+
+      ! compute dimension of each sub domain
+      ALLOCATE( tf_lay%i_lci(tf_lay%i_niproc,tf_lay%i_njproc) )
+      ALLOCATE( tf_lay%i_lcj(tf_lay%i_niproc,tf_lay%i_njproc) )
+
+      tf_lay%i_lci( 1          : il_resti       , : ) = il_isize
+      tf_lay%i_lci( il_resti+1 : tf_lay%i_niproc, : ) = il_isize-1
+
+      tf_lay%i_lcj( : , 1          : il_restj       ) = il_jsize
+      tf_lay%i_lcj( : , il_restj+1 : tf_lay%i_njproc) = il_jsize-1
+
+      ! compute first index of each sub domain
+      ALLOCATE( tf_lay%i_impp(tf_lay%i_niproc,tf_lay%i_njproc) )
+      ALLOCATE( tf_lay%i_jmpp(tf_lay%i_niproc,tf_lay%i_njproc) )
+
+      tf_lay%i_impp(:,:)=1
+      tf_lay%i_jmpp(:,:)=1
+
+      IF( tf_lay%i_niproc > 1 )THEN
+         DO jj=1,tf_lay%i_njproc
+            DO ji=2,tf_lay%i_niproc
+               tf_lay%i_impp(ji,jj) = tf_lay%i_impp(ji-1,jj) + &
+                  &                   tf_lay%i_lci (ji-1,jj) - 2*td_mpp%i_preci
+            ENDDO
+         ENDDO
+      ENDIF
+
+      IF( tf_lay%i_njproc > 1 )THEN
+         DO jj=2,tf_lay%i_njproc
+            DO ji=1,tf_lay%i_niproc
+               tf_lay%i_jmpp(ji,jj) = tf_lay%i_jmpp(ji,jj-1) + &
+                  &                   tf_lay%i_lcj (ji,jj-1) - 2*td_mpp%i_precj
+            ENDDO
+         ENDDO 
+      ENDIF
+
+      ALLOCATE( tf_lay%i_msk(tf_lay%i_niproc,tf_lay%i_njproc) )
+      tf_lay%i_msk(:,:)=0
+      ! init number of sea/land proc
+      tf_lay%i_nsea=0
+      tf_lay%i_nland=tf_lay%i_njproc*tf_lay%i_niproc
+
+      ! check if processor is land or sea
+      DO jj = 1,tf_lay%i_njproc
+         DO ji = 1,tf_lay%i_niproc
+
+            ! compute first and last indoor indices
+            ! west boundary
+            IF( ji == 1 )THEN
+               il_ldi = 1 
+            ELSE
+               il_ldi = 1 + td_mpp%i_preci
+            ENDIF
+
+            ! south boundary
+            IF( jj == 1 )THEN
+               il_ldj = 1 
+            ELSE
+               il_ldj = 1 + td_mpp%i_precj
+            ENDIF
+
+            ! east boundary
+            IF( ji == tf_lay%i_niproc )THEN
+               il_lei = tf_lay%i_lci(ji,jj)
+            ELSE
+               il_lei = tf_lay%i_lci(ji,jj) - td_mpp%i_preci
+            ENDIF
+
+            ! north boundary
+            IF( jj == tf_lay%i_njproc )THEN
+               il_lej = tf_lay%i_lcj(ji,jj)
+            ELSE
+               il_lej = tf_lay%i_lcj(ji,jj) - td_mpp%i_precj
+            ENDIF
+
+            ii1=tf_lay%i_impp(ji,jj) + il_ldi - 1
+            ii2=tf_lay%i_impp(ji,jj) + il_lei - 1
+
+            ij1=tf_lay%i_jmpp(ji,jj) + il_ldj - 1
+            ij2=tf_lay%i_jmpp(ji,jj) + il_lej - 1
+
+            tf_lay%i_msk(ji,jj)=SUM( id_mask(ii1:ii2,ij1:ij2) )
+            IF( tf_lay%i_msk(ji,jj) > 0 )THEN ! sea
+               tf_lay%i_nsea =tf_lay%i_nsea +1
+               tf_lay%i_nland=tf_lay%i_nland-1
+            ENDIF
+
+         ENDDO
+      ENDDO
+
+      CALL logger_info( "MPP COMPUTE LAYOUT: sea proc "//TRIM(fct_str(tf_lay%i_nsea)))
+      CALL logger_info( "MPP COMPUTE LAYOUT: land proc "//TRIM(fct_str(tf_lay%i_nland)))
+      CALL logger_info( "MPP COMPUTE LAYOUT: sum "//TRIM(fct_str( SUM(tf_lay%i_msk(:,:)))))
+
+      tf_lay%i_mean= SUM(tf_lay%i_msk(:,:)) / tf_lay%i_nsea
+      tf_lay%i_min = MINVAL(tf_lay%i_msk(:,:),tf_lay%i_msk(:,:)/=0)
+      tf_lay%i_max = MAXVAL(tf_lay%i_msk(:,:))
+
+      IF( lm_layout )THEN
+         ! print info 
+         WRITE(im_iumout,*) ' '
+         WRITE(im_iumout,*) " jpni=",tf_lay%i_niproc ," jpnj=",tf_lay%i_njproc
+         WRITE(im_iumout,*) " jpi= ",il_isize," jpj= ",il_jsize
+         WRITE(im_iumout,*) " iresti=",td_mpp%i_preci," irestj=",td_mpp%i_precj
+
+
+         WRITE(im_iumout,*) ' nombre de processeurs       ',tf_lay%i_niproc*tf_lay%i_njproc
+         WRITE(im_iumout,*) ' nombre de processeurs mer   ',tf_lay%i_nsea
+         WRITE(im_iumout,*) ' nombre de processeurs terre ',tf_lay%i_nland
+         WRITE(im_iumout,*) ' moyenne de recouvrement     ',tf_lay%i_mean
+         WRITE(im_iumout,*) ' minimum de recouvrement     ',tf_lay%i_min
+         WRITE(im_iumout,*) ' maximum de recouvrement     ',tf_lay%i_max
+      ENDIF
+
+   END FUNCTION layout__init
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE layout__clean(td_lay)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine clean domain layout strcuture.
+   !>
+   !> @author J.Paul
+   !> @date October, 2015 - Initial version
+   !> @date January, 2019
+   !> - nullify array in layout structure
+   !>
+   !> @param[inout] td_lay domain layout strcuture
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TLAY),  INTENT(INOUT) :: td_lay
+      !----------------------------------------------------------------
+
+      IF( ASSOCIATED(td_lay%i_msk) )THEN
+         DEALLOCATE(td_lay%i_msk)
+         NULLIFY(td_lay%i_msk)
+      ENDIF
+      IF( ASSOCIATED(td_lay%i_impp) )THEN
+         DEALLOCATE(td_lay%i_impp)
+         NULLIFY(td_lay%i_impp)
+      ENDIF
+      IF( ASSOCIATED(td_lay%i_jmpp) )THEN
+         DEALLOCATE(td_lay%i_jmpp)
+         NULLIFY(td_lay%i_jmpp)
+      ENDIF
+      IF( ASSOCIATED(td_lay%i_lci) )THEN
+         DEALLOCATE(td_lay%i_lci)
+         NULLIFY(td_lay%i_lci)
+      ENDIF
+      IF( ASSOCIATED(td_lay%i_lcj) )THEN
+         DEALLOCATE(td_lay%i_lcj)
+         NULLIFY(td_lay%i_lcj)
+      ENDIF
+
+      td_lay%i_niproc=0
+      td_lay%i_njproc=0
+      td_lay%i_nland =0
+      td_lay%i_nsea  =0
+
+      td_lay%i_mean  =0
+      td_lay%i_min   =0
+      td_lay%i_max   =0
+
+   END SUBROUTINE layout__clean
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION layout__copy(td_lay) &
+         & RESULT(tf_lay)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy domain layout structure in another one.
+   !>
+   !> @warning do not use on the output of a function who create or read a
+   !> structure (ex: tl_seg=seg__copy(seg__init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date October, 2015 - Initial Version
+   !>
+   !> @param[in] td_lay   domain layout structure
+   !> @return copy of input domain layout structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TLAY), INTENT(IN)  :: td_lay
+      ! function
+      TYPE(TLAY) :: tf_lay
+
+      ! local variable
+      INTEGER(i4), DIMENSION(2)                :: il_shape
+      INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: il_tmp
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! copy scalar 
+      tf_lay%i_niproc   = td_lay%i_niproc
+      tf_lay%i_njproc   = td_lay%i_njproc
+      tf_lay%i_nland    = td_lay%i_nland 
+      tf_lay%i_nsea     = td_lay%i_nsea  
+      tf_lay%i_mean     = td_lay%i_mean  
+      tf_lay%i_min      = td_lay%i_min   
+      tf_lay%i_max      = td_lay%i_max   
+
+      ! copy pointers
+      IF( ASSOCIATED(tf_lay%i_msk) )THEN
+         DEALLOCATE(tf_lay%i_msk)
+      ENDIF
+      IF( ASSOCIATED(td_lay%i_msk) )THEN
+         il_shape(:)=SHAPE(td_lay%i_msk(:,:))
+         ALLOCATE( tf_lay%i_msk(il_shape(jp_I),il_shape(jp_J)) )
+         tf_lay%i_msk(:,:)=td_lay%i_msk(:,:)
+      ENDIF
+
+      IF( ASSOCIATED(tf_lay%i_msk) ) DEALLOCATE(tf_lay%i_msk)
+      IF( ASSOCIATED(td_lay%i_msk) )THEN
+         il_shape(:)=SHAPE(td_lay%i_msk(:,:))
+         ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J)))
+         il_tmp(:,:)=td_lay%i_msk(:,:)
+
+         ALLOCATE( tf_lay%i_msk(il_shape(jp_I),il_shape(jp_J)) )
+         tf_lay%i_msk(:,:)=il_tmp(:,:)
+
+         DEALLOCATE(il_tmp)
+      ENDIF
+
+      IF( ASSOCIATED(tf_lay%i_impp) ) DEALLOCATE(tf_lay%i_impp)
+      IF( ASSOCIATED(td_lay%i_impp) )THEN
+         il_shape(:)=SHAPE(td_lay%i_impp(:,:))
+         ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J)))
+         il_tmp(:,:)=td_lay%i_impp(:,:)
+
+         ALLOCATE( tf_lay%i_impp(il_shape(jp_I),il_shape(jp_J)) )
+         tf_lay%i_impp(:,:)=il_tmp(:,:)
+
+         DEALLOCATE(il_tmp)
+      ENDIF
+
+      IF( ASSOCIATED(tf_lay%i_jmpp) ) DEALLOCATE(tf_lay%i_jmpp)
+      IF( ASSOCIATED(td_lay%i_jmpp) )THEN
+         il_shape(:)=SHAPE(td_lay%i_jmpp(:,:))
+         ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J)))
+         il_tmp(:,:)=td_lay%i_jmpp(:,:)
+
+         ALLOCATE( tf_lay%i_jmpp(il_shape(jp_I),il_shape(jp_J)) )
+         tf_lay%i_jmpp(:,:)=il_tmp(:,:)
+
+         DEALLOCATE(il_tmp)
+      ENDIF
+
+      IF( ASSOCIATED(tf_lay%i_lci) ) DEALLOCATE(tf_lay%i_lci)
+      IF( ASSOCIATED(td_lay%i_lci) )THEN
+         il_shape(:)=SHAPE(td_lay%i_lci(:,:))
+         ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J)))
+         il_tmp(:,:)=td_lay%i_lci(:,:)
+
+         ALLOCATE( tf_lay%i_lci(il_shape(jp_I),il_shape(jp_J)) )
+         tf_lay%i_lci(:,:)=il_tmp(:,:)
+
+         DEALLOCATE(il_tmp)
+      ENDIF
+
+      IF( ASSOCIATED(tf_lay%i_lcj) ) DEALLOCATE(tf_lay%i_lcj)
+      IF( ASSOCIATED(td_lay%i_lcj) )THEN
+         il_shape(:)=SHAPE(td_lay%i_lcj(:,:))
+         ALLOCATE(il_tmp(il_shape(jp_I),il_shape(jp_J)))
+         il_tmp(:,:)=td_lay%i_lcj(:,:)
+
+         ALLOCATE( tf_lay%i_lcj(il_shape(jp_I),il_shape(jp_J)) )
+         tf_lay%i_lcj(:,:)=il_tmp(:,:)
+
+         DEALLOCATE(il_tmp)
+      ENDIF
+
+   END FUNCTION layout__copy
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE mpp__create_layout(td_mpp, td_lay)
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine create mpp structure using domain layout
+   !>
+   !> @detail
+   !>
+   !> @author J.Paul
+   !> @date October, 2015 - Initial version
+   !> @date August, 2017 
+   !> - handle use of domain decomposition for monoproc file
+   !>
+   !> @param[inout] td_mpp mpp strcuture
+   !> @param[in] td_lay domain layout structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP), INTENT(INOUT) :: td_mpp
+      TYPE(TLAY), INTENT(IN   ) :: td_lay
+
+      ! local variable
+      CHARACTER(LEN=lc)                        :: cl_file
+      TYPE(TATT)                               :: tl_att
+
+      TYPE(TFILE), DIMENSION(:), ALLOCATABLE   :: tl_proc
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      ! intialise
+      td_mpp%i_nproc=0
+
+      CALL logger_debug( "MPP CREATE LAYOUT: create domain decomposition with "//&
+      &               TRIM(fct_str(td_lay%i_niproc))//" x "//&
+      &               TRIM(fct_str(td_lay%i_njproc))//" = "//&
+      &               TRIM(fct_str(td_lay%i_nsea))//" processors")
+
+      IF( lm_layout )THEN
+         WRITE(im_iumout,*) ' choix optimum'
+         WRITE(im_iumout,*) ' ============='
+         WRITE(im_iumout,*)
+         ! print info 
+         WRITE(im_iumout,*) ' '
+         WRITE(im_iumout,*) " jpni=",td_lay%i_niproc ," jpnj=",td_lay%i_njproc
+         WRITE(im_iumout,*) " iresti=",td_mpp%i_preci," irestj=",td_mpp%i_precj
+
+
+         WRITE(im_iumout,*) ' nombre de processeurs       ',td_lay%i_niproc*td_lay%i_njproc
+         WRITE(im_iumout,*) ' nombre de processeurs mer   ',td_lay%i_nsea
+         WRITE(im_iumout,*) ' nombre de processeurs terre ',td_lay%i_nland
+         WRITE(im_iumout,*) ' moyenne de recouvrement     ',td_lay%i_mean
+         WRITE(im_iumout,*) ' minimum de recouvrement     ',td_lay%i_min
+         WRITE(im_iumout,*) ' maximum de recouvrement     ',td_lay%i_max
+      ENDIF
+
+      td_mpp%i_niproc=td_lay%i_niproc
+      td_mpp%i_njproc=td_lay%i_njproc
+      !td_mpp%i_nproc =td_lay%i_nsea
+
+      IF( td_mpp%i_niproc*td_mpp%i_njproc == td_lay%i_nsea )THEN
+         IF( td_lay%i_nsea == 1 )THEN
+            td_mpp%c_dom='full'
+         ELSE
+            td_mpp%c_dom='nooverlap'
+         ENDIF
+      ELSE
+            td_mpp%c_dom='noextra'
+      ENDIF
+      
+      ALLOCATE(tl_proc(td_lay%i_nsea))
+      jk=1
+      DO jj=1,td_lay%i_njproc
+         DO ji=1,td_lay%i_niproc
+
+            IF( td_lay%i_msk(ji,jj) >= 1 )THEN
+
+               ! get processor file name
+               IF( td_mpp%l_usempp )THEN
+                  cl_file=file_rename(td_mpp%c_name,jk)
+               ELSE
+                  cl_file=TRIM(td_mpp%c_name)
+               ENDIF
+               ! initialise file structure
+               tl_proc(jk)=file_init(cl_file,td_mpp%c_type)
+
+               ! procesor id
+               tl_proc(jk)%i_pid=jk-1
+
+               tl_att=att_init("DOMAIN_number",tl_proc(jk)%i_pid)
+               CALL file_add_att(tl_proc(jk), tl_att)
+
+               ! processor indices
+               tl_proc(jk)%i_iind=ji
+               tl_proc(jk)%i_jind=jj
+
+               ! fill processor dimension and first indices
+               tl_proc(jk)%i_impp = td_lay%i_impp(ji,jj)
+               tl_proc(jk)%i_jmpp = td_lay%i_jmpp(ji,jj)
+
+               tl_proc(jk)%i_lci  = td_lay%i_lci(ji,jj)
+               tl_proc(jk)%i_lcj  = td_lay%i_lcj(ji,jj)
+
+               ! compute first and last indoor indices
+ 
+               ! west boundary
+               IF( ji == 1 )THEN
+                  tl_proc(jk)%i_ldi = 1 
+                  tl_proc(jk)%l_ctr = .TRUE.
+               ELSE
+                  tl_proc(jk)%i_ldi = 1 + td_mpp%i_preci
+               ENDIF
+
+               ! south boundary
+               IF( jj == 1 )THEN
+                  tl_proc(jk)%i_ldj = 1 
+                  tl_proc(jk)%l_ctr = .TRUE.
+               ELSE
+                  tl_proc(jk)%i_ldj = 1 + td_mpp%i_precj
+               ENDIF
+
+               ! east boundary
+               IF( ji == td_mpp%i_niproc )THEN
+                  tl_proc(jk)%i_lei = td_lay%i_lci(ji,jj)
+                  tl_proc(jk)%l_ctr = .TRUE.
+               ELSE
+                  tl_proc(jk)%i_lei = td_lay%i_lci(ji,jj) - td_mpp%i_preci
+               ENDIF
+
+               ! north boundary
+               IF( jj == td_mpp%i_njproc )THEN
+                  tl_proc(jk)%i_lej = td_lay%i_lcj(ji,jj)
+                  tl_proc(jk)%l_ctr = .TRUE.
+               ELSE
+                  tl_proc(jk)%i_lej = td_lay%i_lcj(ji,jj) - td_mpp%i_precj
+               ENDIF
+
+               ! clean
+               CALL att_clean(tl_att)
+
+               ! update proc number
+               jk=jk+1 
+
+            ENDIF
+         ENDDO
+      ENDDO
+!
+      CALL mpp__add_proc(td_mpp, tl_proc(:))
+      DEALLOCATE(tl_proc)
+
+   END SUBROUTINE mpp__create_layout
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE mpp__optimiz(td_mpp, id_mask, id_nproc)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine optimize the number of sub domain to be used, given mask.
+   !> @details
+   !>  Actually it get the domain decomposition with the most land 
+   !>  processors removed.
+   !>  If no land processor could be removed, it get the decomposition with the
+   !>  most sea processors.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !> @date October, 2015
+   !> - improve way to compute domain layout 
+   !> @date February, 2016
+   !> - new criteria for domain layout in case no land proc
+   !>
+   !> @param[inout] td_mpp mpp strcuture
+   !> @param[in] id_mask   sub domain mask (sea=1, land=0) 
+   !> @pram[in] id_nproc maximum number of processor to be used
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP),                  INTENT(INOUT) :: td_mpp
+      INTEGER(i4), DIMENSION(:,:), INTENT(IN)    :: id_mask
+      INTEGER(i4)                , INTENT(IN)    :: id_nproc
+
+      ! local variable
+      TYPE(TLAY) :: tl_lay
+      TYPE(TLAY) :: tl_sav
+
+      REAL(dp)   :: dl_min
+      REAL(dp)   :: dl_max
+      REAL(dp)   :: dl_ratio
+      REAL(dp)   :: dl_sav
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      CALL logger_trace("MPP OPTIMIZ: look for best domain decomposition")
+      dl_sav=0
+      ! 
+      DO ji=1,id_nproc
+         DO jj=1,id_nproc
+
+            ! compute domain layout
+            tl_lay=layout__init( td_mpp, id_mask, ji,jj )
+            IF( tl_lay%i_nsea <= id_nproc )THEN
+
+               IF( ASSOCIATED(tl_sav%i_lci) )THEN
+                  IF( tl_sav%i_nland /= 0 )THEN
+                     ! look for layout with most land proc
+                     IF( tl_lay%i_nland > tl_sav%i_nland    .OR. &
+                     &   ( tl_lay%i_nland == tl_sav%i_nland .AND. &
+                     &     tl_lay%i_min   >  tl_sav%i_min   ) )THEN
+                        ! save optimiz layout
+                        CALL logger_info("MPP OPTIMIZ:save this decomposition "//&
+                        &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//&
+                        &   TRIM(fct_str(tl_lay%i_nsea)) )
+
+                        tl_sav=layout__copy(tl_lay)
+                     ENDIF
+                  ELSE ! tl_sav%i_nland == 0
+                     ! look for layout with most sea proc 
+                     ! and "square" cell 
+                     dl_min=MIN(tl_lay%i_lci(1,1),tl_lay%i_lcj(1,1))
+                     dl_max=MAX(tl_lay%i_lci(1,1),tl_lay%i_lcj(1,1))
+                     dl_ratio=dl_min/dl_max
+                     IF( tl_lay%i_nsea > tl_sav%i_nsea    .OR. &
+                     &   ( tl_lay%i_nsea == tl_sav%i_nsea .AND. &
+                     &     dl_ratio   >  dl_sav ) )THEN
+                        ! save optimiz layout
+                        CALL logger_info("MPP OPTIMIZ:save this decomposition "//&
+                        &   TRIM(fct_str(ji))//"x"//TRIM(fct_str(jj))//"="//&
+                        &   TRIM(fct_str(tl_lay%i_nsea)) )
+
+                        tl_sav=layout__copy(tl_lay)
+                        dl_sav=dl_ratio
+                     ENDIF
+                  ENDIF
+               ELSE
+                  ! init tl_sav
+                  tl_sav=layout__copy(tl_lay)
+
+                  dl_min=MIN(tl_sav%i_lci(1,1),tl_sav%i_lcj(1,1))
+                  dl_max=MAX(tl_sav%i_lci(1,1),tl_sav%i_lcj(1,1))
+                  dl_sav=dl_min/dl_max
+               ENDIF
+
+            ENDIF
+
+            ! clean
+            CALL layout__clean( tl_lay )
+
+         ENDDO
+      ENDDO
+
+      ! create mpp domain layout
+      CALL mpp__create_layout(td_mpp, tl_sav)
+
+      ! clean
+      CALL layout__clean( tl_sav )
+
+   END SUBROUTINE mpp__optimiz
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE mpp__clean_unit(td_mpp)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine clean mpp strcuture.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !> @date January, 2019
+   !> - nullify file structure inside mpp structure
+   !>
+   !> @param[inout] td_mpp mpp strcuture
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP),  INTENT(INOUT) :: td_mpp
+
+      ! local variable
+      TYPE(TMPP) :: tl_mpp ! empty mpp structure
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      CALL logger_info( &
+      &  "MPP CLEAN: reset mpp "//TRIM(td_mpp%c_name) )
+
+      ! del dimension
+      IF( td_mpp%i_ndim /= 0 )THEN
+         CALL dim_clean( td_mpp%t_dim(:) )
+      ENDIF
+
+      IF( ASSOCIATED(td_mpp%t_proc) )THEN
+         ! clean array of file processor
+         CALL file_clean( td_mpp%t_proc(:) )
+         DEALLOCATE(td_mpp%t_proc)
+         NULLIFY(td_mpp%t_proc)
+      ENDIF
+
+      ! replace by empty structure
+      td_mpp=mpp_copy(tl_mpp)
+
+   END SUBROUTINE mpp__clean_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine clean mpp strcuture.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_mpp mpp strcuture
+   !-------------------------------------------------------------------
+   SUBROUTINE mpp__clean_arr(td_mpp)
+
+      IMPLICIT NONE
+      ! Argument
+      TYPE(TMPP),  DIMENSION(:), INTENT(INOUT) :: td_mpp
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=SIZE(td_mpp(:)),1,-1
+         CALL mpp_clean(td_mpp(ji))
+      ENDDO
+
+   END SUBROUTINE mpp__clean_arr
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE mpp__get_use_unit(td_mpp, id_imin, id_imax, id_jmin, id_jmax)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine get sub domains which cover "zoom domain".
+   !>                      proc use in "zoom domain" 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_mpp mpp strcuture
+   !> @param[in] id_imin   i-direction lower indice
+   !> @param[in] id_imax   i-direction upper indice
+   !> @param[in] id_jmin   j-direction lower indice
+   !> @param[in] id_jmax   j-direction upper indice
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP) ,  INTENT(INOUT) :: td_mpp
+      INTEGER(i4),  INTENT(IN), OPTIONAL :: id_imin
+      INTEGER(i4),  INTENT(IN), OPTIONAL :: id_imax
+      INTEGER(i4),  INTENT(IN), OPTIONAL :: id_jmin
+      INTEGER(i4),  INTENT(IN), OPTIONAL :: id_jmax
+
+      ! local variable
+      LOGICAL     :: ll_iuse
+      LOGICAL     :: ll_juse
+
+      INTEGER(i4) :: il_imin
+      INTEGER(i4) :: il_imax
+      INTEGER(i4) :: il_jmin
+      INTEGER(i4) :: il_jmax
+
+      ! loop indices
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      IF( ASSOCIATED(td_mpp%t_proc) )THEN
+   
+         il_imin=1
+         il_imax=td_mpp%t_dim(1)%i_len
+         IF( PRESENT(id_imin) ) il_imin=id_imin
+         IF( PRESENT(id_imax) ) il_imax=id_imax
+         il_jmin=1
+         il_jmax=td_mpp%t_dim(2)%i_len
+         IF( PRESENT(id_jmin) ) il_jmin=id_jmin
+         IF( PRESENT(id_jmax) ) il_jmax=id_jmax
+
+         ! check domain
+         IF( il_imin < 1 .OR. il_imin > td_mpp%t_dim(1)%i_len .OR. &
+         &   il_imax < 1 .OR. il_imax > td_mpp%t_dim(1)%i_len .OR. &
+         &   il_jmin < 1 .OR. il_jmin > td_mpp%t_dim(2)%i_len .OR. &
+         &   il_jmax < 1 .OR. il_jmax > td_mpp%t_dim(2)%i_len )THEN
+            CALL logger_debug("MPP GET USE: mpp gloabl size "//&
+            &        TRIM(fct_str(td_mpp%t_dim(1)%i_len))//","//&
+            &        TRIM(fct_str(td_mpp%t_dim(2)%i_len)))
+            CALL logger_debug("MPP GET USE: i-indices "//&
+            &        TRIM(fct_str(il_imin))//","//TRIM(fct_str(il_imax)))
+            CALL logger_debug("MPP GET USE: j-indices "//&
+            &        TRIM(fct_str(il_jmin))//","//TRIM(fct_str(il_jmax)))
+            CALL logger_error("MPP GET USE: invalid indices ")
+         ELSE
+            td_mpp%t_proc(:)%l_use=.FALSE.
+            DO jk=1,td_mpp%i_nproc
+
+               ! check i-direction
+               ll_iuse=.FALSE.
+               IF( il_imin < il_imax )THEN
+
+                  ! not overlap east west boundary
+                  IF( td_mpp%t_proc(jk)%i_impp + td_mpp%t_proc(jk)%i_lci > &
+                  &   il_imin .AND.                                  &
+                  &   td_mpp%t_proc(jk)%i_impp < il_imax )THEN
+                      ll_iuse=.TRUE.
+                  ENDIF
+
+               ELSEIF( il_imin == il_imax )THEN
+
+                  ! east west cyclic
+                  ll_iuse=.TRUE.
+
+               ELSE ! il_imin > id_imax
+
+                  ! overlap east west boundary
+                  IF( ( td_mpp%t_proc(jk)%i_impp + td_mpp%t_proc(jk)%i_lci >  &
+                  &     il_imin )                                             &
+                  &   .OR.                                                    &
+                  &   ( td_mpp%t_proc(jk)%i_impp < il_imax) )THEN
+                     ll_iuse=.TRUE.
+                  ENDIF
+
+               ENDIF
+
+               ! check j-direction
+               ll_juse=.FALSE.
+               IF( il_jmin < il_jmax )THEN
+
+                  ! not overlap north fold
+                  IF( td_mpp%t_proc(jk)%i_jmpp + td_mpp%t_proc(jk)%i_lcj > &
+                  &   il_jmin .AND.                                  &
+                  &   td_mpp%t_proc(jk)%i_jmpp < il_jmax )THEN
+                     ll_juse=.TRUE.
+                  ENDIF
+
+               ELSE ! id_jmin >= id_jmax
+
+                  IF( td_mpp%t_proc(jk)%i_jmpp + td_mpp%t_proc(jk)%i_lcj > &
+                  &  il_jmin )THEN
+                     ll_juse=.TRUE.
+                  ENDIF
+
+               ENDIF
+
+               IF( ll_iuse .AND. ll_juse ) td_mpp%t_proc(jk)%l_use=.TRUE.
+
+            ENDDO
+         ENDIF
+
+      ELSE
+         CALL logger_error("MPP GET USE: mpp decomposition not define.")
+      ENDIF
+
+   END SUBROUTINE mpp__get_use_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE mpp_get_contour(td_mpp)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine get sub domains which form global domain border.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_mpp mpp strcuture
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP),  INTENT(INOUT) :: td_mpp
+
+      ! loop indices
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      IF( ASSOCIATED(td_mpp%t_proc) )THEN
+
+         td_mpp%t_proc(:)%l_use = .FALSE.
+         DO jk=1,td_mpp%i_nproc
+            IF( td_mpp%t_proc(jk)%i_ldi == 1 .OR. &
+            &   td_mpp%t_proc(jk)%i_ldj == 1 .OR. &
+            &   td_mpp%t_proc(jk)%i_lei == td_mpp%t_proc(jk)%i_lci .OR. &
+            &   td_mpp%t_proc(jk)%i_lej == td_mpp%t_proc(jk)%i_lcj )THEN
+
+               td_mpp%t_proc(jk)%l_use = .TRUE.
+ 
+            ENDIF
+         ENDDO
+   
+      ELSE
+         CALL logger_error("MPP GET CONTOUR: domain decomposition not define.")
+      ENDIF
+
+   END SUBROUTINE mpp_get_contour
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION mpp_get_proc_index(td_mpp, id_procid) &
+         & RESULT(if_idx)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function return processor indices, without overlap boundary,
+   !> given processor id. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[in] td_mpp    mpp strcuture
+   !> @param[in] id_procid processor id
+   !> @return array of index (/ i1, i2, j1, j2 /)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP) , INTENT(IN) :: td_mpp
+      INTEGER(i4), INTENT(IN) :: id_procid
+
+      ! function
+      INTEGER(i4), DIMENSION(4) :: if_idx
+
+      ! local variable
+      INTEGER(i4) :: il_i1, il_i2
+      INTEGER(i4) :: il_j1, il_j2
+      !----------------------------------------------------------------
+
+      IF( ASSOCIATED(td_mpp%t_proc) )THEN
+
+         IF( TRIM(td_mpp%c_dom) == '' )THEN
+            CALL logger_fatal("MPP GET PROC INDEX: decomposition type unknown. "//&
+            &                 "you should ahve run mpp_get_dom before.")
+         ENDIF
+
+         SELECT CASE(TRIM(td_mpp%c_dom))
+            CASE('full')
+               il_i1 = 1 
+               il_j1 = 1 
+
+               il_i2 = td_mpp%t_dim(1)%i_len
+               il_j2 = td_mpp%t_dim(2)%i_len
+            CASE('noextra')
+               il_i1 = td_mpp%t_proc(id_procid)%i_impp
+               il_j1 = td_mpp%t_proc(id_procid)%i_jmpp
+
+               il_i2 = il_i1 + td_mpp%t_proc(id_procid)%i_lci - 1 
+               il_j2 = il_j1 + td_mpp%t_proc(id_procid)%i_lcj - 1 
+            CASE('nooverlap')
+               il_i1 = td_mpp%t_proc(id_procid)%i_impp + &
+               &        td_mpp%t_proc(id_procid)%i_ldi - 1
+               il_j1 = td_mpp%t_proc(id_procid)%i_jmpp + &
+               &        td_mpp%t_proc(id_procid)%i_ldj - 1
+
+               il_i2 = td_mpp%t_proc(id_procid)%i_impp + &
+               &        td_mpp%t_proc(id_procid)%i_lei - 1
+               il_j2 = td_mpp%t_proc(id_procid)%i_jmpp + &
+               &        td_mpp%t_proc(id_procid)%i_lej - 1
+            CASE DEFAULT
+               CALL logger_error("MPP GET PROC INDEX: invalid "//&
+                  &              "decomposition type.")
+         END SELECT
+
+         if_idx(:)=(/il_i1, il_i2, il_j1, il_j2/)
+
+      ELSE
+         CALL logger_error("MPP GET PROC INDEX: domain decomposition not define.")
+      ENDIF
+
+   END FUNCTION mpp_get_proc_index
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION mpp_get_proc_size(td_mpp, id_procid) &
+         & RESULT(if_size)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function return processor domain size, depending of domain 
+   !> decompisition type, given sub domain id. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[in] td_mpp    mpp strcuture
+   !> @param[in] id_procid sub domain id
+   !> @return array of index (/ isize, jsize /)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP),  INTENT(IN) :: td_mpp
+      INTEGER(i4), INTENT(IN) :: id_procid
+
+      ! function
+      INTEGER(i4), DIMENSION(2) :: if_size
+
+      ! local variable
+      INTEGER(i4) :: il_isize
+      INTEGER(i4) :: il_jsize
+      !----------------------------------------------------------------
+
+      IF( ASSOCIATED(td_mpp%t_proc) )THEN
+
+         IF( TRIM(td_mpp%c_dom) == '' )THEN
+            CALL logger_fatal("MPP GET PROC SIZE: decomposition type unknown. "//&
+            &                 "you should ahve run mpp_get_dom before.")
+         ENDIF
+
+         SELECT CASE(TRIM(td_mpp%c_dom))
+            CASE('full')
+               
+               il_isize = td_mpp%t_dim(1)%i_len
+               il_jsize = td_mpp%t_dim(2)%i_len
+
+            CASE('noextra')
+
+                il_isize = td_mpp%t_proc(id_procid)%i_lci
+                il_jsize = td_mpp%t_proc(id_procid)%i_lcj
+
+            CASE('nooverlap')
+               il_isize = td_mpp%t_proc(id_procid)%i_lei - &
+               &          td_mpp%t_proc(id_procid)%i_ldi + 1
+               il_jsize = td_mpp%t_proc(id_procid)%i_lej - &
+               &          td_mpp%t_proc(id_procid)%i_ldj + 1
+            CASE DEFAULT
+               CALL logger_error("MPP GET PROC SIZE: invalid decomposition type : "//&
+               &  TRIM(td_mpp%c_dom) )
+         END SELECT
+
+         if_size(:)=(/il_isize, il_jsize/)
+
+      ELSE
+         CALL logger_error("MPP GET PROC SIZE: domain decomposition not define.")
+      ENDIF
+
+   END FUNCTION mpp_get_proc_size
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE mpp_get_dom(td_mpp)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !>  This subroutine determine domain decomposition type.
+   !>  (full, overlap, noverlap)
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial version
+   !>
+   !> @param[inout] td_mpp mpp strcuture
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP),  INTENT(INOUT) :: td_mpp
+
+      ! local variable
+      INTEGER(i4) :: il_isize
+      INTEGER(i4) :: il_jsize
+      !----------------------------------------------------------------
+
+      IF( ASSOCIATED(td_mpp%t_proc) )THEN
+
+         IF( td_mpp%i_niproc == 0 .AND. td_mpp%i_njproc == 0 )THEN
+            CALL logger_info("MPP GET DOM: use indoor indices to get domain "//&
+            &             "decomposition type.")
+            IF((td_mpp%t_proc(1)%t_dim(1)%i_len ==                         &
+            &   td_mpp%t_proc(1)%i_lei - td_mpp%t_proc(1)%i_ldi + 1) .AND. &
+            &  (td_mpp%t_proc(1)%t_dim(2)%i_len ==                         &
+            &   td_mpp%t_proc(1)%i_lej - td_mpp%t_proc(1)%i_ldj + 1) )THEN
+
+               td_mpp%c_dom='nooverlap'
+
+            ELSEIF((td_mpp%t_proc(1)%t_dim(1)%i_len ==                     &
+            &       td_mpp%t_proc(1)%i_lci                     )     .AND. &
+            &      (td_mpp%t_proc(1)%t_dim(2)%i_len ==                     &
+            &       td_mpp%t_proc(1)%i_lcj                     )     )THEN
+
+               td_mpp%c_dom='noextra'
+
+            ELSEIF((td_mpp%t_proc(1)%t_dim(1)%i_len ==                     &
+            &       td_mpp%t_dim(1)%i_len             )              .AND. &
+            &      (td_mpp%t_proc(1)%t_dim(2)%i_len ==                     &
+            &       td_mpp%t_dim(2)%i_len )                          )THEN
+
+               td_mpp%c_dom='full'
+
+            ELSE
+
+               CALL logger_error("MPP GET DOM: should have been an impossible case")
+
+               il_isize=td_mpp%t_proc(1)%t_dim(1)%i_len
+               il_jsize=td_mpp%t_proc(1)%t_dim(2)%i_len
+               CALL logger_debug("MPP GET DOM: proc size "//&
+               &  TRIM(fct_str(il_isize))//" x "//TRIM(fct_str(il_jsize)) )
+
+               il_isize=td_mpp%t_proc(1)%i_lei - td_mpp%t_proc(1)%i_ldi + 1
+               il_jsize=td_mpp%t_proc(1)%i_lej - td_mpp%t_proc(1)%i_ldj + 1
+               CALL logger_debug("MPP GET DOM: no overlap size "//&
+               &  TRIM(fct_str(il_isize))//" x "//TRIM(fct_str(il_jsize)) )
+
+               il_isize=td_mpp%t_proc(1)%i_lci
+               il_jsize=td_mpp%t_proc(1)%i_lcj
+               CALL logger_debug("MPP GET DOM: overlap size "//&
+               &  TRIM(fct_str(il_isize))//" x "//TRIM(fct_str(il_jsize)) )
+
+               il_isize=td_mpp%t_dim(1)%i_len
+               il_jsize=td_mpp%t_dim(2)%i_len
+               CALL logger_debug("MPP GET DOM: full size "//&
+               &  TRIM(fct_str(il_isize))//" x "//TRIM(fct_str(il_jsize)) )
+
+            ENDIF
+
+         ELSE
+
+            CALL logger_info("MPP GET DOM: use number of processors following "//&
+            &             "I and J to get domain decomposition type.")
+            IF( td_mpp%i_niproc*td_mpp%i_njproc==td_mpp%i_nproc )THEN
+               IF( td_mpp%i_nproc == 1 )THEN
+                  td_mpp%c_dom='full'
+               ENDIF
+               td_mpp%c_dom='nooverlap'
+            ELSE
+               td_mpp%c_dom='noextra'
+            ENDIF
+
+         ENDIF
+
+      ELSE
+         CALL logger_error("MPP GET DOM: domain decomposition not define.")
+      ENDIF
+
+   END SUBROUTINE mpp_get_dom
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION mpp__check_var_dim(td_mpp, td_var) &
+         & RESULT(lf_check)
+   !-------------------------------------------------------------------
+   !> @brief This function check if variable  and mpp structure use same
+   !> dimension.
+   !>
+   !> @details
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date September 2015
+   !> - do not check used dimension here
+   !>
+   !> @param[in] td_mpp mpp structure
+   !> @param[in] td_var variable structure
+   !> @return dimension of variable and mpp structure agree (or not)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP), INTENT(IN) :: td_mpp
+      TYPE(TVAR), INTENT(IN) :: td_var
+
+      ! function
+      LOGICAL                :: lf_check
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_dim
+      LOGICAL :: ll_error
+      LOGICAL :: ll_warn
+
+      INTEGER(i4)       :: il_ind
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      lf_check=.TRUE.
+
+      ! check used dimension 
+      ll_error=.FALSE.
+      ll_warn=.FALSE.
+      DO ji=1,ip_maxdim
+         il_ind=dim_get_index( td_mpp%t_dim(:), &
+            &                  TRIM(td_var%t_dim(ji)%c_name), &
+            &                  TRIM(td_var%t_dim(ji)%c_sname))
+         IF( il_ind /= 0 )THEN
+            IF( td_var%t_dim(ji)%l_use  .AND. &
+               &td_mpp%t_dim(il_ind)%l_use .AND. &
+               &td_var%t_dim(ji)%i_len /= td_mpp%t_dim(il_ind)%i_len )THEN
+               IF( INDEX( TRIM(td_var%c_axis), &
+                  &       TRIM(fct_upper(td_var%t_dim(ji)%c_name))) == 0 )THEN
+                  ll_warn=.TRUE.
+               ELSE
+                  ll_error=.TRUE.
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDDO
+
+      IF( ll_error )THEN
+
+         cl_dim='(/'
+         DO ji = 1, td_mpp%i_ndim
+            IF( td_mpp%t_dim(ji)%l_use )THEN
+               cl_dim=TRIM(cl_dim)//&
+                  &   TRIM(fct_upper(td_mpp%t_dim(ji)%c_sname))//':'//&
+                  &   TRIM(fct_str(td_mpp%t_dim(ji)%i_len))//','
+            ENDIF
+         ENDDO
+         cl_dim=TRIM(cl_dim)//'/)'
+         CALL logger_debug( " mpp dimension: "//TRIM(cl_dim) )
+
+         cl_dim='(/'
+         DO ji = 1, td_var%i_ndim
+            IF( td_var%t_dim(ji)%l_use )THEN
+               cl_dim=TRIM(cl_dim)//&
+                  &   TRIM(fct_upper(td_var%t_dim(ji)%c_sname))//':'//&
+                  &   TRIM(fct_str(td_var%t_dim(ji)%i_len))//','
+            ENDIF
+         ENDDO
+         cl_dim=TRIM(cl_dim)//'/)'
+         CALL logger_debug( " variable dimension: "//TRIM(cl_dim) )
+
+         lf_check=.FALSE.
+
+         CALL logger_error( &
+            &     " MPP CHECK VAR DIM: variable and file dimension differ"//&
+            &     " for variable "//TRIM(td_var%c_name)//&
+            &     " and file "//TRIM(td_mpp%c_name))
+
+      ELSEIF( ll_warn )THEN
+         CALL logger_warn( &
+            &     " MPP CHECK VAR DIM: variable and file dimension differ"//&
+            &     " for variable "//TRIM(td_var%c_name)//&
+            &     " and file "//TRIM(td_mpp%c_name)//". you should use"//&
+            &     " var_check_dim to remove useless dimension.")
+      ELSE
+
+         IF( td_var%i_ndim >  td_mpp%i_ndim )THEN
+            CALL logger_info("MPP CHECK VAR DIM: variable "//&
+               &     TRIM(td_var%c_name)//" use more dimension than file "//&
+               &     TRIM(td_mpp%c_name)//" do until now.")
+         ENDIF
+
+      ENDIF
+
+   END FUNCTION mpp__check_var_dim
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION mpp_get_index(td_mpp, cd_name) &
+         & RESULT(if_idx)
+   !-------------------------------------------------------------------
+   !> @brief This function return the mpp id, in a array of mpp
+   !> structure,  given mpp base name. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_file   array of file structure
+   !> @param[in] cd_name   file name
+   !> @return file id in array of file structure (0 if not found)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP)      , DIMENSION(:), INTENT(IN) :: td_mpp
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+
+      ! function
+      INTEGER(i4)                                :: if_idx
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_name
+      INTEGER(i4)       :: il_size
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      if_idx=0
+      il_size=SIZE(td_mpp(:))
+
+      cl_name=TRIM( file_rename(cd_name) )
+
+      ! check if mpp is in array of mpp structure
+      DO ji=1,il_size
+         ! look for file name
+         IF( TRIM(fct_lower(td_mpp(ji)%c_name)) == TRIM(fct_lower(cd_name)) )THEN
+ 
+            if_idx=ji
+            EXIT
+
+         ENDIF
+      ENDDO
+
+   END FUNCTION mpp_get_index
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION mpp_recombine_var(td_mpp, cd_name) &
+         & RESULT(tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function recombine variable splitted in mpp structure. 
+   !>
+   !> @author J.Paul
+   !> @date October, 2014 - Initial Version
+   !>
+   !> @param[in] td_mpp   mpp file structure
+   !> @param[in] cd_name  variable name
+   !> @return variable strucutre
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP)      , INTENT(IN) :: td_mpp
+      CHARACTER(LEN=*), INTENT(IN) :: cd_name
+      ! function
+      TYPE(TVAR)                   :: tf_var
+
+      ! local variable
+      INTEGER(i4)                       :: il_varid
+      INTEGER(i4)                       :: il_status
+      INTEGER(i4)                       :: il_i1p
+      INTEGER(i4)                       :: il_i2p
+      INTEGER(i4)                       :: il_j1p
+      INTEGER(i4)                       :: il_j2p
+      INTEGER(i4), DIMENSION(4)         :: il_ind
+
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_strt
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_cnt
+
+      TYPE(TVAR)                        :: tl_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      il_varid=var_get_index( td_mpp%t_proc(1)%t_var(:), cd_name)
+      IF( il_varid /= 0 )THEN
+      
+         tf_var=var_copy(td_mpp%t_proc(1)%t_var(il_varid))
+         ! Allocate space to hold variable value in structure 
+         IF( ASSOCIATED(tf_var%d_value) )THEN
+            DEALLOCATE(tf_var%d_value)   
+         ENDIF
+         ! 
+         DO ji=1,ip_maxdim
+            IF( tf_var%t_dim(ji)%l_use )THEN
+               tf_var%t_dim(ji)%i_len=td_mpp%t_dim(ji)%i_len
+            ENDIF
+         ENDDO
+
+         ALLOCATE(tf_var%d_value( tf_var%t_dim(1)%i_len, &
+            &                     tf_var%t_dim(2)%i_len, &
+            &                     tf_var%t_dim(3)%i_len, &
+            &                     tf_var%t_dim(4)%i_len),&
+            &     stat=il_status)
+         IF(il_status /= 0 )THEN
+
+           CALL logger_error( &
+              &  " MPP RECOMBINE VAR: not enough space to put variable "//&
+              &  TRIM(tf_var%c_name)//" in variable structure")
+
+         ENDIF
+
+         ! FillValue by default
+         tf_var%d_value(:,:,:,:)=tf_var%d_fill
+
+         ! read processor 
+         DO jk=1,td_mpp%i_nproc
+            IF( td_mpp%t_proc(jk)%l_use )THEN
+               ! get processor indices
+               il_ind(:)=mpp_get_proc_index( td_mpp, jk )
+               il_i1p = il_ind(1)
+               il_i2p = il_ind(2)
+               il_j1p = il_ind(3)
+               il_j2p = il_ind(4)
+ 
+               il_strt(:)=(/ 1,1,1,1 /)
+
+               il_cnt(:)=(/ il_i2p-il_i1p+1,         &
+                  &         il_j2p-il_j1p+1,         &
+                  &         tf_var%t_dim(3)%i_len, &
+                  &         tf_var%t_dim(4)%i_len /)
+
+               tl_tmp=iom_read_var( td_mpp%t_proc(jk), tf_var%c_name,&
+                  &                 il_strt(:), il_cnt(:) )
+               
+               ! replace value in output variable structure
+               tf_var%d_value( il_i1p : il_i2p,  &
+                  &            il_j1p : il_j2p,  &
+                  &            :,:) = tl_tmp%d_value(:,:,:,:)
+
+               ! clean
+               CALL var_clean(tl_tmp)
+
+            ENDIF
+         ENDDO
+
+      ELSE
+
+         CALL logger_error( &
+            &  " MPP RECOMBINE VAR: there is no variable with "//&
+            &  "name or standard name"//TRIM(cd_name)//&
+            &  " in mpp file "//TRIM(td_mpp%c_name))
+      ENDIF
+
+   END FUNCTION mpp_recombine_var
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE mpp__read_halo(td_file, td_dimglo) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine read subdomain indices defined with halo
+   !> (NEMO netcdf way)
+   !>
+   !> @author J.Paul
+   !> @date January, 2016 - Initial Version
+   !>
+   !> @param[inout] td_file   mpp structure
+   !-------------------------------------------------------------------
+   
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TFILE)              , INTENT(INOUT) :: td_file
+      TYPE(TDIM) , DIMENSION(:), INTENT(IN   ) :: td_dimglo
+
+      ! local variable
+      INTEGER(i4)       :: il_attid
+      INTEGER(i4)       :: il_ifirst
+      INTEGER(i4)       :: il_jfirst
+      INTEGER(i4)       :: il_ilast
+      INTEGER(i4)       :: il_jlast
+      INTEGER(i4)       :: il_ihalostart
+      INTEGER(i4)       :: il_jhalostart
+      INTEGER(i4)       :: il_ihaloend
+      INTEGER(i4)       :: il_jhaloend
+
+      CHARACTER(LEN=lc) :: cl_dom
+      !----------------------------------------------------------------
+
+      ! DOMAIN_position_first
+      il_attid = 0
+      IF( ASSOCIATED(td_file%t_att) )THEN
+         il_attid=att_get_id( td_file%t_att, "DOMAIN_position_first" )
+      ENDIF
+      IF( il_attid /= 0 )THEN
+         il_ifirst = INT(td_file%t_att(il_attid)%d_value(1))
+         il_jfirst = INT(td_file%t_att(il_attid)%d_value(2))
+      ELSE
+         il_ifirst = 1
+         il_jfirst = 1
+      ENDIF
+
+      ! DOMAIN_position_last
+      il_attid = 0
+      IF( ASSOCIATED(td_file%t_att) )THEN
+         il_attid=att_get_id( td_file%t_att, "DOMAIN_position_last" )
+      ENDIF
+      IF( il_attid /= 0 )THEN
+         il_ilast = INT(td_file%t_att(il_attid)%d_value(1))
+         il_jlast = INT(td_file%t_att(il_attid)%d_value(2))
+      ELSE
+         il_ilast = td_file%t_dim(1)%i_len
+         il_jlast = td_file%t_dim(2)%i_len
+      ENDIF
+
+      ! DOMAIN_halo_size_start
+      il_attid = 0
+      IF( ASSOCIATED(td_file%t_att) )THEN
+         il_attid=att_get_id( td_file%t_att, "DOMAIN_halo_size_start" )
+      ENDIF
+      IF( il_attid /= 0 )THEN
+         il_ihalostart = INT(td_file%t_att(il_attid)%d_value(1))
+         il_jhalostart = INT(td_file%t_att(il_attid)%d_value(2))
+      ELSE
+         il_ihalostart = 0
+         il_jhalostart = 0
+      ENDIF
+
+      ! DOMAIN_halo_size_end
+      il_attid = 0
+      IF( ASSOCIATED(td_file%t_att) )THEN
+         il_attid=att_get_id( td_file%t_att, "DOMAIN_halo_size_end" )
+      ENDIF
+      IF( il_attid /= 0 )THEN
+         il_ihaloend = INT(td_file%t_att(il_attid)%d_value(1))
+         il_jhaloend = INT(td_file%t_att(il_attid)%d_value(2))
+      ELSE
+         il_ihaloend = 0
+         il_jhaloend = 0
+      ENDIF
+
+      IF( (td_dimglo(jp_I)%i_len == td_file%t_dim(jp_I)%i_len) .AND. &
+        & (td_dimglo(jp_J)%i_len == td_file%t_dim(jp_J)%i_len) )THEN
+         cl_dom='full'
+      ELSEIF( il_ihalostart == 0 .AND. il_jhalostart == 0 .AND. &
+           &  il_ihaloend == 0 .AND. il_jhaloend == 0 )THEN
+         cl_dom='nooverlap'
+      ELSE
+         cl_dom='noextra'
+      ENDIF
+
+      SELECT CASE(TRIM(cl_dom))
+         CASE('full')
+            td_file%i_impp = il_ifirst 
+            td_file%i_jmpp = il_jfirst
+            td_file%i_lci  = td_file%t_dim(jp_I)%i_len 
+            td_file%i_lcj  = td_file%t_dim(jp_J)%i_len
+            td_file%i_ldi  = il_ihalostart + 1
+            td_file%i_ldj  = il_jhalostart + 1
+            td_file%i_lei  = td_file%t_dim(jp_I)%i_len - il_ihaloend
+            td_file%i_lej  = td_file%t_dim(jp_J)%i_len - il_jhaloend
+         CASE('noextra')
+            td_file%i_impp = il_ifirst
+            td_file%i_jmpp = il_jfirst
+            td_file%i_lci  = td_file%t_dim(jp_I)%i_len
+            td_file%i_lcj  = td_file%t_dim(jp_J)%i_len
+            td_file%i_ldi  = il_ihalostart + 1
+            td_file%i_ldj  = il_jhalostart + 1
+            td_file%i_lei  = td_file%i_lci - il_ihaloend
+            td_file%i_lej  = td_file%i_lcj - il_jhaloend
+         CASE('nooverlap') !!!?????
+            td_file%i_impp = il_ifirst
+            td_file%i_jmpp = il_jfirst
+            td_file%i_lci  = td_file%t_dim(jp_I)%i_len
+            td_file%i_lcj  = td_file%t_dim(jp_J)%i_len
+            td_file%i_ldi  = 1
+            td_file%i_ldj  = 1 
+            td_file%i_lei  = td_file%t_dim(jp_I)%i_len
+            td_file%i_lej  = td_file%t_dim(jp_J)%i_len
+      END SELECT
+
+   END SUBROUTINE mpp__read_halo
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE mpp__compute_halo(td_mpp) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine compute subdomain indices defined with halo
+   !> (NEMO netcdf way)
+   !>
+   !> @author J.Paul
+   !> @date January, 2016 - Initial Version
+   !>
+   !> @param[inout] td_mpp   mpp structure
+   !-------------------------------------------------------------------
+   
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMPP)      , INTENT(INOUT) :: td_mpp
+
+      ! local variable
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ifirst
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jfirst
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ilast
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jlast
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ihalostart
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jhalostart
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ihaloend
+      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jhaloend
+
+      TYPE(TATT)                             :: tl_att
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ALLOCATE( il_ifirst    (td_mpp%i_nproc) )
+      ALLOCATE( il_jfirst    (td_mpp%i_nproc) )
+
+      ALLOCATE( il_ilast     (td_mpp%i_nproc) )
+      ALLOCATE( il_jlast     (td_mpp%i_nproc) )
+
+      ALLOCATE( il_ihalostart(td_mpp%i_nproc) )
+      ALLOCATE( il_jhalostart(td_mpp%i_nproc) )
+
+      ALLOCATE( il_ihaloend  (td_mpp%i_nproc) )
+      ALLOCATE( il_jhaloend  (td_mpp%i_nproc) )
+
+      SELECT CASE(TRIM(td_mpp%c_dom))
+         CASE('full')
+            
+            il_ifirst(:)=td_mpp%t_proc(:)%i_impp
+            il_jfirst(:)=td_mpp%t_proc(:)%i_jmpp
+            
+            il_ilast(:)=td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%t_dim(jp_I)%i_len - 1
+            il_jlast(:)=td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%t_dim(jp_J)%i_len - 1
+
+            il_ihalostart(:)=td_mpp%t_proc(:)%i_ldi-1
+            il_jhalostart(:)=td_mpp%t_proc(:)%i_ldj-1
+            
+            il_ihaloend(:)=td_mpp%t_proc(:)%t_dim(jp_I)%i_len - td_mpp%t_proc(:)%i_lei
+            il_jhaloend(:)=td_mpp%t_proc(:)%t_dim(jp_J)%i_len - td_mpp%t_proc(:)%i_lej
+
+         CASE('noextra')
+            
+            il_ifirst(:)=td_mpp%t_proc(:)%i_impp
+            il_jfirst(:)=td_mpp%t_proc(:)%i_jmpp
+
+            il_ilast(:) =td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%i_lci - 1
+            il_jlast(:) =td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%i_lcj - 1
+            
+            il_ihalostart(:)=td_mpp%t_proc(:)%i_ldi-1
+            il_jhalostart(:)=td_mpp%t_proc(:)%i_ldj-1
+            
+            il_ihaloend(:)=td_mpp%t_proc(:)%i_lci - td_mpp%t_proc(:)%i_lei
+            il_jhaloend(:)=td_mpp%t_proc(:)%i_lcj - td_mpp%t_proc(:)%i_lej
+
+         CASE('nooverlap')
+
+            il_ifirst(:)=td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%i_ldi - 1
+            il_jfirst(:)=td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%i_ldj - 1
+
+            il_ilast(:)=td_mpp%t_proc(:)%i_impp + td_mpp%t_proc(:)%i_lei - 1
+            il_jlast(:)=td_mpp%t_proc(:)%i_jmpp + td_mpp%t_proc(:)%i_lej - 1
+
+            il_ihalostart(:)=0
+            il_jhalostart(:)=0
+
+            il_ihaloend(:)=0
+            il_jhaloend(:)=0
+
+         CASE DEFAULT
+            CALL logger_fatal("MPP INIT: invalid "//&
+            &              "decomposition type.")                     
+      END SELECT
+
+      DO ji=1,td_mpp%i_nproc
+         tl_att=att_init( "DOMAIN_position_first", &
+         &                (/ il_ifirst(ji), il_jfirst(ji) /) )
+         CALL file_move_att(td_mpp%t_proc(ji), tl_att)      
+
+         tl_att=att_init( "DOMAIN_position_last", &
+         &                (/ il_ilast(ji), il_jlast(ji) /) )
+         CALL file_move_att(td_mpp%t_proc(ji), tl_att)
+
+         tl_att=att_init( "DOMAIN_halo_size_start", &
+         &                (/ il_ihalostart(ji), il_jhalostart(ji) /) )
+         CALL file_move_att( td_mpp%t_proc(ji), tl_att)               
+
+         tl_att=att_init( "DOMAIN_halo_size_end", &
+         &                (/ il_ihaloend(ji), il_jhaloend(ji) /) )
+         CALL file_move_att( td_mpp%t_proc(ji), tl_att)
+      ENDDO
+
+      DEALLOCATE( il_ifirst    )
+      DEALLOCATE( il_jfirst    )
+ 
+      DEALLOCATE( il_ilast     )
+      DEALLOCATE( il_jlast     )
+ 
+      DEALLOCATE( il_ihalostart)
+      DEALLOCATE( il_jhalostart)
+
+      DEALLOCATE( il_ihaloend  )
+      DEALLOCATE( il_jhaloend  )
+
+      !impp
+      tl_att=att_init( "SUBDOMAIN_I_left_bottom_indices", td_mpp%t_proc(:)%i_impp)
+      CALL mpp_move_att(td_mpp, tl_att)
+
+      tl_att=att_init( "SUBDOMAIN_J_left_bottom_indices", td_mpp%t_proc(:)%i_jmpp)
+      CALL mpp_move_att(td_mpp, tl_att)
+
+      ! lci
+      tl_att=att_init( "SUBDOMAIN_I_dimensions", td_mpp%t_proc(:)%i_lci)
+      CALL mpp_move_att(td_mpp, tl_att)
+
+      tl_att=att_init( "SUBDOMAIN_J_dimensions", td_mpp%t_proc(:)%i_lcj)
+      CALL mpp_move_att(td_mpp, tl_att)
+
+      ! ldi
+      tl_att=att_init( "SUBDOMAIN_I_first_indoor_indices", td_mpp%t_proc(:)%i_ldi)
+      CALL mpp_move_att(td_mpp, tl_att)
+
+      tl_att=att_init( "SUBDOMAIN_J_first_indoor_indices", td_mpp%t_proc(:)%i_ldj)
+      CALL mpp_move_att(td_mpp, tl_att)
+
+      ! lei
+      tl_att=att_init( "SUBDOMAIN_I_last_indoor_indices", td_mpp%t_proc(:)%i_lei)
+      CALL mpp_move_att(td_mpp, tl_att)
+
+      tl_att=att_init( "SUBDOMAIN_J_last_indoor_indices", td_mpp%t_proc(:)%i_lej)
+      CALL mpp_move_att(td_mpp, tl_att)         
+
+      ! clean
+      CALL att_clean(tl_att)
+
+   END SUBROUTINE mpp__compute_halo
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE mpp
+
Index: /utils/tools_ticket2413/SIREN/src/multi.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/multi.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/multi.f90	(revision 12863)
@@ -0,0 +1,719 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> This module manage multi file structure.
+!>
+!> @details
+!>    define type TMULTI:<br/>
+!> @code
+!>    TYPE(TMULTI) :: tl_multi
+!> @endcode
+!>
+!>    to initialize a multi-file structure:<br/>
+!> @code
+!>    tl_multi=multi_init(cd_varfile(:))
+!> @endcode
+!>       - cd_varfile : array of variable with file path 
+!>       ('var1:file1','var2:file2')<br/>
+!>          file path could be replaced by a matrix of value.<br/>
+!>          separators used to defined matrix are:
+!>             - ',' for line
+!>             - '/' for row
+!>             - '\' for level<br/>
+!>             Example:<br/>
+!>                - 'var1:3,2,3/1,4,5'
+!>                - 3,2,3/1,4,5  =>  
+!>                      @f$ \left( \begin{array}{ccc}
+!>                           3 & 2 & 3 \\
+!>                           1 & 4 & 5 \end{array} \right) @f$<br/>
+!> 
+!>    to get the number of mpp file in mutli file structure:<br/>
+!>    - tl_multi\%i_nmpp
+!>
+!>    to get the total number of variable in mutli file structure:<br/>
+!>    - tl_multi\%i_nvar
+!>
+!>    @note number of variable and number of file could differ cause several variable
+!>    could be in the same file.
+!>
+!>    to get array of mpp structure in mutli file structure:<br/>
+!>    - tl_multi\%t_mpp(:)
+!>
+!>    to print information about multi structure:<br/>
+!> @code
+!>    CALL multi_print(td_multi)
+!> @endcode
+!>
+!>    to clean multi file strucutre:<br/>
+!> @code
+!>    CALL multi_clean(td_multi)
+!> @endcode
+!>       - td_multi is multi file structure
+!>
+!> @author
+!>  J.Paul
+!>
+!> @date November, 2013 - Initial Version
+!> @date October, 2014
+!> - use mpp file structure instead of file
+!> @date November, 2014 
+!> - Fix memory leaks bug
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE multi
+
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE fct                             ! basic useful function
+   USE dim                             ! dimension manager
+   USE var                             ! variable manager
+   USE file                            ! file manager
+   USE iom                             ! I/O manager
+   USE mpp                             ! MPP manager
+   USE iom_mpp                         ! MPP I/O manager
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   PUBLIC :: TMULTI       !< multi file structure
+
+   ! function and subroutine
+   PUBLIC :: multi_copy        !< copy multi structure
+   PUBLIC :: multi_init        !< initialise multi structure
+   PUBLIC :: multi_clean       !< clean multi strcuture
+   PUBLIC :: multi_print       !< print information about milti structure
+
+   PRIVATE :: multi__add_mpp   !< add file strucutre to multi file structure
+   PRIVATE :: multi__copy_unit !< copy multi file structure
+   PRIVATE :: multi__get_perio !< read periodicity from namelist
+
+   TYPE TMULTI !< multi file structure
+      ! general 
+      INTEGER(i4)                         :: i_nmpp  = 0         !< number of mpp files 
+      INTEGER(i4)                         :: i_nvar  = 0         !< total number of variables
+      TYPE(TMPP) , DIMENSION(:), POINTER  :: t_mpp => NULL()     !< mpp files composing multi
+   END TYPE
+
+   INTERFACE multi_copy
+      MODULE PROCEDURE multi__copy_unit   ! copy multi file structure
+   END INTERFACE   
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION multi__copy_unit(td_multi) &
+         & RESULT (tf_multi)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function copy multi mpp structure in another one
+   !> @details 
+   !> file variable value are copied in a temporary array, 
+   !> so input and output file structure value do not point on the same 
+   !> "memory cell", and so on are independant. 
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> attribute (ex: tl_att=att_copy(att_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>   
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2014
+   !>    - use function instead of overload assignment operator (to avoid memory leak)
+   !>
+   !> @param[in] td_multi    mpp structure
+   !> @return copy of input multi structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMULTI), INTENT(IN)  :: td_multi
+
+      ! function
+      TYPE(TMULTI)              :: tf_multi
+
+      ! local variable
+      TYPE(TMPP) :: tl_mpp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      tf_multi%i_nmpp = td_multi%i_nmpp
+      tf_multi%i_nvar = td_multi%i_nvar
+
+      ! copy variable structure
+      IF( ASSOCIATED(tf_multi%t_mpp) )THEN
+         CALL mpp_clean(tf_multi%t_mpp(:))
+         DEALLOCATE(tf_multi%t_mpp)
+      ENDIF
+      IF( ASSOCIATED(td_multi%t_mpp) .AND. tf_multi%i_nmpp > 0 )THEN
+         ALLOCATE( tf_multi%t_mpp(tf_multi%i_nmpp) )
+         DO ji=1,tf_multi%i_nmpp
+            tl_mpp = mpp_copy(td_multi%t_mpp(ji))
+            tf_multi%t_mpp(ji) = mpp_copy(tl_mpp)
+         ENDDO
+         ! clean
+         CALL mpp_clean(tl_mpp)
+      ENDIF
+
+   END FUNCTION multi__copy_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION multi_init(cd_varfile) &
+         & RESULT (tf_multi)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine initialize multi file structure.
+   !>
+   !> @details
+   !> if variable name is 'all', add all the variable of the file in mutli file
+   !> structure.
+   !> Optionnaly, periodicity could be read behind filename.
+   !>
+   !> @note if first character of filename is numeric, assume matrix is given as
+   !> input.<br/>
+   !> create pseudo file named 'data-*', with matrix read as variable value.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - check if variable to be read is in file
+   !> @date January, 2016
+   !> - read variable dimensions
+   !> @date July, 2016
+   !> - get variable to be read and associated file first
+   !> @date August, 2017
+   !> - get perio from namelist 
+   !> @date January, 2019
+   !> - create and clean file structure to avoid memory leaks
+   !> - fill value read from array of variable structure
+   !> @date May, 2019
+   !> - compare each elt of cl_tabfile to cl_file
+   !> @date August, 2019
+   !> - use periodicity read from namelist, and store in multi structure
+   !>
+   !> @param[in] cd_varfile   variable location information (from namelist) 
+   !> @return multi file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_varfile
+
+      ! function
+      TYPE(TMULTI)                               :: tf_multi
+
+      ! parameters
+      INTEGER(i4)   , PARAMETER        :: ip_nmaxfiles = 50
+      INTEGER(i4)   , PARAMETER        :: ip_nmaxvars = 100
+
+      ! local variable
+      INTEGER(i4)                                             :: il_nvar
+      INTEGER(i4)                                             :: il_nvarin
+      INTEGER(i4)                                             :: il_nfiles
+      INTEGER(i4)                                             :: il_varid
+      INTEGER(i4)                                             :: il_perio
+
+      REAL(dp)                                                :: dl_fill
+      CHARACTER(LEN=lc)                                       :: cl_name
+      CHARACTER(LEN=lc)                                       :: cl_varname
+      CHARACTER(LEN=lc)                                       :: cl_lower
+      CHARACTER(LEN=lc)                                       :: cl_file
+      CHARACTER(LEN=lc)                                       :: cl_matrix
+
+      CHARACTER(LEN=lc), DIMENSION(ip_nmaxfiles)              :: cl_tabfile
+      CHARACTER(LEN=lc), DIMENSION(ip_nmaxfiles, ip_nmaxvars) :: cl_tabvar
+
+      LOGICAL                                                 :: ll_dim
+
+      TYPE(TDIM), DIMENSION(ip_maxdim)                        :: tl_dim
+
+      TYPE(TVAR)                                              :: tl_var
+      TYPE(TVAR) , DIMENSION(:), ALLOCATABLE                  :: tl_varin
+
+      TYPE(TMPP)                                              :: tl_mpp
+
+      TYPE(TFILE)                                             :: tl_file
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      INTEGER(i4) :: jf
+      INTEGER(i4) , DIMENSION(ip_nmaxvars) :: jv
+      !----------------------------------------------------------------
+
+      ji=1
+      jf=0
+      jv(:)=0
+      cl_tabfile(:)=''
+      DO WHILE( TRIM(cd_varfile(ji)) /= '' )
+
+         cl_name=fct_split(cd_varfile(ji),1,':')
+         IF( TRIM(cl_name) == '' )THEN
+            CALL logger_error("MULTI INIT: variable name "//&
+            &                 "is empty. check namelist.")
+         ENDIF
+
+         cl_file=fct_split(cd_varfile(ji),2,':')
+         IF( TRIM(cl_file) == '' )THEN
+            CALL logger_error("MULTI INIT: file name matching variable "//&
+            &                 TRIM(cl_name)//" is empty. check namelist.")
+         ENDIF
+         IF( LEN(TRIM(cl_file)) >= lc )THEN
+            CALL logger_fatal("MULTI INIT: file name too long (>"//&
+            &          TRIM(fct_str(lc))//"). check namelist.")
+         ENDIF
+         
+         IF( TRIM(cl_file) /= '' )THEN
+            jk=0
+            DO jj=1,jf
+               IF( TRIM(cl_file) == TRIM(cl_tabfile(jj)) )THEN            
+                  jk=jj
+                  EXIT
+               ENDIF
+            ENDDO
+            IF ( jk /= 0 )then
+               jv(jk)=jv(jk)+1
+               cl_tabvar(jk,jv(jk))=TRIM(cl_name)
+            ELSE ! jk == 0
+               jf=jf+1
+               IF( jf > ip_nmaxfiles )THEN
+                  CALL logger_fatal("MULTI INIT: too much files in "//&
+                  &  "varfile (>"//TRIM(fct_str(ip_nmaxfiles))//&
+                  &  "). check namelist.")
+               ENDIF
+               cl_tabfile(jf)=TRIM(cl_file)
+               jv(jf)=jv(jf)+1
+               cl_tabvar(jf,jv(jf))=TRIM(cl_name)
+            ENDIF
+         ENDIF
+
+         ji=ji+1
+      ENDDO
+
+!print *,'============'
+!print *,jf,' files ','============'
+!DO ji=1,jf
+!   print *,'file ',trim(cl_tabfile(ji))
+!   print *,jv(ji),' vars '
+!   DO jj=1,jv(ji)
+!      print *,'var ',trim(cl_tabvar(ji,jj))
+!   ENDDO
+!ENDDO
+!print *,'============'
+
+
+      il_nfiles=jf
+      il_nvar=0
+      DO ji=1,il_nfiles
+         cl_file=TRIM(cl_tabfile(ji))
+
+         cl_matrix=''
+         IF( fct_is_num(cl_file(1:1)) )THEN
+            cl_matrix=TRIM(cl_file)
+            WRITE(cl_file,'(a,i2.2)')'data-',ji
+
+            DO jj=1,jv(ji)
+               cl_name=TRIM(cl_tabvar(ji,jv(ji)))
+               cl_lower=TRIM(fct_lower(cl_name))
+
+               tl_var=var_init(TRIM(cl_name))
+               CALL var_read_matrix(tl_var, cl_matrix)
+
+               IF( jj == 1 )THEN
+                  ! create mpp structure
+                  tl_mpp=mpp_init(TRIM(cl_file), tl_var)
+               ENDIF
+
+               ! add variable
+               CALL mpp_add_var(tl_mpp,tl_var)
+               ! number of variable
+               il_nvar=il_nvar+1
+
+            ENDDO
+
+         ELSE
+            CALL multi__get_perio(cl_file, il_perio)
+
+            tl_file=file_init(TRIM(cl_file), id_perio=il_perio)
+            tl_mpp=mpp_init( tl_file, id_perio=il_perio )
+            ! clean
+            CALL file_clean(tl_file)
+
+            il_nvarin=tl_mpp%t_proc(1)%i_nvar
+            ALLOCATE(tl_varin(il_nvarin))
+            DO jj=1,il_nvarin
+               tl_varin(jj)=var_copy(tl_mpp%t_proc(1)%t_var(jj))
+               DO jl=1,ip_maxdim
+                  IF( tl_varin(jj)%t_dim(jl)%l_use )THEN
+                     tl_varin(jj)%t_dim(jl)=dim_copy(tl_mpp%t_dim(jl))
+                  ENDIF
+               ENDDO
+            ENDDO
+
+            ! clean all varible
+            CALL mpp_del_var(tl_mpp)
+
+            DO jj=1,jv(ji)
+               cl_name=TRIM(cl_tabvar(ji,jj))
+               cl_lower=TRIM(fct_lower(cl_name))
+               ! define variable
+               IF( TRIM(fct_lower(cl_lower)) /= 'all' )THEN
+
+                  ! check if variable is in file
+                  il_varid=var_get_index(tl_varin(:),cl_lower)
+                  IF( il_varid == 0 )THEN
+                     CALL logger_fatal("MULTI INIT: variable "//&
+                        & TRIM(cl_name)//" not in file "//&
+                        & TRIM(cl_file) )
+                  ENDIF
+
+                  ! get (global) variable dimension
+                  tl_dim(jp_I)=dim_copy(tl_varin(il_varid)%t_dim(jp_I))
+                  tl_dim(jp_J)=dim_copy(tl_varin(il_varid)%t_dim(jp_J))
+                  tl_dim(jp_K)=dim_copy(tl_varin(il_varid)%t_dim(jp_K))
+                  tl_dim(jp_L)=dim_copy(tl_varin(il_varid)%t_dim(jp_L))
+
+                  cl_varname=tl_varin(il_varid)%c_name
+                  dl_fill=tl_varin(il_varid)%d_fill
+
+                  tl_var=var_init(TRIM(cl_varname), td_dim=tl_dim(:), &
+                     &            dd_fill=dl_fill)
+
+                  ! add variable
+                  CALL mpp_add_var(tl_mpp,tl_var)
+
+                  ! number of variable
+                  il_nvar=il_nvar+1
+
+                  ! clean structure
+                  CALL var_clean(tl_var)
+
+               ELSE ! cl_lower == 'all'
+
+                  DO jk=il_nvarin,1,-1
+
+                     ! check if variable is dimension
+                     ll_dim=.FALSE.
+                     DO jl=1,ip_maxdim
+                        IF( TRIM(tl_mpp%t_proc(1)%t_dim(jl)%c_name) == &
+                        &   TRIM(tl_varin(jk)%c_name) )THEN
+                           ll_dim=.TRUE.
+                           CALL logger_trace("MULTI INIT: "//&
+                           &  TRIM(tl_varin(jk)%c_name)//&
+                           &  ' is var dimension')
+                           EXIT
+                        ENDIF
+                     ENDDO
+                     ! do not use variable dimension
+                     IF( ll_dim )THEN
+                        tl_var=var_init( TRIM(tl_varin(jk)%c_name) )
+                        ! delete variable
+                        CALL mpp_del_var(tl_mpp,tl_var)
+                        ! clean structure
+                        CALL var_clean(tl_var)
+                     ELSE
+                        ! add variable
+                        CALL mpp_add_var(tl_mpp, tl_varin(jk))
+                        ! number of variable
+                        il_nvar=il_nvar+1
+                     ENDIF
+
+                  ENDDO
+
+               ENDIF
+            ENDDO
+            ! clean structure
+            CALL var_clean(tl_varin)
+            DEALLOCATE(tl_varin)
+
+         ENDIF
+
+         CALL multi__add_mpp(tf_multi, tl_mpp)
+
+         ! update total number of variable
+         tf_multi%i_nvar=tf_multi%i_nvar+tl_mpp%t_proc(1)%i_nvar
+
+         ! clean
+         CALL mpp_clean(tl_mpp)
+
+      ENDDO
+
+   END FUNCTION multi_init
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE multi_clean(td_multi)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine clean multi file strucutre.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2019
+   !> - nullify mpp structure in multi file structure
+   !>
+   !> @param[in] td_multi  multi file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMULTI), INTENT(INOUT) :: td_multi
+
+      ! local variable
+      TYPE(TMULTI) :: tl_multi ! empty multi file structure
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      CALL logger_info( " CLEAN: reset multi file " )
+
+      IF( ASSOCIATED( td_multi%t_mpp ) )THEN
+         CALL mpp_clean(td_multi%t_mpp(:))
+         DEALLOCATE(td_multi%t_mpp)
+         NULLIFY(td_multi%t_mpp)
+      ENDIF
+
+      ! replace by empty structure
+      td_multi=multi_copy(tl_multi)
+
+   END SUBROUTINE multi_clean
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE multi_print(td_multi)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine print some information about mpp strucutre.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2019
+   !> - print periodicity
+   !> @date May, 2019
+   !> - specify format output
+   !>
+   !> @param[in] td_multi multi file structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TMULTI), INTENT(IN) :: td_multi
+
+      ! local variable
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      ! print file
+      IF( td_multi%i_nmpp /= 0 .AND. ASSOCIATED(td_multi%t_mpp) )THEN
+         WRITE(*,'(/a,i3)') 'MULTI: total number of file(s): ',&
+         &  td_multi%i_nmpp
+         WRITE(*,'(6x,a,i3)') ' total number of variable(s): ',&
+         &  td_multi%i_nvar
+         DO ji=1,td_multi%i_nmpp
+            WRITE(*,'(3x,3a)') 'FILE ',TRIM(td_multi%t_mpp(ji)%c_name),&
+            & ' CONTAINS'
+            DO jj=1,td_multi%t_mpp(ji)%t_proc(1)%i_nvar
+               IF( ASSOCIATED(td_multi%t_mpp(ji)%t_proc(1)%t_var) )THEN
+                  WRITE(*,'(6x,a)') &
+                  &  TRIM(td_multi%t_mpp(ji)%t_proc(1)%t_var(jj)%c_name)
+                  !WRITE(*,'(6x,a,i0)') 'perio ',td_multi%t_mpp(ji)%t_proc(1)%i_perio
+               ENDIF
+            ENDDO
+         ENDDO
+      ENDIF
+
+   END SUBROUTINE multi_print
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE multi__add_mpp(td_multi, td_mpp)
+   !-------------------------------------------------------------------
+   !> @brief
+   !>    This subroutine add file to multi file structure.
+   !>
+   !> @detail
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date October, 2014
+   !> - use mpp file structure instead of file
+   !> @date January, 2019
+   !> - deallocate mpp structure whatever happens
+   !>
+   !> @param[inout] td_multi  multi mpp file strcuture
+   !> @param[in]    td_mpp    mpp file strcuture
+   !> @return mpp file id in multi mpp file structure
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMULTI), INTENT(INOUT) :: td_multi
+      TYPE(TMPP)  , INTENT(IN)    :: td_mpp
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_mppid
+      
+      TYPE(TMPP), DIMENSION(:), ALLOCATABLE :: tl_mpp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      il_mppid=0
+      IF( ASSOCIATED(td_multi%t_mpp) )THEN
+         il_mppid=mpp_get_index(td_multi%t_mpp(:),TRIM(td_mpp%c_name))
+      ENDIF
+
+      IF( il_mppid /= 0 )THEN
+
+            CALL logger_debug( " MULTI ADD FILE: mpp file "//TRIM(td_mpp%c_name)//&
+            &               " already in multi mpp file structure")
+
+            ! add new variable
+            DO ji=1,td_mpp%t_proc(1)%i_nvar
+               CALL mpp_add_var(td_multi%t_mpp(il_mppid), td_mpp%t_proc(1)%t_var(ji))
+            ENDDO
+
+      ELSE
+ 
+         CALL logger_trace("MULTI ADD MPP: add mpp "//&
+         &               TRIM(td_mpp%c_name)//" in multi mpp file structure")
+
+         IF( td_multi%i_nmpp > 0 )THEN
+            ! 
+            ! already other mpp file in multi file structure
+            ALLOCATE( tl_mpp(td_multi%i_nmpp), stat=il_status )
+            IF(il_status /= 0 )THEN
+
+               CALL logger_error( " MULTI ADD MPP FILE: not enough space to put &
+               &               mpp file in multi mpp file structure")
+
+            ELSE
+               ! save temporary multi file structure
+               tl_mpp(:)=mpp_copy(td_multi%t_mpp(:))
+
+               CALL mpp_clean(td_multi%t_mpp(:))
+               DEALLOCATE( td_multi%t_mpp )
+               ALLOCATE( td_multi%t_mpp(td_multi%i_nmpp+1), stat=il_status)
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( " MULTI ADD MPP FILE: not enough space "//&
+                  &  "to put mpp file in multi mpp file structure ")
+
+               ENDIF
+
+               ! copy mpp file in multi mpp file before
+               td_multi%t_mpp(1:td_multi%i_nmpp) = mpp_copy(tl_mpp(:))
+
+               ! clean
+               CALL mpp_clean(tl_mpp(:))
+            ENDIF
+            DEALLOCATE(tl_mpp)
+
+         ELSE
+            ! no file in multi file structure
+            IF( ASSOCIATED(td_multi%t_mpp) )THEN
+               CALL mpp_clean(td_multi%t_mpp(:))
+               DEALLOCATE(td_multi%t_mpp)
+            ENDIF
+            ALLOCATE( td_multi%t_mpp(td_multi%i_nmpp+1), stat=il_status )
+            IF(il_status /= 0 )THEN
+
+               CALL logger_error( " MULTI ADD MPP FILE: not enough space "//&
+               &  "to put mpp file in multi mpp file structure " )
+
+            ENDIF
+         ENDIF
+
+         ! update number of mpp
+         td_multi%i_nmpp=td_multi%i_nmpp+1
+
+         ! add new mpp
+         td_multi%t_mpp(td_multi%i_nmpp)=mpp_copy(td_mpp)
+
+      ENDIF
+
+   END SUBROUTINE multi__add_mpp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE multi__get_perio(cd_file, id_perio)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine check if variable file, read in namelist, contains 
+   !> periodicity value and return it if true. 
+   !> 
+   !> @details
+   !> periodicity value is assume to follow string "perio ="
+   !>
+   !> @author J.Paul
+   !> @date January, 2019 - Initial Version
+   !> @date August, 209
+   !> - rewrite function to subroutine
+   !> - output filename string contains only filename (no more periodicity if
+   !> given)
+   !>
+   !> @param[inout] cd_file    file name
+   !> @param[  out] id_perio   NEMO periodicity 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(INOUT) :: cd_file
+      INTEGER(i4)     , INTENT(  OUT) :: id_perio
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_perio
+ 
+      INTEGER(i4)       :: il_ind
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      ! init
+      cl_perio=''
+      id_perio=-1
+
+      ji=1
+      cl_tmp=fct_split(cd_file,ji,';')
+      DO WHILE( TRIM(cl_tmp) /= '' )
+         il_ind=INDEX(TRIM(cl_tmp),'perio')
+         IF( il_ind /= 0 )THEN
+            ! check character just after
+            jj=il_ind+LEN('perio')
+            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. &
+            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN
+               cl_perio=fct_split(cl_tmp,2,'=')
+               EXIT
+            ENDIF
+         ENDIF
+         ji=ji+1
+         cl_tmp=fct_split(cd_file,ji,';')         
+      ENDDO
+      cd_file=fct_split(cd_file,1,';')
+
+      IF( TRIM(cl_perio) /= '' )THEN
+         IF( fct_is_num(cl_perio) )THEN
+            READ(cl_perio,*) id_perio
+            CALL logger_debug("MULTI GET PERIO: will use periodicity value of "//&
+            &  TRIM(fct_str(id_perio))//" for file "//TRIM(cd_file) )
+         ELSE
+            CALL logger_error("MULTI GET PERIO: invalid periodicity value ("//&
+               & TRIM(cl_perio)//") for file "//TRIM(cd_file)//&
+               & ". check namelist." )
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE multi__get_perio
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE multi
+
Index: /utils/tools_ticket2413/SIREN/src/phycst.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/phycst.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/phycst.f90	(revision 12863)
@@ -0,0 +1,56 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief This module defines physical constant.
+!>
+!> @author
+!> J.paul
+! REVISION HISTORY:
+!> @date November, 2013 - Initial Version
+!> @date September, 2015
+!> - add physical constant to compute meshmask
+!> @date January, 2019
+!> - half reduce epsilon value
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE phycst
+
+   USE kind                         ! F90 kind parameter
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   PUBLIC :: dp_pi      !< pi
+   PUBLIC :: dp_eps     !< epsilon value
+   PUBLIC :: dp_rearth  !< earth radius [m]
+   PUBLIC :: dp_deg2rad !< degree to radian ratio 
+   PUBLIC :: dp_rad2deg !< radian to degree ratio 
+   PUBLIC :: dp_delta   !<  
+   PUBLIC :: dp_omega   !< earth rotation parameter [s-1] 
+   PUBLIC :: dp_day     !< day                                [s]
+   PUBLIC :: dp_siyea   !< sideral year                       [s]
+   PUBLIC :: dp_siday   !< sideral day                        [s]
+
+   REAL(dp), PUBLIC ::   rday = 24.*60.*60.     !: day                                [s]
+   REAL(dp), PUBLIC ::   rsiyea                 !: sideral year                       [s]
+   REAL(dp), PUBLIC ::   rsiday                 !: sideral day                        [s]
+
+   REAL(dp), PARAMETER :: dp_pi = 3.14159274101257_dp
+   REAL(dp), PARAMETER :: dp_eps = 0.5 * EPSILON(1._dp)
+   REAL(dp), PARAMETER :: dp_rearth = 6371229._dp !m
+   REAL(dp), PARAMETER :: dp_deg2rad = dp_pi/180.0
+   REAL(dp), PARAMETER :: dp_rad2deg = 180.0/dp_pi
+
+   REAL(dp), PARAMETER :: dp_day = 24.*60.*60.     
+   REAL(dp), PARAMETER :: dp_siyea = 365.25_dp * dp_day * &
+      &  2._dp * dp_pi / 6.283076_dp
+   REAL(dp), PARAMETER :: dp_siday = dp_day / ( 1._dp + dp_day / dp_siyea )
+
+   REAL(dp), PARAMETER :: dp_delta=1.e-6
+   REAL(dp), PARAMETER :: dp_omega= 2._dp * dp_pi / dp_siday
+
+END MODULE phycst
+
Index: /utils/tools_ticket2413/SIREN/src/variable.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/variable.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/variable.f90	(revision 12863)
@@ -0,0 +1,9705 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief 
+!> This module manage variable structure.
+!>
+!> @details
+!> to define type TVAR:<br/>
+!> @code
+!>    TYPE(TVAR) :: tl_var
+!> @endcode
+!>
+!>    @note the variable value inside structure will always be 4D array of real(8).<br/>
+!>    However the variable value could be initialised with
+!>    array of real(4), real(8), integer(4) or integer(8).
+!>        
+!> to initialise a variable structure:<br/>
+!> @code
+!>    tl_var=var_init( cd_name, [value,] [id_start, [id_count,]] [id_type,] [td_dim,] [td_att]... )
+!> @endcode
+!>       - cd_name is the variable name
+!>       - value is a 1D,2D,3D or 4D array, see var_init for more information [optional]
+!>       - id_start is a integer(4) 1D array of index from which the data 
+!>          values will be read [optional]
+!>       - id_count is a integer(4) 1D array of the number of indices selected
+!>          along each dimension [optional]
+!>       - id_type is the type of the variable to be used [optional]
+!>       - td_dim is the array of dimension structure [optional]
+!>       - td_att is the array of attribute structure [optional]
+!>    Note:<br/>
+!>       - others optionals arguments could be added, see var_init.
+!>       - to put scalar variable (OD), use td_dim with all dimension unused
+!> (td_dim(:)%l_use=.FALSE.)
+!>    
+!>    to print information about variable structure:<br/>
+!> @code
+!>    CALL var_print(td_var [,ld_more])
+!> @endcode
+!>       - td_var is the variable structure
+!>       - ld_more to print more information about variable
+!>
+!> to clean variable structure:<br/>
+!> @code
+!>    CALL var_clean(tl_var)
+!> @endcode
+!>
+!> to copy variable structure in another one (using different memory cell):<br/>
+!> @code
+!>    tl_var2=var_copy(tl_var1) 
+!> @endcode
+!>    @note as we use pointer for the value array of the variable structure,
+!>    the use of the assignment operator (=) to copy variable structure 
+!>    create a pointer on the same array. 
+!>    This is not the case with this copy function.
+!>
+!> to get variable name:<br/>
+!>    - tl_var\%c_name
+!>
+!> to get grid point of the variable
+!>    - tl_var\%c_point
+!>
+!> to get EW overlap:<br/>
+!>    - tl_var\%i_ew
+!>
+!> to get variable value:<br/>
+!>    - tl_var\%d_value(:,:,:,:)
+!>    
+!> to get the type number (based on NETCDF type constants) of the variable 
+!>    (as define initially or read in file):<br/>
+!>    - tl_var\%i_type
+!>
+!> to get variable id (read from a file):<br/>
+!>    - tl_var\%i_id
+!>
+!> **Variable dimension**<br/>
+!> to get the number of dimension used in the variable:<br/>
+!>    - tl_var\%i_ndim
+!>
+!> to get the array of dimension structure (4 elts) associated to the
+!> variable:<br/>
+!>    - tl_var\%t_dim(:)
+!>
+!> **Variable attributes**<br/>
+!> @note attribue value are always character or real(8) 1D array.<br/>
+!>
+!> to get the number of attributes of the variable:<br/>
+!>    - tl_var\%i_natt
+!>
+!> to get the array of attribute structure associated to the
+!> variable:<br/>
+!>    - tl_var\%t_att(:)
+!>
+!> Some attribute are highlight, to be easily used.
+!> to get variable standard name:<br/>
+!>    - tl_var\%c_stdname
+!>
+!> to get variable longname:<br/>
+!>    - tl_var\%c_longname
+!>
+!> to get variable units:<br/>
+!>    - tl_var\%c_units
+!>
+!> to get variable axis:<br/>
+!>    - tl_var\%c_axis
+!>
+!> to get variable scale factor:<br/>
+!>    - tl_var\%d_scf
+!>
+!> to get variable add offset:<br/>
+!>    - tl_var\%d_ofs
+!>
+!> to get variable FillValue:<br/>
+!>    - tl_var\%d_fill
+!>
+!> to add value to a variable structure:<br/>
+!> @code
+!>    CALL var_add_value(tl_var, value, [id_type,] [id_start, [id_count]]) 
+!> @endcode
+!>       - value : 4D array of value (real(4), real(8), integer(1), integer(2), integer(4), integer(8))
+!>       - id_type is the type of the variable to be used (default is the type
+!> of array value)
+!>       - id_start : 1D array of the index in the variable from which the data
+!>       values will be read (integer(4), optional)
+!>       - id_count : 1D array of the number of indices selected along each 
+!>       dimension (integer(4), optional)
+!>
+!> to add attribute to a variable structure:<br/>
+!> @code
+!>    CALL var_add_att(tl_var, td_att)
+!> @endcode
+!>       - td_att is an attribute structure, or array of attribute structure 
+!>
+!> to add dimension to a variable structure:<br/>
+!> @code
+!>    CALL var_add_dim(tl_var, td_dim)
+!> @endcode
+!>       - td_dim is a dimension structure, or array of dimension structure
+!> 
+!> to delete value of a variable structure:<br/>
+!> @code
+!>    CALL var_del_value(tl_var)
+!> @endcode
+!>
+!> to delete one attribute of a variable structure:<br/>
+!> @code
+!>    CALL var_del_att(tl_var, td_att)
+!> @endcode
+!>       - td_att is an attribute structure 
+!> or
+!> @code
+!>    CALL var_del_att(tl_var, cd_name)
+!> @endcode
+!>       - cd_name is attribute name 
+!>
+!> to delete one dimension of a variable structure:<br/>
+!> @code
+!>    CALL var_del_dim(tl_var, td_dim)
+!> @endcode
+!>       - td_dim is a dimension structure
+!>
+!> to overwrite one attribute structure in variable structure:<br/>
+!> @code
+!>    CALL var_move_att(tl_var, td_att)
+!> @endcode
+!>       - td_att is an attribute structure
+!>
+!> to overwrite one dimension structure in variable structure:<br/>
+!> @code
+!>    CALL var_move_dim(tl_var, td_dim)
+!> @endcode
+!>       - td_dim is a dimension structure
+!>
+!> to get the mask of a variable strucutre, (based on its FillValue):<br/>
+!> @code
+!>    mask(:,:)=var_get_mask(tl_var)
+!> @endcode
+!>
+!> to change FillValue to standard NETCDF Fill Value:<br/>
+!> @code
+!>    CALL  var_chg_FillValue(tl_var, [dd_fill])
+!> @endcode
+!>       - dd_fill is the FillValue to be used [optional]
+!>
+!> to concatenate two variables:<br/>
+!> @code
+!>    tl_var=var_concat(tl_var1, tl_var2, [DIM])
+!> @endcode
+!>       - tl_var1 : variable structure 
+!>       - tl_var2 : variable structure 
+!>       - DIM : number of the dimension following which concatenate (1=>I, 2=>J, 3=>Z, 4=>T) [optional, default=4]
+!>
+!> to forced min and max value of a variable:<br/>
+!>    - define min and max value of the variable:<br/>
+!>       - tl_var\%d_min=min<br/>
+!>       - tl_var\%d_max=max<br/>
+!>          - min and max : real(8) value
+!>    - then <br/>
+!> @code
+!>    CALL  var_limit_value( tl_var )
+!> @endcode
+!>
+!> to get the biggest dimensions use in a array of variable:<br/>
+!> @code
+!>    tl_dim(:)=var_max_dim(tl_var(:))
+!> @endcode
+!>       - tl_var(:) : array of variable structure
+!>       - tl_dim(:) : array (4 elts) of dimension structure
+!>
+!> to reorder dimension of a variable (default 'x','y','z','t'):<br/>
+!> @code
+!>    CALL var_reorder( td_var, cd_dimorder )
+!> @endcode
+!>       - td_var is variable structure
+!>       - cd_dimorder string character(LEN=4) of dimension order to be used (example:
+!> 'yxzt') [optional]
+!>
+!> to get variable index, in an array of variable structure:<br/>
+!> @code
+!>   il_index=var_get_index( td_var, cd_name )
+!> @endcode
+!>    - td_var array of variable structure
+!>    - cd_name variable name
+!> 
+!> to get variable id, read from a file:<br/>
+!> @code
+!>  il_id=var_get_id( td_var, cd_name )
+!> @endcode
+!>    - td_var array of variable structure
+!>    - cd_name variable name
+!>
+!> to get free variable unit in an array of variable structure:<br/>
+!> @code
+!>  il_unit=var_get_unit(td_var)
+!> @endcode
+!>    - td_var array of variable structure
+!>
+!> to convert time variable structure in date structure:<br/>
+!> @code
+!>   tl_date=var_to_date(td_var) 
+!> @endcode
+!>    - td_var is time variable structure
+!>    - tl_date is date structure
+!>
+!> to read matrix value from character string in namelist
+!> @code
+!>    CALL var_read_matrix(td_var, cd_matrix)
+!> @endcode
+!>    - td_var is variable structure
+!>    - cd_matrix is matrix value
+!>
+!> to read variable configuration file ('variable.cfg') and fill global array
+!> of variable structure:<br/>
+!> @code
+!>    CALL var_def_extra( cd_file )
+!> @endcode
+!>    - cd_file is filename
+!>
+!> to add variable information get from namelist, in global array of variable 
+!> structure:
+!> @code
+!>    CALL var_chg_extra( cd_varinfo )
+!> @endcode
+!>    - cd_varinfo is variable information from namelist
+!>
+!> to clean global array of variable structure:<br/>
+!> @code
+!>    CALL var_clean_extra( )
+!> @endcode
+!>
+!> to check variable dimension expected, as defined in file 'variable.cfg':<br/>
+!> @code
+!>    CALL var_check_dim( td_var )
+!> @endcode
+!>    - td_var is variable structure
+!> 
+!> @author
+!> J.Paul
+!>
+!> @date November, 2013 - Initial Version
+!> @date September, 2014
+!>  - add var_reorder
+!> @date November, 2014 
+!> - Fix memory leaks bug
+!> @date June, 2015
+!> - change way to get variable information in namelist
+!> @date July, 2015 
+!> - add subroutine var_chg_unit to change unit of output variable
+!> @date Spetember, 2015
+!> - manage useless (dummy) variable
+!> @date October, 2016
+!> - add subroutine to clean global array of extra information.
+!> - define logical for variable to be used
+!> @date May, 2019
+!> - read number of element for each dummy array in configuration file
+!>
+!> @todo
+!> - var_copy_value qui copie le tableau de valeur mais verifie que tous les
+!> attribut sont egaux
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE var
+
+   USE netcdf                          ! nf90 library
+   USE global                          ! global variable
+   USE kind                            ! F90 kind parameter
+   USE logger                          ! log file manager
+   USE date                            ! date manager
+   USE fct                             ! basic useful function
+   USE att                             ! attribute manager
+   USE dim                             ! dimension manager
+   USE math                            ! mathematical function
+
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+   PUBLIC :: TVAR        !< variable structure
+
+   PUBLIC :: tg_varextra !< array of variable structure with extra information.
+
+   PRIVATE :: im_ndumvar !< number of elt in dummy variable array
+   PRIVATE :: cm_dumvar  !< dummy variable array
+
+   ! function and subroutine
+   PUBLIC :: var_init          !< initialize variable structure
+   PUBLIC :: var_print         !< print variable information
+   PUBLIC :: var_clean         !< clean variable structure
+   PUBLIC :: var_copy          !< copy variable structure
+   PUBLIC :: var_add_value     !< add array of value in variable structure
+   PUBLIC :: var_add_att       !< add attribute structure in variable structure
+   PUBLIC :: var_add_dim       !< add dimension structure in variable structure
+   PUBLIC :: var_del_value     !< delete array of value of variable structure
+   PUBLIC :: var_del_att       !< delete one attribute structure of variable structure
+   PUBLIC :: var_del_dim       !< delete one dimension structure of variable structure
+   PUBLIC :: var_move_att      !< overwrite one attribute structure in variable structure
+   PUBLIC :: var_move_dim      !< overwrite one dimension structure in variable structure 
+   PUBLIC :: var_get_mask      !< return the mask of variable
+   PUBLIC :: var_chg_FillValue !< change FillValue to standard NETCDF Fill Value
+   PUBLIC :: var_concat        !< concatenate two variables
+   PUBLIC :: var_limit_value   !< forced min and max value
+   PUBLIC :: var_chg_unit      !< change variable unit and value
+   PUBLIC :: var_chg_name      !< change variable name
+   PUBLIC :: var_max_dim       !< get array of maximum dimension use
+   PUBLIC :: var_reorder       !< reorder table of value in variable structure
+   PUBLIC :: var_get_index     !< return the variable index, in an array of variable structure 
+   PUBLIC :: var_get_id        !< return the variable id, read from a file 
+   PUBLIC :: var_get_unit      !< get free variable unit in an array of variable structure
+   PUBLIC :: var_to_date       !< convert time variable structure in date structure
+   PUBLIC :: var_read_matrix   !< read matrix value from character string in namelist 
+   PUBLIC :: var_def_extra     !< read variable configuration file, and save extra information.
+   PUBLIC :: var_chg_extra     !< read variable namelist information, and modify extra information.
+   PUBLIC :: var_clean_extra   !< clean gloabl array of extra information.
+   PUBLIC :: var_check_dim     !< check variable dimension expected
+   PUBLIC :: var_get_dummy     !< fill dummy variable array
+   PUBLIC :: var_is_dummy      !< check if variable is defined as dummy variable
+
+   PRIVATE :: var__init          ! initialize variable structure without array of value
+   PRIVATE :: var__init_dp       ! initialize variable structure with real(8) 4D array of value
+   PRIVATE :: var__init_1D_dp    ! initialize variable structure with real(8) 1D array of value
+   PRIVATE :: var__init_2D_dp    ! initialize variable structure with real(8) 2D array of value
+   PRIVATE :: var__init_3D_dp    ! initialize variable structure with real(8) 3D array of value
+   PRIVATE :: var__init_sp       ! initialize variable structure with real(4) 4D array of value
+   PRIVATE :: var__init_1D_sp    ! initialize variable structure with real(4) 1D array of value
+   PRIVATE :: var__init_2D_sp    ! initialize variable structure with real(4) 2D array of value
+   PRIVATE :: var__init_3D_sp    ! initialize variable structure with real(4) 3D array of value
+   PRIVATE :: var__init_i1       ! initialize variable structure with integer(1) 4D array of value
+   PRIVATE :: var__init_1D_i1    ! initialize variable structure with integer(1) 1D array of value
+   PRIVATE :: var__init_2D_i1    ! initialize variable structure with integer(1) 2D array of value
+   PRIVATE :: var__init_3D_i1    ! initialize variable structure with integer(1) 3D array of value
+   PRIVATE :: var__init_i2       ! initialize variable structure with integer(2) 4D array of value
+   PRIVATE :: var__init_1D_i2    ! initialize variable structure with integer(2) 1D array of value
+   PRIVATE :: var__init_2D_i2    ! initialize variable structure with integer(2) 2D array of value
+   PRIVATE :: var__init_3D_i2    ! initialize variable structure with integer(2) 3D array of value
+   PRIVATE :: var__init_i4       ! initialize variable structure with integer(4) 4D array of value
+   PRIVATE :: var__init_1D_i4    ! initialize variable structure with integer(4) 1D array of value
+   PRIVATE :: var__init_2D_i4    ! initialize variable structure with integer(4) 2D array of value
+   PRIVATE :: var__init_3D_i4    ! initialize variable structure with integer(4) 3D array of value
+   PRIVATE :: var__init_i8       ! initialize variable structure with integer(8) 4D array of value
+   PRIVATE :: var__init_1D_i8    ! initialize variable structure with integer(8) 1D array of value
+   PRIVATE :: var__init_2D_i8    ! initialize variable structure with integer(8) 2D array of value
+   PRIVATE :: var__init_3D_i8    ! initialize variable structure with integer(8) 3D array of value
+   PRIVATE :: var__print_unit    ! print information on one variable
+   PRIVATE :: var__print_arr     ! print information on a array of variables
+   PRIVATE :: var__clean_unit    ! clean variable structure
+   PRIVATE :: var__clean_arr_1D  ! clean 1D array of variable structure
+   PRIVATE :: var__clean_arr_2D  ! clean 2D array of variable structure
+   PRIVATE :: var__clean_arr_3D  ! clean 3D array of variable structure
+   PRIVATE :: var__add_value_dp  ! add array of value real(8) in variable structure
+   PRIVATE :: var__add_value_rp  ! add array of value real(4) in variable structure
+   PRIVATE :: var__add_value_i1  ! add array of value integer(1) in variable structure
+   PRIVATE :: var__add_value_i2  ! add array of value integer(2) in variable structure
+   PRIVATE :: var__add_value_i4  ! add array of value integer(4) in variable structure
+   PRIVATE :: var__add_value_i8  ! add array of value integer(8) in variable structure
+   PRIVATE :: var__add_att_unit  ! add one attribute structure in variable structure
+   PRIVATE :: var__add_att_arr   ! add a array of attribute structure in variable structure
+   PRIVATE :: var__del_att_name  ! delete one attribute given attribute name
+   PRIVATE :: var__del_att_str   ! delete one attribute given attribute structure
+   PRIVATE :: var__add_dim_unit  ! add one dimension structure in variable structure
+   PRIVATE :: var__add_dim_arr   ! add a array of dimension structure in variable structure
+   PRIVATE :: var__add_value     ! add a 4D array of real(8) value in a variable structure.
+   PRIVATE :: var__copy_unit     ! copy variable structure
+   PRIVATE :: var__copy_arr      ! copy a array of variable structure
+   PRIVATE :: var__get_extra     ! add extra information in variable structure
+   PRIVATE :: var__concat_i      ! concatenate varibales in i-direction
+   PRIVATE :: var__concat_j      ! concatenate varibales in j-direction
+   PRIVATE :: var__concat_k      ! concatenate varibales in k-direction
+   PRIVATE :: var__concat_l      ! concatenate varibales in l-direction
+   PRIVATE :: var__get_max       ! get maximum value from namelist 
+   PRIVATE :: var__get_min       ! get minimum value from namelist
+   PRIVATE :: var__get_unf       ! get scale factor value from namelist
+   PRIVATE :: var__get_unt       ! get output unit from namelist
+   PRIVATE :: var__get_namout    ! get output variable name from namelist
+   PRIVATE :: var__get_interp    ! get interpolation method from namelist
+   PRIVATE :: var__get_extrap    ! get extrapolation method from namelist
+   PRIVATE :: var__get_filter    ! get filter method from namelist
+
+   TYPE TVAR   !< variable structure
+
+      CHARACTER(LEN=lc) :: c_name  = ''  !< variable name
+      CHARACTER(LEN=lc) :: c_point = 'T' !< ARAKAWA C-grid point name (T,U,V,F)
+      INTEGER(i4)       :: i_id = 0      !< variable id
+      INTEGER(i4)       :: i_ew = -1     !< east-west overlap
+
+      REAL(dp)   , DIMENSION(:,:,:,:), POINTER :: d_value => NULL() !< variable value
+
+      !!! netcdf
+      INTEGER(i4)       :: i_type = 0           !< variable type
+      INTEGER(i4)       :: i_natt = 0           !< number of attributes
+      INTEGER(i4)       :: i_ndim = 0           !< number of dimensions
+      TYPE(TATT), DIMENSION(:), POINTER :: t_att => NULL() !< variable attributes
+      TYPE(TDIM), DIMENSION(ip_maxdim)  :: t_dim           !< variable dimension
+ 
+      LOGICAL           :: l_file = .FALSE. !< variable read in a file
+      LOGICAL           :: l_use  = .TRUE.  !< variable to be used
+
+      ! highlight some attributes
+      CHARACTER(LEN=lc) :: c_stdname  = ''!< variable standard name
+      CHARACTER(LEN=lc) :: c_longname = ''!< variable long name
+      CHARACTER(LEN=lc) :: c_units    = ''!< variable units
+      CHARACTER(LEN=lc) :: c_axis     = ''!< variable axis
+      REAL(dp)          :: d_scf = 1.           !< scale factor
+      REAL(dp)          :: d_ofs = 0.           !< offset
+      REAL(dp)          :: d_fill= 0.           !< fill value     ! NF90_FILL_DOUBLE 
+      REAL(dp)          :: d_min = dp_fill      !< minimum value 
+      REAL(dp)          :: d_max = dp_fill      !< maximum value 
+ 
+      ! will be changed in output
+      CHARACTER(LEN=lc) :: c_unt = ''           !< output variable unit (linked to unit factor)
+      REAL(dp)          :: d_unf = 1._dp        !< unit factor
+
+      CHARACTER(LEN=lc) :: c_namout = ''        !< output variable name (renamed variable)
+
+      !!! netcdf4
+      LOGICAL           :: l_contiguous = .FALSE. !< use contiguous storage or not
+      LOGICAL           :: l_shuffle    = .FALSE. !< shuffle filter is turned on or not
+      LOGICAL           :: l_fletcher32 = .FALSE. !< fletcher32 filter is turned on or not
+      INTEGER(i4)       :: i_deflvl = 0           !< deflate level from 0 to 9, 0 indicates no deflation is in use
+      INTEGER(i4), DIMENSION(ip_maxdim) :: i_chunksz = (/1,1,1,1/) !< chunk size
+
+      !!! dimg
+      INTEGER(i4) :: i_rec  = 0 !< record number
+
+      CHARACTER(LEN=lc), DIMENSION(2) :: c_interp = '' !< interpolation method
+      CHARACTER(LEN=lc), DIMENSION(1) :: c_extrap = '' !< extrapolation method
+      CHARACTER(LEN=lc), DIMENSION(5) :: c_filter = '' !< filter method
+
+   END TYPE TVAR
+
+   TYPE(TVAR), DIMENSION(:), ALLOCATABLE :: tg_varextra !< array of variable structure with extra information.
+                                                        !< fill when running var_def_extra() 
+
+   INTEGER(i4)                               , SAVE :: im_ndumvar !< number of elt in dummy variable array
+   CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg), SAVE :: cm_dumvar  !< dummy variable
+
+   INTERFACE var_init
+      MODULE PROCEDURE var__init       ! initialize variable structure without array of value
+      MODULE PROCEDURE var__init_dp    ! initialize variable structure with real(8) 4D array of value
+      MODULE PROCEDURE var__init_1D_dp ! initialize variable structure with real(8) 1D array of value
+      MODULE PROCEDURE var__init_2D_dp ! initialize variable structure with real(8) 2D array of value
+      MODULE PROCEDURE var__init_3D_dp ! initialize variable structure with real(8) 3D array of value
+      MODULE PROCEDURE var__init_sp    ! initialize variable structure with real(4) 4D array of value
+      MODULE PROCEDURE var__init_1D_sp ! initialize variable structure with real(4) 1D array of value
+      MODULE PROCEDURE var__init_2D_sp ! initialize variable structure with real(4) 2D array of value
+      MODULE PROCEDURE var__init_3D_sp ! initialize variable structure with real(4) 3D array of value
+      MODULE PROCEDURE var__init_i1    ! initialize variable structure with integer(1) 4D array of value
+      MODULE PROCEDURE var__init_1D_i1 ! initialize variable structure with integer(1) 1D array of value
+      MODULE PROCEDURE var__init_2D_i1 ! initialize variable structure with integer(1) 2D array of value
+      MODULE PROCEDURE var__init_3D_i1 ! initialize variable structure with integer(1) 3D array of value
+      MODULE PROCEDURE var__init_i2    ! initialize variable structure with integer(2) 4D array of value
+      MODULE PROCEDURE var__init_1D_i2 ! initialize variable structure with integer(2) 1D array of value
+      MODULE PROCEDURE var__init_2D_i2 ! initialize variable structure with integer(2) 2D array of value
+      MODULE PROCEDURE var__init_3D_i2 ! initialize variable structure with integer(2) 3D array of value
+      MODULE PROCEDURE var__init_i4    ! initialize variable structure with integer(4) 4D array of value
+      MODULE PROCEDURE var__init_1D_i4 ! initialize variable structure with integer(4) 1D array of value
+      MODULE PROCEDURE var__init_2D_i4 ! initialize variable structure with integer(4) 2D array of value
+      MODULE PROCEDURE var__init_3D_i4 ! initialize variable structure with integer(4) 3D array of value
+      MODULE PROCEDURE var__init_i8    ! initialize variable structure with integer(8) 4D array of value
+      MODULE PROCEDURE var__init_1D_i8 ! initialize variable structure with integer(8) 1D array of value
+      MODULE PROCEDURE var__init_2D_i8 ! initialize variable structure with integer(8) 2D array of value
+      MODULE PROCEDURE var__init_3D_i8 ! initialize variable structure with integer(8) 3D array of value
+   END INTERFACE var_init
+
+   INTERFACE var_print
+      MODULE PROCEDURE var__print_unit ! print information on one variable
+      MODULE PROCEDURE var__print_arr  ! print information on a array of variables
+   END INTERFACE var_print
+   
+   INTERFACE var_clean
+      MODULE PROCEDURE var__clean_unit   
+      MODULE PROCEDURE var__clean_arr_1D    
+      MODULE PROCEDURE var__clean_arr_2D    
+      MODULE PROCEDURE var__clean_arr_3D    
+   END INTERFACE
+
+   INTERFACE var_add_value
+      MODULE PROCEDURE var__add_value_dp  ! add array of value real(8) in variable structure
+      MODULE PROCEDURE var__add_value_rp  ! add array of value real(4) in variable structure
+      MODULE PROCEDURE var__add_value_i1  ! add array of value integer(1) in variable structure
+      MODULE PROCEDURE var__add_value_i2  ! add array of value integer(2) in variable structure
+      MODULE PROCEDURE var__add_value_i4  ! add array of value integer(4) in variable structure
+      MODULE PROCEDURE var__add_value_i8  ! add array of value integer(8) in variable structure
+   END INTERFACE var_add_value
+
+   INTERFACE var_add_att
+      MODULE PROCEDURE var__add_att_unit ! add one attribute structure in variable structure
+      MODULE PROCEDURE var__add_att_arr  ! add a array of attribute structure in variable structure
+   END INTERFACE var_add_att
+
+   INTERFACE var_del_att               ! delete one attribute in variable structure
+      MODULE PROCEDURE var__del_att_name ! - given attribute name
+      MODULE PROCEDURE var__del_att_str  ! - given attribute structure
+   END INTERFACE var_del_att
+
+   INTERFACE var_add_dim
+      MODULE PROCEDURE var__add_dim_unit ! add one dimension structure in variable structure
+      MODULE PROCEDURE var__add_dim_arr  ! add a array of dimension structure in variable structure
+   END INTERFACE var_add_dim
+
+   INTERFACE var_copy
+      MODULE PROCEDURE var__copy_unit   ! copy variable structure
+      MODULE PROCEDURE var__copy_arr    ! copy variable structure
+   END INTERFACE
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__copy_unit(td_var, ld_value) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy variable structure in another one
+   !> @details 
+   !> variable values are copied in a transitional variable, so input and output
+   !> variable structure values do not point on the same "memory cell", and so
+   !> are independant. 
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> structure (ex: tl_var=var_copy(var_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2014
+   !> - use function instead of overload assignment operator (to avoid memory leak)
+   !> @date July, 2017
+   !> - permit to copy variable structure without value
+   !> @date January, 2019
+   !> - use scalar instead of array, as transitional variable
+   !> @date February, 2019
+   !> - copy namout
+   !>
+   !> @param[in] td_var   variable structure
+   !> @param[in] ld_value copy variable value (default .TRUE.)
+   !> @return copy of input variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR), INTENT(IN) :: td_var
+      LOGICAL   , INTENT(IN), OPTIONAL :: ld_value
+
+      ! function
+      TYPE(TVAR)             :: tf_var
+
+      ! local variable
+      TYPE(TATT) :: tl_att
+      REAL(dp)   :: dl_value
+      LOGICAL    :: ll_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      ll_value=.TRUE.
+      IF( PRESENT(ld_value) ) ll_value=ld_value
+      ! copy variable name, id, ..
+      tf_var%c_name     = TRIM(td_var%c_name)
+      tf_var%c_point    = TRIM(td_var%c_point)
+      tf_var%i_id       = td_var%i_id
+      tf_var%i_ew       = td_var%i_ew
+
+      tf_var%d_min      = td_var%d_min
+      tf_var%d_max      = td_var%d_max
+
+      tf_var%c_unt      = TRIM(td_var%c_unt)
+      tf_var%d_unf      = td_var%d_unf
+
+      tf_var%c_namout   = TRIM(td_var%c_namout)
+
+      tf_var%i_type     = td_var%i_type
+      tf_var%i_natt     = td_var%i_natt
+      tf_var%i_ndim     = td_var%i_ndim
+      tf_var%i_ndim     = td_var%i_ndim
+
+      ! copy dimension
+      tf_var%t_dim(:)   = dim_copy(td_var%t_dim(:))
+
+      ! copy attribute
+      IF( ASSOCIATED(tf_var%t_att) )THEN
+         CALL att_clean( tf_var%t_att(:) )
+         DEALLOCATE(tf_var%t_att)
+      ENDIF
+      IF( ASSOCIATED(td_var%t_att) .AND. tf_var%i_natt > 0 )THEN
+         ALLOCATE( tf_var%t_att(tf_var%i_natt) )
+         DO ji=1,tf_var%i_natt
+            tl_att=att_copy(td_var%t_att(ji))
+            tf_var%t_att(ji)=att_copy(tl_att)
+         ENDDO
+         ! clean
+         CALL att_clean(tl_att)
+      ENDIF
+
+      tf_var%l_file     = td_var%l_file
+      tf_var%l_use      = td_var%l_use
+
+      ! copy highlight attribute
+      tf_var%c_stdname  = TRIM(td_var%c_stdname)
+      tf_var%c_longname = TRIM(td_var%c_longname)
+      tf_var%c_units    = TRIM(td_var%c_units)
+      tf_var%c_axis     = TRIM(td_var%c_axis)
+      tf_var%d_unf      = td_var%d_unf
+      tf_var%d_scf      = td_var%d_scf
+      tf_var%d_ofs      = td_var%d_ofs
+      tf_var%d_fill     = td_var%d_fill
+      
+      ! copy netcdf4 variable
+      tf_var%l_contiguous  = td_var%l_contiguous
+      tf_var%l_shuffle     = td_var%l_shuffle
+      tf_var%l_fletcher32  = td_var%l_fletcher32 
+      tf_var%i_deflvl      = td_var%i_deflvl
+      tf_var%i_chunksz(:)  = td_var%i_chunksz(:)
+      
+      ! copy dimg variable
+      tf_var%i_rec = td_var%i_rec
+
+      ! copy pointer in an independant variable
+      IF( ASSOCIATED(tf_var%d_value) ) DEALLOCATE(tf_var%d_value)
+      IF( ll_value .AND. ASSOCIATED(td_var%d_value) )THEN
+         ALLOCATE( tf_var%d_value( tf_var%t_dim(1)%i_len, &
+            &                      tf_var%t_dim(2)%i_len, &
+            &                      tf_var%t_dim(3)%i_len, &
+            &                      tf_var%t_dim(4)%i_len ) )
+         DO jl=1,td_var%t_dim(4)%i_len
+            DO jk=1,td_var%t_dim(3)%i_len
+               DO jj=1,td_var%t_dim(2)%i_len
+                  DO ji=1,td_var%t_dim(1)%i_len
+                     dl_value=td_var%d_value(ji,jj,jk,jl)
+                     tf_var%d_value(ji,jj,jk,jl)=dl_value
+                  ENDDO
+               ENDDO
+            ENDDO
+         ENDDO
+
+      ENDIF
+
+      tf_var%c_interp(:)=td_var%c_interp(:)
+      tf_var%c_extrap(:)=td_var%c_extrap(:)
+      tf_var%c_filter(:)=td_var%c_filter(:)
+
+   END FUNCTION var__copy_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__copy_arr(td_var) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine copy a array of variable structure in another one
+   !> @details 
+   !> see var__copy_unit
+   !>
+   !> @warning do not use on the output of a function who create or read an
+   !> structure (ex: tl_var=var_copy(var_init()) is forbidden).
+   !> This will create memory leaks.
+   !> @warning to avoid infinite loop, do not use any function inside 
+   !> this subroutine
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date November, 2014
+   !> - use function instead of overload assignment operator 
+   !> (to avoid memory leak)
+   !>
+   !> @param[in] td_var   array of variable structure
+   !> @return copy of input array of variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR), DIMENSION(:), INTENT(IN   ) :: td_var
+
+      ! function
+      TYPE(TVAR), DIMENSION(SIZE(td_var(:)))  :: tf_var
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=1,SIZE(td_var(:))
+         tf_var(ji)=var_copy(td_var(ji))
+      ENDDO
+
+   END FUNCTION var__copy_arr
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var__clean_unit(td_var)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine clean variable structure
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2019
+   !> - nullify attributes structure inside variable strcuture
+   !>
+   !> @param[inout] td_var variable strucutre
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+
+      ! local variable
+      TYPE(TVAR) :: tl_var ! empty variable strucutre
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! del attribute
+      IF( ASSOCIATED(td_var%t_att) )THEN
+         CALL att_clean( td_var%t_att(:) )
+         DEALLOCATE(td_var%t_att)
+         NULLIFY(td_var%t_att)
+      ENDIF
+
+      ! del dimension
+      IF( td_var%i_ndim /= 0 )THEN
+         CALL dim_clean(td_var%t_dim(:))
+      ENDIF
+
+      ! del value
+      IF( ASSOCIATED(td_var%d_value) )THEN
+         CALL var_del_value(td_var)
+      ENDIF
+
+      ! replace by empty structure
+      td_var=var_copy(tl_var)
+
+   END SUBROUTINE var__clean_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var__clean_arr_1D(td_var)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine clean 1D array of variable structure
+   !>
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] td_var array of variable strucutre
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR), DIMENSION(:), INTENT(INOUT) :: td_var
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=SIZE(td_var(:)),1,-1
+         CALL var_clean(td_var(ji))
+      ENDDO
+
+   END SUBROUTINE var__clean_arr_1D
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var__clean_arr_2D(td_var)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine clean 2D array of variable structure
+   !>
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] td_var array of variable strucutre
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR), DIMENSION(:,:), INTENT(INOUT) :: td_var
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      DO jj=SIZE(td_var(:,:),DIM=2),1,-1
+         DO ji=SIZE(td_var(:,:),DIM=1),1,-1
+            CALL var_clean(td_var(ji,jj))
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE var__clean_arr_2D
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var__clean_arr_3D(td_var)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine clean 3D array of variable structure
+   !>
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[inout] td_var array of variable strucutre
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR), DIMENSION(:,:,:), INTENT(INOUT) :: td_var
+
+      ! local variable
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      DO jk=SIZE(td_var(:,:,:),DIM=3),1,-1
+         DO jj=SIZE(td_var(:,:,:),DIM=2),1,-1
+            DO ji=SIZE(td_var(:,:,:),DIM=1),1,-1
+               CALL var_clean(td_var(ji,jj,jk))
+            ENDDO
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE var__clean_arr_3D
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__init(cd_name, id_type, td_dim,             &
+         &            td_att, dd_fill, cd_units, cd_axis,   &
+         &            cd_stdname, cd_longname,              &
+         &            cd_point, id_id, id_ew,               &
+         &            dd_scf, dd_ofs,  id_rec,              &
+         &            dd_min, dd_max,                       &
+         &            ld_contiguous, ld_shuffle,            &
+         &            ld_fletcher32, id_deflvl, id_chunksz, &
+         &            cd_interp, cd_extrap, cd_filter,      &
+         &            cd_unt, dd_unf,                       &
+         &            cd_namout) &
+         &  RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure, given variable name.
+   !>
+   !> @details
+   !> Optionally you could add 1D,2D,3D or 4D array of value, 
+   !> see var__init_1D_dp, var__init_2D_dp... for more information.
+   !>
+   !> you could also add more information with the following optional arguments:
+   !>   - id_type :  integer(4) variable type, (as defined by NETCDF type constants).
+   !>   - td_dim : array of dimension structure.
+   !>   - td_att  : array of attribute structure.
+   !>   - dd_fill : real(8) variable FillValue. if none NETCDF FillValue will be used.
+   !>   - cd_units : string character of units.
+   !>   - cd_axis : string character of axis expected to be used
+   !>   - cd_stdname : string character of variable standard name.
+   !>   - cd_longname : string character of variable long name.
+   !>   - cd_point : one character for ARAKAWA C-grid point name (T,U,V,F).
+   !>   - id_id : variable id (read from a file).
+   !>   - id_ew : number of point composing east west wrap band.
+   !>   - dd_unf : real(8) value for units factor attribute.
+   !>   - dd_scf : real(8) value for scale factor attribute.
+   !>   - dd_ofs : real(8) value for add offset attribute.
+   !>   - id_rec : record id (for rstdimg file).
+   !>   - dd_min : real(8) value for minimum value.
+   !>   - dd_max : real(8) value for maximum value.
+   !>   - ld_contiguous : use contiguous storage or not (for netcdf4).
+   !>   - ld_shuffle :  shuffle filter is turned on or not (for netcdf4).
+   !>   - ld_fletcher32 : fletcher32 filter is turned on or not (for netcdf4).
+   !>   - id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use (for netcdf4).
+   !>   - id_chunksz : chunk size (for netcdf4).
+   !>   - cd_interp  : a array of character defining interpolation method.
+   !>   - cd_extrap  : a array of character defining extrapolation method.
+   !>   - cd_filter  : a array of character defining filtering method.
+   !>   - cd_unt : a string character to define output unit
+   !>   - dd_unf : real(8) factor applied to change unit
+   !>
+   !>  @note most of these optionals arguments will be inform automatically,
+   !>  when reading variable from a file, or using confiuguration file variable.cfg.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 
+   !> - Bug fix: conversion of the FillValue type (float case)
+   !> @date June, 2015 
+   !> - add unit factor (to change unit)
+   !> @date February, 2019
+   !> - add output name (to change name)
+   !>
+   !> @param[in] cd_name         variable name
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] dd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle      shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          output unit (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @param[in] cd_namout       output name (renamed variable)
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_att
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_namout
+
+      ! function
+      TYPE(TVAR)                                         :: tf_var
+
+      ! local variable
+      INTEGER(i4) :: il_ind
+
+      TYPE(TATT)  :: tl_att
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(tf_var)
+
+      tf_var%c_name=TRIM(ADJUSTL(cd_name))
+
+      ! standard name
+      IF( PRESENT(cd_stdname) )THEN
+         tf_var%c_stdname=TRIM(ADJUSTL(cd_stdname))
+      ENDIF
+
+      ! long name
+      IF( PRESENT(cd_longname) )THEN
+         tf_var%c_longname=TRIM(ADJUSTL(cd_longname))
+      ENDIF
+
+      ! point
+      IF( PRESENT(cd_point) )THEN
+         tf_var%c_point=TRIM(ADJUSTL(cd_point))
+      ENDIF
+
+      ! variable id
+      IF( PRESENT(id_id) )THEN
+         tf_var%i_id=id_id
+      ENDIF
+
+      ! east west wrap
+      IF( PRESENT(id_ew) )THEN
+         tf_var%i_ew=id_ew
+      ENDIF
+
+      ! type
+      IF( PRESENT(id_type) )THEN
+         tf_var%i_type=id_type
+      ELSE
+         tf_var%i_type=NF90_DOUBLE
+      ENDIF
+
+      ! add attribute
+      IF( PRESENT(td_att) )THEN
+         CALL var_add_att(tf_var, td_att(:))
+      ENDIF
+
+      ! add _FillValue
+      IF( PRESENT(dd_fill) )THEN
+         SELECT CASE( tf_var%i_type )
+            CASE(NF90_BYTE)
+               tl_att=att_init('_FillValue', INT(dd_fill,i1) )
+            CASE(NF90_SHORT)
+               tl_att=att_init('_FillValue', INT(dd_fill,i2) )
+            CASE(NF90_INT)
+               tl_att=att_init('_FillValue', INT(dd_fill,i4) )
+            CASE(NF90_FLOAT)
+               tl_att=att_init('_FillValue', REAL(dd_fill,sp) )
+            CASE DEFAULT ! NF90_DOUBLE
+               tl_att=att_init('_FillValue', dd_fill )
+         END SELECT
+         CALL var_move_att(tf_var, tl_att)
+      ELSE
+         il_ind=0
+         IF( ASSOCIATED(tf_var%t_att) )THEN
+            il_ind=att_get_index(tf_var%t_att(:),'_FillValue')
+         ENDIF
+         IF( il_ind == 0 )THEN
+            SELECT CASE( tf_var%i_type )
+               CASE(NF90_BYTE)
+                  tl_att=att_init('_FillValue',NF90_FILL_BYTE)
+               CASE(NF90_SHORT)
+                  tl_att=att_init('_FillValue',NF90_FILL_SHORT)
+               CASE(NF90_INT)
+                  tl_att=att_init('_FillValue',NF90_FILL_INT)
+               CASE(NF90_FLOAT)
+                  tl_att=att_init('_FillValue',NF90_FILL_FLOAT)
+               CASE DEFAULT ! NF90_DOUBLE
+                  tl_att=att_init('_FillValue',NF90_FILL_DOUBLE)
+            END SELECT         
+            CALL var_add_att(tf_var, tl_att)
+         ENDIF
+      ENDIF
+
+      ! scale factor
+      IF( PRESENT(dd_scf) )THEN
+         tl_att=att_init('scale_factor',dd_scf)
+         CALL var_move_att(tf_var, tl_att)
+      ENDIF
+
+      ! add offset
+      IF( PRESENT(dd_ofs) )THEN
+         tl_att=att_init('add_offset',dd_ofs)
+         CALL var_move_att(tf_var, tl_att)
+      ENDIF
+
+      IF( PRESENT(cd_units) )THEN
+         tl_att=att_init('units',cd_units)
+         CALL var_move_att(tf_var, tl_att)
+      ENDIF
+
+      IF( PRESENT(cd_axis) )THEN
+         tf_var%c_axis=TRIM(cd_axis)
+      ENDIF
+
+      ! add dimension
+      IF( PRESENT(td_dim) )THEN
+         CALL var_add_dim(tf_var, td_dim(:))
+      ELSE
+         CALL var_add_dim(tf_var, dim_fill_unused())
+      ENDIF
+
+      IF( PRESENT(id_rec) )THEN
+         tf_var%i_rec=id_rec
+      ENDIF
+
+      ! add minimum value
+      IF( PRESENT(dd_min) )THEN
+         tf_var%d_min=dd_min
+      ENDIF
+
+      ! add maximum value
+      IF( PRESENT(dd_max) )THEN
+         tf_var%d_max=dd_max
+      ENDIF
+
+      ! netcdf4
+      IF( PRESENT(ld_contiguous) )THEN
+         tf_var%l_contiguous=ld_contiguous
+      ENDIF
+
+      IF( PRESENT(ld_shuffle) )THEN
+         tf_var%l_shuffle=ld_shuffle
+      ENDIF
+
+      IF( PRESENT(ld_fletcher32) )THEN
+         tf_var%l_fletcher32=ld_fletcher32
+      ENDIF
+
+       IF( PRESENT(id_deflvl) )THEN
+         tf_var%i_deflvl=id_deflvl
+      ENDIF     
+      
+      IF( PRESENT(id_chunksz) )THEN
+         tf_var%i_chunksz(:)=id_chunksz(:)
+      ENDIF
+
+      ! interp
+      IF( PRESENT(cd_interp) )THEN
+         tf_var%c_interp(:)=cd_interp(:)
+      ENDIF
+
+      !extrap
+      IF( PRESENT(cd_extrap) )THEN
+         tf_var%c_extrap(:)=cd_extrap(:)
+      ENDIF
+
+      !filter
+      IF( PRESENT(cd_filter) )THEN
+         tf_var%c_filter(:)=cd_filter(:)
+      ENDIF
+
+      ! unit factor
+      IF( PRESENT(dd_unf) )THEN
+         tl_att=att_init('units_factor',dd_unf)
+         CALL var_move_att(tf_var, tl_att)
+      ENDIF
+
+      ! output unit (linked to unit factor)
+      IF( PRESENT(cd_unt) )THEN
+         tl_att=att_init('new_units',cd_unt)
+         CALL var_move_att(tf_var, tl_att)
+      ENDIF
+
+      ! output name (renamed variable)
+      IF( PRESENT(cd_unt) )THEN
+         tl_att=att_init('output_name',cd_namout)
+         CALL var_move_att(tf_var, tl_att)
+      ENDIF
+
+      ! add extra information
+      CALL var__get_extra(tf_var)
+
+      ! delete some attribute cause linked to file where variable come from
+      CALL var_del_att(tf_var, 'refinment_factor')
+      CALL var_del_att(tf_var, 'interpolation')
+      CALL var_del_att(tf_var, 'extrapolation')
+      CALL var_del_att(tf_var, 'filter')
+      CALL var_del_att(tf_var, 'src_file')
+      CALL var_del_att(tf_var, 'src_i_indices')
+      CALL var_del_att(tf_var, 'src_j_indices')
+      CALL var_del_att(tf_var, 'valid_min')
+      CALL var_del_att(tf_var, 'valid_max')
+      CALL var_del_att(tf_var, 'missing_value')
+
+      ! clean
+      CALL att_clean(tl_att)
+
+   END FUNCTION var__init
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__init_1D_dp(cd_name, dd_value,                    &
+         &                  id_start, id_count, id_type, td_dim,  &
+         &                  td_att, dd_fill, cd_units, cd_axis,   &
+         &                  cd_stdname, cd_longname,              &
+         &                  cd_point, id_id, id_ew,               &
+         &                  dd_scf, dd_ofs,  id_rec,              &
+         &                  dd_min, dd_max,                       &
+         &                  ld_contiguous, ld_shuffle,            &
+         &                  ld_fletcher32, id_deflvl, id_chunksz, &
+         &                  cd_interp, cd_extrap, cd_filter,      &
+         &                  cd_unt, dd_unf,                       &
+         &                  cd_namout) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a real(8) 1D array of value.
+   !> @details 
+   !> Optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> Dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('z') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !> @date November, 2016
+   !> - allow to add scalar value
+   !> @date February, 2019
+   !> - add output name (to change name)
+   !>
+   !> @param[in] cd_name         variable name
+   !> @param[in] dd_value        1D array of real(8) value
+   !> @param[in] id_start        index in the variable from which the data values 
+   !> will be read
+   !> @param[in] id_count        number of indices selected along each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] dd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle      shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @param[in] cd_namout       output name (renamed variable)
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      REAL(dp)        , DIMENSION(:)        , INTENT(IN) :: dd_value
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      ,                       INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:)        , INTENT(IN), OPTIONAL :: td_att
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_namout
+
+      ! function
+      TYPE(TVAR)                                         :: tf_var
+
+      ! local variable
+      INTEGER(i4)                                    :: il_type
+      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_start
+      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_count
+
+      REAL(dp)   , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_value
+
+      TYPE(TDIM) , DIMENSION(ip_maxdim)              :: tl_dim
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(tf_var)
+
+      ! dummy call to avoid warning
+      il_type=NF90_DOUBLE
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      tl_dim(1)=dim_init( 'Z', id_len=SIZE(dd_value(:)) )
+      IF( PRESENT(td_dim) )THEN
+         tl_dim(1)=dim_copy(td_dim)
+      ENDIF
+
+      il_start(:)=1
+      IF( PRESENT(id_start) )THEN
+         il_start(1)=id_start
+      ENDIF
+
+      il_count(:)=tl_dim(:)%i_len
+      IF( PRESENT(id_count) )THEN
+         il_count(1)=id_count
+      ENDIF
+
+      ! reorder dimension
+      CALL dim_reorder(tl_dim(:))
+      ! reorder array
+      il_start(:)=dim_reorder_2xyzt(tl_dim(:),il_start(:))
+      il_count(:)=dim_reorder_2xyzt(tl_dim(:),il_count(:))
+
+      tf_var=var__init( cd_name, id_type=il_type,           &
+         &              td_dim=tl_dim(:), td_att=td_att,    &
+         &              dd_fill=dd_fill, cd_units=cd_units, &
+         &              cd_axis=cd_axis,                    &
+         &              cd_stdname=cd_stdname,              &
+         &              cd_longname=cd_longname,            &
+         &              cd_point=cd_point, id_id=id_id,     &
+         &              id_ew=id_ew, dd_scf=dd_scf,         &
+         &              dd_ofs=dd_ofs,  id_rec=id_rec,      &
+         &              dd_min=dd_min, dd_max=dd_max,       &
+         &              ld_contiguous=ld_contiguous,        &
+         &              ld_shuffle=ld_shuffle,              &
+         &              ld_fletcher32=ld_fletcher32,        &
+         &              id_deflvl=id_deflvl,                &
+         &              id_chunksz=id_chunksz(:),           &
+         &              cd_interp=cd_interp(:),             &
+         &              cd_extrap=cd_extrap(:),             &
+         &              cd_filter=cd_filter(:),             &
+         &              cd_unt=cd_unt, dd_unf=dd_unf,       &
+         &              cd_namout=cd_namout )
+   
+      ! add value
+      ALLOCATE( dl_value(tl_dim(1)%i_len, &
+      &                  tl_dim(2)%i_len, &
+      &                  tl_dim(3)%i_len, &
+      &                  tl_dim(4)%i_len) )
+
+      IF( tl_dim(1)%l_use )THEN
+         dl_value(:,1,1,1) = dd_value(:)
+      ELSEIF( tl_dim(2)%l_use )THEN
+         dl_value(1,:,1,1) = dd_value(:)
+      ELSEIF( tl_dim(3)%l_use )THEN
+         dl_value(1,1,:,1) = dd_value(:)
+      ELSEIF( tl_dim(4)%l_use )THEN
+         dl_value(1,1,1,:) = dd_value(:)
+      ELSE
+         IF( SIZE(dd_value(:)) > 1 )THEN
+            CALL logger_fatal("VAR INIT: can not add value from variable "//&
+            &  TRIM(cd_name)//". invalid dimension to be used")
+         ELSE
+            dl_value(1,1,1,1) = dd_value(1)
+            CALL logger_warn("VAR INIT: add scalar value for variable "//&
+            &  TRIM(cd_name))
+
+         ENDIF
+      ENDIF
+
+      CALL var_add_value( tf_var, dl_value(:,:,:,:), il_type, &
+         &                il_start(:), il_count(:) )
+
+      ! clean
+      DEALLOCATE( dl_value )
+      CALL dim_clean(tl_dim)
+
+   END FUNCTION var__init_1D_dp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__init_2D_dp(cd_name, dd_value,                    &
+         &                  id_start, id_count, id_type, td_dim,  &
+         &                  td_att, dd_fill, cd_units, cd_axis,   &
+         &                  cd_stdname, cd_longname,              &
+         &                  cd_point, id_id, id_ew,               &
+         &                  dd_scf, dd_ofs,  id_rec,              &
+         &                  dd_min, dd_max,                       &
+         &                  ld_contiguous, ld_shuffle,            &
+         &                  ld_fletcher32, id_deflvl, id_chunksz, &
+         &                  cd_interp, cd_extrap, cd_filter,      &
+         &                  cd_unt, dd_unf,                       &
+         &                  cd_namout) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a real(8) 2D array of value. 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> @details 
+   !> array of 2 dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 
+   !> - bug fix: array initialise with dimension
+   !> array not only one value
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> - Bux fix: dimension array initialise not only one value
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !> @date February, 2019
+   !> - add output name (to change name)
+   !>
+   !> @param[in] cd_name         variable name
+   !> @param[in] dd_value        1D array of real(8) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] dd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle      shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates 
+   !> no deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @param[in] cd_namout       output name (renamed variable)
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      REAL(dp)        , DIMENSION(:,:)      , INTENT(IN) :: dd_value
+      INTEGER(i4)     , DIMENSION(:)        , INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:)        , INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:)        , INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:)        , INTENT(IN), OPTIONAL :: td_att
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_namout
+
+      ! function
+      TYPE(TVAR)                                         :: tf_var
+
+      ! local variable
+      INTEGER(i4)                                    :: il_type
+      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_start
+      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_count
+
+      REAL(dp)   , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_value
+
+      TYPE(TDIM) , DIMENSION(ip_maxdim)              :: tl_dim
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(tf_var)
+
+      ! dummy call to avoid warning
+      il_type=NF90_DOUBLE
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      tl_dim(1)=dim_init( 'X', id_len=SIZE(dd_value(:,:),DIM=1) )
+      tl_dim(2)=dim_init( 'Y', id_len=SIZE(dd_value(:,:),DIM=2) )
+      IF( PRESENT(td_dim) )THEN
+         IF( SIZE(td_dim(:)) /= 2 )THEN
+            CALL logger_error("VAR INIT: dimension of dimension structure "//&
+            &                 " not conform")
+         ELSE
+            tl_dim(1)=dim_copy(td_dim(1))
+            tl_dim(2)=dim_copy(td_dim(2))
+         ENDIF
+      ENDIF
+
+      il_start(:)=1
+      IF( PRESENT(id_start) )THEN
+         IF( SIZE(id_start(:)) /= 2 )THEN
+            CALL logger_error("VAR INIT: dimension of start array "//&
+            &                 " not conform")
+         ELSE
+            il_start(1)=id_start(1)
+            il_start(2)=id_start(2)
+         ENDIF
+      ENDIF
+
+      il_count(:)=tl_dim(:)%i_len
+      IF( PRESENT(id_count) )THEN
+         IF( SIZE(id_count(:)) /= 2 )THEN
+            CALL logger_error("VAR INIT: dimension of count array "//&
+            &                 " not conform")
+         ELSE
+            il_count(1)=id_count(1)
+            il_count(2)=id_count(2)
+         ENDIF
+      ENDIF
+
+      ! reorder dimension
+      CALL dim_reorder(tl_dim(:))
+      ! reorder array
+      il_start(:)=dim_reorder_2xyzt(tl_dim(:),il_start(:))
+      il_count(:)=dim_reorder_2xyzt(tl_dim(:),il_count(:))
+
+      tf_var=var__init( cd_name, id_type=il_type,           &
+         &              td_dim=tl_dim(:), td_att=td_att,    &
+         &              dd_fill=dd_fill, cd_units=cd_units, &
+         &              cd_axis=cd_axis,                    &
+         &              cd_stdname=cd_stdname,              &
+         &              cd_longname=cd_longname,            &
+         &              cd_point=cd_point, id_id=id_id,     &
+         &              id_ew=id_ew, dd_scf=dd_scf,         &
+         &              dd_ofs=dd_ofs,  id_rec=id_rec,      &
+         &              dd_min=dd_min, dd_max=dd_max,       &
+         &              ld_contiguous=ld_contiguous,        &
+         &              ld_shuffle=ld_shuffle,              &
+         &              ld_fletcher32=ld_fletcher32,        &
+         &              id_deflvl=id_deflvl,                &
+         &              id_chunksz=id_chunksz(:),           &
+         &              cd_interp=cd_interp(:),             &
+         &              cd_extrap=cd_extrap(:),             &
+         &              cd_filter=cd_filter(:),             &
+         &              cd_unt=cd_unt, dd_unf=dd_unf,       &
+         &              cd_namout=cd_namout )
+   
+      ! add value
+      ALLOCATE( dl_value(tl_dim(1)%i_len, &
+         &               tl_dim(2)%i_len, &
+         &               tl_dim(3)%i_len, &
+         &               tl_dim(4)%i_len) )
+
+      IF( tl_dim(1)%l_use .AND. tl_dim(2)%l_use )THEN
+         dl_value(:,:,1,1)=dd_value(:,:)
+      ELSEIF( tl_dim(1)%l_use .AND. tl_dim(3)%l_use )THEN
+         dl_value(:,1,:,1)=dd_value(:,:)
+      ELSEIF( tl_dim(1)%l_use .AND. tl_dim(4)%l_use )THEN
+         dl_value(:,1,1,:)=dd_value(:,:)
+      ELSEIF( tl_dim(2)%l_use .AND. tl_dim(3)%l_use )THEN
+         dl_value(1,:,:,1)=dd_value(:,:)
+      ELSEIF( tl_dim(2)%l_use .AND. tl_dim(4)%l_use )THEN
+         dl_value(1,:,1,:)=dd_value(:,:)
+      ELSEIF( tl_dim(3)%l_use .AND. tl_dim(4)%l_use )THEN
+         dl_value(1,1,:,:)=dd_value(:,:)
+      ELSE
+         CALL logger_fatal("VAR INIT: can not add value from variable "//&
+         &  TRIM(cd_name)//". invalid dimension to be used")
+      ENDIF
+
+      CALL var_add_value( tf_var, dl_value(:,:,:,:), il_type, &
+         &                il_start(:), il_count(:) )
+
+      ! clean
+      DEALLOCATE( dl_value )
+      CALL dim_clean(tl_dim)
+
+   END FUNCTION var__init_2D_dp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__init_3D_dp(cd_name, dd_value,                    &
+         &                  id_start, id_count, id_type, td_dim,  &
+         &                  td_att, dd_fill, cd_units, cd_axis,   &
+         &                  cd_stdname, cd_longname,              &
+         &                  cd_point, id_id, id_ew,               &
+         &                  dd_scf, dd_ofs,  id_rec,              &
+         &                  dd_min, dd_max,                       &
+         &                  ld_contiguous, ld_shuffle,            &
+         &                  ld_fletcher32, id_deflvl, id_chunksz, &
+         &                  cd_interp, cd_extrap, cd_filter,      &
+         &                  cd_unt, dd_unf,                       &
+         &                  cd_namout) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a real(8) 3D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> array of 3 dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y','z') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !> @date February, 2019
+   !> - add output name (to change name)
+   !>
+   !> @param[in] cd_name         variable name
+   !> @param[in] dd_value        1D array of real(8) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] dd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @param[in] cd_namout       output name (renamed variable)
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      REAL(dp)        , DIMENSION(:,:,:)    , INTENT(IN) :: dd_value
+      INTEGER(i4)     , DIMENSION(:)        , INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:)        , INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:)        , INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:)        , INTENT(IN), OPTIONAL :: td_att
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_namout
+
+      ! function
+      TYPE(TVAR)                                         :: tf_var
+
+      ! local variable
+      INTEGER(i4)                                    :: il_type
+      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_start
+      INTEGER(i4), DIMENSION(ip_maxdim)              :: il_count
+
+      REAL(dp)   , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_value
+
+      TYPE(TDIM) , DIMENSION(ip_maxdim)              :: tl_dim
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(tf_var)
+
+      ! dummy call to avoid warning
+      il_type=NF90_DOUBLE
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      tl_dim(1)=dim_init( 'X', id_len=SIZE(dd_value(:,:,:),DIM=1) )
+      tl_dim(2)=dim_init( 'Y', id_len=SIZE(dd_value(:,:,:),DIM=2) )
+      tl_dim(3)=dim_init( 'Z', id_len=SIZE(dd_value(:,:,:),DIM=3) )
+      IF( PRESENT(td_dim) )THEN
+         IF( SIZE(td_dim(:)) /= 3 )THEN
+            CALL logger_error("VAR INIT: dimension of dimension structure "//&
+            &                 " not conform")
+         ELSE
+            tl_dim(1)=dim_copy(td_dim(1))
+            tl_dim(2)=dim_copy(td_dim(2))
+            tl_dim(3)=dim_copy(td_dim(3))
+         ENDIF
+      ENDIF
+
+      il_start(:)=1
+      IF( PRESENT(id_start) )THEN
+         IF( SIZE(id_start(:)) /= 3 )THEN
+            CALL logger_error("VAR INIT: dimension of start array "//&
+            &                 " not conform")
+         ELSE
+            il_start(1)=id_start(1)
+            il_start(2)=id_start(2)
+            il_start(3)=id_start(3)
+         ENDIF
+      ENDIF
+
+      il_count(:)=tl_dim(:)%i_len
+      IF( PRESENT(id_count) )THEN
+         IF( SIZE(id_count(:)) /= 3 )THEN
+            CALL logger_error("VAR INIT: dimension of count array "//&
+            &                 " not conform")
+         ELSE
+            il_count(1)=id_count(1)
+            il_count(2)=id_count(2)
+            il_count(3)=id_count(3)
+         ENDIF
+      ENDIF
+
+      ! reorder dimension
+      CALL dim_reorder(tl_dim(:))
+      ! reorder array
+      il_start(:)=dim_reorder_2xyzt(tl_dim(:),il_start(:))
+      il_count(:)=dim_reorder_2xyzt(tl_dim(:),il_count(:))
+
+      tf_var=var__init( cd_name, id_type=il_type,           &
+         &              td_dim=tl_dim(:), td_att=td_att,    &
+         &              dd_fill=dd_fill, cd_units=cd_units, &
+         &              cd_axis=cd_axis,                    &
+         &              cd_stdname=cd_stdname,              &
+         &              cd_longname=cd_longname,            &
+         &              cd_point=cd_point, id_id=id_id,     &
+         &              id_ew=id_ew, dd_scf=dd_scf,         &
+         &              dd_ofs=dd_ofs,  id_rec=id_rec,      &
+         &              dd_min=dd_min, dd_max=dd_max,       &
+         &              ld_contiguous=ld_contiguous,        &
+         &              ld_shuffle=ld_shuffle,              &
+         &              ld_fletcher32=ld_fletcher32,        &
+         &              id_deflvl=id_deflvl,                &
+         &              id_chunksz=id_chunksz(:),           &
+         &              cd_interp=cd_interp(:),             &
+         &              cd_extrap=cd_extrap(:),             &
+         &              cd_filter=cd_filter(:),             &
+         &              cd_unt=cd_unt, dd_unf=dd_unf,       &
+         &              cd_namout=cd_namout )
+   
+      ! add value
+      ALLOCATE( dl_value(tl_dim(1)%i_len, &
+      &                  tl_dim(2)%i_len, &
+      &                  tl_dim(3)%i_len, &
+      &                  tl_dim(4)%i_len) )
+
+      IF( tl_dim(1)%l_use .AND. tl_dim(2)%l_use .AND. tl_dim(3)%l_use )THEN
+         dl_value(:,:,:,1)=dd_value(:,:,:)
+      ELSEIF( tl_dim(1)%l_use .AND. tl_dim(2)%l_use .AND. tl_dim(4)%l_use  )THEN
+         dl_value(:,:,1,:)=dd_value(:,:,:)
+      ELSEIF( tl_dim(1)%l_use .AND. tl_dim(3)%l_use .AND. tl_dim(4)%l_use )THEN
+         dl_value(:,1,:,:)=dd_value(:,:,:)
+      ELSEIF( tl_dim(2)%l_use .AND. tl_dim(3)%l_use .AND. tl_dim(4)%l_use )THEN
+         dl_value(1,:,:,:)=dd_value(:,:,:)
+      ELSE
+         CALL logger_fatal("VAR INIT: can not add value from variable "//&
+         &  TRIM(cd_name)//". invalid dimension to be used")
+      ENDIF
+
+      CALL var_add_value( tf_var, dl_value(:,:,:,:), il_type, &
+         &                il_start(:), il_count(:) )
+
+      ! clean
+      DEALLOCATE( dl_value )
+      CALL dim_clean(tl_dim)
+
+   END FUNCTION var__init_3D_dp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__init_dp(cd_name, dd_value,                    &
+         &               id_start, id_count, id_type, td_dim,  &
+         &               td_att, dd_fill, cd_units, cd_axis,   &
+         &               cd_stdname, cd_longname,              &
+         &               cd_point, id_id, id_ew,               &
+         &               dd_scf, dd_ofs,  id_rec,              &
+         &               dd_min, dd_max,                       &
+         &               ld_contiguous, ld_shuffle,            &
+         &               ld_fletcher32, id_deflvl, id_chunksz, &
+         &               cd_interp, cd_extrap, cd_filter,      &
+         &               cd_unt, dd_unf,                       &
+         &               cd_namout) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a real(8) 4D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> Dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y','z','t') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !> @date February, 2019
+   !> - add output name (to change name)
+   !>
+   !> @param[in] cd_name         variable name
+   !> @param[in] dd_value        4D array of real(8) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] dd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @param[in] cd_namout       output name (renamed variable)
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      REAL(dp)        , DIMENSION(:,:,:,:),   INTENT(IN) :: dd_value
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_att
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_namout
+
+      ! function
+      TYPE(TVAR)                                         :: tf_var
+
+      ! local variable
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_shape
+      TYPE(TDIM)                        :: tl_dim
+
+      INTEGER(i4) :: il_type
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(tf_var)
+
+      ! dummy call to avoid warning
+      il_type=NF90_DOUBLE
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      tf_var=var__init( cd_name, id_type=il_type,           &
+         &              td_dim=td_dim, td_att=td_att,       &
+         &              dd_fill=dd_fill, cd_units=cd_units, &
+         &              cd_axis=cd_axis,                    &
+         &              cd_stdname=cd_stdname,              &
+         &              cd_longname=cd_longname,            &
+         &              cd_point=cd_point, id_id=id_id,     &
+         &              id_ew=id_ew, dd_scf=dd_scf,         &
+         &              dd_ofs=dd_ofs,  id_rec=id_rec,      &
+         &              dd_min=dd_min, dd_max=dd_max,       &
+         &              ld_contiguous=ld_contiguous,        &
+         &              ld_shuffle=ld_shuffle,              &
+         &              ld_fletcher32=ld_fletcher32,        &
+         &              id_deflvl=id_deflvl,                &
+         &              id_chunksz=id_chunksz(:),           &
+         &              cd_interp=cd_interp(:),             &
+         &              cd_extrap=cd_extrap(:),             &
+         &              cd_filter=cd_filter(:),             &
+         &              cd_unt=cd_unt, dd_unf=dd_unf,       &
+         &              cd_namout=cd_namout )
+ 
+      ! add value
+      IF( .NOT. PRESENT(td_dim) )THEN
+         il_shape(:)=SHAPE(dd_value(:,:,:,:)) 
+         DO ji=1,ip_maxdim
+            tl_dim=dim_init( cp_dimorder(ji:ji), id_len=il_shape(ji)) 
+            CALL var_add_dim(tf_var, tl_dim)
+         ENDDO
+      ENDIF
+
+      CALL var_add_value( tf_var, dd_value(:,:,:,:), il_type, &
+         &                id_start(:), id_count(:) )
+
+      ! clean
+      CALL dim_clean(tl_dim)
+
+   END FUNCTION var__init_dp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__init_1D_sp(cd_name, rd_value,                    &
+         &                  id_start, id_count, id_type, td_dim,  &
+         &                  td_att, rd_fill, cd_units, cd_axis,   &
+         &                  cd_stdname, cd_longname,              &
+         &                  cd_point, id_id, id_ew,               &
+         &                  dd_scf, dd_ofs,  id_rec,              &
+         &                  dd_min, dd_max,                       &
+         &                  ld_contiguous, ld_shuffle,            &
+         &                  ld_fletcher32, id_deflvl, id_chunksz, &
+         &                  cd_interp, cd_extrap, cd_filter,      &
+         &                  cd_unt, dd_unf,                       &
+         &                  cd_namout) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a real(4) 1D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('z') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !> @date January, 2019
+   !> - decompose array conversion on each dimension
+   !> @date February, 2019
+   !> - add output name (to change name)
+   !>
+   !> @param[in] cd_name         variable name
+   !> @param[in] rd_value        1D array of real(4) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] rd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @param[in] cd_namout       output name (renamed variable)
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      REAL(sp)        , DIMENSION(:)        , INTENT(IN) :: rd_value
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      ,                       INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_att
+      REAL(sp)        ,                       INTENT(IN), OPTIONAL :: rd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_namout
+
+      ! function
+      TYPE(TVAR)                                         :: tf_var
+
+      ! local variable
+      INTEGER(i4)                                       :: il_type
+      INTEGER(i4)                                       :: il_shape
+
+      REAL(dp)                                          :: dl_fill
+      REAL(dp)        , DIMENSION(:)      , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(tf_var)      
+
+      il_type=NF90_FLOAT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_FLOAT
+      IF( PRESENT(rd_fill) ) dl_fill=REAL(rd_fill,dp)
+
+      il_shape=SIZE(rd_value(:))
+      ALLOCATE( dl_value( il_shape) )
+
+      DO ji=1,il_shape
+         dl_value(ji)=REAL(rd_value(ji),dp)
+      ENDDO
+
+      tf_var=var_init( cd_name, dl_value(:),               &
+         &             id_start=id_start,                  &
+         &             id_count=id_count,                  &
+         &             id_type=il_type,                    &
+         &             td_dim=td_dim, td_att=td_att,       &
+         &             dd_fill=dl_fill,                    &
+         &             cd_units=cd_units,                  &
+         &             cd_axis=cd_axis,                    &
+         &             cd_stdname=cd_stdname,              &
+         &             cd_longname=cd_longname,            &
+         &             cd_point=cd_point, id_id=id_id,     &
+         &             id_ew=id_ew, dd_scf=dd_scf,         &
+         &             dd_ofs=dd_ofs,  id_rec=id_rec,      &
+         &             dd_min=dd_min, dd_max=dd_max,       &
+         &             ld_contiguous=ld_contiguous,        &
+         &             ld_shuffle=ld_shuffle,              &
+         &             ld_fletcher32=ld_fletcher32,        &
+         &             id_deflvl=id_deflvl,                &
+         &             id_chunksz=id_chunksz(:),           &
+         &             cd_interp=cd_interp(:),             &
+         &             cd_extrap=cd_extrap(:),             &
+         &             cd_filter=cd_filter(:),             &
+         &             cd_unt=cd_unt, dd_unf=dd_unf,       &
+         &             cd_namout=cd_namout )
+ 
+      DEALLOCATE( dl_value )
+ 
+   END FUNCTION var__init_1D_sp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__init_2D_sp(cd_name, rd_value,                    &
+         &                  id_start, id_count, id_type, td_dim,  &
+         &                  td_att, rd_fill, cd_units, cd_axis,   &
+         &                  cd_stdname, cd_longname,              &
+         &                  cd_point, id_id, id_ew,               &
+         &                  dd_scf, dd_ofs,  id_rec,              &
+         &                  dd_min, dd_max,                       &
+         &                  ld_contiguous, ld_shuffle,            &
+         &                  ld_fletcher32, id_deflvl, id_chunksz, &
+         &                  cd_interp, cd_extrap, cd_filter,      &
+         &                  cd_unt, dd_unf,                       &
+         &                  cd_namout) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a real(4) 2D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> array of 2 dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !> @date January, 2019
+   !> - decompose array conversion on each dimension
+   !> @date February, 2019
+   !> - add output name (to change name)
+   !>
+   !> @param[in] cd_name         : variable name
+   !> @param[in] rd_value        : 2D array of real(4) value
+   !> @param[in] id_start        : index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        : number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         : variable type 
+   !> @param[in] td_dim          : array of dimension structure
+   !> @param[in] td_att          : array of attribute structure
+   !> @param[in] rd_fill         : fill value
+   !> @param[in] cd_units        : units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      : variable standard name
+   !> @param[in] cd_longname     : variable long name
+   !> @param[in] cd_point        : point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           : variable id
+   !> @param[in] id_ew           : east west wrap
+   !> @param[in] dd_scf          : scale factor
+   !> @param[in] dd_ofs          : add offset
+   !> @param[in] id_rec          : record id (for rstdimg file)
+   !> @param[in] dd_min          : minimum value
+   !> @param[in] dd_max          : maximum value
+   !> @param[in] ld_contiguous   : use contiguous storage or not 
+   !> @param[in] ld_shuffle      :  shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   : fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       : deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      : chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @param[in] cd_namout       output name (renamed variable)
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      REAL(sp)        , DIMENSION(:,:)     ,  INTENT(IN) :: rd_value
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_att
+      REAL(sp)        ,                       INTENT(IN), OPTIONAL :: rd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_namout
+
+      ! function
+      TYPE(TVAR)                                         :: tf_var
+
+      ! local variable
+      INTEGER(i4)                                  :: il_type
+      INTEGER(i4), DIMENSION(2)                    :: il_shape
+
+      REAL(dp)                                     :: dl_fill
+      REAL(dp)   , DIMENSION(:,:)    , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(tf_var)      
+
+      il_type=NF90_FLOAT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_FLOAT
+      IF( PRESENT(rd_fill) ) dl_fill=REAL(rd_fill,dp)
+
+      il_shape(:)=SHAPE(rd_value(:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+         &                il_shape(2)) )
+
+      DO jj=1,il_shape(2)
+         DO ji=1,il_shape(1)
+            dl_value(ji,jj)=REAL(rd_value(ji,jj),dp)
+         ENDDO
+      ENDDO
+
+      tf_var=var_init( cd_name, dl_value(:,:),             &
+         &             id_start=id_start,                  &
+         &             id_count=id_count,                  &
+         &             id_type=il_type,                    &
+         &             td_dim=td_dim, td_att=td_att,       &
+         &             dd_fill=dl_fill,                    &
+         &             cd_units=cd_units,                  &
+         &             cd_axis=cd_axis,                    &
+         &             cd_stdname=cd_stdname,              &
+         &             cd_longname=cd_longname,            &
+         &             cd_point=cd_point, id_id=id_id,     &
+         &             id_ew=id_ew, dd_scf=dd_scf,         &
+         &             dd_ofs=dd_ofs,  id_rec=id_rec,      &
+         &             dd_min=dd_min, dd_max=dd_max,       &
+         &             ld_contiguous=ld_contiguous,        &
+         &             ld_shuffle=ld_shuffle,              &
+         &             ld_fletcher32=ld_fletcher32,        &
+         &             id_deflvl=id_deflvl,                &
+         &             id_chunksz=id_chunksz(:),           &
+         &             cd_interp=cd_interp(:),             &
+         &             cd_extrap=cd_extrap(:),             &
+         &             cd_filter=cd_filter(:),             &
+         &             cd_unt=cd_unt, dd_unf=dd_unf,       &
+         &             cd_namout=cd_namout )
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_2D_sp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__init_3D_sp(cd_name, rd_value,        &
+         &                             id_start, id_count, id_type, td_dim, &
+         &                             td_att, rd_fill, cd_units, cd_axis,&
+         &                             cd_stdname, cd_longname,  &
+         &                             cd_point, id_id, id_ew,   &
+         &                             dd_scf, dd_ofs,  id_rec,  &
+         &                             dd_min, dd_max,           &
+         &                             ld_contiguous, ld_shuffle,&
+         &                             ld_fletcher32, id_deflvl, id_chunksz, &
+         &                             cd_interp, cd_extrap, cd_filter, &
+         &                             cd_unt, dd_unf, &
+         &                             cd_namout) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a real(4) 3D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> array of 3 dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y','z') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !> @date January, 2019
+   !> - decompose array conversion on each dimension
+   !> @date February, 2019
+   !> - add output name (to change name)
+   !>
+   !> @param[in] cd_name         : variable name
+   !> @param[in] rd_value        : 2D array of real(4) value
+   !> @param[in] id_start        : index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        : number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         : variable type 
+   !> @param[in] td_dim          : array of dimension structure
+   !> @param[in] td_att          : array of attribute structure
+   !> @param[in] rd_fill         : fill value
+   !> @param[in] cd_units        : units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      : variable standard name
+   !> @param[in] cd_longname     : variable long name
+   !> @param[in] cd_point        : point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           : variable id
+   !> @param[in] id_ew           : east west wrap
+   !> @param[in] dd_scf          : scale factor
+   !> @param[in] dd_ofs          : add offset
+   !> @param[in] id_rec          : record id (for rstdimg file)
+   !> @param[in] dd_min          : minimum value
+   !> @param[in] dd_max          : maximum value
+   !> @param[in] ld_contiguous   : use contiguous storage or not 
+   !> @param[in] ld_shuffle      :  shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   : fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       : deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      : chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @param[in] cd_namout       output name (renamed variable)
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      REAL(sp)        , DIMENSION(:,:,:)   ,  INTENT(IN) :: rd_value
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_att
+      REAL(sp)        ,                       INTENT(IN), OPTIONAL :: rd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_namout
+
+      ! function
+      TYPE(TVAR)                                         :: tf_var
+
+      ! local variable
+      INTEGER(i4)                                  :: il_type
+      INTEGER(i4), DIMENSION(3)                    :: il_shape
+
+      REAL(dp)                                     :: dl_fill
+      REAL(dp)   , DIMENSION(:,:,:)  , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(tf_var)      
+
+      il_type=NF90_FLOAT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_FLOAT
+      IF( PRESENT(rd_fill) ) dl_fill=REAL(rd_fill,dp)
+
+      il_shape(:)=SHAPE(rd_value(:,:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+         &                il_shape(2), &
+         &                il_shape(3)) )
+
+      DO jk=1,il_shape(3)
+         DO jj=1,il_shape(2)
+            DO ji=1,il_shape(1)
+               dl_value(ji,jj,jk)=REAL(rd_value(ji,jj,jk),dp)
+            ENDDO
+         ENDDO
+      ENDDO
+
+      tf_var=var_init( cd_name, dl_value(:,:,:),           &
+         &             id_start=id_start,                  &
+         &             id_count=id_count,                  &
+         &             id_type=il_type,                    &
+         &             td_dim=td_dim, td_att=td_att,       &
+         &             dd_fill=dl_fill,                    &
+         &             cd_units=cd_units,                  &
+         &             cd_axis=cd_axis,                    &
+         &             cd_stdname=cd_stdname,              &
+         &             cd_longname=cd_longname,            &
+         &             cd_point=cd_point, id_id=id_id,     &
+         &             id_ew=id_ew, dd_scf=dd_scf,         &
+         &             dd_ofs=dd_ofs,  id_rec=id_rec,      &
+         &             dd_min=dd_min, dd_max=dd_max,       &
+         &             ld_contiguous=ld_contiguous,        &
+         &             ld_shuffle=ld_shuffle,              &
+         &             ld_fletcher32=ld_fletcher32,        &
+         &             id_deflvl=id_deflvl,                &
+         &             id_chunksz=id_chunksz(:),           &
+         &             cd_interp=cd_interp(:),             &
+         &             cd_extrap=cd_extrap(:),             &
+         &             cd_filter=cd_filter(:),             &
+         &             cd_unt=cd_unt, dd_unf=dd_unf,       &
+         &             cd_namout=cd_namout )
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_3D_sp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__init_sp(cd_name, rd_value,                    &
+         &               id_start, id_count, id_type, td_dim,  &
+         &               td_att, rd_fill, cd_units, cd_axis,   &
+         &               cd_stdname, cd_longname,              &
+         &               cd_point, id_id, id_ew,               &
+         &               dd_scf, dd_ofs,  id_rec,              &
+         &               dd_min, dd_max,                       &
+         &               ld_contiguous, ld_shuffle,            &
+         &               ld_fletcher32, id_deflvl, id_chunksz, &
+         &               cd_interp, cd_extrap, cd_filter,      &
+         &               cd_unt, dd_unf,                       &
+         &               cd_namout) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a real(4) 4D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> Dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y','z','t') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !> @date January, 2019
+   !> - decompose array conversion on each dimension
+   !> @date February, 2019
+   !> - add output name (to change name)
+   !>
+   !> @param[in] cd_name         variable name
+   !> @param[in] rd_value        4D array of real(4) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] rd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle      shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @param[in] cd_namout       output name (renamed variable)
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      REAL(sp)        , DIMENSION(:,:,:,:),   INTENT(IN) :: rd_value
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_att
+      REAL(sp)        ,                       INTENT(IN), OPTIONAL :: rd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_namout
+
+      ! function
+      TYPE(TVAR)                                         :: tf_var
+
+      ! local variable
+      INTEGER(i4)                                       :: il_type
+      INTEGER(i4), DIMENSION(ip_maxdim)                 :: il_shape
+
+      REAL(dp)                                          :: dl_fill
+      REAL(dp)        , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(tf_var)      
+
+      il_type=NF90_FLOAT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_FLOAT
+      IF( PRESENT(rd_fill) ) dl_fill=REAL(rd_fill,dp)
+
+      il_shape(:)=SHAPE(rd_value(:,:,:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+         &                il_shape(2), &
+         &                il_shape(3), &
+         &                il_shape(4)) )
+
+      DO jl=1,il_shape(4)
+         DO jk=1,il_shape(3)
+            DO jj=1,il_shape(2)
+               DO ji=1,il_shape(1)
+                  dl_value(ji,jj,jk,jl)=REAL(rd_value(ji,jj,jk,jl),dp)
+               ENDDO
+            ENDDO
+         ENDDO
+      ENDDO
+
+      tf_var=var_init( cd_name, dl_value(:,:,:,:),         &
+         &             id_start=id_start,                  &
+         &             id_count=id_count,                  &
+         &             id_type=il_type,                    &
+         &             td_dim=td_dim, td_att=td_att,       &
+         &             dd_fill=dl_fill,                    &
+         &             cd_units=cd_units,                  &
+         &             cd_axis=cd_axis,                    &
+         &             cd_stdname=cd_stdname,              &
+         &             cd_longname=cd_longname,            &
+         &             cd_point=cd_point, id_id=id_id,     &
+         &             id_ew=id_ew, dd_scf=dd_scf,         &
+         &             dd_ofs=dd_ofs,  id_rec=id_rec,      &
+         &             dd_min=dd_min, dd_max=dd_max,       &
+         &             ld_contiguous=ld_contiguous,        &
+         &             ld_shuffle=ld_shuffle,              &
+         &             ld_fletcher32=ld_fletcher32,        &
+         &             id_deflvl=id_deflvl,                &
+         &             id_chunksz=id_chunksz(:),           &
+         &             cd_interp=cd_interp(:),             &
+         &             cd_extrap=cd_extrap(:),             &
+         &             cd_filter=cd_filter(:),             &
+         &             cd_unt=cd_unt, dd_unf=dd_unf,       &
+         &             cd_namout=cd_namout )
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_sp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__init_1D_i8(cd_name, kd_value,                    &
+         &                  id_start, id_count, id_type, td_dim,  &
+         &                  td_att, kd_fill, cd_units, cd_axis,   &
+         &                  cd_stdname, cd_longname,              &
+         &                  cd_point, id_id, id_ew,               &
+         &                  dd_scf, dd_ofs,  id_rec,              &
+         &                  dd_min, dd_max,                       &
+         &                  ld_contiguous, ld_shuffle,            &
+         &                  ld_fletcher32, id_deflvl, id_chunksz, &
+         &                  cd_interp, cd_extrap, cd_filter,      &
+         &                  cd_unt, dd_unf,                       &
+         &                  cd_namout) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(8) 1D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('z') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !> @date January, 2019
+   !> - decompose array conversion on each dimension
+   !> @date February, 2019
+   !> - add output name (to change name)
+   !>
+   !> @param[in] cd_name         : variable name
+   !> @param[in] kd_value        : 1D array of integer(8) value
+   !> @param[in] id_start        : index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        : number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         : variable type 
+   !> @param[in] td_dim          : array of dimension structure
+   !> @param[in] td_att          : array of attribute structure
+   !> @param[in] kd_fill         : fill value
+   !> @param[in] cd_units        : units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      : variable standard name
+   !> @param[in] cd_longname     : variable long name
+   !> @param[in] cd_point        : point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           : variable id
+   !> @param[in] id_ew           : east west wrap
+   !> @param[in] dd_scf          : scale factor
+   !> @param[in] dd_ofs          : add offset
+   !> @param[in] id_rec          : record id (for rstdimg file)
+   !> @param[in] dd_min          : minimum value
+   !> @param[in] dd_max          : maximum value
+   !> @param[in] ld_contiguous   : use contiguous storage or not 
+   !> @param[in] ld_shuffle      :  shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   : fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       : deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      : chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @param[in] cd_namout       output name (renamed variable)
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i8)     , DIMENSION(:)        , INTENT(IN) :: kd_value
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      ,                       INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i8)     ,                       INTENT(IN), OPTIONAL :: kd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_namout
+
+      ! function
+      TYPE(TVAR)                                         :: tf_var
+
+      ! local variable
+      INTEGER(i4)                                       :: il_type
+      INTEGER(i4)                                       :: il_shape
+
+      REAL(dp)                                          :: dl_fill
+      REAL(dp)        , DIMENSION(:)      , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(tf_var)      
+
+      il_type=NF90_INT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_INT
+      IF( PRESENT(kd_fill) ) dl_fill=REAL(kd_fill,dp)
+
+      il_shape=SIZE(kd_value(:))
+      ALLOCATE( dl_value( il_shape) )
+
+      DO ji=1,il_shape
+         dl_value(ji)=REAL(kd_value(ji),dp)
+      ENDDO
+
+      tf_var=var_init( cd_name, dl_value(:),               &
+         &             id_start=id_start,                  &
+         &             id_count=id_count,                  &
+         &             id_type=il_type,                    &
+         &             td_dim=td_dim, td_att=td_att,       &
+         &             dd_fill=dl_fill,                    &
+         &             cd_units=cd_units,                  &
+         &             cd_axis=cd_axis,                    &
+         &             cd_stdname=cd_stdname,              &
+         &             cd_longname=cd_longname,            &
+         &             cd_point=cd_point, id_id=id_id,     &
+         &             id_ew=id_ew, dd_scf=dd_scf,         &
+         &             dd_ofs=dd_ofs,  id_rec=id_rec,      &
+         &             dd_min=dd_min, dd_max=dd_max,       &
+         &             ld_contiguous=ld_contiguous,        &
+         &             ld_shuffle=ld_shuffle,              &
+         &             ld_fletcher32=ld_fletcher32,        &
+         &             id_deflvl=id_deflvl,                &
+         &             id_chunksz=id_chunksz(:),           &
+         &             cd_interp=cd_interp(:),             &
+         &             cd_extrap=cd_extrap(:),             &
+         &             cd_filter=cd_filter(:),             &
+         &             cd_unt=cd_unt, dd_unf=dd_unf,       &
+         &             cd_namout=cd_namout )
+ 
+      DEALLOCATE( dl_value )
+ 
+   END FUNCTION var__init_1D_i8
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__init_2D_i8(cd_name, kd_value,        &
+         &                             id_start, id_count, id_type, td_dim, &
+         &                             td_att, kd_fill, cd_units, cd_axis,&
+         &                             cd_stdname, cd_longname,  &
+         &                             cd_point, id_id, id_ew,   &
+         &                             dd_scf, dd_ofs,  id_rec,  &
+         &                             dd_min, dd_max,           &
+         &                             ld_contiguous, ld_shuffle,&
+         &                             ld_fletcher32, id_deflvl, id_chunksz, &
+         &                             cd_interp, cd_extrap, cd_filter, &
+         &                             cd_unt, dd_unf, &
+         &                             cd_namout) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(8) 2D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> array of 2 dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !> @date January, 2019
+   !> - decompose array conversion on each dimension
+   !> @date February, 2019
+   !> - add output name (to change name)
+   !>
+   !> @param[in] cd_name         variable name
+   !> @param[in] kd_value        2D array of integer(8) value
+   !> @param[in] id_start        index in the variable from which the data values 
+   !> will be read
+   !> @param[in] id_count        number of indices selected along each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] kd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @param[in] cd_namout       output name (renamed variable)
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i8)     , DIMENSION(:,:)     ,  INTENT(IN) :: kd_value
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i8)     ,                       INTENT(IN), OPTIONAL :: kd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_namout
+
+      ! function
+      TYPE(TVAR)                                         :: tf_var
+
+      ! local variable
+      INTEGER(i4)                                  :: il_type
+      INTEGER(i4), DIMENSION(2)                    :: il_shape
+
+      REAL(dp)                                     :: dl_fill
+      REAL(dp)   , DIMENSION(:,:)    , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(tf_var)      
+
+      il_type=NF90_INT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_INT
+      IF( PRESENT(kd_fill) ) dl_fill=REAL(kd_fill,dp)
+
+      il_shape(:)=SHAPE(kd_value(:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+         &                il_shape(2)) )
+
+      DO jj=1,il_shape(2)
+         DO ji=1,il_shape(1)
+            dl_value(ji,jj)=REAL(kd_value(ji,jj),dp)
+         ENDDO
+      ENDDO
+
+      tf_var=var_init( cd_name, dl_value(:,:),             &
+         &             id_start=id_start,                  &
+         &             id_count=id_count,                  &
+         &             id_type=il_type,                    &
+         &             td_dim=td_dim, td_att=td_att,       &
+         &             dd_fill=dl_fill,                    &
+         &             cd_units=cd_units,                  &
+         &             cd_axis=cd_axis,                    &
+         &             cd_stdname=cd_stdname,              &
+         &             cd_longname=cd_longname,            &
+         &             cd_point=cd_point, id_id=id_id,     &
+         &             id_ew=id_ew, dd_scf=dd_scf,         &
+         &             dd_ofs=dd_ofs,  id_rec=id_rec,      &
+         &             dd_min=dd_min, dd_max=dd_max,       &
+         &             ld_contiguous=ld_contiguous,        &
+         &             ld_shuffle=ld_shuffle,              &
+         &             ld_fletcher32=ld_fletcher32,        &
+         &             id_deflvl=id_deflvl,                &
+         &             id_chunksz=id_chunksz(:),           &
+         &             cd_interp=cd_interp(:),             &
+         &             cd_extrap=cd_extrap(:),             &
+         &             cd_filter=cd_filter(:),             &
+         &             cd_unt=cd_unt, dd_unf=dd_unf,       &
+         &             cd_namout=cd_namout )
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_2D_i8
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__init_3D_i8(cd_name, kd_value,                    &
+         &                  id_start, id_count, id_type, td_dim,  &
+         &                  td_att, kd_fill, cd_units, cd_axis,   &
+         &                  cd_stdname, cd_longname,              &
+         &                  cd_point, id_id, id_ew,               &
+         &                  dd_scf, dd_ofs,  id_rec,              &
+         &                  dd_min, dd_max,                       &
+         &                  ld_contiguous, ld_shuffle,            &
+         &                  ld_fletcher32, id_deflvl, id_chunksz, &
+         &                  cd_interp, cd_extrap, cd_filter,      &
+         &                  cd_unt, dd_unf,                       &
+         &                  cd_namout) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(8) 3D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> array of 3 dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y','z') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !> @date January, 2019
+   !> - decompose array conversion on each dimension
+   !> @date February, 2019
+   !> - add output name (to change name)
+   !>
+   !> @param[in] cd_name         variable name
+   !> @param[in] kd_value        2D array of integer(8) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] kd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @param[in] cd_namout       output name (renamed variable)
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i8)     , DIMENSION(:,:,:)   ,  INTENT(IN) :: kd_value
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i8)     ,                       INTENT(IN), OPTIONAL :: kd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_namout
+
+      ! function
+      TYPE(TVAR)                                         :: tf_var
+
+      ! local variable
+      INTEGER(i4)                                  :: il_type
+      INTEGER(i4), DIMENSION(3)                    :: il_shape
+
+      REAL(dp)                                     :: dl_fill
+      REAL(dp)   , DIMENSION(:,:,:)  , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(tf_var)      
+
+      il_type=NF90_INT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_INT
+      IF( PRESENT(kd_fill) ) dl_fill=REAL(kd_fill,dp)
+
+      il_shape(:)=SHAPE(kd_value(:,:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+         &                il_shape(2), &
+         &                il_shape(3)) )
+
+      DO jk=1,il_shape(3)
+         DO jj=1,il_shape(2)
+            DO ji=1,il_shape(1)
+               dl_value(ji,jj,jk)=REAL(kd_value(ji,jj,jk),dp)
+            ENDDO
+         ENDDO
+      ENDDO
+
+      tf_var=var_init( cd_name, dl_value(:,:,:),           &
+         &             id_start=id_start,                  &
+         &             id_count=id_count,                  &
+         &             id_type=il_type,                    &
+         &             td_dim=td_dim, td_att=td_att,       &
+         &             dd_fill=dl_fill,                    &
+         &             cd_units=cd_units,                  &
+         &             cd_axis=cd_axis,                    &
+         &             cd_stdname=cd_stdname,              &
+         &             cd_longname=cd_longname,            &
+         &             cd_point=cd_point, id_id=id_id,     &
+         &             id_ew=id_ew, dd_scf=dd_scf,         &
+         &             dd_ofs=dd_ofs,  id_rec=id_rec,      &
+         &             dd_min=dd_min, dd_max=dd_max,       &
+         &             ld_contiguous=ld_contiguous,        &
+         &             ld_shuffle=ld_shuffle,              &
+         &             ld_fletcher32=ld_fletcher32,        &
+         &             id_deflvl=id_deflvl,                &
+         &             id_chunksz=id_chunksz(:),           &
+         &             cd_interp=cd_interp(:),             &
+         &             cd_extrap=cd_extrap(:),             &
+         &             cd_filter=cd_filter(:),             &
+         &             cd_unt=cd_unt, dd_unf=dd_unf,       &
+         &             cd_namout=cd_namout )
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_3D_i8
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__init_i8(cd_name, kd_value,                    &
+         &               id_start, id_count, id_type, td_dim,  &
+         &               td_att, kd_fill, cd_units, cd_axis,   &
+         &               cd_stdname, cd_longname,              &
+         &               cd_point, id_id, id_ew,               &
+         &               dd_scf, dd_ofs,  id_rec,              &
+         &               dd_min, dd_max,                       &
+         &               ld_contiguous, ld_shuffle,            &
+         &               ld_fletcher32, id_deflvl, id_chunksz, &
+         &               cd_interp, cd_extrap, cd_filter,      &
+         &               cd_unt, dd_unf,                       &
+         &               cd_namout) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(8) 4D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> Dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y','z','t') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !> @date January, 2019
+   !> - decompose array conversion on each dimension
+   !> @date February, 2019
+   !> - add output name (to change name)
+   !>
+   !> @param[in] cd_name         variable name
+   !> @param[in] kd_value        4D array of integer(8) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] kd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @param[in] cd_namout       output name (renamed variable)
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i8)     , DIMENSION(:,:,:,:),   INTENT(IN) :: kd_value
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i8)     ,                       INTENT(IN), OPTIONAL :: kd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_namout
+
+      ! function
+      TYPE(TVAR)                                         :: tf_var
+
+      ! local variable
+      INTEGER(i4)                                       :: il_type
+      INTEGER(i4), DIMENSION(ip_maxdim)                 :: il_shape
+
+      REAL(dp)                                          :: dl_fill
+      REAL(dp)        , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(tf_var)      
+
+      il_type=NF90_INT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_INT
+      IF( PRESENT(kd_fill) ) dl_fill=REAL(kd_fill,dp)
+
+      il_shape(:)=SHAPE(kd_value(:,:,:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+         &                il_shape(2), &
+         &                il_shape(3), &
+         &                il_shape(4)) )
+
+      DO jl=1,il_shape(4)
+         DO jk=1,il_shape(3)
+            DO jj=1,il_shape(2)
+               DO ji=1,il_shape(1)
+                  dl_value(ji,jj,jk,jl)=REAL(kd_value(ji,jj,jk,jl),dp)
+               ENDDO
+            ENDDO
+         ENDDO
+      ENDDO                  
+
+      tf_var=var_init( cd_name, dl_value(:,:,:,:),         &
+         &             id_start=id_start,                  &
+         &             id_count=id_count,                  &
+         &             id_type=il_type,                    &
+         &             td_dim=td_dim, td_att=td_att,       &
+         &             dd_fill=dl_fill,                    &
+         &             cd_units=cd_units,                  &
+         &             cd_axis=cd_axis,                    &
+         &             cd_stdname=cd_stdname,              &
+         &             cd_longname=cd_longname,            &
+         &             cd_point=cd_point, id_id=id_id,     &
+         &             id_ew=id_ew, dd_scf=dd_scf,         &
+         &             dd_ofs=dd_ofs,  id_rec=id_rec,      &
+         &             dd_min=dd_min, dd_max=dd_max,       &
+         &             ld_contiguous=ld_contiguous,        &
+         &             ld_shuffle=ld_shuffle,              &
+         &             ld_fletcher32=ld_fletcher32,        &
+         &             id_deflvl=id_deflvl,                &
+         &             id_chunksz=id_chunksz(:),           &
+         &             cd_interp=cd_interp(:),             &
+         &             cd_extrap=cd_extrap(:),             &
+         &             cd_filter=cd_filter(:),             &
+         &             cd_unt=cd_unt, dd_unf=dd_unf,       &
+         &             cd_namout=cd_namout )
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_i8
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__init_1D_i4(cd_name, id_value,                    &
+         &                  id_start, id_count, id_type, td_dim,  &
+         &                  td_att, id_fill, cd_units, cd_axis,   &
+         &                  cd_stdname, cd_longname,              &
+         &                  cd_point, id_id, id_ew,               &
+         &                  dd_scf, dd_ofs,  id_rec,              &
+         &                  dd_min, dd_max,                       &
+         &                  ld_contiguous, ld_shuffle,            &
+         &                  ld_fletcher32, id_deflvl, id_chunksz, &
+         &                  cd_interp, cd_extrap, cd_filter,      &
+         &                  cd_unt, dd_unf,                       &
+         &                  cd_namout) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(4) 1D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('z') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !> @date January, 2019
+   !> - decompose array conversion on each dimension
+   !> @date February, 2019
+   !> - add output name (to change name)
+   !>
+   !> @param[in] cd_name         variable name
+   !> @param[in] id_value        1D array of integer(4) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] id_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @param[in] cd_namout       output name (renamed variable)
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i4)     , DIMENSION(:)        , INTENT(IN) :: id_value
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      ,                       INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_namout
+
+      ! function
+      TYPE(TVAR)                                         :: tf_var
+
+      ! local variable
+      INTEGER(i4)                                       :: il_type
+      INTEGER(i4)                                       :: il_shape
+
+      REAL(dp)                                          :: dl_fill
+      REAL(dp)        , DIMENSION(:)      , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(tf_var)      
+
+      il_type=NF90_INT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_INT
+      IF( PRESENT(id_fill) ) dl_fill=REAL(id_fill,dp)
+
+      il_shape=SIZE(id_value(:))
+      ALLOCATE( dl_value( il_shape) )
+
+      DO ji=1,il_shape
+         dl_value(ji)=REAL(id_value(ji),dp)
+      ENDDO
+
+      tf_var=var_init( cd_name, dl_value(:),               &
+         &             id_start=id_start,                  &
+         &             id_count=id_count,                  &
+         &             id_type=il_type,                    &
+         &             td_dim=td_dim, td_att=td_att,       &
+         &             dd_fill=dl_fill,                    &
+         &             cd_units=cd_units,                  &
+         &             cd_axis=cd_axis,                    &
+         &             cd_stdname=cd_stdname,              &
+         &             cd_longname=cd_longname,            &
+         &             cd_point=cd_point, id_id=id_id,     &
+         &             id_ew=id_ew, dd_scf=dd_scf,         &
+         &             dd_ofs=dd_ofs,  id_rec=id_rec,      &
+         &             dd_min=dd_min, dd_max=dd_max,       &
+         &             ld_contiguous=ld_contiguous,        &
+         &             ld_shuffle=ld_shuffle,              &
+         &             ld_fletcher32=ld_fletcher32,        &
+         &             id_deflvl=id_deflvl,                &
+         &             id_chunksz=id_chunksz(:),           &
+         &             cd_interp=cd_interp(:),             &
+         &             cd_extrap=cd_extrap(:),             &
+         &             cd_filter=cd_filter(:),             &
+         &             cd_unt=cd_unt, dd_unf=dd_unf,       &
+         &             cd_namout=cd_namout )
+ 
+      DEALLOCATE( dl_value )
+ 
+   END FUNCTION var__init_1D_i4
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__init_2D_i4(cd_name, id_value,                    &
+         &                  id_start, id_count, id_type, td_dim,  &
+         &                  td_att, id_fill, cd_units, cd_axis,   &
+         &                  cd_stdname, cd_longname,              &
+         &                  cd_point, id_id, id_ew,               &
+         &                  dd_scf, dd_ofs,  id_rec,              &
+         &                  dd_min, dd_max,                       &
+         &                  ld_contiguous, ld_shuffle,            &
+         &                  ld_fletcher32, id_deflvl, id_chunksz, &
+         &                  cd_interp, cd_extrap, cd_filter,      &
+         &                  cd_unt, dd_unf,                       &
+         &                  cd_namout) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(4) 2D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> array of 2 dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !> @date January, 2019
+   !> - decompose array conversion on each dimension
+   !> @date February, 2019
+   !> - add output name (to change name)
+   !>
+   !> @param[in] cd_name         variable name
+   !> @param[in] id_value        2D array of integer(4) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] id_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @param[in] cd_namout       output name (renamed variable)
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i4)     , DIMENSION(:,:)     ,  INTENT(IN) :: id_value
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_namout
+
+      ! function
+      TYPE(TVAR)                                         :: tf_var
+
+      ! local variable
+      INTEGER(i4)                                  :: il_type
+      INTEGER(i4), DIMENSION(2)                    :: il_shape
+
+      REAL(dp)                                     :: dl_fill
+      REAL(dp)   , DIMENSION(:,:)    , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(tf_var)      
+
+      il_type=NF90_INT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_INT
+      IF( PRESENT(id_fill) ) dl_fill=REAL(id_fill,dp)
+
+      il_shape(:)=SHAPE(id_value(:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+         &                il_shape(2)) )
+
+      DO jj=1,il_shape(2)
+         DO ji=1,il_shape(1)
+            dl_value(ji,jj)=REAL(id_value(ji,jj),dp)
+         ENDDO
+      ENDDO
+
+      tf_var=var_init( cd_name, dl_value(:,:),             &
+         &             id_start=id_start,                  &
+         &             id_count=id_count,                  &
+         &             id_type=il_type,                    &
+         &             td_dim=td_dim, td_att=td_att,       &
+         &             dd_fill=dl_fill,                    &
+         &             cd_units=cd_units,                  &
+         &             cd_axis=cd_axis,                    &
+         &             cd_stdname=cd_stdname,              &
+         &             cd_longname=cd_longname,            &
+         &             cd_point=cd_point, id_id=id_id,     &
+         &             id_ew=id_ew, dd_scf=dd_scf,         &
+         &             dd_ofs=dd_ofs,  id_rec=id_rec,      &
+         &             dd_min=dd_min, dd_max=dd_max,       &
+         &             ld_contiguous=ld_contiguous,        &
+         &             ld_shuffle=ld_shuffle,              &
+         &             ld_fletcher32=ld_fletcher32,        &
+         &             id_deflvl=id_deflvl,                &
+         &             id_chunksz=id_chunksz(:),           &
+         &             cd_interp=cd_interp(:),             &
+         &             cd_extrap=cd_extrap(:),             &
+         &             cd_filter=cd_filter(:),             &
+         &             cd_unt=cd_unt, dd_unf=dd_unf,       &
+         &             cd_namout=cd_namout )
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_2D_i4
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__init_3D_i4(cd_name, id_value,                    &
+         &                  id_start, id_count, id_type, td_dim,  &
+         &                  td_att, id_fill, cd_units, cd_axis,   &
+         &                  cd_stdname, cd_longname,              &
+         &                  cd_point, id_id, id_ew,               &
+         &                  dd_scf, dd_ofs,  id_rec,              &
+         &                  dd_min, dd_max,                       &
+         &                  ld_contiguous, ld_shuffle,            &
+         &                  ld_fletcher32, id_deflvl, id_chunksz, &
+         &                  cd_interp, cd_extrap, cd_filter,      &
+         &                  cd_unt, dd_unf,                       &
+         &                  cd_namout) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(4) 3D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> array of 3 dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y','z') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !> @date January, 2019
+   !> - decompose array conversion on each dimension
+   !> @date February, 2019
+   !> - add output name (to change name)
+   !>
+   !> @param[in] cd_name         variable name
+   !> @param[in] id_value        3D array of integer(4) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] id_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @param[in] cd_namout       output name (renamed variable)
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i4)     , DIMENSION(:,:,:)   ,  INTENT(IN) :: id_value
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_namout
+
+      ! function
+      TYPE(TVAR)                                         :: tf_var
+
+      ! local variable
+      INTEGER(i4)                                  :: il_type
+      INTEGER(i4), DIMENSION(3)                    :: il_shape
+
+      REAL(dp)                                     :: dl_fill
+      REAL(dp)   , DIMENSION(:,:,:)  , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(tf_var)      
+
+      il_type=NF90_INT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_INT
+      IF( PRESENT(id_fill) ) dl_fill=REAL(id_fill,dp)
+
+      il_shape(:)=SHAPE(id_value(:,:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+         &                il_shape(2), &
+         &                il_shape(3)) )
+
+      DO jk=1,il_shape(3)
+         DO jj=1,il_shape(2)
+            DO ji=1,il_shape(1)
+               dl_value(ji,jj,jk)=REAL(id_value(ji,jj,jk),dp)
+            ENDDO
+         ENDDO
+      ENDDO
+
+      tf_var=var_init( cd_name, dl_value(:,:,:),           &
+         &             id_start=id_start,                  &
+         &             id_count=id_count,                  &
+         &             id_type=il_type,                    &
+         &             td_dim=td_dim, td_att=td_att,       &
+         &             dd_fill=dl_fill,                    &
+         &             cd_units=cd_units,                  &
+         &             cd_axis=cd_axis,                    &
+         &             cd_stdname=cd_stdname,              &
+         &             cd_longname=cd_longname,            &
+         &             cd_point=cd_point, id_id=id_id,     &
+         &             id_ew=id_ew, dd_scf=dd_scf,         &
+         &             dd_ofs=dd_ofs,  id_rec=id_rec,      &
+         &             dd_min=dd_min, dd_max=dd_max,       &
+         &             ld_contiguous=ld_contiguous,        &
+         &             ld_shuffle=ld_shuffle,              &
+         &             ld_fletcher32=ld_fletcher32,        &
+         &             id_deflvl=id_deflvl,                &
+         &             id_chunksz=id_chunksz(:),           &
+         &             cd_interp=cd_interp(:),             &
+         &             cd_extrap=cd_extrap(:),             &
+         &             cd_filter=cd_filter(:),             &
+         &             cd_unt=cd_unt, dd_unf=dd_unf,       &
+         &             cd_namout=cd_namout )
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_3D_i4
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__init_i4(cd_name, id_value,                    &
+         &               id_start, id_count, id_type, td_dim,  &
+         &               td_att, id_fill, cd_units, cd_axis,   &
+         &               cd_stdname, cd_longname,              &
+         &               cd_point, id_id, id_ew,               &
+         &               dd_scf, dd_ofs,  id_rec,              &
+         &               dd_min, dd_max,                       &
+         &               ld_contiguous, ld_shuffle,            &
+         &               ld_fletcher32, id_deflvl, id_chunksz, &
+         &               cd_interp, cd_extrap, cd_filter,      &
+         &               cd_unt, dd_unf,                       &
+         &               cd_namout) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(4) 4D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> Dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y','z','t') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !> @date January, 2019
+   !> - decompose array conversion on each dimension
+   !> @date February, 2019
+   !> - add output name (to change name)
+   !>
+   !> @param[in] cd_name         variable name
+   !> @param[in] id_value        4D array of integer(4) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] id_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @param[in] cd_namout       output name (renamed variable)
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i4)     , DIMENSION(:,:,:,:),   INTENT(IN) :: id_value
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_namout
+
+      ! function
+      TYPE(TVAR)                                         :: tf_var
+
+      ! local variable
+      INTEGER(i4)                                       :: il_type
+      INTEGER(i4), DIMENSION(ip_maxdim)                 :: il_shape
+
+      REAL(dp)                                          :: dl_fill
+      REAL(dp)        , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(tf_var)      
+
+      il_type=NF90_INT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_INT
+      IF( PRESENT(id_fill) ) dl_fill=REAL(id_fill,dp)
+
+      il_shape(:)=SHAPE(id_value(:,:,:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+         &                il_shape(2), &
+         &                il_shape(3), &
+         &                il_shape(4)) )
+
+      DO jl=1,il_shape(4)
+         DO jk=1,il_shape(3)
+            DO jj=1,il_shape(2)
+               DO ji=1,il_shape(1)
+                  dl_value(ji,jj,jk,jl)=REAL(id_value(ji,jj,jk,jl),dp)
+               ENDDO
+            ENDDO
+         ENDDO
+      ENDDO
+
+      tf_var=var_init( cd_name, dl_value(:,:,:,:),         &
+         &             id_start=id_start,                  &
+         &             id_count=id_count,                  &
+         &             id_type=il_type,                    &
+         &             td_dim=td_dim, td_att=td_att,       &
+         &             dd_fill=dl_fill,                    &
+         &             cd_units=cd_units,                  &
+         &             cd_axis=cd_axis,                    &
+         &             cd_stdname=cd_stdname,              &
+         &             cd_longname=cd_longname,            &
+         &             cd_point=cd_point, id_id=id_id,     &
+         &             id_ew=id_ew, dd_scf=dd_scf,         &
+         &             dd_ofs=dd_ofs,  id_rec=id_rec,      &
+         &             dd_min=dd_min, dd_max=dd_max,       &
+         &             ld_contiguous=ld_contiguous,        &
+         &             ld_shuffle=ld_shuffle,              &
+         &             ld_fletcher32=ld_fletcher32,        &
+         &             id_deflvl=id_deflvl,                &
+         &             id_chunksz=id_chunksz(:),           &
+         &             cd_interp=cd_interp(:),             &
+         &             cd_extrap=cd_extrap(:),             &
+         &             cd_filter=cd_filter(:),             &
+         &             cd_unt=cd_unt, dd_unf=dd_unf,       &
+         &             cd_namout=cd_namout )
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_i4
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__init_1D_i2(cd_name, sd_value,                    &
+         &                  id_start, id_count, id_type, td_dim,  &
+         &                  td_att, sd_fill, cd_units, cd_axis,   &
+         &                  cd_stdname, cd_longname,              &
+         &                  cd_point, id_id, id_ew,               &
+         &                  dd_scf, dd_ofs,  id_rec,              &
+         &                  dd_min, dd_max,                       &
+         &                  ld_contiguous, ld_shuffle,            &
+         &                  ld_fletcher32, id_deflvl, id_chunksz, &
+         &                  cd_interp, cd_extrap, cd_filter,      &
+         &                  cd_unt, dd_unf,                       &
+         &                  cd_namout) &
+         &  RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(2) 1D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('z') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !> @date January, 2019
+   !> - decompose array conversion on each dimension
+   !> @date February, 2019
+   !> - add output name (to change name)
+   !>
+   !> @param[in] cd_name         variable name
+   !> @param[in] sd_value        1D array of integer(2) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] sd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @param[in] cd_namout       output name (renamed variable)
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i2)     , DIMENSION(:)        , INTENT(IN) :: sd_value
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      ,                       INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i2)     ,                       INTENT(IN), OPTIONAL :: sd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_namout
+
+      ! function
+      TYPE(TVAR)                                         :: tf_var
+
+      ! local variable
+      INTEGER(i4)                                       :: il_type
+      INTEGER(i4)                                       :: il_shape
+
+      REAL(dp)                                          :: dl_fill
+      REAL(dp)        , DIMENSION(:)      , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(tf_var)      
+
+      il_type=NF90_SHORT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_SHORT
+      IF( PRESENT(sd_fill) ) dl_fill=REAL(sd_fill,dp)
+
+      il_shape=SIZE(sd_value(:))
+      ALLOCATE( dl_value( il_shape) )
+
+      DO ji=1,il_shape
+         dl_value(ji)=REAL(sd_value(ji),dp)
+      ENDDO
+
+      tf_var=var_init( cd_name, dl_value(:),               &
+         &             id_start=id_start,                  &
+         &             id_count=id_count,                  &
+         &             id_type=il_type,                    &
+         &             td_dim=td_dim, td_att=td_att,       &
+         &             dd_fill=dl_fill,                    &
+         &             cd_units=cd_units,                  &
+         &             cd_axis=cd_axis,                    &
+         &             cd_stdname=cd_stdname,              &
+         &             cd_longname=cd_longname,            &
+         &             cd_point=cd_point, id_id=id_id,     &
+         &             id_ew=id_ew, dd_scf=dd_scf,         &
+         &             dd_ofs=dd_ofs,  id_rec=id_rec,      &
+         &             dd_min=dd_min, dd_max=dd_max,       &
+         &             ld_contiguous=ld_contiguous,        &
+         &             ld_shuffle=ld_shuffle,              &
+         &             ld_fletcher32=ld_fletcher32,        &
+         &             id_deflvl=id_deflvl,                &
+         &             id_chunksz=id_chunksz(:),           &
+         &             cd_interp=cd_interp(:),             &
+         &             cd_extrap=cd_extrap(:),             &
+         &             cd_filter=cd_filter(:),             &
+         &             cd_unt=cd_unt, dd_unf=dd_unf,       &
+         &             cd_namout=cd_namout )
+ 
+      DEALLOCATE( dl_value )
+ 
+   END FUNCTION var__init_1D_i2
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__init_2D_i2(cd_name, sd_value,                    &
+         &                  id_start, id_count, id_type, td_dim,  &
+         &                  td_att, sd_fill, cd_units, cd_axis,   &
+         &                  cd_stdname, cd_longname,              &
+         &                  cd_point, id_id, id_ew,               &
+         &                  dd_scf, dd_ofs,  id_rec,              &
+         &                  dd_min, dd_max,                       &
+         &                  ld_contiguous, ld_shuffle,            &
+         &                  ld_fletcher32, id_deflvl, id_chunksz, &
+         &                  cd_interp, cd_extrap, cd_filter,      &
+         &                  cd_unt, dd_unf,                       &
+         &                  cd_namout) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(2) 2D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> array of 2 dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !> @date January, 2019
+   !> - decompose array conversion on each dimension
+   !> @date February, 2019
+   !> - add output name (to change name)
+   !>
+   !> @param[in] cd_name         variable name
+   !> @param[in] sd_value        2D array of integer(2) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] sd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @param[in] cd_namout       output name (renamed variable)
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i2)     , DIMENSION(:,:)     ,  INTENT(IN) :: sd_value
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i2)     ,                       INTENT(IN), OPTIONAL :: sd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_namout
+
+      ! function
+      TYPE(TVAR)                                         :: tf_var
+
+      ! local variable
+      INTEGER(i4)                                  :: il_type
+      INTEGER(i4), DIMENSION(2)                    :: il_shape
+
+      REAL(dp)                                     :: dl_fill
+      REAL(dp)   , DIMENSION(:,:)    , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(tf_var)      
+
+      il_type=NF90_SHORT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_SHORT
+      IF( PRESENT(sd_fill) ) dl_fill=REAL(sd_fill,dp)
+
+      il_shape(:)=SHAPE(sd_value(:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+         &                il_shape(2)) )
+
+      DO jj=1,il_shape(2)
+         DO ji=1,il_shape(1)
+            dl_value(ji,jj)=REAL(sd_value(ji,jj),dp)
+         ENDDO
+      ENDDO
+
+      tf_var=var_init( cd_name, dl_value(:,:),             &
+         &             id_start=id_start,                  &
+         &             id_count=id_count,                  &
+         &             id_type=il_type,                    &
+         &             td_dim=td_dim, td_att=td_att,       &
+         &             dd_fill=dl_fill,                    &
+         &             cd_units=cd_units,                  &
+         &             cd_axis=cd_axis,                    &
+         &             cd_stdname=cd_stdname,              &
+         &             cd_longname=cd_longname,            &
+         &             cd_point=cd_point, id_id=id_id,     &
+         &             id_ew=id_ew, dd_scf=dd_scf,         &
+         &             dd_ofs=dd_ofs,  id_rec=id_rec,      &
+         &             dd_min=dd_min, dd_max=dd_max,       &
+         &             ld_contiguous=ld_contiguous,        &
+         &             ld_shuffle=ld_shuffle,              &
+         &             ld_fletcher32=ld_fletcher32,        &
+         &             id_deflvl=id_deflvl,                &
+         &             id_chunksz=id_chunksz(:),           &
+         &             cd_interp=cd_interp(:),             &
+         &             cd_extrap=cd_extrap(:),             &
+         &             cd_filter=cd_filter(:),             &
+         &             cd_unt=cd_unt, dd_unf=dd_unf,       &
+         &             cd_namout=cd_namout )
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_2D_i2
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__init_3D_i2(cd_name, sd_value,                    &
+         &                  id_start, id_count, id_type, td_dim,  &
+         &                  td_att, sd_fill, cd_units, cd_axis,   &
+         &                  cd_stdname, cd_longname,              &
+         &                  cd_point, id_id, id_ew,               &
+         &                  dd_scf, dd_ofs,  id_rec,              &
+         &                  dd_min, dd_max,                       &
+         &                  ld_contiguous, ld_shuffle,            &
+         &                  ld_fletcher32, id_deflvl, id_chunksz, &
+         &                  cd_interp, cd_extrap, cd_filter,      &
+         &                  cd_unt, dd_unf,                       &
+         &                  cd_namout) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(2) 3D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> array of 3 dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y','z') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !> @date January, 2019
+   !> - decompose array conversion on each dimension
+   !> @date February, 2019
+   !> - add output name (to change name)
+   !>
+   !> @param[in] cd_name         variable name
+   !> @param[in] sd_value        3D array of integer(2) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] sd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @param[in] cd_namout       output name (renamed variable)
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i2)     , DIMENSION(:,:,:)   ,  INTENT(IN) :: sd_value
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i2)     ,                       INTENT(IN), OPTIONAL :: sd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_namout
+
+      ! function
+      TYPE(TVAR)                                         :: tf_var
+
+      ! local variable
+      INTEGER(i4)                                  :: il_type
+      INTEGER(i4), DIMENSION(3)                    :: il_shape
+
+      REAL(dp)                                     :: dl_fill
+      REAL(dp)   , DIMENSION(:,:,:)  , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(tf_var)      
+
+      il_type=NF90_SHORT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_SHORT
+      IF( PRESENT(sd_fill) ) dl_fill=REAL(sd_fill,dp)
+
+      il_shape(:)=SHAPE(sd_value(:,:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+         &                il_shape(2), &
+         &                il_shape(3)) )
+
+      DO jk=1,il_shape(3)
+         DO jj=1,il_shape(2)
+            DO ji=1,il_shape(1)
+               dl_value(ji,jj,jk)=REAL(sd_value(ji,jj,jk),dp)
+            ENDDO
+         ENDDO
+      ENDDO
+
+      tf_var=var_init( cd_name, dl_value(:,:,:),           &
+         &             id_start=id_start,                  &
+         &             id_count=id_count,                  &
+         &             id_type=il_type,                    &
+         &             td_dim=td_dim, td_att=td_att,       &
+         &             dd_fill=dl_fill,                    &
+         &             cd_units=cd_units,                  &
+         &             cd_axis=cd_axis,                    &
+         &             cd_stdname=cd_stdname,              &
+         &             cd_longname=cd_longname,            &
+         &             cd_point=cd_point, id_id=id_id,     &
+         &             id_ew=id_ew, dd_scf=dd_scf,         &
+         &             dd_ofs=dd_ofs,  id_rec=id_rec,      &
+         &             dd_min=dd_min, dd_max=dd_max,       &
+         &             ld_contiguous=ld_contiguous,        &
+         &             ld_shuffle=ld_shuffle,              &
+         &             ld_fletcher32=ld_fletcher32,        &
+         &             id_deflvl=id_deflvl,                &
+         &             id_chunksz=id_chunksz(:),           &
+         &             cd_interp=cd_interp(:),             &
+         &             cd_extrap=cd_extrap(:),             &
+         &             cd_filter=cd_filter(:),             &
+         &             cd_unt=cd_unt, dd_unf=dd_unf,       &
+         &             cd_namout=cd_namout )
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_3D_i2
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__init_i2(cd_name, sd_value,        &
+         &                          id_start, id_count, id_type, td_dim, &
+         &                          td_att, sd_fill, cd_units, cd_axis,&
+         &                          cd_stdname, cd_longname,  &
+         &                          cd_point, id_id, id_ew,   &
+         &                          dd_scf, dd_ofs,  id_rec,  &
+         &                          dd_min, dd_max,           &
+         &                          ld_contiguous, ld_shuffle,&
+         &                          ld_fletcher32, id_deflvl, id_chunksz, &
+         &                          cd_interp, cd_extrap, cd_filter, &
+         &                          cd_unt, dd_unf, &
+         &                          cd_namout) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(2) 4D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> Dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y','z','t') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !> @date January, 2019
+   !> - decompose array conversion on each dimension
+   !> @date February, 2019
+   !> - add output name (to change name)
+   !>
+   !> @param[in] cd_name         variable name
+   !> @param[in] sd_value        4D array of integer(2) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] sd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @param[in] cd_namout       output name (renamed variable)
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i2)     , DIMENSION(:,:,:,:),   INTENT(IN) :: sd_value
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i2)     ,                       INTENT(IN), OPTIONAL :: sd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_namout
+
+      ! function
+      TYPE(TVAR)                                         :: tf_var
+
+      ! local variable
+      INTEGER(i4)                                       :: il_type
+      INTEGER(i4), DIMENSION(ip_maxdim)                 :: il_shape
+
+      REAL(dp)                                          :: dl_fill
+      REAL(dp)        , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(tf_var)      
+
+      il_type=NF90_SHORT
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_SHORT
+      IF( PRESENT(sd_fill) ) dl_fill=REAL(sd_fill,dp)
+
+      il_shape(:)=SHAPE(sd_value(:,:,:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+         &                il_shape(2), &
+         &                il_shape(3), &
+         &                il_shape(4)) )
+
+      DO jl=1,il_shape(4)
+         DO jk=1,il_shape(3)
+            DO jj=1,il_shape(2)
+               DO ji=1,il_shape(1)
+                  dl_value(ji,jj,jk,jl)=REAL(sd_value(ji,jj,jk,jl),dp)
+               ENDDO
+            ENDDO
+         ENDDO
+      ENDDO
+
+      tf_var=var_init( cd_name, dl_value(:,:,:,:),         &
+         &             id_start=id_start,                  &
+         &             id_count=id_count,                  &
+         &             id_type=il_type,                    &
+         &             td_dim=td_dim, td_att=td_att,       &
+         &             dd_fill=dl_fill,                    &
+         &             cd_units=cd_units,                  &
+         &             cd_axis=cd_axis,                    &
+         &             cd_stdname=cd_stdname,              &
+         &             cd_longname=cd_longname,            &
+         &             cd_point=cd_point, id_id=id_id,     &
+         &             id_ew=id_ew, dd_scf=dd_scf,         &
+         &             dd_ofs=dd_ofs,  id_rec=id_rec,      &
+         &             dd_min=dd_min, dd_max=dd_max,       &
+         &             ld_contiguous=ld_contiguous,        &
+         &             ld_shuffle=ld_shuffle,              &
+         &             ld_fletcher32=ld_fletcher32,        &
+         &             id_deflvl=id_deflvl,                &
+         &             id_chunksz=id_chunksz(:),           &
+         &             cd_interp=cd_interp(:),             &
+         &             cd_extrap=cd_extrap(:),             &
+         &             cd_filter=cd_filter(:),             &
+         &             cd_unt=cd_unt, dd_unf=dd_unf,       &
+         &             cd_namout=cd_namout )
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_i2
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__init_1D_i1(cd_name, bd_value,                    &
+         &                  id_start, id_count, id_type, td_dim,  &
+         &                  td_att, bd_fill, cd_units, cd_axis,   &
+         &                  cd_stdname, cd_longname,              &
+         &                  cd_point, id_id, id_ew,               &
+         &                  dd_scf, dd_ofs,  id_rec,              &
+         &                  dd_min, dd_max,                       &
+         &                  ld_contiguous, ld_shuffle,            &
+         &                  ld_fletcher32, id_deflvl, id_chunksz, &
+         &                  cd_interp, cd_extrap, cd_filter,      &
+         &                  cd_unt, dd_unf,                       &
+         &                  cd_namout) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(1) 1D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('z') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !> @date January, 2019
+   !> - decompose array conversion on each dimension
+   !> @date February, 2019
+   !> - add output name (to change name)
+   !>
+   !> @param[in] cd_name         variable name
+   !> @param[in] bd_value        1D array of integer(1) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] bd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @param[in] cd_namout       output name (renamed variable)
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i1)     , DIMENSION(:)        , INTENT(IN) :: bd_value
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      ,                       INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i1)     ,                       INTENT(IN), OPTIONAL :: bd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_namout
+
+      ! function
+      TYPE(TVAR)                                         :: tf_var
+
+      ! local variable
+      INTEGER(i4)                                       :: il_type
+      INTEGER(i4)                                       :: il_shape
+
+      REAL(dp)                                          :: dl_fill
+      REAL(dp)        , DIMENSION(:)      , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(tf_var)      
+
+      il_type=NF90_BYTE
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_BYTE
+      IF( PRESENT(bd_fill) ) dl_fill=REAL(bd_fill,dp)
+
+      il_shape=SIZE(bd_value(:))
+      ALLOCATE( dl_value( il_shape) )
+
+      DO ji=1,il_shape
+         dl_value(ji)=REAL(bd_value(ji),dp)
+      ENDDO
+
+      tf_var=var_init( cd_name, dl_value(:),               &
+         &             id_start=id_start,                  &
+         &             id_count=id_count,                  &
+         &             id_type=il_type,                    &
+         &             td_dim=td_dim, td_att=td_att,       &
+         &             dd_fill=dl_fill,                    &
+         &             cd_units=cd_units,                  &
+         &             cd_axis=cd_axis,                    &
+         &             cd_stdname=cd_stdname,              &
+         &             cd_longname=cd_longname,            &
+         &             cd_point=cd_point, id_id=id_id,     &
+         &             id_ew=id_ew, dd_scf=dd_scf,         &
+         &             dd_ofs=dd_ofs,  id_rec=id_rec,      &
+         &             dd_min=dd_min, dd_max=dd_max,       &
+         &             ld_contiguous=ld_contiguous,        &
+         &             ld_shuffle=ld_shuffle,              &
+         &             ld_fletcher32=ld_fletcher32,        &
+         &             id_deflvl=id_deflvl,                &
+         &             id_chunksz=id_chunksz(:),           &
+         &             cd_interp=cd_interp(:),             &
+         &             cd_extrap=cd_extrap(:),             &
+         &             cd_filter=cd_filter(:),             &
+         &             cd_unt=cd_unt, dd_unf=dd_unf,       &
+         &             cd_namout=cd_namout )
+ 
+      DEALLOCATE( dl_value )
+ 
+   END FUNCTION var__init_1D_i1
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__init_2D_i1(cd_name, bd_value,                    &
+         &                  id_start, id_count, id_type, td_dim,  &
+         &                  td_att, bd_fill, cd_units, cd_axis,   &
+         &                  cd_stdname, cd_longname,              &
+         &                  cd_point, id_id, id_ew,               &
+         &                  dd_scf, dd_ofs,  id_rec,              &
+         &                  dd_min, dd_max,                       &
+         &                  ld_contiguous, ld_shuffle,            &
+         &                  ld_fletcher32, id_deflvl, id_chunksz, &
+         &                  cd_interp, cd_extrap, cd_filter,      &
+         &                  cd_unt, dd_unf,                       &
+         &                  cd_namout) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(1) 2D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> array of 2 dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !> @date January, 2019
+   !> - decompose array conversion on each dimension
+   !> @date February, 2019
+   !> - add output name (to change name)
+   !>
+   !> @param[in] cd_name         variable name
+   !> @param[in] bd_value        2D array of integer(1) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] bd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @param[in] cd_namout       output name (renamed variable)
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i1)     , DIMENSION(:,:)     ,  INTENT(IN) :: bd_value
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i1)     ,                       INTENT(IN), OPTIONAL :: bd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_namout
+
+      ! function
+      TYPE(TVAR)                                         :: tf_var
+
+      ! local variable
+      INTEGER(i4)                                  :: il_type
+      INTEGER(i4), DIMENSION(2)                    :: il_shape
+
+      REAL(dp)                                     :: dl_fill
+      REAL(dp)   , DIMENSION(:,:)    , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(tf_var)      
+
+      il_type=NF90_BYTE
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_BYTE
+      IF( PRESENT(bd_fill) ) dl_fill=REAL(bd_fill,dp)
+
+      il_shape(:)=SHAPE(bd_value(:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+         &                il_shape(2)) )
+
+      DO jj=1,il_shape(2)
+         DO ji=1,il_shape(1)
+            dl_value(ji,jj)=REAL(bd_value(ji,jj),dp)
+         ENDDO
+      ENDDO
+
+      tf_var=var_init( cd_name, dl_value(:,:),             &
+         &             id_start=id_start,                  &
+         &             id_count=id_count,                  &
+         &             id_type=il_type,                    &
+         &             td_dim=td_dim, td_att=td_att,       &
+         &             dd_fill=dl_fill,                    &
+         &             cd_units=cd_units,                  &
+         &             cd_axis=cd_axis,                    &
+         &             cd_stdname=cd_stdname,              &
+         &             cd_longname=cd_longname,            &
+         &             cd_point=cd_point, id_id=id_id,     &
+         &             id_ew=id_ew, dd_scf=dd_scf,         &
+         &             dd_ofs=dd_ofs,  id_rec=id_rec,      &
+         &             dd_min=dd_min, dd_max=dd_max,       &
+         &             ld_contiguous=ld_contiguous,        &
+         &             ld_shuffle=ld_shuffle,              &
+         &             ld_fletcher32=ld_fletcher32,        &
+         &             id_deflvl=id_deflvl,                &
+         &             id_chunksz=id_chunksz(:),           &
+         &             cd_interp=cd_interp(:),             &
+         &             cd_extrap=cd_extrap(:),             &
+         &             cd_filter=cd_filter(:),             &
+         &             cd_unt=cd_unt, dd_unf=dd_unf,       &
+         &             cd_namout=cd_namout )
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_2D_i1
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__init_3D_i1(cd_name, bd_value,                    &
+         &                  id_start, id_count, id_type, td_dim,  &
+         &                  td_att, bd_fill, cd_units, cd_axis,   &
+         &                  cd_stdname, cd_longname,              &
+         &                  cd_point, id_id, id_ew,               &
+         &                  dd_scf, dd_ofs,  id_rec,              &
+         &                  dd_min, dd_max,                       &
+         &                  ld_contiguous, ld_shuffle,            &
+         &                  ld_fletcher32, id_deflvl, id_chunksz, &
+         &                  cd_interp, cd_extrap, cd_filter,      &
+         &                  cd_unt, dd_unf,                       &
+         &                  cd_namout) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(1) 3D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> array of 3 dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y','z') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case.    
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !> @date January, 2019
+   !> - decompose array conversion on each dimension
+   !> @date February, 2019
+   !> - add output name (to change name)
+   !>
+   !> @param[in] cd_name         variable name
+   !> @param[in] bd_value        3D array of integer(1) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] bd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @param[in] cd_namout       output name (renamed variable)
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i1)     , DIMENSION(:,:,:)   ,  INTENT(IN) :: bd_value
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:)       ,  INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i1)     ,                       INTENT(IN), OPTIONAL :: bd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_namout
+
+      ! function
+      TYPE(TVAR)                                         :: tf_var
+
+      ! local variable
+      INTEGER(i4)                                  :: il_type
+      INTEGER(i4), DIMENSION(3)                    :: il_shape
+
+      REAL(dp)                                     :: dl_fill
+      REAL(dp)   , DIMENSION(:,:,:)  , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(tf_var)      
+
+      il_type=NF90_BYTE
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_BYTE
+      IF( PRESENT(bd_fill) ) dl_fill=REAL(bd_fill,dp)
+
+      il_shape(:)=SHAPE(bd_value(:,:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+         &                il_shape(2), &
+         &                il_shape(3)) )
+
+      DO jk=1,il_shape(3)
+         DO jj=1,il_shape(2)
+            DO ji=1,il_shape(1)
+               dl_value(:,:,:)=REAL(bd_value(:,:,:),dp)
+            ENDDO
+         ENDDO
+      ENDDO
+
+      tf_var=var_init( cd_name, dl_value(:,:,:),           &
+         &             id_start=id_start,                  &
+         &             id_count=id_count,                  &
+         &             id_type=il_type,                    &
+         &             td_dim=td_dim, td_att=td_att,       &
+         &             dd_fill=dl_fill,                    &
+         &             cd_units=cd_units,                  &
+         &             cd_axis=cd_axis,                    &
+         &             cd_stdname=cd_stdname,              &
+         &             cd_longname=cd_longname,            &
+         &             cd_point=cd_point, id_id=id_id,     &
+         &             id_ew=id_ew, dd_scf=dd_scf,         &
+         &             dd_ofs=dd_ofs,  id_rec=id_rec,      &
+         &             dd_min=dd_min, dd_max=dd_max,       &
+         &             ld_contiguous=ld_contiguous,        &
+         &             ld_shuffle=ld_shuffle,              &
+         &             ld_fletcher32=ld_fletcher32,        &
+         &             id_deflvl=id_deflvl,                &
+         &             id_chunksz=id_chunksz(:),           &
+         &             cd_interp=cd_interp(:),             &
+         &             cd_extrap=cd_extrap(:),             &
+         &             cd_filter=cd_filter(:),             &
+         &             cd_unt=cd_unt, dd_unf=dd_unf,       &
+         &             cd_namout=cd_namout )
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_3D_i1
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__init_i1(cd_name, bd_value,                    &
+         &               id_start, id_count, id_type, td_dim,  &
+         &               td_att, bd_fill, cd_units, cd_axis,   &
+         &               cd_stdname, cd_longname,              &
+         &               cd_point, id_id, id_ew,               &
+         &               dd_scf, dd_ofs,  id_rec,              &
+         &               dd_min, dd_max,                       &
+         &               ld_contiguous, ld_shuffle,            &
+         &               ld_fletcher32, id_deflvl, id_chunksz, &
+         &               cd_interp, cd_extrap, cd_filter,      &
+         &               cd_unt, dd_unf,                       &
+         &               cd_namout) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function initialize a variable structure,
+   !> with a integer(1) 4D array of value.
+   !> @details 
+   !> optionally could be added:<br/>
+   !> - dimension structure.
+   !> - attribute structure.
+   !>
+   !> Dimension structure is needed to put value in variable structure. 
+   !> If none is given, we assume array is ordered as ('x','y','z','t') and we 
+   !> use array size as lentgh dimension. 
+   !>
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. Dimension structure is needed in that 
+   !> case. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015
+   !> - add interp, extrap, and filter argument
+   !> @date July, 2015
+   !> - add unit factor (to change unit)
+   !> @date January, 2019
+   !> - decompose array conversion on each dimension
+   !> @date February, 2019
+   !> - add output name (to change name)
+   !>
+   !> @param[in] cd_name         variable name
+   !> @param[in] bd_value        4D array of integer(1) value
+   !> @param[in] id_start        index in the variable from which the 
+   !> data values will be read
+   !> @param[in] id_count        number of indices selected along 
+   !> each dimension
+   !> @param[in] id_type         variable type 
+   !> @param[in] td_dim          array of dimension structure
+   !> @param[in] td_att          array of attribute structure
+   !> @param[in] bd_fill         fill value
+   !> @param[in] cd_units        units
+   !> @param[in] cd_axis         axis expected to be used
+   !> @param[in] cd_stdname      variable standard name
+   !> @param[in] cd_longname     variable long name
+   !> @param[in] cd_point        point on Arakawa-C grid (T,U,V,F)
+   !> @param[in] id_id           variable id
+   !> @param[in] id_ew           east west wrap
+   !> @param[in] dd_scf          scale factor
+   !> @param[in] dd_ofs          add offset
+   !> @param[in] id_rec          record id (for rstdimg file)
+   !> @param[in] dd_min          minimum value
+   !> @param[in] dd_max          maximum value
+   !> @param[in] ld_contiguous   use contiguous storage or not 
+   !> @param[in] ld_shuffle       shuffle filter is turned on or not
+   !> @param[in] ld_fletcher32   fletcher32 filter is turned on or not
+   !> @param[in] id_deflvl       deflate level from 0 to 9, 0 indicates no 
+   !> deflation is in use
+   !> @param[in] id_chunksz      chunk size
+   !> @param[in] cd_interp       interpolation method
+   !> @param[in] cd_extrap       extrapolation method
+   !> @param[in] cd_filter       filter method
+   !> @param[in] cd_unt          new units (linked to units factor)
+   !> @param[in] dd_unf          units factor
+   !> @param[in] cd_namout       output name (renamed variable)
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*),                       INTENT(IN) :: cd_name
+      INTEGER(i1)     , DIMENSION(:,:,:,:),   INTENT(IN) :: bd_value
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_type 
+      TYPE(TDIM)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_dim
+      TYPE(TATT)      , DIMENSION(:),         INTENT(IN), OPTIONAL :: td_att
+      INTEGER(i1)     ,                       INTENT(IN), OPTIONAL :: bd_fill
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_units
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_axis 
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_stdname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_longname
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_point
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_id 
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_ew 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_scf
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_ofs
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_rec 
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_min
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_max
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_contiguous
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_shuffle
+      LOGICAL         ,                       INTENT(IN), OPTIONAL :: ld_fletcher32
+      INTEGER(i4)     ,                       INTENT(IN), OPTIONAL :: id_deflvl
+      INTEGER(i4)     , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
+      CHARACTER(LEN=*), DIMENSION(2)        , INTENT(IN), OPTIONAL :: cd_interp
+      CHARACTER(LEN=*), DIMENSION(1)        , INTENT(IN), OPTIONAL :: cd_extrap
+      CHARACTER(LEN=*), DIMENSION(5)        , INTENT(IN), OPTIONAL :: cd_filter
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_unt
+      REAL(dp)        ,                       INTENT(IN), OPTIONAL :: dd_unf
+      CHARACTER(LEN=*),                       INTENT(IN), OPTIONAL :: cd_namout
+
+      ! function
+      TYPE(TVAR)                                         :: tf_var
+
+      ! local variable
+      INTEGER(i4)                                       :: il_type
+      INTEGER(i4), DIMENSION(ip_maxdim)                 :: il_shape
+
+      REAL(dp)                                          :: dl_fill
+      REAL(dp)        , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      ! clean variable
+      CALL var_clean(tf_var)      
+
+      il_type=NF90_BYTE
+      IF( PRESENT(id_type) ) il_type=id_type
+
+      dl_fill=NF90_FILL_BYTE
+      IF( PRESENT(bd_fill) ) dl_fill=REAL(bd_fill,dp)
+
+      il_shape(:)=SHAPE(bd_value(:,:,:,:))
+
+      ALLOCATE( dl_value( il_shape(1), &
+         &                il_shape(2), &
+         &                il_shape(3), &
+         &                il_shape(4)) )
+
+      DO jl=1,il_shape(4)
+         DO jk=1,il_shape(3)
+            DO jj=1,il_shape(2)
+               DO ji=1,il_shape(1)
+                  dl_value(ji,jj,jk,jl)=REAL(bd_value(ji,jj,jk,jl),dp)
+               ENDDO
+            ENDDO
+         ENDDO
+      ENDDO
+
+      tf_var=var_init( cd_name, dl_value(:,:,:,:),         &
+         &             id_start=id_start,                  &
+         &             id_count=id_count,                  &
+         &             id_type=il_type,                    &
+         &             td_dim=td_dim, td_att=td_att,       &
+         &             dd_fill=dl_fill,                    &
+         &             cd_units=cd_units,                  &
+         &             cd_axis=cd_axis,                    &
+         &             cd_stdname=cd_stdname,              &
+         &             cd_longname=cd_longname,            &
+         &             cd_point=cd_point, id_id=id_id,     &
+         &             id_ew=id_ew, dd_scf=dd_scf,         &
+         &             dd_ofs=dd_ofs,  id_rec=id_rec,      &
+         &             dd_min=dd_min, dd_max=dd_max,       &
+         &             ld_contiguous=ld_contiguous,        &
+         &             ld_shuffle=ld_shuffle,              &
+         &             ld_fletcher32=ld_fletcher32,        &
+         &             id_deflvl=id_deflvl,                &
+         &             id_chunksz=id_chunksz(:),           &
+         &             cd_interp=cd_interp(:),             &
+         &             cd_extrap=cd_extrap(:),             &
+         &             cd_filter=cd_filter(:),             &
+         &             cd_unt=cd_unt, dd_unf=dd_unf,       &
+         &             cd_namout=cd_namout )
+      
+      DEALLOCATE( dl_value )
+      
+   END FUNCTION var__init_i1
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var_concat(td_var1, td_var2, id_dim) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief  This function concatenate variable value following id_dim direction.
+   !> 
+   !> @details
+   !> By default variable are concatenate following time dimension. To
+   !> concatenate following another dimension, specify id_dim=x where x is the
+   !> dimension number (jp_I, jp_J,jp_K, jp_L). 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_var1   variable structure
+   !> @param[in] td_var2   variable structure
+   !> @param[in] DIM       dimension following which concatenate
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) , INTENT(IN) :: td_var1
+      TYPE(TVAR) , INTENT(IN) :: td_var2
+      INTEGER(i4), INTENT(IN), OPTIONAL :: id_dim
+
+      ! function
+      TYPE(TVAR)              :: tf_var
+
+      ! local variable
+      INTEGER(i4) :: il_dim
+      !----------------------------------------------------------------
+      il_dim=4
+      IF( PRESENT(id_dim) ) il_dim=id_dim
+
+      IF( .NOT. ASSOCIATED(td_var1%d_value) )THEN
+         CALL logger_error("VAR CONCAT: no value associated to variable "//&
+            &  TRIM(td_var1%c_name) )
+      ELSEIF( .NOT. ASSOCIATED(td_var2%d_value) )THEN
+         CALL logger_error("VAR CONCAT: no value associated to variable "//&
+            &  TRIM(td_var2%c_name) )
+      ELSEIF( il_dim < 0 .OR. il_dim > 4 )THEN
+         CALL logger_error("VAR CONCAT: invalid concatenate dimension ")
+      ELSE
+         ! check other dimension
+         SELECT CASE(il_dim)
+         CASE(jp_I)
+            tf_var=var__concat_i(td_var1, td_var2)
+         CASE(jp_J)
+            tf_var=var__concat_j(td_var1, td_var2)
+         CASE(jp_K)
+            tf_var=var__concat_k(td_var1, td_var2)
+         CASE(jp_L)
+            tf_var=var__concat_l(td_var1, td_var2)
+         END SELECT
+      ENDIF
+
+   END FUNCTION var_concat
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__concat_i(td_var1, td_var2) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief  This function concatenate variable value following i-direction.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2019
+   !> - decompose array copy on each dimension
+   !>
+   !> @param[in] td_var1   variable structure
+   !> @param[in] td_var2   variable structure
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) , INTENT(IN) :: td_var1
+      TYPE(TVAR) , INTENT(IN) :: td_var2
+
+      ! function
+      TYPE(TVAR)              :: tf_var
+
+      ! local variable
+      TYPE(TVAR)        :: tl_var
+      CHARACTER(LEN=lc) :: cl_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+      IF( .NOT. td_var1%t_dim(1)%l_use .OR. &
+         &.NOT. td_var1%t_dim(1)%l_use )THEN
+
+         CALL logger_error("VAR CONCAT: can not concatenate variable "//&
+            &              TRIM(td_var1%c_name)//" on an unused dimension I")
+   
+      ELSEIF( ANY(td_var1%t_dim(2:4)%i_len /=  td_var2%t_dim(2:4)%i_len) )THEN
+
+         cl_tmp='('//":"//","//&
+            &   TRIM(fct_str(td_var1%t_dim(2)%i_len))//','//&
+            &   TRIM(fct_str(td_var1%t_dim(3)%i_len))//','//&
+            &   TRIM(fct_str(td_var1%t_dim(4)%i_len))//')'
+         CALL logger_debug("VAR CONCAT: first variable dimensions "//&
+            &   TRIM(cl_tmp) )
+         cl_tmp='('//":"//","//&
+            &   TRIM(fct_str(td_var2%t_dim(2)%i_len))//','//&
+            &   TRIM(fct_str(td_var2%t_dim(3)%i_len))//','//&
+            &   TRIM(fct_str(td_var2%t_dim(4)%i_len))//')'         
+         CALL logger_debug("VAR CONCAT: second variable dimensions "//&
+            &   TRIM(cl_tmp) )
+
+         CALL logger_error("VAR CONCAT: dimension not conform")
+
+      ELSE
+         tl_var=var_copy(td_var1)
+
+         DEALLOCATE(tl_var%d_value)
+         ! change dimension length
+         tl_var%t_dim(1)%i_len=td_var1%t_dim(1)%i_len+td_var2%t_dim(1)%i_len
+         
+         ALLOCATE(tl_var%d_value(tl_var%t_dim(1)%i_len, &
+            &                    tl_var%t_dim(2)%i_len, &
+            &                    tl_var%t_dim(3)%i_len, &
+            &                    tl_var%t_dim(4)%i_len) )
+
+         ! copy first variable value
+         DO jl=1,tl_var%t_dim(4)%i_len
+            DO jk=1,tl_var%t_dim(3)%i_len
+               DO jj=1,tl_var%t_dim(2)%i_len
+                  DO ji=1,td_var1%t_dim(1)%i_len
+                     tl_var%d_value(ji,jj,jk,jl) = td_var1%d_value(ji,jj,jk,jl)
+                  ENDDO
+               ENDDO
+            ENDDO
+         ENDDO
+         !            tl_var%d_value(1:td_var1%t_dim(1)%i_len,:,:,:) = &
+         !&  td_var1%d_value(:,:,:,:)
+
+         ! copy second variable value
+         DO jl=1,tl_var%t_dim(4)%i_len
+            DO jk=1,tl_var%t_dim(3)%i_len
+               DO jj=1,tl_var%t_dim(2)%i_len
+                  DO ji=1,td_var2%t_dim(1)%i_len
+                     tl_var%d_value(ji+td_var1%t_dim(1)%i_len,jj,jk,jl) = td_var2%d_value(ji,jj,jk,jl)
+                  ENDDO
+               ENDDO
+            ENDDO
+         ENDDO
+         !tl_var%d_value(td_var1%t_dim(1)%i_len+1:tl_var%t_dim(1)%i_len,:,:,:)=&
+         !&  td_var2%d_value(:,:,:,:)
+
+         ! save result
+         tf_var=var_copy(tl_var)
+
+         ! clean
+         CALL var_clean(tl_var)
+      ENDIF
+
+   END FUNCTION var__concat_i
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__concat_j(td_var1, td_var2) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief  This function concatenate variable value following j-direction.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2019
+   !> - decompose array copy on each dimension
+   !>
+   !> @param[in] td_var1   variable structure
+   !> @param[in] td_var2   variable structure
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) , INTENT(IN) :: td_var1
+      TYPE(TVAR) , INTENT(IN) :: td_var2
+
+      ! function
+      TYPE(TVAR)              :: tf_var
+
+      ! local variable
+      TYPE(TVAR)        :: tl_var
+      CHARACTER(LEN=lc) :: cl_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+      IF( .NOT. td_var1%t_dim(2)%l_use .OR. &
+      &   .NOT. td_var1%t_dim(2)%l_use )THEN
+
+         CALL logger_error("VAR CONCAT: can not concatenate variable "//&
+         &  TRIM(td_var1%c_name)//" on an unused dimension J")      
+
+      ELSEIF(     td_var1%t_dim(1)%i_len   /=  td_var2%t_dim(1)%i_len  .OR. &
+      &   ANY(td_var1%t_dim(3:4)%i_len /=  td_var2%t_dim(3:4)%i_len) )THEN
+
+         cl_tmp='('//&
+            &    TRIM(fct_str(td_var1%t_dim(1)%i_len))//','//&
+            &    ":"//','//&
+            &    TRIM(fct_str(td_var1%t_dim(3)%i_len))//','//&
+            &    TRIM(fct_str(td_var1%t_dim(4)%i_len))//')'
+         CALL logger_debug("VAR CONCAT: first variable dimensions "//&
+            &    TRIM(cl_tmp) )
+         cl_tmp='('//&
+            &    TRIM(fct_str(td_var1%t_dim(1)%i_len))//','//&
+            &    ":"//','//&
+            &    TRIM(fct_str(td_var2%t_dim(3)%i_len))//','//&
+            &    TRIM(fct_str(td_var2%t_dim(4)%i_len))//')'         
+         CALL logger_debug("VAR CONCAT: second variable dimensions "//&
+            &    TRIM(cl_tmp) )
+
+         CALL logger_error("VAR CONCAT: dimension not conform")
+
+      ELSE
+         tl_var=var_copy(td_var1)
+
+         DEALLOCATE(tl_var%d_value)
+         ! change dimension length
+         tl_var%t_dim(2)%i_len=td_var1%t_dim(2)%i_len+td_var2%t_dim(2)%i_len
+         
+         ALLOCATE(tl_var%d_value(tl_var%t_dim(1)%i_len, &
+            &                    tl_var%t_dim(2)%i_len, &
+            &                    tl_var%t_dim(3)%i_len, &
+            &                    tl_var%t_dim(4)%i_len) )
+
+         ! copy first variable value
+         DO jl=1,tl_var%t_dim(4)%i_len
+            DO jk=1,tl_var%t_dim(3)%i_len
+               DO jj=1,td_var1%t_dim(2)%i_len
+                  DO ji=1,tl_var%t_dim(1)%i_len
+                     tl_var%d_value(ji,jj,jk,jl) = td_var1%d_value(ji,jj,jk,jl)
+                  ENDDO
+               ENDDO
+            ENDDO
+         ENDDO
+         !         tl_var%d_value(:,1:td_var1%t_dim(2)%i_len,:,:)= &
+         !&  td_var1%d_value(:,:,:,:)
+
+         ! copy second variable value
+         DO jl=1,tl_var%t_dim(4)%i_len
+            DO jk=1,tl_var%t_dim(3)%i_len
+               DO jj=1,td_var2%t_dim(2)%i_len
+                  DO ji=1,tl_var%t_dim(1)%i_len
+                     tl_var%d_value(ji,jj+td_var2%t_dim(2)%i_len,jk,jl) = td_var2%d_value(ji,jj,jk,jl)
+                  ENDDO
+               ENDDO
+            ENDDO
+         ENDDO    
+         !         tl_var%d_value(:,td_var1%t_dim(2)%i_len+1:tl_var%t_dim(2)%i_len,:,:)=&
+         !&  td_var2%d_value(:,:,:,:)
+
+         ! save result
+         tf_var=var_copy(tl_var)
+
+         ! clean
+         CALL var_clean(tl_var)
+      ENDIF
+
+   END FUNCTION var__concat_j
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__concat_k(td_var1, td_var2) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief  This function concatenate variable value following k-direction.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2019
+   !> - decompose array copy on each dimension
+   !
+   !> @param[in] td_var1   variable structure
+   !> @param[in] td_var2   variable structure
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) , INTENT(IN) :: td_var1
+      TYPE(TVAR) , INTENT(IN) :: td_var2
+
+      ! function
+      TYPE(TVAR)              :: tf_var
+
+      ! local variable
+      TYPE(TVAR)        :: tl_var
+      CHARACTER(LEN=lc) :: cl_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+      IF( .NOT. td_var1%t_dim(3)%l_use .OR. &
+      &   .NOT. td_var1%t_dim(3)%l_use )THEN
+
+         CALL logger_error("VAR CONCAT: can not concatenate variable "//&
+         &  TRIM(td_var1%c_name)//" on an unused dimension K")      
+
+      ELSEIF(     td_var1%t_dim(4)%i_len   /=  td_var2%t_dim(4)%i_len  .OR. &
+      &   ANY(td_var1%t_dim(1:2)%i_len /=  td_var2%t_dim(1:2)%i_len) )THEN
+
+         cl_tmp='('//&
+            &    TRIM(fct_str(td_var1%t_dim(1)%i_len))//','//&
+            &    TRIM(fct_str(td_var1%t_dim(2)%i_len))//','//&
+            &    ":"//','//&
+            &    TRIM(fct_str(td_var1%t_dim(4)%i_len))//')'
+         CALL logger_debug("VAR CONCAT: first variable dimensions "//&
+            &    TRIM(cl_tmp) )
+         cl_tmp='('//&
+            &    TRIM(fct_str(td_var1%t_dim(1)%i_len))//','//&
+            &    TRIM(fct_str(td_var2%t_dim(2)%i_len))//','//&
+            &    ":"//','//&
+            &    TRIM(fct_str(td_var2%t_dim(4)%i_len))//')'         
+         CALL logger_debug("VAR CONCAT: second variable dimensions "//&
+            &    TRIM(cl_tmp) )
+
+         CALL logger_error("VAR CONCAT: dimension not conform")
+
+      ELSE
+         tl_var=var_copy(td_var1)
+
+         DEALLOCATE(tl_var%d_value)
+         ! change dimension length
+         tl_var%t_dim(3)%i_len=td_var1%t_dim(3)%i_len+td_var2%t_dim(3)%i_len
+         
+         ALLOCATE(tl_var%d_value(tl_var%t_dim(1)%i_len, &
+            &                    tl_var%t_dim(2)%i_len, &
+            &                    tl_var%t_dim(3)%i_len, &
+            &                    tl_var%t_dim(4)%i_len) )
+
+         ! copy first variable value
+         DO jl=1,tl_var%t_dim(4)%i_len
+            DO jk=1,td_var1%t_dim(3)%i_len
+               DO jj=1,tl_var%t_dim(2)%i_len
+                  DO ji=1,tl_var%t_dim(1)%i_len
+                     tl_var%d_value(ji,jj,jk,jl) = td_var1%d_value(ji,jj,jk,jl)
+                  ENDDO
+               ENDDO
+            ENDDO
+         ENDDO
+         !tl_var%d_value(:,:,1:td_var1%t_dim(3)%i_len,:)= &
+         ! &  td_var1%d_value(:,:,:,:)
+
+         ! copy second variable value
+         DO jl=1,tl_var%t_dim(4)%i_len
+            DO jk=1,td_var2%t_dim(3)%i_len
+               DO jj=1,tl_var%t_dim(2)%i_len
+                  DO ji=1,tl_var%t_dim(1)%i_len
+                     tl_var%d_value(ji,jj,jk+td_var1%t_dim(3)%i_len,jl) = td_var2%d_value(ji,jj,jk,jl)
+                  ENDDO
+               ENDDO
+            ENDDO
+         ENDDO
+         !tl_var%d_value(:,:,td_var1%t_dim(3)%i_len+1:tl_var%t_dim(3)%i_len,:)=&
+         !&  td_var2%d_value(:,:,:,:)
+
+         ! save result
+         tf_var=var_copy(tl_var)
+
+         ! clean
+         CALL var_clean(tl_var)
+      ENDIF
+
+   END FUNCTION var__concat_k
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__concat_l(td_var1, td_var2) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief  This function concatenate variable value following l-direction.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2019
+   !> - decompose array copy on each dimension
+   !>
+   !> @param[in] td_var1   variable structure
+   !> @param[in] td_var2   variable structure
+   !> @return variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR) , INTENT(IN) :: td_var1
+      TYPE(TVAR) , INTENT(IN) :: td_var2
+
+      ! function
+      TYPE(TVAR)              :: tf_var
+
+      ! local variable
+      TYPE(TVAR)        :: tl_var
+      CHARACTER(LEN=lc) :: cl_tmp
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+      IF( .NOT. td_var1%t_dim(4)%l_use .OR. &
+      &   .NOT. td_var1%t_dim(4)%l_use )THEN
+
+         CALL logger_error("VAR CONCAT: can not concatenate variable "//&
+         &  TRIM(td_var1%c_name)//" on an unused dimension L")      
+
+      ELSEIF( ANY(td_var1%t_dim(1:3)%i_len /=  td_var2%t_dim(1:3)%i_len) )THEN
+
+         cl_tmp='('//&
+            &    TRIM(fct_str(td_var1%t_dim(1)%i_len))//','//&
+            &    TRIM(fct_str(td_var1%t_dim(2)%i_len))//','//&
+            &    TRIM(fct_str(td_var1%t_dim(3)%i_len))//','//&
+            &    ":"//','//')'
+         CALL logger_debug("VAR CONCAT: first variable dimensions "//&
+            &   TRIM(cl_tmp) )
+         cl_tmp='('//&
+            &    TRIM(fct_str(td_var1%t_dim(1)%i_len))//','//&
+            &    TRIM(fct_str(td_var2%t_dim(2)%i_len))//','//&
+            &    TRIM(fct_str(td_var2%t_dim(3)%i_len))//','//&
+            &    ":"//','//')'         
+         CALL logger_debug("VAR CONCAT: second variable dimensions "//&
+            &    TRIM(cl_tmp) )
+
+         CALL logger_error("VAR CONCAT: dimension not conform")
+
+      ELSE
+         tl_var=var_copy(td_var1)
+
+         DEALLOCATE(tl_var%d_value)
+         ! change dimension length
+         tl_var%t_dim(4)%i_len=td_var1%t_dim(4)%i_len+td_var2%t_dim(4)%i_len
+         
+         ALLOCATE(tl_var%d_value(tl_var%t_dim(1)%i_len, &
+            &                    tl_var%t_dim(2)%i_len, &
+            &                    tl_var%t_dim(3)%i_len, &
+            &                    tl_var%t_dim(4)%i_len) )
+
+         ! copy first variable value
+         DO jl=1,td_var1%t_dim(4)%i_len
+            DO jk=1,tl_var%t_dim(3)%i_len
+               DO jj=1,tl_var%t_dim(2)%i_len
+                  DO ji=1,tl_var%t_dim(1)%i_len
+                     tl_var%d_value(ji,jj,jk,jl) = td_var1%d_value(ji,jj,jk,jl)
+                  ENDDO
+               ENDDO
+            ENDDO
+         ENDDO
+         !tl_var%d_value(:,:,1:td_var1%t_dim(4)%i_len,:)= &
+         !&  td_var1%d_value(:,:,:,:)
+
+         ! copy second variable value
+         DO jl=1,td_var2%t_dim(4)%i_len
+            DO jk=1,tl_var%t_dim(3)%i_len
+               DO jj=1,tl_var%t_dim(2)%i_len
+                  DO ji=1,tl_var%t_dim(1)%i_len
+                     tl_var%d_value(ji,jj,jk,jl+td_var2%t_dim(4)%i_len) = td_var2%d_value(ji,jj,jk,jl)
+                  ENDDO
+               ENDDO
+            ENDDO
+         ENDDO
+         !tl_var%d_value(:,:,td_var1%t_dim(4)%i_len+1:tl_var%t_dim(4)%i_len,:)=&
+         !&  td_var2%d_value(:,:,:,:)
+
+         ! save result
+         tf_var=var_copy(tl_var)
+
+         ! clean
+         CALL var_clean(tl_var)
+      ENDIF
+
+   END FUNCTION var__concat_l
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var__add_att_arr(td_var, td_att)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add an array of attribute structure 
+   !> in a variable structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - add all element of the array in the same time
+   !> @date January, 2019
+   !> - deallocate attribute strucure whatever happens
+   !>
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_att    array of attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR),               INTENT(INOUT) :: td_var
+      TYPE(TATT), DIMENSION(:), INTENT(IN)    :: td_att
+
+      ! local variable
+      INTEGER(i4) :: il_natt
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_ind
+      TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      il_natt=SIZE(td_att(:))
+
+      IF( td_var%i_natt > 0 )THEN
+      ! already other attribute in variable structure
+         ALLOCATE( tl_att(td_var%i_natt), stat=il_status )
+         IF(il_status /= 0 )THEN
+
+            CALL logger_error( &
+               &  " VAR ADD ATT: not enough space to put attributes from "//&
+               &  TRIM(td_var%c_name)//" in temporary attribute structure")
+
+         ELSE
+
+            ! save temporary global attribute's variable structure
+            tl_att(:)=att_copy(td_var%t_att(:))
+
+            CALL att_clean(td_var%t_att(:))
+            DEALLOCATE( td_var%t_att )
+            ALLOCATE( td_var%t_att(td_var%i_natt+il_natt), stat=il_status )
+            IF(il_status /= 0 )THEN
+
+               CALL logger_error( &
+                  &  " VAR ADD ATT: not enough space to put attributes "//&
+                  &  "in variable structure "//TRIM(td_var%c_name) )
+
+            ENDIF
+
+            ! copy attribute in variable before
+            td_var%t_att(1:td_var%i_natt)=att_copy(tl_att(:))
+
+            ! clean
+            CALL att_clean(tl_att(:))
+         ENDIF
+         DEALLOCATE(tl_att)
+
+      ELSE
+      ! no attribute in variable structure
+         IF( ASSOCIATED(td_var%t_att) )THEN
+            CALL att_clean(td_var%t_att(:))
+            DEALLOCATE(td_var%t_att)
+         ENDIF
+         ALLOCATE( td_var%t_att(td_var%i_natt+il_natt), stat=il_status )
+         IF(il_status /= 0 )THEN
+
+            CALL logger_error( &
+               &  " VAR ADD ATT: not enough space to put attributes "//&
+               &  "in variable structure "//TRIM(td_var%c_name) )
+
+         ENDIF
+      ENDIF
+
+      ALLOCATE( tl_att(il_natt) )
+      tl_att(:)=att_copy(td_att(:))
+
+      ! check if attribute already in variable structure
+      DO ji=1,il_natt
+         il_ind=0
+         il_ind=att_get_index( td_var%t_att(:), tl_att(ji)%c_name )
+         IF( il_ind /= 0 )THEN
+            CALL logger_error( &
+               &  " VAR ADD ATT: attribute "//TRIM(tl_att(ji)%c_name)//&
+               &  ", already in variable "//TRIM(td_var%c_name) )
+            CALL att_clean(tl_att(ji))
+         ENDIF
+      ENDDO
+
+      ! add new attributes
+      td_var%t_att(td_var%i_natt+1:td_var%i_natt+il_natt)=att_copy(tl_att(:))
+
+      DEALLOCATE(tl_att)
+
+      DO ji=1,il_natt
+         ! highlight some attribute
+         IF( ASSOCIATED(td_var%t_att(td_var%i_natt+ji)%d_value) .OR. &
+           & td_var%t_att(td_var%i_natt+ji)%c_value /= 'none' )THEN
+            SELECT CASE(TRIM(td_var%t_att(td_var%i_natt+ji)%c_name))
+
+               CASE("add_offset")
+                  td_var%d_ofs = td_var%t_att(td_var%i_natt+ji)%d_value(1)
+               CASE("scale_factor")
+                  td_var%d_scf = td_var%t_att(td_var%i_natt+ji)%d_value(1)
+               CASE("_FillValue")
+                  td_var%d_fill = td_var%t_att(td_var%i_natt+ji)%d_value(1)
+               CASE("ew_overlap")
+                  td_var%i_ew = INT(td_var%t_att(td_var%i_natt+ji)%d_value(1),i4) 
+               CASE("standard_name")
+                  td_var%c_stdname = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value)
+               CASE("long_name")
+                  td_var%c_longname = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value)
+               CASE("units")
+                  td_var%c_units = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value)
+               CASE("grid_point")
+                  td_var%c_point = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value)
+
+            END SELECT
+         ENDIF
+      ENDDO
+
+      ! update number of attribute
+      td_var%i_natt=td_var%i_natt+il_natt
+
+
+   END SUBROUTINE var__add_att_arr
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var__add_att_unit(td_var, td_att)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add an attribute structure 
+   !> in a variable structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - use var__add_att_arr subroutine
+   !> @date January, 2019
+   !> - clean attribute strucure
+   !>
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_att    attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+      TYPE(TATT), INTENT(IN)    :: td_att
+
+      ! local variable
+      TYPE(TATT), DIMENSION(1) :: tl_att
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! copy structure in an array
+      tl_att(1)=att_copy(td_att)
+
+      ! 
+      CALL var_add_att( td_var, tl_att(:) )
+
+      ! clean
+      CALL att_clean(tl_att)
+
+   END SUBROUTINE var__add_att_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var__del_att_name(td_var, cd_name)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine delete an attribute 
+   !> from variable structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date February, 2015 
+   !> - define local attribute structure to avoid mistake 
+   !> with pointer
+   !> @date January, 2019
+   !> - clean attribute strucure
+   !>
+   !> @param[inout] td_var variable structure
+   !> @param[in] cd_name   attribute name
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR)      , INTENT(INOUT) :: td_var
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+
+      ! local variable
+      INTEGER(i4) :: il_ind
+
+      TYPE(TATT)  :: tl_att
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! check if attribute already in variable structure
+      il_ind=0
+      IF( ASSOCIATED(td_var%t_att) )THEN
+         il_ind=att_get_index( td_var%t_att(:), TRIM(cd_name) )
+      ENDIF
+
+      IF( il_ind == 0 )THEN
+
+         CALL logger_debug( &
+         &  " VAR DEL ATT: no attribute "//TRIM(cd_name)//&
+         &  ", in variable "//TRIM(td_var%c_name) )
+
+      ELSE
+         
+         tl_att=att_copy(td_var%t_att(il_ind))
+         CALL var_del_att(td_var, tl_att)
+         ! clean
+         CALL att_clean(tl_att)
+      ENDIF
+
+   END SUBROUTINE var__del_att_name
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var__del_att_str(td_var, td_att)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine delete an attribute 
+   !> from variable structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013- Initial Version
+   !> @date February, 2015 
+   !> - delete highlight attribute too, when attribute 
+   !> is deleted
+   !>
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_att    attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+      TYPE(TATT), INTENT(IN)    :: td_att
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      INTEGER(i4) :: il_ind
+      TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      ! check if attribute already in variable structure
+      il_ind=0
+      IF( ASSOCIATED(td_var%t_att) )THEN
+         il_ind=att_get_index( td_var%t_att(:), td_att%c_name )
+      ENDIF
+
+      IF( il_ind == 0 )THEN
+
+         CALL logger_debug( &
+         &  " VAR DEL ATT: no attribute "//TRIM(td_att%c_name)//&
+         &  ", in variable "//TRIM(td_var%c_name) )
+
+      ELSE
+         
+         CALL logger_trace( &
+         &  " VAR DEL ATT: del attribute "//TRIM(td_att%c_name)//&
+         &  ", in var "//TRIM(td_var%c_name) )
+
+         IF( td_var%i_natt == 1 )THEN
+
+            CALL att_clean(td_var%t_att(:))
+            DEALLOCATE(td_var%t_att)
+
+            ! new number of attribute in variable
+            td_var%i_natt=td_var%i_natt-1
+
+         ELSE
+            ALLOCATE( tl_att(td_var%i_natt-1), stat=il_status )
+            IF(il_status /= 0 )THEN
+
+               CALL logger_error( &
+               &  " VAR ADD ATT: not enough space to put attributes from "//&
+               &  TRIM(td_var%c_name)//" in temporary attribute structure")
+
+            ELSE
+
+               ! save temporary global attribute's variable structure
+               tl_att(1:il_ind-1)=att_copy(td_var%t_att(1:il_ind-1))
+               IF( il_ind < td_var%i_natt )THEN
+                  tl_att(il_ind:)=att_copy(td_var%t_att(il_ind+1:))
+               ENDIF
+
+               CALL att_clean(td_var%t_att(:))
+               DEALLOCATE( td_var%t_att )
+
+               ! new number of attribute in variable
+               td_var%i_natt=td_var%i_natt-1
+
+               ALLOCATE( td_var%t_att(td_var%i_natt), stat=il_status )
+               IF(il_status /= 0 )THEN
+
+                  CALL logger_error( &
+                  &  " VAR ADD ATT: not enough space to put attributes "//&
+                  &  "in variable structure "//TRIM(td_var%c_name) )
+
+               ENDIF
+
+               ! copy attribute in variable before
+               td_var%t_att(1:td_var%i_natt)=att_copy(tl_att(:))
+
+               ! clean
+               CALL att_clean(tl_att(:))
+            ENDIF 
+            DEALLOCATE(tl_att)
+         ENDIF
+
+         ! highlight attribute
+         SELECT CASE( TRIM(td_att%c_name) )
+
+            CASE("add_offset")
+               td_var%d_ofs = 0._dp
+            CASE("scale_factor")
+               td_var%d_scf = 1._dp
+            CASE("_FillValue")
+               td_var%d_fill = 0._dp
+            CASE("ew_overlap")
+               td_var%i_ew = -1 
+            CASE("standard_name")
+               td_var%c_stdname = ''
+            CASE("long_name")
+               td_var%c_longname = ''
+            CASE("units")
+               td_var%c_units = ''
+            CASE("grid_point")
+               td_var%c_point = ''
+
+         END SELECT
+
+      ENDIF
+
+   END SUBROUTINE var__del_att_str
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var_move_att(td_var, td_att)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine move an attribute structure 
+   !> from variable structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_att    attribute structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+      TYPE(TATT), INTENT(IN)    :: td_att
+
+      ! local variable
+      TYPE(TATT) :: tl_att
+
+      !----------------------------------------------------------------
+      ! copy attribute
+      tl_att=att_copy(td_att)
+
+      ! remove attribute with same name
+      CALL var_del_att(td_var, tl_att)
+
+      ! add new attribute
+      CALL var_add_att(td_var, tl_att)
+
+      ! clean
+      CALL att_clean(tl_att)
+
+   END SUBROUTINE var_move_att
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var__add_dim_arr(td_var, td_dim)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add an array of dimension structure in a variable 
+   !> structure.
+   !> - number of dimension in variable can't be greater than 4
+   !> - dimension can't be already uses in variable structure
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_dim    dimension structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR),               INTENT(INOUT) :: td_var
+      TYPE(TDIM), DIMENSION(:), INTENT(IN)    :: td_dim
+
+      ! local variable
+      INTEGER(i4) :: il_ndim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      il_ndim=SIZE(td_dim(:))
+      IF( il_ndim <= ip_maxdim )THEN
+
+         DO ji=1,il_ndim
+            CALL var_add_dim(td_var, td_dim(ji))
+         ENDDO
+
+      ELSE
+         CALL logger_error( &
+         &  " VAR ADD DIM: too much dimension to put in structure "//&
+         &  "("//TRIM(fct_str(il_ndim))//")" )
+      ENDIF
+
+   END SUBROUTINE var__add_dim_arr
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var__add_dim_unit(td_var, td_dim) 
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add one dimension in a variable 
+   !> structure.
+   !> @details
+   !> - number of dimension in variable can't be greater than 4
+   !> - dimension can't be already uses in variable structure 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_dim    dimension structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR)      , INTENT(INOUT) :: td_var
+      TYPE(TDIM)      , INTENT(IN   ) :: td_dim
+
+      ! local variable
+      INTEGER(i4) :: il_ind
+      !----------------------------------------------------------------
+
+      IF( td_var%i_ndim <= ip_maxdim )THEN
+
+         ! check if dimension already used in variable structure
+         il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname))
+         IF( il_ind == 0 )THEN
+            CALL logger_warn( &
+            &  " VAR ADD DIM: dimension "//TRIM(td_dim%c_name)//&
+            &  ", short name "//TRIM(td_dim%c_sname)//&
+            &  ", will not be added in variable "//TRIM(td_var%c_name) )
+         ELSEIF( td_var%t_dim(il_ind)%l_use )THEN
+            CALL logger_error( &
+            &  " VAR ADD DIM: dimension "//TRIM(td_dim%c_name)//&
+            &  ", short name "//TRIM(td_dim%c_sname)//&
+            &  ", already used in variable "//TRIM(td_var%c_name) )
+         ELSE
+
+            ! back to disorder dimension array 
+            CALL dim_disorder(td_var%t_dim(:))
+
+            ! add new dimension
+            td_var%t_dim(td_var%i_ndim+1)=dim_copy(td_dim)
+
+            ! update number of attribute
+            td_var%i_ndim=COUNT(td_var%t_dim(:)%l_use)
+
+         ENDIF
+         ! reorder dimension to ('x','y','z','t')
+         CALL dim_reorder(td_var%t_dim(:))
+
+      ELSE
+         CALL logger_error( &
+         &  " VAR ADD DIM: too much dimension in variable "//&
+         &  TRIM(td_var%c_name)//" ("//TRIM(fct_str(td_var%i_ndim))//")")
+      ENDIF
+
+   END SUBROUTINE var__add_dim_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var_del_dim(td_var, td_dim)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine delete a dimension structure in a variable 
+   !> structure.
+   !>
+   !> @warning delete variable value too.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_dim    dimension structure
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+      
+      ! Argument      
+      TYPE(TVAR)      , INTENT(INOUT) :: td_var
+      TYPE(TDIM)      , INTENT(IN   ) :: td_dim
+
+      ! local variable
+      INTEGER(i4) :: il_ind
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_shape
+
+      TYPE(TDIM)  :: tl_dim ! empty dimension structure
+      !----------------------------------------------------------------
+
+      IF( td_var%i_ndim <= ip_maxdim )THEN
+
+         CALL logger_trace( &
+         &  " VAR DEL DIM: delete dimension "//TRIM(td_dim%c_name)//&
+         &  ", short name "//TRIM(td_dim%c_sname)//&
+         &  ", in variable "//TRIM(td_var%c_name) )
+         
+         ! check if dimension already in variable structure
+         il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname))
+
+         ! replace dimension by empty one
+         td_var%t_dim(il_ind)=dim_copy(tl_dim)
+
+         ! update number of dimension
+         td_var%i_ndim=COUNT(td_var%t_dim(:)%l_use)
+
+         ! remove variable value using this dimension
+         IF( ASSOCIATED(td_var%d_value) )THEN
+            il_shape(:)=SHAPE(td_var%d_value(:,:,:,:))
+            IF(il_shape(il_ind)/=td_dim%i_len)THEN
+               CALL logger_warn("VAR DEL DIM: remove value of variable "//&
+               &  TRIM(td_var%c_name) )
+               CALL var_del_value(td_var)
+            ENDIF
+         ENDIF
+
+         ! reorder dimension to ('x','y','z','t')
+         CALL dim_reorder(td_var%t_dim)
+
+      ELSE
+         CALL logger_error( &
+         &  " VAR DEL DIM: too much dimension in variable "//&
+         &  TRIM(td_var%c_name)//" ("//TRIM(fct_str(td_var%i_ndim))//")")
+      ENDIF
+
+   END SUBROUTINE var_del_dim
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var_move_dim(td_var, td_dim)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine move a dimension structure 
+   !> in variable structure.
+   !>
+   !> @warning 
+   !> - dimension order could be changed
+   !> - delete variable value 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure
+   !> @param[in] td_dim    dimension structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR)      , INTENT(INOUT) :: td_var
+      TYPE(TDIM)      , INTENT(IN   ) :: td_dim
+
+      ! local variable
+      INTEGER(i4) :: il_ind
+      INTEGER(i4) :: il_dimid
+      !----------------------------------------------------------------
+
+      IF( td_var%i_ndim <= ip_maxdim )THEN
+
+         ! check if dimension already in mpp structure
+         il_ind=dim_get_index(td_var%t_dim(:), td_dim%c_name, td_dim%c_sname)
+         IF( il_ind /= 0 )THEN
+
+            il_dimid=td_var%t_dim(il_ind)%i_id
+            ! replace dimension
+            td_var%t_dim(il_ind)=dim_copy(td_dim)
+            td_var%t_dim(il_ind)%i_id=il_dimid
+            td_var%t_dim(il_ind)%l_use=.TRUE.
+
+         ELSE
+            CALL var_add_dim(td_var, td_dim)
+         ENDIF
+
+      ELSE
+         CALL logger_error( &
+         &  "VAR MOVE DIM: too much dimension in variale "//&
+         &  TRIM(td_var%c_name)//" ("//TRIM(fct_str(td_var%i_ndim))//")")
+      ENDIF
+
+   END SUBROUTINE var_move_dim
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var__print_arr(td_var)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine print informations of an array of variables. 
+   !>
+   !> @author J.Paul
+   !> @date June, 2014 - Initial Version
+   !>
+   !> @param[in] td_var array of variables structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_var
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      DO ji=1,SIZE(td_var(:))
+         CALL var_print(td_var(ji))
+      ENDDO
+
+   END SUBROUTINE var__print_arr
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var__print_unit(td_var, ld_more)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine print variable information.</br/>
+   !> @details
+   !> If ld_more is TRUE (default), print information about variable dimensions
+   !> and variable attributes.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_var    variable structure
+   !> @param[in] ld_more   print more infomration about variable
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR), INTENT(IN) :: td_var
+      LOGICAL,    INTENT(IN), OPTIONAL :: ld_more
+
+      ! local vairbale
+      CHARACTER(LEN=lc) :: cl_type
+      REAL(dp)          :: dl_min
+      REAL(dp)          :: dl_max
+      LOGICAL           :: ll_more
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      ll_more=.TRUE.
+      IF( PRESENT(ld_more) )THEN
+         ll_more=ld_more
+      ENDIF
+
+      SELECT CASE( td_var%i_type )
+
+         CASE(NF90_CHAR)
+            cl_type='CHAR'
+         CASE(NF90_BYTE)
+            cl_type='BYTE'
+         CASE(NF90_SHORT)
+            cl_type='SHORT'
+         CASE(NF90_INT)
+            cl_type='INT'
+         CASE(NF90_FLOAT)
+            cl_type='FLOAT'
+         CASE(NF90_DOUBLE)
+            cl_type='DOUBLE'
+         CASE DEFAULT
+            !cl_type='unknown'
+            cl_type=''
+      END SELECT      
+
+      WRITE(*,'((/a,a),4(/3x,a,a),4(/3x,a,i3),&
+         &     (/3x,a,a),3(/3x,a,ES12.4))')&
+         &    " Variable : ",TRIM(td_var%c_name),    &
+         &    " standard name : ",TRIM(td_var%c_stdname), &
+         &    " long name     : ",TRIM(td_var%c_longname), &
+         &    " units         : ",TRIM(td_var%c_units),   &
+         &    " point         : ",TRIM(td_var%c_point),   &
+         &    " id            : ",td_var%i_id,            &
+         &    " rec           : ",td_var%i_rec,           &
+         &    " ndim          : ",td_var%i_ndim,          &
+         &    " natt          : ",td_var%i_natt,          &
+         &    " type          : ",TRIM(cl_type),          &
+         &    " scale factor  : ",td_var%d_scf,           &
+         &    " add offset    : ",td_var%d_ofs,           &
+         &    " _FillValue    : ",td_var%d_fill
+
+      IF( ASSOCIATED(td_var%d_value) )THEN
+         dl_min=MINVAL(td_var%d_value(:,:,:,:), &
+            &          mask=(td_var%d_value(:,:,:,:)/=td_var%d_fill) )&
+            &   *td_var%d_scf+td_var%d_ofs
+         dl_max=MAXVAL(td_var%d_value(:,:,:,:), &
+            &          mask=(td_var%d_value(:,:,:,:)/=td_var%d_fill) )&
+            &   *td_var%d_scf+td_var%d_ofs
+
+         WRITE(*,'((3x,a),2(/3x,a,ES12.4))')&
+            &     "VALUE ASSOCIATED" ,       &
+            &     " min value     : ",dl_min,&        
+            &     " max value     : ",dl_max
+      ENDIF      
+
+      IF( ll_more )THEN
+         ! print dimension
+         IF(  td_var%i_ndim /= 0 )THEN
+            WRITE(*,'(a)') " Variable dimension"
+            DO ji=1,ip_maxdim
+               IF( td_var%t_dim(ji)%l_use )THEN
+                  CALL dim_print(td_var%t_dim(ji))
+               ENDIF
+            ENDDO
+         ENDIF
+
+         ! print attribute
+         IF( td_var%i_natt /= 0 )THEN
+            WRITE(*,'(a)') " Variable attribute"
+            DO ji=1,td_var%i_natt
+               CALL att_print(td_var%t_att(ji))
+            ENDDO
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE var__print_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var__add_value(td_var, dd_value, id_start, id_count)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add a 4D array of real(8) value in a variable 
+   !> structure.
+   !>
+   !> @details 
+   !> indices in the variable where value will be written could be specify if
+   !> start and count array are given. 
+   !> @warning Dimension of the array must be ordered as ('x','y','z','t')
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2019
+   !> - decompose array copy on each dimension
+   !>
+   !> @param[inout] td_var variable structure
+   !> @param[in] dd_value  array of variable value
+   !> @param[in] id_start  index in the variable from which the data values 
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR),                        INTENT(INOUT) :: td_var
+      REAL(dp),    DIMENSION(:,:,:,:),   INTENT(IN)    :: dd_value
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_start
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_count
+
+      ! local variable
+      INTEGER(i4) :: il_status
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count
+      INTEGER(i4), DIMENSION(ip_maxdim) :: il_shape
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      ! check id_count and id_start optionals parameters...
+      IF( (       PRESENT(id_start)  .AND. (.NOT. PRESENT(id_count))) .OR. &
+          ((.NOT. PRESENT(id_start)) .AND.        PRESENT(id_count) ) )THEN
+         CALL logger_warn( &
+         &  " VAR ADD VALUE: id_start and id_count should be both specified")
+      ENDIF
+
+      IF( PRESENT(id_start).AND.PRESENT(id_count) )THEN
+
+         ! keep ordered array ('x','y','z','t')
+         il_start(:)=id_start(:)
+         il_count(:)=id_count(:)
+
+      ELSE
+
+         ! keep ordered array ('x','y','z','t')
+         il_start(:)=(/1,1,1,1/)
+         il_count(:)=td_var%t_dim(:)%i_len
+
+      ENDIF
+
+      ! check dimension of input array
+      il_shape(:)=SHAPE(dd_value(:,:,:,:))
+      IF(.NOT.ALL( il_count(:) == il_shape(:)) )THEN
+
+         CALL logger_debug(" ADD VALUE: check dimension order !!")
+         DO ji = 1, ip_maxdim
+            CALL logger_debug( &
+            &  " VAR ADD VALUE: count : "//TRIM(fct_str(il_count(ji)))//&
+            &  " array dimension : "//TRIM(fct_str(il_shape(ji))))
+         ENDDO
+         CALL logger_error( &
+         &  " VAR ADD VALUE: dimension of input array, and count array differ " )
+
+      ELSE
+
+         ! check dimension of variable
+         IF(.NOT.ALL(il_start(:)+il_count(:)-1 <= td_var%t_dim(:)%i_len) )THEN
+
+            CALL logger_debug(" VAR ADD VALUE: check dimension order !!")
+            DO ji = 1, ip_maxdim
+               CALL logger_debug( &
+               &  " VAR ADD VALUE: start ("//TRIM(fct_str(il_start(ji)))//") "//&
+               &  "+ count ("//TRIM(fct_str(il_count(ji)))//") "//&
+               &  "variable dimension "//TRIM(fct_str(td_var%t_dim(ji)%i_len)))
+            ENDDO
+
+            CALL logger_error( &
+            &  " VAR ADD VALUE: start + count exceed variable dimension bound. " )
+         ELSE
+
+            ! special case for scalar variable
+            IF( td_var%i_ndim == 0 )THEN
+               ! reorder dimension to ('x','y','z','t')
+               CALL dim_reorder(td_var%t_dim)
+            ENDIF
+
+            IF( ASSOCIATED(td_var%d_value) )THEN
+
+               CALL logger_warn( &
+               &  "VAR ADD VALUE: value already in variable "//&
+               &  TRIM(td_var%c_name)//&
+               &  " (standard name "//TRIM(td_var%c_stdname)//")" )
+
+            ELSE
+
+               ! Allocate space to hold variable value in structure
+               ALLOCATE(td_var%d_value( td_var%t_dim(1)%i_len, &
+                  &                     td_var%t_dim(2)%i_len, &
+                  &                     td_var%t_dim(3)%i_len, &
+                  &                     td_var%t_dim(4)%i_len),&
+                  &     stat=il_status)
+               IF(il_status /= 0 )THEN
+
+                 CALL logger_error( &
+                  &  " VAR ADD VALUE: not enough space to put variable "//&
+                  &  TRIM(td_var%c_name)//&
+                  &  " in variable structure")
+
+               ENDIF
+               
+               ! initialise array
+               CALL logger_trace( &
+                  & " VAR ADD VALUE: value in variable "//TRIM(td_var%c_name)//&
+                  & ", initialise to FillValue "//TRIM(fct_str(td_var%d_fill)) )
+               td_var%d_value(:,:,:,:)=td_var%d_fill
+
+            ENDIF
+
+            CALL logger_debug( &
+            &  " VAR ADD VALUE: put value in variable "//TRIM(td_var%c_name)//&
+            &  " (standard name "//TRIM(td_var%c_stdname)//")" )
+
+            ! put value in variable structure
+            DO jl=1,il_count(4)
+               DO jk=1,il_count(3)
+                  DO jj=1,il_count(2)
+                     DO ji=1,il_count(1)
+                        td_var%d_value(ji+il_start(1)-1, &
+                           &           jj+il_start(2)-1, &
+                           &           jk+il_start(3)-1, &
+                           &           jl+il_start(4)-1 ) = dd_value(ji,jj,jk,jl)
+                     ENDDO
+                  ENDDO
+               ENDDO
+            ENDDO
+
+!            td_var%d_value( il_start(1):il_start(1)+il_count(1)-1, &
+!            &               il_start(2):il_start(2)+il_count(2)-1, &
+!            &               il_start(3):il_start(3)+il_count(3)-1, &
+!            &               il_start(4):il_start(4)+il_count(4)-1 ) = dd_value(:,:,:,:)
+
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE var__add_value
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var__add_value_dp(td_var, dd_value, id_type, id_start, id_count)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add a 4D array of real(8) value in a variable 
+   !> structure. Dimension of the array must be ordered as ('x','y','z','t')
+   !>
+   !> @details 
+   !> Optionally, you could specify the type of the variable to be used (default real(8)),
+   !> and indices of the variable where value will be written with start and count array.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure
+   !> @param[in] dd_value  array of variable value
+   !> @param[in] id_type   type of the variable to be used (default real(8)) 
+   !> @param[in] id_start  start indices of the variable where data values 
+   !> will be written
+   !> @param[in] id_count  number of indices selected along each dimension
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR),                        INTENT(INOUT) :: td_var
+      REAL(dp),    DIMENSION(:,:,:,:),   INTENT(IN)    :: dd_value
+      INTEGER(i4),                       INTENT(IN),   OPTIONAL  :: id_type
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_start
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_count
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_type
+      !----------------------------------------------------------------
+
+      IF( PRESENT(id_type) )THEN
+         td_var%i_type=id_type
+
+         cl_type=''
+         SELECT CASE(td_var%i_type)
+         CASE(NF90_DOUBLE)
+            cl_type='DOUBLE'
+         CASE(NF90_FLOAT)
+            cl_type='FLOAT'
+         CASE(NF90_INT)
+            cl_type='INT'
+         CASE(NF90_SHORT)
+            cl_type='SHORT'
+         CASE(NF90_BYTE)
+            cl_type='BYTE'
+         END SELECT
+         CALL logger_trace("VAR ADD VALUE: "//TRIM(td_var%c_name)//&
+         &                " value will be saved as "//TRIM(cl_type)) 
+      ENDIF
+
+      CALL var__add_value(td_var, dd_value, id_start, id_count)
+
+   END SUBROUTINE var__add_value_dp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var__add_value_rp(td_var, rd_value, id_type, id_start, id_count)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add a 4D array of real(4) value in a variable 
+   !> structure. Dimension of the array must be ordered as ('x','y','z','t')
+   !>
+   !> @details 
+   !> Optionally, you could specify the type of the variable to be used (default real(4)),
+   !> and indices of the variable where value will be written with start and count array.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2019
+   !> - decompose array conversion on each dimension
+   !>
+   !> @param[inout] td_var variable structure
+   !> @param[in] rd_value  array of variable value
+   !> @param[in] id_type   type of the variable to be used (default real(4)) 
+   !> @param[in] id_start  start indices of the variable where data values 
+   !> will be written
+   !> @param[in] id_count  number of indices selected along each dimension
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR),                        INTENT(INOUT) :: td_var
+      REAL(sp),    DIMENSION(:,:,:,:),   INTENT(IN)    :: rd_value
+      INTEGER(i4),                       INTENT(IN),   OPTIONAL  :: id_type
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_start
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_count
+
+      ! local variable
+      CHARACTER(LEN=lc)                                    :: cl_type
+
+      INTEGER(i4)                                          :: il_status
+      INTEGER(i4)      , DIMENSION(ip_maxdim)              :: il_shape
+
+      REAL(dp)         , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      IF( PRESENT(id_type) )THEN
+         td_var%i_type=id_type
+
+         cl_type=''
+         SELECT CASE(td_var%i_type)
+         CASE(NF90_DOUBLE)
+            cl_type='DOUBLE'
+         CASE(NF90_FLOAT)
+            cl_type='FLOAT'
+         CASE(NF90_INT)
+            cl_type='INT'
+         CASE(NF90_SHORT)
+            cl_type='SHORT'
+         CASE(NF90_BYTE)
+            cl_type='BYTE'
+         END SELECT
+         CALL logger_trace("VAR ADD VALUE: "//TRIM(td_var%c_name)//&
+         &                " value will be saved as "//TRIM(cl_type)) 
+      ENDIF      
+
+      il_shape=SHAPE(rd_value)
+      ALLOCATE( dl_value(il_shape(1), il_shape(2), il_shape(3), il_shape(4)),&
+      &         stat=il_status)
+      IF(il_status /= 0 )THEN
+
+        CALL logger_error( &
+         &  " VAR ADD VALUE: not enough space to put variable "//&
+         &  TRIM(td_var%c_name)//&
+         &  " in variable structure")
+
+      ENDIF
+
+      DO jl=1,il_shape(4)
+         DO jk=1,il_shape(3)
+            DO jj=1,il_shape(2)
+               DO ji=1,il_shape(1)
+                  dl_value(ji,jj,jk,jl)=REAL(rd_value(ji,jj,jk,jl), dp)
+               ENDDO
+            ENDDO
+         ENDDO
+      ENDDO
+
+      CALL var__add_value(td_var, dl_value(:,:,:,:), id_start(:), id_count(:))
+
+      DEALLOCATE(dl_value)
+
+   END SUBROUTINE var__add_value_rp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var__add_value_i1(td_var, bd_value, id_type, id_start, id_count)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add a 4D array of integer(1) value in a variable 
+   !> structure. Dimension of the array must be ordered as ('x','y','z','t')
+   !>
+   !> @details 
+   !> Optionally, you could specify the type of the variable to be used (default integer(1)),
+   !> and indices of the variable where value will be written with start and count array.
+   !>
+   !> @note variable type is forced to BYTE
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2019
+   !> - decompose array conversion on each dimension
+   !>
+   !> @param[inout] td_var variabele structure
+   !> @param[in] bd_value  array of variable value
+   !> @param[in] id_type   type of the variable to be used (default integer(1)) 
+   !> @param[in] id_start  start indices of the variable where data values 
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR),                        INTENT(INOUT) :: td_var
+      INTEGER(i1), DIMENSION(:,:,:,:),   INTENT(IN)    :: bd_value
+      INTEGER(i4),                       INTENT(IN),   OPTIONAL  :: id_type
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_start
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_count
+
+      ! local variable
+      CHARACTER(LEN=lc)                                    :: cl_type
+
+      INTEGER(i4)                                          :: il_status
+      INTEGER(i4)      , DIMENSION(ip_maxdim)              :: il_shape
+
+      REAL(dp)         , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      IF( PRESENT(id_type) )THEN
+         td_var%i_type=id_type
+
+         cl_type=''
+         SELECT CASE(td_var%i_type)
+         CASE(NF90_DOUBLE)
+            cl_type='DOUBLE'
+         CASE(NF90_FLOAT)
+            cl_type='FLOAT'
+         CASE(NF90_INT)
+            cl_type='INT'
+         CASE(NF90_SHORT)
+            cl_type='SHORT'
+         CASE(NF90_BYTE)
+            cl_type='BYTE'
+         END SELECT
+         CALL logger_trace("VAR ADD VALUE: "//TRIM(td_var%c_name)//&
+         &                " value will be saved as "//TRIM(cl_type)) 
+      ENDIF
+
+      il_shape=SHAPE(bd_value)
+      ALLOCATE( dl_value(il_shape(1), il_shape(2), il_shape(3), il_shape(4)),&
+      &         stat=il_status)
+      IF(il_status /= 0 )THEN
+
+        CALL logger_error( &
+         &  " VAR ADD VALUE: not enough space to put variable "//&
+         &  TRIM(td_var%c_name)//&
+         &  " in variable structure")
+
+      ENDIF
+
+      DO jl=1,il_shape(4)
+         DO jk=1,il_shape(3)
+            DO jj=1,il_shape(2)
+               DO ji=1,il_shape(1)
+                  dl_value(ji,jj,jk,jl)=REAL(bd_value(ji,jj,jk,jl),dp)      
+               ENDDO
+            ENDDO
+         ENDDO
+      ENDDO
+
+      CALL var__add_value(td_var, dl_value(:,:,:,:), id_start(:), id_count(:))
+
+      DEALLOCATE(dl_value)
+
+   END SUBROUTINE var__add_value_i1
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var__add_value_i2(td_var, sd_value, id_type, id_start, id_count)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add a 4D array of integer(2) value in a variable 
+   !> structure. Dimension of the array must be ordered as ('x','y','z','t')
+   !>
+   !> @details 
+   !> Optionally, you could specify the type of the variable to be used (default integer(2)),
+   !> and indices of the variable where value will be written with start and count array.
+   !>
+   !> @note variable type is forced to SHORT
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2019
+   !> - decompose array conversion on each dimension
+   !>
+   !> @param[inout] td_var variabele structure
+   !> @param[in] sd_value  array of variable value
+   !> @param[in] id_type   type of the variable to be used (default integer(2)) 
+   !> @param[in] id_start  start indices of the variable where data values 
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR),                        INTENT(INOUT) :: td_var
+      INTEGER(i2), DIMENSION(:,:,:,:),   INTENT(IN)    :: sd_value
+      INTEGER(i4),                       INTENT(IN),   OPTIONAL  :: id_type
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_start
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_count
+
+      ! local variable
+      CHARACTER(LEN=lc)                                    :: cl_type
+
+      INTEGER(i4)                                          :: il_status
+      INTEGER(i4)      , DIMENSION(ip_maxdim)              :: il_shape
+
+      REAL(dp)         , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      IF( PRESENT(id_type) )THEN
+         td_var%i_type=id_type
+
+         cl_type=''
+         SELECT CASE(td_var%i_type)
+         CASE(NF90_DOUBLE)
+            cl_type='DOUBLE'
+         CASE(NF90_FLOAT)
+            cl_type='FLOAT'
+         CASE(NF90_INT)
+            cl_type='INT'
+         CASE(NF90_SHORT)
+            cl_type='SHORT'
+         CASE(NF90_BYTE)
+            cl_type='BYTE'
+         END SELECT
+         CALL logger_trace("VAR ADD VALUE: "//TRIM(td_var%c_name)//&
+         &                " value will be saved as "//TRIM(cl_type)) 
+      ENDIF
+
+      il_shape=SHAPE(sd_value)
+      ALLOCATE( dl_value(il_shape(1), il_shape(2), il_shape(3), il_shape(4)),&
+      &         stat=il_status)
+      IF(il_status /= 0 )THEN
+
+        CALL logger_error( &
+         &  " VAR ADD VALUE: not enough space to put variable "//&
+         &  TRIM(td_var%c_name)//&
+         &  " in variable structure")
+
+      ENDIF
+
+      DO jl=1,il_shape(4)
+         DO jk=1,il_shape(3)
+            DO jj=1,il_shape(2)
+               DO ji=1,il_shape(1)
+                  dl_value(ji,jj,jk,jl)=REAL(sd_value(ji,jj,jk,jl),dp)      
+               ENDDO
+            ENDDO
+         ENDDO
+      ENDDO
+
+      CALL var__add_value(td_var, dl_value(:,:,:,:), id_start(:), id_count(:))
+
+      DEALLOCATE(dl_value)
+
+   END SUBROUTINE var__add_value_i2
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var__add_value_i4(td_var, id_value, id_type, id_start, id_count)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add a 4D array of integer(4) value in a variable 
+   !> structure. Dimension of the array must be ordered as ('x','y','z','t')
+   !>
+   !> @details 
+   !> Optionally, you could specify the type of the variable to be used (default integer(4)),
+   !> and indices of the variable where value will be written with start and count array.
+   !>
+   !> @note variable type is forced to INT
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2019
+   !> - decompose array conversion on each dimension
+   !>
+   !> @param[inout] td_var variabele structure
+   !> @param[in] id_value  array of variable value
+   !> @param[in] id_type   type of the variable to be used (default integer(4)) 
+   !> @param[in] id_start  start indices of the variable where data values 
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR),                        INTENT(INOUT) :: td_var
+      INTEGER(i4), DIMENSION(:,:,:,:),   INTENT(IN)    :: id_value
+      INTEGER(i4),                       INTENT(IN),   OPTIONAL  :: id_type
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_start
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_count
+
+      ! local variable
+      CHARACTER(LEN=lc)                                    :: cl_type
+
+      INTEGER(i4)                                          :: il_status
+      INTEGER(i4)      , DIMENSION(ip_maxdim)              :: il_shape
+
+      REAL(dp)         , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      IF( PRESENT(id_type) )THEN
+         td_var%i_type=id_type
+
+         cl_type=''
+         SELECT CASE(td_var%i_type)
+         CASE(NF90_DOUBLE)
+            cl_type='DOUBLE'
+         CASE(NF90_FLOAT)
+            cl_type='FLOAT'
+         CASE(NF90_INT)
+            cl_type='INT'
+         CASE(NF90_SHORT)
+            cl_type='SHORT'
+         CASE(NF90_BYTE)
+            cl_type='BYTE'
+         END SELECT
+         CALL logger_trace("VAR ADD VALUE: "//TRIM(td_var%c_name)//&
+         &                " value will be saved as "//TRIM(cl_type)) 
+      ENDIF
+
+      il_shape=SHAPE(id_value)
+      ALLOCATE( dl_value(il_shape(1), il_shape(2), il_shape(3), il_shape(4)),&
+      &         stat=il_status)
+      IF(il_status /= 0 )THEN
+
+        CALL logger_error( &
+         &  " VAR ADD VALUE: not enough space to put variable "//&
+         &  TRIM(td_var%c_name)//&
+         &  " in variable structure")
+
+      ENDIF
+
+      DO jl=1,il_shape(4)
+         DO jk=1,il_shape(3)
+            DO jj=1,il_shape(2)
+               DO ji=1,il_shape(1)
+                  dl_value(ji,jj,jk,jl)=REAL(id_value(ji,jj,jk,jl),dp)      
+               ENDDO
+            ENDDO
+         ENDDO
+      ENDDO
+
+      CALL var__add_value(td_var, dl_value(:,:,:,:), id_start(:), id_count(:))
+
+      DEALLOCATE(dl_value)
+
+   END SUBROUTINE var__add_value_i4
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var__add_value_i8(td_var, kd_value, id_type, id_start, id_count)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine add a 4D array of integer(8) value in a variable 
+   !> structure. Dimension of the array must be ordered as ('x','y','z','t')
+   !>
+   !> @details 
+   !> Optionally, you could specify the type of the variable to be used (default integer(4)),
+   !> and indices of the variable where value will be written with start and count array.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2019
+   !> - decompose array conversion on each dimension
+   !>
+   !> @param[inout] td_var variable structure
+   !> @param[in] kd_value  array of variable value
+   !> @param[in] id_type   type of the variable to be used (default integer(8)) 
+   !> @param[in] id_start  start indices of the variable where data values 
+   !> will be read
+   !> @param[in] id_count  number of indices selected along each dimension
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR),                        INTENT(INOUT) :: td_var
+      INTEGER(i8), DIMENSION(:,:,:,:),   INTENT(IN)    :: kd_value
+      INTEGER(i4),                       INTENT(IN),   OPTIONAL  :: id_type
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_start
+      INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN),   OPTIONAL  :: id_count
+
+      ! local variable
+      CHARACTER(LEN=lc)                                    :: cl_type
+
+      INTEGER(i4)                                          :: il_status
+      INTEGER(i4)      , DIMENSION(ip_maxdim)              :: il_shape
+
+      REAL(dp)         , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_value
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      IF( PRESENT(id_type) )THEN
+         td_var%i_type=id_type
+
+         cl_type=''
+         SELECT CASE(td_var%i_type)
+         CASE(NF90_DOUBLE)
+            cl_type='DOUBLE'
+         CASE(NF90_FLOAT)
+            cl_type='FLOAT'
+         CASE(NF90_INT)
+            cl_type='INT'
+         CASE(NF90_SHORT)
+            cl_type='SHORT'
+         CASE(NF90_BYTE)
+            cl_type='BYTE'
+         END SELECT
+         CALL logger_trace("VAR ADD VALUE: "//TRIM(td_var%c_name)//&
+         &                " value will be saved as "//TRIM(cl_type)) 
+      ENDIF
+
+      il_shape=SHAPE(kd_value)
+      ALLOCATE( dl_value(il_shape(1), il_shape(2), il_shape(3), il_shape(4)),&
+      &         stat=il_status)
+      IF(il_status /= 0 )THEN
+
+        CALL logger_error( &
+         &  " VAR ADD VALUE: not enough space to put variable "//&
+         &  TRIM(td_var%c_name)//&
+         &  " in variable structure")
+
+      ENDIF
+
+      DO jl=1,il_shape(4)
+         DO jk=1,il_shape(3)
+            DO jj=1,il_shape(2)
+               DO ji=1,il_shape(1)
+                  dl_value(ji,jj,jk,jl)=REAL(kd_value(ji,jj,jk,jl),dp)
+               ENDDO
+            ENDDO
+         ENDDO
+      ENDDO
+
+      CALL var__add_value(td_var, dl_value, id_start, id_count)
+
+      DEALLOCATE(dl_value)
+
+   END SUBROUTINE var__add_value_i8
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var_del_value(td_var)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine remove variable value in a variable 
+   !> structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2019
+   !> - nullify array inside variable structure
+   !>
+   !> @param[inout] td_var variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+
+      !----------------------------------------------------------------
+      CALL logger_debug( &
+      &  " VAR DEL VALUE: value in variable "//TRIM(td_var%c_name)//&
+      &  ", standard name "//TRIM(td_var%c_stdname)//&
+      &  " will be remove ")
+
+      DEALLOCATE(td_var%d_value)
+      NULLIFY(td_var%d_value)
+
+   END SUBROUTINE var_del_value
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var_get_index(td_var, cd_name, cd_stdname) &
+         & RESULT (if_idx)
+   !-------------------------------------------------------------------
+   !> @brief This function return the variable index, in a array of variable
+   !> structure,  given variable name or standard name. 
+   !>
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[in] td_var       array of variable structure
+   !> @param[in] cd_name      variable name
+   !> @param[in] cd_stdname   variable standard name
+   !> @return variable index in array of variable structure (0 if not found)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR)      , DIMENSION(:), INTENT(IN) :: td_var
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+      CHARACTER(LEN=*),               INTENT(IN), OPTIONAL :: cd_stdname
+
+      ! function
+      INTEGER(i4)                                :: if_idx
+
+      ! local variable
+      INTEGER(i4) :: il_size
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      if_idx=0
+      il_size=SIZE(td_var(:))
+
+      ! check if variable is in array of variable structure
+      DO ji=1,il_size
+
+         ! look for variable name
+         IF( fct_lower(td_var(ji)%c_name) == fct_lower(cd_name) )THEN
+         
+            if_idx=ji
+            EXIT
+
+         ! look for variable standard name
+         ELSE IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_name) .AND.&
+            &     TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN
+            
+            if_idx=ji
+            EXIT
+
+         ELSE IF( PRESENT(cd_stdname) )THEN 
+
+            IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_stdname) .AND.&
+               &TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN
+            
+               if_idx=ji
+               EXIT
+            ENDIF
+
+         ENDIF
+
+         ! look for variable longname
+         IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_name) .AND.&
+            &TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN
+            
+            if_idx=ji
+            EXIT
+
+         ELSE IF( PRESENT(cd_stdname) )THEN
+
+            IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_stdname) .AND.&
+               &TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN
+            
+               if_idx=ji
+               EXIT
+            ENDIF
+
+         ENDIF
+
+      ENDDO
+
+   END FUNCTION var_get_index
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var_get_id(td_var, cd_name, cd_stdname) &
+         & RESULT (if_id)
+   !-------------------------------------------------------------------
+   !> @brief This function return the variable id, 
+   !> given variable name or standard name. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015
+   !> - check long name
+   !>
+   !> @param[in] td_var       array of variable structure
+   !> @param[in] cd_name      variable name
+   !> @param[in] cd_stdname   variable standard name
+   !> @return variable id in array of variable structure (0 if not found)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR)      , DIMENSION(:), INTENT(IN) :: td_var
+      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
+      CHARACTER(LEN=*),               INTENT(IN), OPTIONAL :: cd_stdname
+
+      ! function
+      INTEGER(i4)                                :: if_id
+
+      ! local variable
+      INTEGER(i4) :: il_size
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+      if_id=0
+      il_size=SIZE(td_var(:))
+
+      ! check if variable is in array of variable structure
+      DO ji=1,il_size
+      
+         ! look for variable name
+         IF( fct_lower(td_var(ji)%c_name) == fct_lower(cd_name) )THEN
+         
+            if_id=td_var(ji)%i_id
+            EXIT
+
+         ! look for variable standard name
+         ELSE IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_name) .AND.&
+            &     TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN
+            
+            if_id=td_var(ji)%i_id
+            EXIT
+
+         ELSE IF( PRESENT(cd_stdname) )THEN
+
+            IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_stdname) .AND.&
+               &TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN
+            
+               if_id=td_var(ji)%i_id
+               EXIT
+            ENDIF
+
+         ENDIF
+
+         ! look for variable long name
+         IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_name) .AND.&
+            &TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN
+            
+            if_id=td_var(ji)%i_id
+            EXIT
+
+         ELSE IF( PRESENT(cd_stdname) )THEN 
+
+            IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_stdname) .AND.&
+               &TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN
+            
+               if_id=td_var(ji)%i_id
+               EXIT
+            ENDIF
+
+         ENDIF
+
+      ENDDO
+
+   END FUNCTION var_get_id
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var_get_mask(td_var) &
+         & RESULT (if_mask)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function return the mask 3D of variable, given variable structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_var array of variable structure
+   !> @return variable mask(3D)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR), INTENT(IN) :: td_var
+
+      ! function
+      INTEGER(i4), DIMENSION(td_var%t_dim(1)%i_len, &
+         &                   td_var%t_dim(2)%i_len, &
+         &                   td_var%t_dim(3)%i_len ) :: if_mask
+
+      ! local variable
+      !----------------------------------------------------------------
+
+      IF( ASSOCIATED(td_var%d_value) )THEN
+
+         CALL logger_debug( "VAR GET MASK: create mask from variable "//&
+            &               TRIM(td_var%c_name)//", FillValue ="//&
+            &               TRIM(fct_str(td_var%d_fill)))
+         if_mask(:,:,:)=1
+         WHERE( td_var%d_value(:,:,:,1) == td_var%d_fill )
+            if_mask(:,:,:)=0
+         ENDWHERE
+
+      ELSE
+         CALL logger_error("VAR GET MASK: variable value not define.")
+      ENDIF
+
+   END FUNCTION var_get_mask
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var_chg_FillValue(td_var, dd_fill)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine change FillValue of the variable to 
+   !> standard NETCDF FillValue. 
+   !>
+   !> @details
+   !> optionally, you could specify a dummy _FillValue to be used
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date January, 2019
+   !> - write fill value on array level by level
+   !>
+   !> @param[inout] td_var array of variable structure
+   !> @param[in] dd_fill _FillValue to be used
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+      REAL(dp)  , INTENT(IN)   , OPTIONAL :: dd_fill
+
+      ! local variable
+      TYPE(TATT) :: tl_att
+
+      INTEGER(i1) :: bl_fill
+      INTEGER(i2) :: sl_fill
+      INTEGER(i4) :: il_fill
+      REAL(sp)    :: rl_fill
+
+      ! loop indices
+      INTEGER(i4) :: jl
+      !----------------------------------------------------------------
+
+      CALL logger_trace( "VAR CHG FILL VALUE: change _FillValue in variable "//&
+      &  TRIM(td_var%c_name) )
+
+      ! define attribute FillValue
+      SELECT CASE( td_var%i_type )
+
+         CASE(NF90_BYTE)
+            IF( PRESENT(dd_fill) )THEN
+               bl_fill=INT(dd_fill,i1)
+               tl_att=att_init('_FillValue',bl_fill)
+            ELSE
+               tl_att=att_init('_FillValue',NF90_FILL_BYTE)
+            ENDIF
+         CASE(NF90_SHORT)
+            IF( PRESENT(dd_fill) )THEN
+               sl_fill=INT(dd_fill,i2)
+               tl_att=att_init('_FillValue',sl_fill)
+            ELSE
+               tl_att=att_init('_FillValue',NF90_FILL_SHORT)
+            ENDIF
+         CASE(NF90_INT)
+            IF( PRESENT(dd_fill) )THEN
+               il_fill=INT(dd_fill,i4)
+               tl_att=att_init('_FillValue',il_fill)
+            ELSE
+               tl_att=att_init('_FillValue',NF90_FILL_INT)
+            ENDIF
+         CASE(NF90_FLOAT)
+            IF( PRESENT(dd_fill) )THEN
+               rl_fill=REAL(dd_fill,sp)
+               tl_att=att_init('_FillValue',rl_fill)
+            ELSE
+               tl_att=att_init('_FillValue',NF90_FILL_FLOAT)
+            ENDIF
+         CASE DEFAULT ! NF90_DOUBLE
+            IF( PRESENT(dd_fill) )THEN
+               tl_att=att_init('_FillValue',dd_fill)
+            ELSE
+               tl_att=att_init('_FillValue',NF90_FILL_DOUBLE)
+            ENDIF
+
+      END SELECT
+
+      IF( ASSOCIATED(td_var%d_value) )THEN
+         ! change FillValue in variable value
+         DO jl=1,td_var%t_dim(jp_L)%i_len
+            WHERE( td_var%d_value(:,:,:,jl) == td_var%d_fill )
+               td_var%d_value(:,:,:,jl)=tl_att%d_value(1)
+            END WHERE
+         ENDDO
+      ENDIF
+
+      ! change attribute _FillValue
+      CALL var_move_att(td_var, tl_att)
+
+      ! clean
+      CALL att_clean(tl_att)
+
+   END SUBROUTINE var_chg_FillValue
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var_def_extra( cd_file )
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine read variable configuration file. And save 
+   !> global array of variable structure with extra information: tg_varextra.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - new namelist format to get extra information (interpolation,...)
+   !>
+   !> @param[in] cd_file   configuration file of variable
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_file
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_line
+      CHARACTER(LEN=lc) :: cl_interp
+
+      INTEGER(i4)       :: il_nvar
+      INTEGER(i4)       :: il_fileid
+      INTEGER(i4)       :: il_status
+
+      LOGICAL           :: ll_exist
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( ALLOCATED(tg_varextra) )THEN
+         CALL var_clean(tg_varextra(:))
+         DEALLOCATE(tg_varextra)
+      ENDIF
+
+      ! read config variable file
+      INQUIRE(FILE=TRIM(cd_file), EXIST=ll_exist)
+      IF( ll_exist )THEN
+         
+         ! get number of variable to be read
+
+         il_fileid=fct_getunit()
+         OPEN( il_fileid, FILE=TRIM(cd_file), &
+            &             FORM='FORMATTED',   &
+            &             ACCESS='SEQUENTIAL',&
+            &             STATUS='OLD',       &
+            &             ACTION='READ',      &
+            &             IOSTAT=il_status)
+         CALL fct_err(il_status)
+         IF( il_status /= 0 )THEN
+            CALL logger_fatal("VAR DEF EXTRA: can not open file "//&
+            &                 TRIM(cd_file))
+         ENDIF
+
+         ! read file
+         READ( il_fileid, FMT='(a)', IOSTAT=il_status ) cl_line
+         cl_line=TRIM(ADJUSTL(cl_line))
+         il_nvar=0
+         DO WHILE( il_status == 0 )
+
+         ! search line not beginning with comment character
+            IF( SCAN( TRIM(fct_concat(cp_com(:))) ,cl_line(1:1)) == 0 )THEN
+               il_nvar=il_nvar+1
+            ENDIF
+            
+            READ( il_fileid, FMT='(a)', IOSTAT=il_status ) cl_line
+            cl_line=TRIM(ADJUSTL(cl_line))
+         ENDDO
+
+         IF( il_nvar <= 0 )THEN
+            CALL logger_warn("VAR DEF EXTRA: no variable to be read")
+
+            CLOSE( il_fileid, IOSTAT=il_status )
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_error("VAR DEF EXTRA: closing file "//TRIM(cd_file))
+            ENDIF
+
+         ELSE
+            CALL logger_info("VAR DEF EXTRA: "//TRIM(fct_str(il_nvar))//&
+               &             " variable to be read on varaible config file"//&
+               &             TRIM(cd_file))
+
+            CALL logger_trace("VAR DEF EXTRA: rewind "//TRIM(cd_file))
+            REWIND( il_fileid, IOSTAT=il_status)
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_error("VAR DEF EXTRA: opening file "//TRIM(cd_file))
+            ENDIF
+
+            ALLOCATE( tg_varextra(il_nvar) )
+
+            ! read file
+            READ( il_fileid, FMT='(a)', IOSTAT=il_status ) cl_line
+            cl_line=TRIM(ADJUSTL(cl_line))
+            ji=1
+            DO WHILE( il_status == 0 )
+
+               IF( SCAN( TRIM(fct_concat(cp_com(:))) ,cl_line(1:1)) == 0 )THEN
+                  tg_varextra(ji)%i_id      = ji
+                  tg_varextra(ji)%c_name    =TRIM(fct_split(cl_line,1))
+                  tg_varextra(ji)%c_units   =TRIM(fct_split(cl_line,2))
+                  tg_varextra(ji)%c_axis    =TRIM(fct_split(cl_line,3))
+                  tg_varextra(ji)%c_point   =TRIM(fct_split(cl_line,4))
+
+                  cl_interp='int='//TRIM(fct_split(cl_line,5))
+                  tg_varextra(ji)%c_interp(:) = &
+                     &  var__get_interp(TRIM(tg_varextra(ji)%c_name), cl_interp)
+                  CALL logger_debug("VAR DEF EXTRA: "//&
+                     &  TRIM(tg_varextra(ji)%c_name)//&
+                     &  " "//TRIM(tg_varextra(ji)%c_interp(1)))
+
+                  tg_varextra(ji)%c_longname=TRIM(fct_split(cl_line,6))
+                  tg_varextra(ji)%c_stdname =TRIM(fct_split(cl_line,7))
+               ELSE
+                  ji=ji-1
+               ENDIF
+               
+               READ( il_fileid, FMT='(a)', IOSTAT=il_status ) cl_line
+               cl_line=TRIM(ADJUSTL(cl_line))
+               ji=ji+1
+            ENDDO
+
+            CLOSE( il_fileid, IOSTAT=il_status )
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_error("VAR DEF EXTRA: closing file "//TRIM(cd_file))
+            ENDIF
+         ENDIF
+
+      ELSE
+
+         CALL logger_error("VAR DEF EXTRA: can't find file "//TRIM(cd_file))
+
+      ENDIF      
+
+   END SUBROUTINE var_def_extra
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var_chg_extra( cd_varinfo )
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine add variable information get from namelist in 
+   !> global array of variable structure with extra information: tg_varextra.
+   !> 
+   !> @details 
+   !> string character format must be : <br/>
+   !> "varname:int=interp; flt=filter; ext=extrap; min=min; max=max"<br/>
+   !> you could specify only interpolation, filter or extrapolation method, 
+   !> whatever the order. you could find more
+   !> information about available method in \ref interp, \ref filter, and
+   !> \ref extrap module.<br/>
+   !> Examples: 
+   !> cn_varinfo='Bathymetry:flt=2*hamming(2,3); min=10.'
+   !> cn_varinfo='votemper:int=cubic; ext=dist_weight; max=40.'
+   !>
+   !>
+   !> @warning variable should be define in tg_varextra (ie in configuration
+   !> file, to be able to add information from namelist
+   !>
+   !> @note If you do not specify a method which is required, default one is
+   !> apply.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date July, 2015 
+   !> - get unit and unit factor (to change unit) 
+   !> @date February, 2019
+   !> - get variable output name
+   !>
+   !> @param[in] cd_varinfo   variable information from namelist
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_varinfo
+
+      ! local variable
+      CHARACTER(LEN=lc)                            :: cl_name
+      CHARACTER(LEN=lc)                            :: cl_method
+      CHARACTER(LEN=lc), DIMENSION(2)              :: cl_interp
+      CHARACTER(LEN=lc), DIMENSION(1)              :: cl_extrap
+      CHARACTER(LEN=lc), DIMENSION(5)              :: cl_filter
+      CHARACTER(LEN=lc)                            :: cl_unt
+      CHARACTER(LEN=lc)                            :: cl_namout
+
+      INTEGER(i4)                                  :: il_ind
+      INTEGER(i4)                                  :: il_nvar
+
+      REAL(dp)                                     :: dl_min
+      REAL(dp)                                     :: dl_max
+      REAL(dp)                                     :: dl_unf
+
+      TYPE(TVAR)       , DIMENSION(:), ALLOCATABLE :: tl_varextra
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( ALLOCATED(tg_varextra) )THEN
+         ji=1
+         DO WHILE( TRIM(cd_varinfo(ji)) /= '' )
+
+            cl_name  =fct_lower(fct_split(cd_varinfo(ji),1,':'))
+            cl_method=fct_split(cd_varinfo(ji),2,':')
+
+            dl_min=var__get_min(cl_name, cl_method)
+            dl_max=var__get_max(cl_name, cl_method)
+            dl_unf=var__get_unf(cl_name, cl_method)
+            cl_interp(:)=var__get_interp(cl_name, cl_method)
+            cl_extrap(:)=var__get_extrap(cl_name, cl_method)
+            cl_filter(:)=var__get_filter(cl_name, cl_method)
+            cl_unt=var__get_unt(cl_name, cl_method)
+            cl_namout=var__get_namout(cl_name, cl_method)
+
+
+            il_ind=var_get_index(tg_varextra(:), TRIM(cl_name))
+            IF( il_ind /= 0 )THEN
+               IF( dl_min /= dp_fill ) tg_varextra(il_ind)%d_min=dl_min
+               IF( dl_max /= dp_fill ) tg_varextra(il_ind)%d_max=dl_max
+               IF( dl_unf /= dp_fill ) tg_varextra(il_ind)%d_unf=dl_unf
+               IF(cl_unt      /='') tg_varextra(il_ind)%c_unt      =cl_unt
+               IF(cl_namout   /='') tg_varextra(il_ind)%c_namout   =cl_namout
+               IF(cl_interp(1)/='') tg_varextra(il_ind)%c_interp(:)=cl_interp(:)
+               IF(cl_extrap(1)/='') tg_varextra(il_ind)%c_extrap(:)=cl_extrap(:)
+               IF(cl_filter(1)/='') tg_varextra(il_ind)%c_filter(:)=cl_filter(:)
+            ELSE
+
+               IF( ALLOCATED(tg_varextra) )THEN
+                  il_nvar=SIZE(tg_varextra(:))
+                  ! save older variable
+                  ALLOCATE( tl_varextra(il_nvar) )
+                  tl_varextra(:)=var_copy(tg_varextra(:))
+
+                  CALL var_clean(tg_varextra(:))
+                  DEALLOCATE(tg_varextra)
+                  ALLOCATE( tg_varextra(il_nvar+1) )
+                  
+                  tg_varextra(1:il_nvar)=var_copy(tl_varextra(:))
+
+                  ! clean
+                  CALL var_clean(tl_varextra(:))
+                  DEALLOCATE(tl_varextra)
+
+               ELSE
+
+                  il_nvar=0
+                  ALLOCATE( tg_varextra(1) )
+
+               ENDIF
+
+               ! add new variable
+               il_ind=il_nvar+1
+               tg_varextra(il_ind)=var_init( TRIM(cl_name), &
+                  &                          cd_interp=cl_interp(:), &
+                  &                          cd_extrap=cl_extrap(:), &
+                  &                          cd_filter=cl_filter(:), &
+                  &                          dd_min = dl_min, &
+                  &                          dd_max = dl_max, &
+                  &                          cd_unt = cl_unt, &
+                  &                          dd_unf = dl_unf, &
+                  &                          cd_namout = cl_namout )
+
+            ENDIF
+
+            ji=ji+1
+            CALL logger_debug( "VAR CHG EXTRA: name       "//&
+               &               TRIM(tg_varextra(il_ind)%c_name) )
+            CALL logger_debug( "VAR CHG EXTRA: interp     "//&
+               &               TRIM(tg_varextra(il_ind)%c_interp(1)) )         
+            CALL logger_debug( "VAR CHG EXTRA: filter     "//&
+               &               TRIM(tg_varextra(il_ind)%c_filter(1)) )         
+            CALL logger_debug( "VAR CHG EXTRA: extrap     "//&
+               &               TRIM(tg_varextra(il_ind)%c_extrap(1)) )
+            IF( tg_varextra(il_ind)%d_min /= dp_fill )THEN
+               CALL logger_debug( "VAR CHG EXTRA: min value  "//&
+                  &               TRIM(fct_str(tg_varextra(il_ind)%d_min)) )
+            ENDIF
+            IF( tg_varextra(il_ind)%d_max /= dp_fill )THEN
+               CALL logger_debug( "VAR CHG EXTRA: max value  "//&
+                  &               TRIM(fct_str(tg_varextra(il_ind)%d_max)) )
+            ENDIF
+            IF( TRIM(tg_varextra(il_ind)%c_unt) /= '' )THEN
+               CALL logger_debug( "VAR CHG EXTRA: new unit  "//&
+                  &               TRIM(tg_varextra(il_ind)%c_unt) )
+            ENDIF
+            IF( tg_varextra(il_ind)%d_unf /= 1. )THEN
+               CALL logger_debug( "VAR CHG EXTRA: new unit factor  "//&
+                  &               TRIM(fct_str(tg_varextra(il_ind)%d_unf)) )
+            ENDIF
+            IF( TRIM(tg_varextra(il_ind)%c_namout) /= '' )THEN
+               CALL logger_debug( "VAR CHG EXTRA: new name output  "//&
+                  &               TRIM(tg_varextra(il_ind)%c_namout) )
+            ENDIF
+         ENDDO
+      ENDIF
+
+   END SUBROUTINE var_chg_extra
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var_clean_extra( )
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine clean global array of variable structure 
+   !> with extra information: tg_varextra.
+   !> 
+   !> @author J.Paul
+   !> @date October, 2016 - Initial Version
+   !> @date January, 2019
+   !> - check if tg_varextra is allocated before clean it
+   !>
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      !----------------------------------------------------------------
+
+      IF( ALLOCATED(tg_varextra) )THEN
+         CALL var_clean(tg_varextra(:))
+         DEALLOCATE(tg_varextra)
+      ENDIF
+
+   END SUBROUTINE var_clean_extra
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var_read_matrix(td_var, cd_matrix)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine read matrix value from character string in namelist
+   !> and fill variable structure value.
+   !>
+   !> @details
+   !> to split matrix, separator use are:<br/>
+   !> - ',' for line
+   !> - '/' for row
+   !> - '\' for level<br/>
+   !> Example:<br/>
+   !> 3,2,3/1,4,5  => 
+   !> @f$ \left( \begin{array}{ccc}
+   !> 3 & 2 & 3 \\
+   !> 1 & 4 & 5 \end{array} \right) @f$
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure
+   !> @param[in] cd_matrix matrix value
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR)      , INTENT(INOUT) :: td_var
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_matrix
+
+      ! local variable
+      CHARACTER(LEN=lc)                                  :: cl_array
+      CHARACTER(LEN=lc)                                  :: cl_line
+      CHARACTER(LEN=lc)                                  :: cl_elt
+
+      REAL(dp)         , DIMENSION(:,:,:)  , ALLOCATABLE :: dl_matrix
+      REAL(dp)         , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
+
+      TYPE(TDIM)       , DIMENSION(:)      , ALLOCATABLE :: tl_dim
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk      
+      !----------------------------------------------------------------
+
+      IF( TRIM(cd_matrix) == '' )THEN
+         CALL logger_debug("VAR READ MATRIX: no matrix to be read")
+      ELSE
+
+         !1- read matrix
+         ALLOCATE( dl_matrix(ip_maxmtx, ip_maxmtx, ip_maxmtx) )
+         dl_matrix(:,:,:)=td_var%d_fill
+
+         jk=1
+         cl_array=fct_split(TRIM(cd_matrix),jk,'\ ')
+         CALL logger_debug("VAR MATRIX array "//TRIM(cl_array) )
+         DO WHILE( TRIM(cl_array) /= '' )
+            jj=1
+            cl_line=fct_split(TRIM(cl_array),jj,'/')
+            CALL logger_debug("VAR MATRIX line "//TRIM(cl_line) )
+            DO WHILE( TRIM(cl_line) /= '' )
+               ji=1
+               cl_elt=fct_split(TRIM(cl_line),ji,',')
+               CALL logger_debug("VAR MATRIX elt "//TRIM(cl_elt) )
+               DO WHILE( TRIM(cl_elt) /= '') 
+                  READ(cl_elt,*) dl_matrix(ji,jj,jk)
+                  ji=ji+1
+                  cl_elt=fct_split(TRIM(cl_line),ji,',')
+                  CALL logger_debug("VAR MATRIX elt "//TRIM(cl_elt) )
+               ENDDO
+               jj=jj+1
+               cl_line=fct_split(TRIM(cl_array),jj,'/')
+               CALL logger_debug("VAR MATRIX line "//TRIM(cl_line) )
+            ENDDO
+            jk=jk+1
+            cl_array=fct_split(TRIM(cd_matrix),jk,'\ ')
+            CALL logger_debug("VAR MATRIX array "//TRIM(cl_array) )
+         ENDDO
+
+         ! save useful value
+         ALLOCATE( dl_value(ji-1,jj-1,jk-1,1) )
+         dl_value(:,:,:,1)=dl_matrix(1:ji-1,1:jj-1,1:jk-1)
+
+         DEALLOCATE(dl_matrix)
+
+         ALLOCATE( tl_dim(3) )
+
+         IF( ji-1 > 0 ) tl_dim(1)=dim_init('x',ji-1)
+         IF( jj-1 > 0 ) tl_dim(2)=dim_init('y',jj-1)
+         IF( jk-1 > 0 ) tl_dim(3)=dim_init('z',jk-1)
+         
+         CALL var_add_dim(td_var, tl_dim(:))
+         ! clean
+         CALL dim_clean(tl_dim)
+         DEALLOCATE( tl_dim )
+
+         IF( ASSOCIATED(td_var%d_value) ) DEALLOCATE(td_var%d_value)
+         CALL var_add_value(td_var, dl_value(:,:,:,:), id_type=NF90_FLOAT)
+
+         DEALLOCATE( dl_value )
+      ENDIF
+
+   END SUBROUTINE var_read_matrix
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var__get_extra(td_var)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine add extra information in variable structure.
+   !> 
+   !> @details 
+   !> if variable name is informed in global array of variable structure (tg_varextra).
+   !> fill empty parameter on variable structure.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+
+      INTEGER(i4)       :: il_ind
+      
+      TYPE(TATT)        :: tl_att
+
+      ! loop indices
+      INTEGER(i4)       :: ji
+      !----------------------------------------------------------------
+
+      IF( ALLOCATED(tg_varextra) )THEN
+
+         il_ind=var_get_index( tg_varextra(:), TRIM(td_var%c_name),  &
+                                               TRIM(td_var%c_stdname))
+         IF( il_ind /= 0 )THEN
+
+            ! name
+            IF( TRIM(td_var%c_name) == '' .AND. &
+            &   TRIM(tg_varextra(il_ind)%c_name) /= '' )THEN
+               td_var%c_name=TRIM(tg_varextra(il_ind)%c_name)
+            ENDIF
+
+            ! standard name
+            IF( TRIM(tg_varextra(il_ind)%c_stdname) /= '' .AND. &
+            &   ( TRIM(td_var%c_stdname) == '' .OR. &
+            &     TRIM(tg_varextra(il_ind)%c_stdname) /= &
+            &     TRIM(td_var%c_stdname) ) )THEN
+               td_var%c_stdname=TRIM(tg_varextra(il_ind)%c_stdname)
+               ! create attibute
+               tl_att=att_init('standard_name',TRIM(td_var%c_stdname))
+               CALL var_move_att(td_var, tl_att)
+            ENDIF
+
+            ! long_name
+            IF( TRIM(tg_varextra(il_ind)%c_longname) /= '' .AND. &
+            &   ( TRIM(td_var%c_longname) == '' .OR. &
+            &     TRIM(tg_varextra(il_ind)%c_longname) /= &
+            &     TRIM(td_var%c_longname) ) )THEN
+               td_var%c_longname=TRIM(tg_varextra(il_ind)%c_longname)
+               ! create attibute
+               tl_att=att_init('long_name',TRIM(td_var%c_longname))
+               CALL var_move_att(td_var, tl_att)               
+            ENDIF
+
+            ! units
+            IF( TRIM(td_var%c_units) == '' .AND. & 
+            &   TRIM(tg_varextra(il_ind)%c_units) /= '' )THEN
+               td_var%c_units=TRIM(tg_varextra(il_ind)%c_units)
+               ! create attibute
+               tl_att=att_init('units',TRIM(td_var%c_units))
+               CALL var_move_att(td_var, tl_att)               
+            ENDIF
+
+            ! axis
+            IF( TRIM(tg_varextra(il_ind)%c_axis) /= '' .AND. &
+            &   ( TRIM(td_var%c_axis) == '' .OR. & 
+            &     TRIM(tg_varextra(il_ind)%c_axis) /= &
+            &     TRIM(td_var%c_axis) ) )THEN
+               td_var%c_axis=TRIM(tg_varextra(il_ind)%c_axis)
+               ! create attibute
+               IF( TRIM(fct_upper(td_var%c_name)) == TRIM(td_var%c_axis) )THEN
+                  tl_att=att_init('axis',TRIM(td_var%c_axis))
+               ELSE
+                  cl_tmp=""
+                  DO ji=LEN(TRIM(td_var%c_axis)),1,-1
+                     cl_tmp=TRIM(cl_tmp)//" "//TRIM(td_var%c_axis(ji:ji))
+                  ENDDO
+                  tl_att=att_init('associate',TRIM(ADJUSTL(cl_tmp)))
+               ENDIF
+               CALL var_move_att(td_var, tl_att)
+            ENDIF
+
+            ! grid point
+            IF( TRIM(tg_varextra(il_ind)%c_point) /= '' .AND. &
+            &   ( TRIM(td_var%c_point) == '' .OR. &
+            &     TRIM(tg_varextra(il_ind)%c_point) /= &
+            &     TRIM(td_var%c_point) ) )THEN
+               td_var%c_point=TRIM(tg_varextra(il_ind)%c_point)
+            ELSE
+               IF( TRIM(td_var%c_point) == '' )THEN
+                  CALL logger_warn("VAR GET EXTRA: unknown grid point "//&
+                  &  "for variable "//TRIM(td_var%c_name)//&
+                  &  ". assume it is a T-point.")
+                  td_var%c_point='T'
+               ENDIF
+            ENDIF
+            ! create attibute
+            tl_att=att_init('grid_point',TRIM(td_var%c_point))
+            CALL var_move_att(td_var, tl_att)               
+
+            ! clean
+            CALL att_clean(tl_att)
+
+            ! interp
+            IF( TRIM(td_var%c_interp(1)) == '' .AND. &
+            &   TRIM(tg_varextra(il_ind)%c_interp(1)) /= '' )THEN
+               td_var%c_interp(:)=tg_varextra(il_ind)%c_interp(:)
+            ENDIF
+
+            ! extrap
+            IF( TRIM(td_var%c_extrap(1)) == '' .AND. &
+            &   TRIM(tg_varextra(il_ind)%c_extrap(1)) /= '' )THEN
+               td_var%c_extrap(:)=tg_varextra(il_ind)%c_extrap(:)
+            ENDIF
+
+            ! filter
+            IF( TRIM(td_var%c_filter(1)) == '' .AND. &
+            &   TRIM(tg_varextra(il_ind)%c_filter(1)) /= '' )THEN
+               td_var%c_filter(:)=tg_varextra(il_ind)%c_filter(:)
+            ENDIF            
+
+            ! min value
+            IF( td_var%d_min == dp_fill .AND. &
+            &   tg_varextra(il_ind)%d_min /= dp_fill )THEN
+               td_var%d_min=tg_varextra(il_ind)%d_min
+            ENDIF
+
+            ! max value
+            IF( td_var%d_max == dp_fill .AND. &
+            &   tg_varextra(il_ind)%d_max /= dp_fill )THEN
+               td_var%d_max=tg_varextra(il_ind)%d_max
+            ENDIF
+
+            ! unt
+            IF( TRIM(td_var%c_unt) == '' .AND. &
+            &   TRIM(tg_varextra(il_ind)%c_unt) /= '' )THEN
+               td_var%c_unt=TRIM(tg_varextra(il_ind)%c_unt)
+            ENDIF
+
+            ! units factor
+            IF( td_var%d_unf == 1._dp .AND. &
+            &   tg_varextra(il_ind)%d_unf /= 1._dp )THEN
+               td_var%d_unf=tg_varextra(il_ind)%d_unf
+            ENDIF
+
+            ! namout
+            IF( TRIM(td_var%c_namout) == '' .AND. &
+            &   TRIM(tg_varextra(il_ind)%c_namout) /= '' )THEN
+               td_var%c_namout=TRIM(tg_varextra(il_ind)%c_namout)
+            ENDIF
+
+         ELSE
+            CALL logger_warn("VAR GET EXTRA: no extra information on "//&
+               &  "variable "//TRIM(td_var%c_name)//". you should define it"//&
+               &  " (see variable.cfg).")
+         ENDIF
+
+      ELSE
+
+         CALL logger_debug("VAR GET EXTRA: no extra information on variable "//&
+         &             " you should have run var_def_extra. ")
+
+      ENDIF
+
+   END SUBROUTINE var__get_extra
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__get_min(cd_name, cd_varinfo) &
+         & RESULT (df_min)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function check if variable information read in namelist contains 
+   !> minimum value and return it if true. 
+   !> 
+   !> @details
+   !> minimum value is assume to follow string "min ="
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - change way to get information in namelist, 
+   !> value follows string "min ="
+   !> @date Feb, 2016
+   !> - check character just after keyword
+   !>
+   !> @param[in] cd_name      variable name
+   !> @param[in] cd_varinfo   variable information read in namelist 
+   !> @return minimum value to be used (FillValue if none)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_varinfo
+
+      ! function
+      REAL(dp)                        :: df_min
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_min
+      
+      INTEGER(i4)       :: il_ind
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+      ! init
+      cl_min=''
+      df_min=dp_fill
+
+      ji=1
+      cl_tmp=fct_split(cd_varinfo,ji,';')
+      DO WHILE( TRIM(cl_tmp) /= '' )
+         il_ind=INDEX(TRIM(cl_tmp),'min')
+         IF( il_ind /= 0 )THEN
+            ! check character just after
+            jj=il_ind+LEN('min')
+            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. &
+            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN
+               cl_min=fct_split(cl_tmp,2,'=')
+               EXIT
+            ENDIF
+         ENDIF
+         ji=ji+1
+         cl_tmp=fct_split(cd_varinfo,ji,';')         
+      ENDDO
+
+      IF( TRIM(cl_min) /= '' )THEN
+         IF( fct_is_real(cl_min) )THEN
+            READ(cl_min,*) df_min
+            CALL logger_debug("VAR GET MIN: will use minimum value of "//&
+               &  TRIM(fct_str(df_min))//" for variable "//TRIM(cd_name) )
+         ELSE
+            CALL logger_error("VAR GET MIN: invalid minimum value ("//&
+               & TRIM(cl_min)//") for variable "//TRIM(cd_name)//&
+               & ". check namelist." )
+         ENDIF
+      ENDIF
+
+   END FUNCTION var__get_min
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__get_max(cd_name, cd_varinfo) &
+         & RESULT (df_max)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function check if variable information read in namelist contains 
+   !> maximum value and return it if true. 
+   !> 
+   !> @details
+   !> maximum value is assume to follow string "max ="
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - change way to get information in namelist, 
+   !> value follows string "max ="
+   !> @date Feb, 2016
+   !> - check character just after keyword
+   !>
+   !> @param[in] cd_name      variable name
+   !> @param[in] cd_varinfo   variable information read in namelist 
+   !> @return maximum value to be used (FillValue if none)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_varinfo
+
+      ! function
+      REAL(dp)                        :: df_max
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_max
+      
+      INTEGER(i4)       :: il_ind
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+      ! init
+      cl_max=''
+      df_max=dp_fill
+
+      ji=1
+      cl_tmp=fct_split(cd_varinfo,ji,';')
+      DO WHILE( TRIM(cl_tmp) /= '' )
+         il_ind=INDEX(TRIM(cl_tmp),'max')
+         IF( il_ind /= 0 )THEN
+            ! check character just after
+            jj=il_ind+LEN('max')
+            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. &
+            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN
+               cl_max=fct_split(cl_tmp,2,'=')
+               EXIT
+            ENDIF
+         ENDIF
+         ji=ji+1
+         cl_tmp=fct_split(cd_varinfo,ji,';')         
+      ENDDO
+
+      IF( TRIM(cl_max) /= '' )THEN
+         IF( fct_is_real(cl_max) )THEN
+            READ(cl_max,*) df_max
+            CALL logger_debug("VAR GET MAX: will use maximum value of "//&
+               &  TRIM(fct_str(df_max))//" for variable "//TRIM(cd_name) )
+         ELSE
+            CALL logger_error("VAR GET MAX: invalid maximum value for "//&
+               &  "variable "//TRIM(cd_name)//". check namelist." )
+         ENDIF
+      ENDIF
+
+   END FUNCTION var__get_max
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__get_unf(cd_name, cd_varinfo) &
+         & RESULT (df_unf)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function check if variable information read in namelist contains 
+   !> units factor value and return it if true. 
+   !> 
+   !> @details
+   !> units factor value is assume to follow string "unf ="
+   !>
+   !> @author J.Paul
+   !> @date June, 2015 - Initial Version
+   !> @date Feb, 2016
+   !> - check character just after keyword
+   !>
+   !> @param[in] cd_name      variable name
+   !> @param[in] cd_varinfo   variable information read in namelist 
+   !> @return untis factor value to be used (FillValue if none)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_varinfo
+
+      ! function
+      REAL(dp)                        :: df_unf
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_unf
+      
+      INTEGER(i4)       :: il_ind
+
+      REAL(dp)          :: dl_unf
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+      ! init
+      cl_unf=''
+      df_unf=dp_fill
+
+      ji=1
+      cl_tmp=fct_split(cd_varinfo,ji,';')
+      DO WHILE( TRIM(cl_tmp) /= '' )
+         il_ind=INDEX(TRIM(cl_tmp),'unf')
+         IF( il_ind /= 0 )THEN
+            ! check character just after
+            jj=il_ind+LEN('unf')
+            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. &
+               & TRIM(cl_tmp(jj:jj)) == '=' )THEN
+               cl_unf=fct_split(cl_tmp,2,'=')
+               EXIT
+            ENDIF
+         ENDIF
+         ji=ji+1
+         cl_tmp=fct_split(cd_varinfo,ji,';')         
+      ENDDO
+
+      IF( TRIM(cl_unf) /= '' )THEN
+         dl_unf=math_compute(cl_unf)
+         IF( dl_unf /= dp_fill )THEN
+            df_unf = dl_unf
+            CALL logger_debug("VAR GET UNITS FACTOR: will use units factor "//&
+               &  "value of "//TRIM(fct_str(df_unf))//" for variable "//&
+               &   TRIM(cd_name) )
+         ELSE
+            CALL logger_error("VAR GET UNITS FACTOR: invalid units factor "//&
+               &  "value for variable "//TRIM(cd_name)//". check namelist." )
+         ENDIF
+      ENDIF
+
+   END FUNCTION var__get_unf
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__get_interp(cd_name, cd_varinfo) &
+         & RESULT (cf_interp)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function check if variable information read in namelist contains 
+   !> interpolation method and return it if true. 
+   !> 
+   !> @details 
+   !> interpolation method is assume to follow string "int ="
+   !>
+   !> compare method name with the list of interpolation method available (see
+   !> module global).
+   !> check if factor (*rhoi, /rhoj..) are present.<br/>
+   !> Example:<br/> 
+   !> - int=cubic/rhoi ; ext=dist_weight
+   !> - int=bilin
+   !> see @ref interp module for more information.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - change way to get information in namelist, 
+   !> value follows string "int ="
+   !> @date Feb, 2016
+   !> - check character just after keyword
+   !>
+   !> @param[in] cd_name      variable name
+   !> @param[in] cd_varinfo   variable information read in namelist
+   !> @return array of character information about interpolation 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_varinfo
+
+      ! function
+      CHARACTER(LEN=lc), DIMENSION(2) :: cf_interp
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_int
+      CHARACTER(LEN=lc) :: cl_factor
+      
+      INTEGER(i4)       :: il_ind
+      INTEGER(i4)       :: il_len
+
+      INTEGER(i4)       :: il_mul
+      INTEGER(i4)       :: il_div
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      cf_interp(:)=''
+
+      ji=1
+      cl_tmp=fct_split(cd_varinfo,ji,';')
+      DO WHILE( TRIM(cl_tmp) /= '' )
+         il_ind=INDEX(TRIM(cl_tmp),'int')
+         IF( il_ind /= 0 )THEN
+            ! check character just after
+            jj=il_ind+LEN('int')
+            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. &
+            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN
+               cl_int=fct_split(cl_tmp,2,'=')
+               EXIT
+            ENDIF
+         ENDIF
+         ji=ji+1
+         cl_tmp=fct_split(cd_varinfo,ji,';')         
+      ENDDO
+
+      IF( TRIM(cl_int) /= '' )THEN
+         DO jj=1,ip_ninterp
+            il_ind= INDEX(fct_lower(cl_int),TRIM(cp_interp_list(jj)))
+            IF( il_ind /= 0 )THEN
+
+               cf_interp(1)=TRIM(cp_interp_list(jj))
+               il_len=LEN(TRIM(cp_interp_list(jj)))
+               
+               ! look for factor
+               IF( il_ind==1 )THEN
+                  cl_factor=cl_int(il_len+1:)
+               ELSE
+                  cl_factor=cl_int(1:il_ind-1)
+               ENDIF
+               il_mul=SCAN(TRIM(cl_factor),'*')
+               il_div=SCAN(TRIM(cl_factor),'/')
+               
+               il_len=LEN(cl_factor)
+               IF( il_mul /= 0 )THEN
+                  IF( il_mul==1 )THEN
+                     cl_factor=cl_factor(2:il_len)
+                  ELSE
+                     cl_factor=cl_factor(1:il_mul-1)
+                  ENDIF
+
+               ELSE IF( il_div /=0 )THEN
+                  IF( il_div==1 )THEN
+                     cl_factor=cl_factor(2:il_len)
+                  ELSE
+                     cl_factor=cl_factor(1:il_div-1)
+                  ENDIF
+
+               ELSE
+                  cl_factor=''
+               ENDIF
+
+               SELECT CASE(TRIM(cl_factor))
+                  CASE('rhoi','rhoj','rhok')
+                     IF( il_mul /= 0 ) cf_interp(2)='*'//TRIM(cl_factor)
+                     IF( il_div /= 0 ) cf_interp(2)='/'//TRIM(cl_factor)
+                  CASE('')
+                     cf_interp(2)=''
+                  CASE DEFAULT
+                     cf_interp(2)=''
+                     CALL logger_error("VAR GET INTERP: variable "//&
+                        &     TRIM(cd_name)//&
+                        &     " invalid factor coefficient. check namelist. "//&
+                        &     " factor should be choose between rhox rhoy rhoz.")
+               END SELECT
+
+               EXIT
+            ENDIF
+         ENDDO
+      ENDIF
+
+   END FUNCTION var__get_interp
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__get_extrap(cd_name, cd_varinfo) &
+         & RESULT (cf_extrap)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function check if variable information read in namelist contains 
+   !> extrapolation method and return it if true. 
+   !> 
+   !> @details 
+   !> extrapolation method is assume to follow string "ext ="
+   !> 
+   !> compare method name with the list of extrapolation method available (see
+   !> module global).<br/>
+   !> Example:<br/>
+   !> - int=cubic ; ext=dist_weight
+   !> - ext=min_error
+   !> see @ref extrap module for more information.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - change way to get information in namelist, 
+   !> value follows string "ext ="
+   !> @date Feb, 2016
+   !> - check character just after keyword
+   !>
+   !> @param[in] cd_name      variable name
+   !> @param[in] cd_varinfo   variable information read in namelist
+   !> @return array of character information about extrapolation
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_varinfo
+
+      ! function
+      CHARACTER(LEN=lc), DIMENSION(1) :: cf_extrap
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_ext
+
+      INTEGER(i4)       :: il_ind
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      cf_extrap(:)=''
+
+      ji=1
+      cl_tmp=fct_split(cd_varinfo,ji,';')
+      DO WHILE( TRIM(cl_tmp) /= '' )
+         il_ind=INDEX(TRIM(cl_tmp),'ext')
+         IF( il_ind /= 0 )THEN
+            ! check character just after
+            jj=il_ind+LEN('ext')
+            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. &
+            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN
+               cl_ext=fct_split(cl_tmp,2,'=')
+               EXIT
+            ENDIF
+         ENDIF
+         ji=ji+1
+         cl_tmp=fct_split(cd_varinfo,ji,';')         
+      ENDDO
+
+      IF( TRIM(cl_ext) /= '' )THEN
+         DO jj=1,ip_nextrap
+            IF( TRIM(fct_lower(cl_ext)) == TRIM(cp_extrap_list(jj)) )THEN
+               cf_extrap(1)=TRIM(cp_extrap_list(jj))
+
+               CALL logger_trace("VAR GET EXTRAP: variable "//TRIM(cd_name)//&
+                  &  " will use extrapolation method "//TRIM(cf_extrap(1)) )
+
+               EXIT
+            ENDIF
+         ENDDO
+      ENDIF
+
+
+   END FUNCTION var__get_extrap
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__get_filter(cd_name, cd_varinfo) &
+         & RESULt (cf_filter)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function check if variable information read in namelist contains 
+   !> filter method and return it if true 
+   !> 
+   !> @details 
+   !> filter method is assume to follow string "flt ="
+   !>
+   !> compare method name with the list of filter method available (see
+   !> module global).
+   !> look for the number of run, using '*' separator, and method parameters inside
+   !> bracket.<br/>
+   !> Example:<br/>
+   !> - int=cubic ; flt=2*hamming(2,3)
+   !> - flt=hann
+   !> see @ref filter module for more information.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !> @date June, 2015 
+   !> - change way to get information in namelist, 
+   !> value follows string "flt ="
+   !> @date Feb, 2016
+   !> - check character just after keyword
+   !>
+   !> @param[in] cd_name      variable name
+   !> @param[in] cd_varinfo   variable information read in namelist 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_varinfo
+
+      ! function
+      CHARACTER(LEN=lc), DIMENSION(5) :: cf_filter
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      CHARACTER(LEN=lc) :: cl_flt
+      INTEGER(i4)       :: il_ind
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      cf_filter(:)=''
+
+      ji=1
+      cl_tmp=fct_split(cd_varinfo,ji,';')
+      DO WHILE( TRIM(cl_tmp) /= '' )
+         il_ind=INDEX(TRIM(cl_tmp),'flt')
+         IF( il_ind /= 0 )THEN
+            ! check character just after
+            jj=il_ind+LEN('flt')
+            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. &
+            &    TRIM(cl_tmp(jj:jj)) == '=' )THEN
+               cl_flt=fct_split(cl_tmp,2,'=')
+               EXIT
+            ENDIF
+         ENDIF
+         ji=ji+1
+         cl_tmp=fct_split(cd_varinfo,ji,';')         
+      ENDDO
+      
+      IF( TRIM(cl_flt) /= '' )THEN
+         DO jj=1,ip_nfilter
+            il_ind=INDEX(fct_lower(cl_flt),TRIM(cp_filter_list(jj)))
+            IF( il_ind /= 0 )THEN
+               cf_filter(1)=TRIM(cp_filter_list(jj))
+
+               ! look for number of run
+               il_ind=SCAN(fct_lower(cl_flt),'*')
+               IF( il_ind /=0 )THEN
+                  IF( fct_is_num(cl_flt(1:il_ind-1)) )THEN
+                     cf_filter(2)=TRIM(cl_flt(1:il_ind-1))
+                  ELSE IF( fct_is_num(cl_flt(il_ind+1:)) )THEN
+                     cf_filter(2)=TRIM(cl_flt(il_ind+1:))
+                  ELSE
+                     cf_filter(2)='1'
+                  ENDIF
+               ELSE
+                  cf_filter(2)='1'
+               ENDIF
+
+               ! look for filter parameter
+               il_ind=SCAN(fct_lower(cl_flt),'(')
+               IF( il_ind /=0 )THEN
+                  cl_flt=TRIM(cl_flt(il_ind+1:))
+                  il_ind=SCAN(fct_lower(cl_flt),')')
+                  IF( il_ind /=0 )THEN
+                     cl_flt=TRIM(cl_flt(1:il_ind-1))
+                     ! look for cut-off frequency
+                     cf_filter(3)=fct_split(cl_flt,1,',')
+                     ! look for halo size
+                     cf_filter(4)=fct_split(cl_flt,2,',')
+                     ! look for alpha parameter
+                     cf_filter(5)=fct_split(cl_flt,3,',')
+                  ELSE
+                     CALL logger_error("VAR GET FILTER: variable "//&
+                     &  TRIM(cd_name)//&
+                     &  " unclosed parentheses. check namelist. ")
+                  ENDIF
+               ELSE
+                  cf_filter(3)=''
+                  cf_filter(4)=''
+                  cf_filter(5)=''
+               ENDIF
+   
+               CALL logger_trace("VAR GET FILTER: name   "//TRIM(cf_filter(1)))
+               CALL logger_trace("VAR GET FILTER: nturn  "//TRIM(cf_filter(2)))
+               CALL logger_trace("VAR GET FILTER: cutoff "//TRIM(cf_filter(3)))
+               CALL logger_trace("VAR GET FILTER: halo   "//TRIM(cf_filter(4)))
+               CALL logger_trace("VAR GET FILTER: alpha  "//TRIM(cf_filter(5)))
+
+               EXIT
+            ENDIF
+         ENDDO
+      ENDIF
+
+   END FUNCTION var__get_filter
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__get_unt(cd_name, cd_varinfo) &
+         & RESULT (cf_unt)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function check if variable information read in namelist contains 
+   !> output unit and return it if true. 
+   !> 
+   !> @details 
+   !> output unit is assume to follow string "unt ="
+   !>
+   !> @author J.Paul
+   !> @date June, 2015 - Initial Version
+   !> @date February, 2016
+   !> - check character just after keyword
+   !>
+   !> @param[in] cd_name      variable name
+   !> @param[in] cd_varinfo   variable information read in namelist
+   !> @return unit string character 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_varinfo
+
+      ! function
+      CHARACTER(LEN=lc)               :: cf_unt
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      
+      INTEGER(i4)       :: il_ind
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      cf_unt=''
+
+      ji=1
+      cl_tmp=fct_split(cd_varinfo,ji,';')
+      DO WHILE( TRIM(cl_tmp) /= '' )
+         il_ind=INDEX(TRIM(cl_tmp),'unt')
+         IF( il_ind /= 0 )THEN
+            ! check character just after
+            jj=il_ind+LEN('unt')
+            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. &
+               & TRIM(cl_tmp(jj:jj)) == '=' )THEN
+               cf_unt=fct_split(cl_tmp,2,'=')
+               EXIT
+            ENDIF
+         ENDIF
+         ji=ji+1
+         cl_tmp=fct_split(cd_varinfo,ji,';')         
+      ENDDO
+
+      IF( TRIM(cf_unt) /= '' )THEN
+         CALL logger_debug("VAR GET UNIT: will use output unit "//&
+            &  TRIM(cf_unt)//" for variable "//&
+            &  TRIM(cd_name) )
+      ENDIF
+
+   END FUNCTION var__get_unt
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var__get_namout(cd_name, cd_varinfo) &
+         & RESULT (cf_namout)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function check if variable information read in namelist contains 
+   !> variable ouptut name and return it if true. 
+   !> 
+   !> @details 
+   !> output name is assume to follow string "out ="
+   !>
+   !> @author J.Paul
+   !> @date February, 2019 - Initial Version
+   !>
+   !> @param[in] cd_name      variable name
+   !> @param[in] cd_varinfo   variable information read in namelist
+   !> @return ouptut name string character 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
+      CHARACTER(LEN=*), INTENT(IN   ) :: cd_varinfo
+
+      ! function
+      CHARACTER(LEN=lc)               :: cf_namout
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_tmp
+      
+      INTEGER(i4)       :: il_ind
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      cf_namout=''
+
+      ji=1
+      cl_tmp=fct_split(cd_varinfo,ji,';')
+      DO WHILE( TRIM(cl_tmp) /= '' )
+         il_ind=INDEX(TRIM(cl_tmp),'out')
+         IF( il_ind /= 0 )THEN
+            ! check character just after
+            jj=il_ind+LEN('out')
+            IF(  TRIM(cl_tmp(jj:jj)) == ' ' .OR. &
+               & TRIM(cl_tmp(jj:jj)) == '=' )THEN
+               cf_namout=fct_split(cl_tmp,2,'=')
+               EXIT
+            ENDIF
+         ENDIF
+         ji=ji+1
+         cl_tmp=fct_split(cd_varinfo,ji,';')         
+      ENDDO
+
+      IF( TRIM(cf_namout) /= '' )THEN
+         CALL logger_debug("VAR GET NAMOUT: will use output name "//&
+            &  TRIM(cf_namout)//" for variable "//&
+            &  TRIM(cd_name) )
+      ENDIF
+
+   END FUNCTION var__get_namout
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var_max_dim(td_var) &
+         & RESULT (tf_dim)
+   !-------------------------------------------------------------------
+   !> @brief 
+   !> This function search and save the biggest dimensions use 
+   !> in an array of variable structure.
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_var array of variable structure
+   !> @return array of dimension 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_var
+      
+      ! function
+      TYPE(TDIM), DIMENSION(ip_maxdim)     :: tf_dim
+
+      ! local variable
+      INTEGER(i4) :: il_nvar
+      
+      ! loop indices
+      INTEGER(i4) :: ji   
+      !-------------------------------------------------------------------
+                          
+      il_nvar=SIZE(td_var(:))
+                          
+      tf_dim(:)=dim_copy(td_var(1)%t_dim(:))
+
+      IF( il_nvar > 1 )THEN
+         DO ji=2,il_nvar     
+                             
+            IF( td_var(ji)%t_dim(1)%l_use .AND. &
+            &   td_var(ji)%t_dim(1)%i_len >= tf_dim(1)%i_len )THEN
+               tf_dim(1)=dim_copy(td_var(ji)%t_dim(1))
+            ENDIF            
+                             
+            IF( td_var(ji)%t_dim(2)%l_use .AND. &
+            &   td_var(ji)%t_dim(2)%i_len >= tf_dim(2)%i_len )THEN 
+               tf_dim(2)=dim_copy(td_var(ji)%t_dim(2))
+            ENDIF            
+                             
+            IF( td_var(ji)%t_dim(3)%l_use .AND. &
+            &   td_var(ji)%t_dim(3)%i_len >= tf_dim(3)%i_len )THEN 
+               tf_dim(3)=dim_copy(td_var(ji)%t_dim(3))
+            ENDIF            
+                             
+            IF( td_var(ji)%t_dim(4)%l_use .AND. &
+            &   td_var(ji)%t_dim(4)%i_len >= tf_dim(4)%i_len )THEN
+               tf_dim(4)=dim_copy(td_var(ji)%t_dim(4))
+            ENDIF
+
+         ENDDO
+      ENDIF
+
+   END FUNCTION var_max_dim
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var_limit_value(td_var)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine forced minimum and maximum value of variable,
+   !> with value of variable structure attribute d_min and d_max.
+   !> 
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure
+   !-------------------------------------------------------------------
+      
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+
+      ! local variable
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( ASSOCIATED(td_var%d_value) )THEN
+         !1- forced minimum value
+         IF( td_var%d_min /= dp_fill )THEN
+            WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill .AND. &
+               &   td_var%d_value(:,:,:,:) <  td_var%d_min )
+               td_var%d_value(:,:,:,:)=td_var%d_min
+            END WHERE
+         ENDIF
+
+         !2- forced maximum value 
+         IF( td_var%d_max /= dp_fill )THEN
+            WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill .AND. &
+               &   td_var%d_value(:,:,:,:) >  td_var%d_max )
+               td_var%d_value(:,:,:,:)=td_var%d_max
+            END WHERE
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE var_limit_value
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var_chg_name(td_var)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine replace name of the variable,
+   !> 
+   !> @details
+   !> output name (namout) is read from the namelist.
+   !>
+   !> @note the variable value should be already read.
+   !>
+   !> @author J.Paul
+   !> @date February, 2019 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( ASSOCIATED(td_var%d_value) )THEN
+         !- change variable name 
+         IF( TRIM(td_var%c_namout) /= TRIM(td_var%c_name) .AND. &
+         &   TRIM(td_var%c_namout) /= '' )THEN
+            td_var%c_name = TRIM(td_var%c_namout)
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE var_chg_name
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var_chg_unit(td_var)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine replace unit name of the variable,
+   !> and apply unit factor to the value of this variable.
+   !> 
+   !> @details
+   !> new unit name (unt) and unit factor (unf) are read from the namelist.
+   !>
+   !> @note the variable value should be already read.
+   !>
+   !> @author J.Paul
+   !> @date June, 2015 - Initial Version
+   !>
+   !> @param[inout] td_var variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+
+      ! local variable
+      TYPE(TATT)                :: tl_att
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( ASSOCIATED(td_var%d_value) )THEN
+         !- change value
+         IF( td_var%d_unf /= 1._dp )THEN
+            WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )
+               td_var%d_value(:,:,:,:)=td_var%d_value(:,:,:,:)*td_var%d_unf
+            END WHERE
+
+            !- change scale factor and offset to avoid mistake
+            tl_att=att_init('scale_factor',1._dp)
+            CALL var_move_att(td_var, tl_att)
+
+            tl_att=att_init('add_offset',0._dp)
+            CALL var_move_att(td_var, tl_att)
+         ENDIF
+
+         !- change unit name 
+         IF( TRIM(td_var%c_unt) /= TRIM(td_var%c_units) .AND. &
+         &   TRIM(td_var%c_unt) /= '' )THEN
+            tl_att=att_init('units',TRIM(td_var%c_unt))
+            CALL var_move_att(td_var,tl_att)
+         ENDIF
+         ! clean
+         CALL att_clean(tl_att)
+
+      ENDIF
+
+   END SUBROUTINE var_chg_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var_check_dim(td_var)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine check variable dimension expected, as defined in
+   !> file 'variable.cfg'.
+   !> 
+   !> @details 
+   !> compare dimension used in variable structure with string character
+   !> axis from configuration file. 
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[inout] td_var    variable structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR), INTENT(INOUT) :: td_var
+
+      ! local variable
+      INTEGER(i4)       :: il_naxis
+      INTEGER(i4)       :: il_ndim
+      CHARACTER(LEN=lc) :: cl_dim
+
+      LOGICAL           :: ll_warn
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      IF( TRIM(td_var%c_axis) /= '' )THEN
+
+         cl_dim=''
+         DO ji=1,ip_maxdim
+            IF( td_var%t_dim(ji)%l_use )THEN
+               cl_dim=TRIM(cl_dim)//TRIM(fct_upper(td_var%t_dim(ji)%c_sname))
+            ENDIF
+         ENDDO
+
+         il_naxis=LEN( TRIM(ADJUSTL(td_var%c_axis)) )
+         il_ndim =LEN( TRIM(ADJUSTL(cl_dim)) )
+         IF( il_naxis >= il_ndim )THEN
+            ll_warn=.FALSE.
+            DO ji=1,il_naxis
+               IF( INDEX(TRIM(cl_dim),td_var%c_axis(ji:ji)) == 0 )THEN
+                  CALL logger_debug("VAR CHECK DIM: "//TRIM(cl_dim)//&
+                     &              " "//TRIM(td_var%c_axis(ji:ji)) )
+                  ll_warn=.TRUE.
+                  EXIT
+               ENDIF
+            ENDDO
+
+            IF( ll_warn )THEN
+               CALL logger_warn("VAR CHECK DIM: variable dimension ("//&
+                  &             TRIM(cl_dim)//") not conform with dimension"//&
+                  &             " expected ("//TRIM(td_var%c_axis)//"). ") 
+            ENDIF
+         ELSE
+            ! too much dimension
+            CALL logger_warn("VAR CHECK DIM: too much dimension for "//&
+               &             "variable "//TRIM(td_var%c_name)//".")
+            cl_dim=TRIM(fct_upper(cp_dimorder))
+            il_ndim =LEN( TRIM(ADJUSTL(cl_dim)) )
+            DO ji=1,il_ndim 
+               IF( INDEX(TRIM(td_var%c_axis),cl_dim(ji:ji)) == 0 )THEN
+                  IF( td_var%t_dim(ji)%l_use )THEN
+                     IF( td_var%t_dim(ji)%i_len == 1 )THEN
+                        ! remove useless dimension
+                        CALL var_del_dim(td_var,td_var%t_dim(ji))
+                     ELSE
+                        CALL logger_warn("VAR CHECK DIM: variable "//&
+                           &     TRIM(td_var%c_name)//" should not use"//&
+                           &     " dimension "//TRIM(td_var%t_dim(ji)%c_name))
+                     ENDIF
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDIF
+
+      ELSE
+         ! no information on variable dimension expected
+      ENDIF
+
+   END SUBROUTINE var_check_dim
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var_reorder(td_var, cd_dimorder)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This subroutine reshape variable value and dimension 
+   !> in variable structure.
+   !> @details
+   !> output dimension will be ordered as defined in 
+   !> input array of dimension
+   !> Optionaly you could specify output dimension order with
+   !> string character of dimension
+   !> 
+   !> @author J.Paul
+   !> @date August, 2014 - Initial Version
+   !> @date July 2015 
+   !> - do not use dim_disorder anymore
+   !>
+   !> @param[inout] td_var       variable structure
+   !> @param[in]    cd_dimorder  string character of dimension order to be used
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR)              , INTENT(INOUT) :: td_var
+      CHARACTER(LEN=ip_maxdim), INTENT(IN   ), OPTIONAL :: cd_dimorder
+
+      ! local variable
+      CHARACTER(LEN=lc)                             :: cl_dimorder
+
+      REAL(dp)  , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_value
+
+      TYPE(TDIM), DIMENSION(ip_maxdim)              :: tl_dim
+
+      ! loop indices
+      !----------------------------------------------------------------
+
+      cl_dimorder=TRIM(cp_dimorder)
+      IF( PRESENT(cd_dimorder) ) cl_dimorder=TRIM(ADJUSTL(cd_dimorder))
+
+      CALL logger_debug("VAR REORDER: work on "//TRIM(td_var%c_name)//&
+         &  " new dimension order "//TRIM(cl_dimorder))
+
+      tl_dim(:)=dim_copy(td_var%t_dim(:))
+
+      CALL dim_reorder(tl_dim(:),TRIM(cl_dimorder))
+
+      ALLOCATE(dl_value(tl_dim(1)%i_len, &
+         &              tl_dim(2)%i_len, &
+         &              tl_dim(3)%i_len, &
+         &              tl_dim(4)%i_len ))
+
+      dl_value(:,:,:,:)=dim_reshape_2xyzt(tl_dim, &
+         &                                td_var%d_value(:,:,:,:))
+
+      ! change dimension
+      td_var%t_dim(:)=dim_copy(tl_dim(:))
+      ! change value
+      DEALLOCATE( td_var%d_value )
+      CALL var_add_value(td_var, dl_value(:,:,:,:))
+
+      ! clean
+      DEALLOCATE(dl_value)
+      CALL dim_clean(tl_dim(:))
+
+   END SUBROUTINE var_reorder
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var_get_unit(td_var) &
+         & RESULT (if_unit)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function get the next unused unit in array of variable structure. 
+   !> 
+   !> @author J.Paul
+   !> @date September, 2014 - Initial Version
+   !>
+   !> @param[in] td_var array of variable structure 
+   !> @return free variable id
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_var
+
+      ! function
+      INTEGER(i4)                          :: if_unit
+
+      ! local variable
+      ! loop indices
+      !----------------------------------------------------------------
+
+      if_unit=MAXVAL(td_var(:)%i_id)+1
+
+   END FUNCTION var_get_unit
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var_to_date(td_var) &
+         & RESULT (tf_date)
+   !-------------------------------------------------------------------
+   !> @brief
+   !> This function convert a time variable structure in date structure. 
+   !> 
+   !> @author J.Paul
+   !> @date November, 2014 - Initial Version
+   !> @date January, 2019
+   !> -  add case for units in hours  
+   !>
+   !> @param[in] td_var time variable structure 
+   !> @return date structure
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TVAR), INTENT(IN) :: td_var
+
+      ! function
+      TYPE(TDATE)            :: tf_date
+
+      ! local variable
+      CHARACTER(LEN=lc) :: cl_step
+      CHARACTER(LEN=lc) :: cl_date
+
+      INTEGER(i4) :: il_attid
+
+      INTEGER(i8) :: kl_nsec
+
+      TYPE(TDATE) :: tl_dateo
+      ! loop indices
+      !----------------------------------------------------------------
+
+      IF( INDEX(TRIM(td_var%c_name),'time') /= 0 )THEN
+         IF( ASSOCIATED(td_var%d_value) )THEN
+
+            il_attid=att_get_index(td_var%t_att(:),'units')
+            IF( il_attid /=0 )THEN
+               cl_step=fct_split(td_var%t_att(il_attid)%c_value,1,'since')
+               cl_date=fct_split(td_var%t_att(il_attid)%c_value,2,'since')
+
+               SELECT CASE(TRIM(cl_step))
+                  CASE('seconds')
+                     kl_nsec=INT(td_var%d_value(1,1,1,1),i8)
+                  CASE('hours')
+                     kl_nsec=INT(td_var%d_value(1,1,1,1)*3600,i8)
+                  CASE('days')
+                     kl_nsec=INT(td_var%d_value(1,1,1,1)*86400,i8)
+                  CASE DEFAULT
+                     CALL logger_error("VAR TO DATE: unknown units format "//&
+                     &  "in variable "//TRIM(td_var%c_name))
+               END SELECT
+
+               CALL logger_trace("VAR TO DATE: "//fct_str(kl_nsec)//&
+                  &              "seconds since "//TRIM(cl_date))
+
+               tl_dateo=date_init(cl_date)
+
+               tf_date=date_init(kl_nsec,tl_dateo)
+
+            ELSE
+               CALL logger_error("VAR TO DATE: no attribute units in "//&
+                  &              "variable "//TRIM(td_var%c_name))
+            ENDIF
+         ELSE
+            CALL logger_error("VAR TO DATE: no value associated to "//&
+               &              "variable "//TRIM(td_var%c_name))
+         ENDIF
+      ELSE
+         CALL logger_error("VAR TO DATE: variable "//TRIM(td_var%c_name)//&
+            &              "can not be convert in date.")
+      ENDIF
+
+   END FUNCTION var_to_date
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE var_get_dummy(cd_dummy)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill dummy variable array
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial Version
+   !> @date May, 2019
+   !> - read number of dummy element
+   !>
+   !> @param[in] cd_dummy dummy configuration file
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_dummy
+
+      ! local variable
+      INTEGER(i4)   :: il_fileid
+      INTEGER(i4)   :: il_status
+
+      LOGICAL       :: ll_exist
+
+      ! loop indices
+      ! namelist
+      INTEGER(i4)                                :: in_ndumvar
+      INTEGER(i4)                                :: in_ndumdim
+      INTEGER(i4)                                :: in_ndumatt
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumvar
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumdim
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumatt
+
+      !----------------------------------------------------------------
+      NAMELIST /namdum/ &   !< dummy namelist
+      &  in_ndumvar,&       !< number of variable  name
+      &  in_ndumdim,&       !< number of dimension name
+      &  in_ndumatt,&       !< number of attribute name
+      &  cn_dumvar, &       !< variable  name
+      &  cn_dumdim, &       !< dimension name
+      &  cn_dumatt          !< attribute name
+      !----------------------------------------------------------------
+
+      ! init
+      cm_dumvar(:)=''
+
+      ! read namelist
+      INQUIRE(FILE=TRIM(cd_dummy), EXIST=ll_exist)
+      IF( ll_exist )THEN
+    
+         il_fileid=fct_getunit()
+   
+         OPEN( il_fileid, FILE=TRIM(cd_dummy), &
+            &             FORM='FORMATTED',    &
+            &             ACCESS='SEQUENTIAL', &
+            &             STATUS='OLD',        &
+            &             ACTION='READ',       &
+            &             IOSTAT=il_status)
+         CALL fct_err(il_status)
+         IF( il_status /= 0 )THEN
+            CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_dummy))
+         ENDIF
+   
+         READ( il_fileid, NML = namdum )
+         im_ndumvar  = in_ndumvar
+         cm_dumvar(:)= cn_dumvar(:)
+
+         CLOSE( il_fileid )
+
+         IF( im_ndumvar > ip_maxdumcfg )THEN
+            CALL logger_fatal("VAR GET dUMMY : too much dummy variables &
+               &              ( >"//fct_str(ip_maxdumcfg)//" ). &
+               &              set ip_maxdumcfg to higher value.")
+         ENDIF
+
+      ENDIF
+   
+   END SUBROUTINE var_get_dummy
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION var_is_dummy(td_var) &
+         & RESULT (lf_dummy)
+   !-------------------------------------------------------------------
+   !> @brief This function check if variable is defined as dummy variable
+   !> in configuraton file
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial Version
+   !> @date, May, 2019
+   !> - use number of dummy elt in do-loop
+   !>
+   !> @param[in] td_var variable structure
+   !> @return true if variable is dummy variable 
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TVAR), INTENT(IN) :: td_var
+      
+      ! function
+      LOGICAL                :: lf_dummy
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      lf_dummy=.FALSE.
+      DO ji=1,im_ndumvar !ip_maxdumcfg
+         IF( fct_lower(td_var%c_name) == fct_lower(cm_dumvar(ji)) )THEN
+            lf_dummy=.TRUE.
+            EXIT
+         ENDIF
+      ENDDO
+
+   END FUNCTION var_is_dummy
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE var
+
Index: /utils/tools_ticket2413/SIREN/src/vgrid.f90
===================================================================
--- /utils/tools_ticket2413/SIREN/src/vgrid.f90	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/src/vgrid.f90	(revision 12863)
@@ -0,0 +1,872 @@
+!----------------------------------------------------------------------
+! NEMO system team, System and Interface for oceanic RElocable Nesting
+!----------------------------------------------------------------------
+!
+! DESCRIPTION:
+!> @brief This module manage vertical grid.
+!>
+!> @details
+!>    to set the depth of model levels and the resulting vertical scale
+!> factors:<br/>
+!> @code
+!>    CALL vgrid_zgr_z(dd_gdepw(:), dd_gdept(:), dd_e3w(:), dd_e3t(:), 
+!>                     dd_ppkth, dd_ppkth2, dd_ppacr, dd_ppacr2, 
+!>                     dd_ppdzmin, dd_pphmax, dd_pp_to_be_computed, 
+!>                     dd_ppa0, dd_ppa1, dd_ppa2, dd_ppsur)
+!> @endcode
+!>       - dd_gdepw is array of depth value on W point
+!>       - dd_gdept is array of depth value on T point
+!>       - dd_e3w   is array of vertical mesh size on W point
+!>       - dd_e3t   is array of vertical mesh size on T point
+!>       - dd_ppkth              see NEMO documentation
+!>       - dd_ppkth2             see NEMO documentation
+!>       - dd_ppacr              see NEMO documentation
+!>       - dd_ppdzmin            see NEMO documentation
+!>       - dd_pphmax             see NEMO documentation
+!>       - dd_pp_to_be_computed  see NEMO documentation
+!>       - dd_ppa1               see NEMO documentation
+!>       - dd_ppa2               see NEMO documentation
+!>       - dd_ppa0               see NEMO documentation
+!>       - dd_ppsur              see NEMO documentation
+!>    
+!> 
+!>    to set the depth and vertical scale factor in partial step z-coordinate
+!>  case:<br/>
+!> @code
+!>    CALL vgrid_zgr_zps(id_mbathy(:,:), dd_bathy(:,:), id_jpkmax, dd_gdepw(:), 
+!>                       dd_e3t(:), dd_e3zps_min, dd_e3zps_rat)
+!> @endcode
+!>       - id_mbathy is array of bathymetry level
+!>       - dd_bathy  is array of bathymetry
+!>       - id_jpkmax is the maximum number of level to be used
+!>       - dd_gdepw  is array of vertical mesh size on W point
+!>       - dd_e3t    is array of vertical mesh size on T point
+!>       - dd_e3zps_min    see NEMO documentation
+!>       - dd_e3zps_rat    see NEMO documentation
+!>
+!>    to check the bathymetry in levels:<br/>
+!> @code
+!>    CALL vgrid_zgr_bat_ctl(id_mbathy, id_jpkmax, id_jpk)
+!> @endcode
+!>       - id_mbathy is array of bathymetry level
+!>       - id_jpkmax is the maximum number of level to be used
+!>       - id_jpk    is the number of level
+!>   
+!>    to compute bathy level in T,U,V,F point from  Bathymetry file:<br/>
+!> @code
+!>    tl_level(:)=vgrid_get_level(td_bathy, [cd_namelist,] [td_dom,] [id_nlevel])
+!> @endcode
+!>       - td_bathy is Bathymetry file structure
+!>       - cd_namelist is namelist [optional]
+!>       - td_dom is domain structure [optional]
+!>       - id_nlevel is number of lelvel to be used [optional]
+!>    
+!> @author
+!> J.Paul
+!>
+!> @date November, 2013 - Initial Version
+!> @date Spetember, 2014
+!> - add header
+!> @date June, 2015 - update subroutine with NEMO 3.6
+!>
+!> @todo
+!> - fusionner vgrid et grid_zgr
+!>
+!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+!----------------------------------------------------------------------
+MODULE vgrid
+
+   USE netcdf                          ! nf90 library
+   USE kind                            ! F90 kind parameter
+   USE fct                             ! basic usefull function
+   USE global                          ! global parameter
+   USE phycst                          ! physical constant
+   USE logger                          ! log file manager
+   USE file                            ! file manager
+   USE var                             ! variable manager
+   USE dim                             ! dimension manager
+   USE dom                             ! domain manager
+   USE grid                            ! grid manager
+   USE iom                             ! I/O manager
+   USE mpp                             ! MPP manager
+   USE iom_mpp                         ! I/O MPP manager
+   IMPLICIT NONE
+   ! NOTE_avoid_public_variables_if_possible
+
+   ! type and variable
+
+   ! function and subroutine
+   PUBLIC :: vgrid_zgr_z 
+   PUBLIC :: vgrid_zgr_zps
+   PUBLIC :: vgrid_zgr_bat_ctl
+   PUBLIC :: vgrid_get_level
+
+CONTAINS
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE vgrid_zgr_z(dd_gdepw, dd_gdept, dd_e3w, dd_e3t,          &
+         &                dd_e3w_1d, dd_e3t_1d,                        &
+         &                dd_ppkth, dd_ppkth2, dd_ppacr, dd_ppacr2,    &
+         &                dd_ppdzmin, dd_pphmax, dd_pp_to_be_computed, &
+         &                dd_ppa0, dd_ppa1, dd_ppa2, dd_ppsur )
+   !-------------------------------------------------------------------
+   !> @brief This subroutine set the depth of model levels and the resulting 
+   !>      vertical scale factors.
+   !>
+   !> @details
+   !> ** Method  :   z-coordinate system (use in all type of coordinate)
+   !>        The depth of model levels is defined from an analytical
+   !>      function the derivative of which gives the scale factors.
+   !>        both depth and scale factors only depend on k (1d arrays). <br/>
+   !>              w-level: gdepw  = fsdep(k)                           <br/>
+   !>                       e3w(k) = dk(fsdep)(k)     = fse3(k)         <br/>
+   !>              t-level: gdept  = fsdep(k+0.5)                       <br/>
+   !>                       e3t(k) = dk(fsdep)(k+0.5) = fse3(k+0.5)     <br/>
+   !>
+   !> ** Action  : - gdept, gdepw : depth of T- and W-point (m)          <br/>
+   !>              -  e3t, e3w    : scale factors at T- and W-levels (m) <br/>
+   !>
+   !> @author G. Madec
+   !> @date Marsh,2008 - F90: Free form and module
+   !>
+   !> @note Reference : Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766.
+   !>
+   !> @param[inout] dd_gdepw
+   !> @param[inout] dd_gedpt
+   !> @param[inout] dd_e3w
+   !> @param[inout] dd_e2t
+   !> @param[in] dd_ppkth 
+   !> @param[in] dd_ppkth2
+   !> @param[in] dd_ppacr
+   !> @param[in] dd_ppacr2
+   !> @param[in] dd_ppdzmin
+   !> @param[in] dd_pphmax 
+   !> @param[in] dd_pp_to_be_computed
+   !> @param[in] dd_ppa1
+   !> @param[in] dd_ppa2 
+   !> @param[in] dd_ppa0
+   !> @param[in] dd_ppsur
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_gdepw
+      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_gdept
+      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_e3w
+      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_e3t
+      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_e3w_1d
+      REAL(dp), DIMENSION(:), INTENT(INOUT) :: dd_e3t_1d
+
+      REAL(dp)              , INTENT(IN   ) :: dd_ppkth
+      REAL(dp)              , INTENT(IN   ) :: dd_ppkth2
+      REAL(dp)              , INTENT(IN   ) :: dd_ppacr
+      REAL(dp)              , INTENT(IN   ) :: dd_ppacr2
+
+      REAL(dp)              , INTENT(IN   ) :: dd_ppdzmin
+      REAL(dp)              , INTENT(IN   ) :: dd_pphmax
+      REAL(dp)              , INTENT(IN   ) :: dd_pp_to_be_computed
+
+      REAL(dp)              , INTENT(IN   ) :: dd_ppa0
+      REAL(dp)              , INTENT(IN   ) :: dd_ppa1
+      REAL(dp)              , INTENT(IN   ) :: dd_ppa2
+      REAL(dp)              , INTENT(IN   ) :: dd_ppsur
+
+      ! local variable
+      REAL(dp) :: dl_zkth
+      REAL(dp) :: dl_zkth2
+      REAL(dp) :: dl_zdzmin
+      REAL(dp) :: dl_zhmax
+      REAL(dp) :: dl_zacr
+      REAL(dp) :: dl_zacr2
+
+      REAL(dp) :: dl_ppacr
+      REAL(dp) :: dl_ppacr2
+
+      REAL(dp) :: dl_za0
+      REAL(dp) :: dl_za1
+      REAL(dp) :: dl_za2
+      REAL(dp) :: dl_zsur
+      REAL(dp) :: dl_zw
+      REAL(dp) :: dl_zt
+
+      INTEGER(i4) :: il_jpk
+
+      ! loop indices
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+       dl_ppacr = dd_ppacr
+       IF( dd_ppa1 == 0._dp ) dl_ppacr =1.0
+       dl_ppacr2= dd_ppacr2
+       IF( dd_ppa2 == 0._dp ) dl_ppacr2=1.0
+
+      ! Set variables from parameters
+      ! ------------------------------
+       dl_zkth   = dd_ppkth       ;   dl_zacr  = dl_ppacr
+       dl_zdzmin = dd_ppdzmin     ;   dl_zhmax = dd_pphmax
+       dl_zkth2  = dd_ppkth2      ;   dl_zacr2 = dl_ppacr2
+
+       il_jpk = SIZE(dd_gdepw(:))
+
+      ! If ppa1 and ppa0 and ppsur are et to pp_to_be_computed
+      !  za0, za1, zsur are computed from ppdzmin , pphmax, ppkth, ppacr
+      !
+       IF(  dd_ppa1  == dd_pp_to_be_computed  .AND.  &
+         &  dd_ppa0  == dd_pp_to_be_computed  .AND.  &
+         &  dd_ppsur == dd_pp_to_be_computed           ) THEN
+         dl_za1 = ( dl_zdzmin - dl_zhmax / REAL((il_jpk-1),dp) ) &
+             &     / ( TANH((1-dl_zkth)/dl_zacr) - dl_zacr/REAL((il_jpk-1),dp) &
+             &     * (  LOG( COSH( (REAL(il_jpk,dp) - dl_zkth) / dl_zacr) )    &
+             &        - LOG( COSH(( 1.0  - dl_zkth) / dl_zacr) ) )  )
+
+         dl_za0  = dl_zdzmin - dl_za1 * TANH( (1.0-dl_zkth) / dl_zacr )
+         dl_zsur = - dl_za0 - dl_za1 * dl_zacr * LOG( COSH( (1-dl_zkth) / dl_zacr )  )
+
+       ELSE
+         dl_za1 = dd_ppa1 ;       dl_za0 = dd_ppa0 ;  dl_zsur = dd_ppsur
+         dl_za2 = dd_ppa2
+       ENDIF
+
+      ! Reference z-coordinate (depth - scale factor at T- and W-points)
+      ! ======================
+      IF(  dd_ppkth == 0. )THEN            !  uniform vertical grid       
+
+         dl_za1 = dl_zhmax/REAL((il_jpk-1),dp) 
+         DO jk = 1, il_jpk
+            dl_zw = REAL(jk,dp)
+            dl_zt = REAL(jk,dp) + 0.5_dp
+            dd_gdepw(jk) = ( dl_zw - 1.0 ) * dl_za1
+            dd_gdept(jk) = ( dl_zt - 1.0 ) * dl_za1
+            dd_e3w  (jk) =  dl_za1
+            dd_e3t  (jk) =  dl_za1
+         END DO
+
+      ELSE
+
+         DO jk = 1, il_jpk
+            dl_zw = REAL( jk,dp)
+            dl_zt = REAL( jk,dp) + 0.5_dp
+            dd_gdepw(jk) = ( dl_zsur + dl_za0 * dl_zw + &
+            &                dl_za1 * dl_zacr * LOG( COSH( (dl_zw-dl_zkth)/dl_zacr ) ) + &
+            &                dl_za2 * dl_zacr2* LOG( COSH( (dl_zw-dl_zkth2)/dl_zacr2 ) ) )
+            dd_gdept(jk) = ( dl_zsur + dl_za0 * dl_zt + &
+            &                dl_za1 * dl_zacr * LOG( COSH( (dl_zt-dl_zkth)/dl_zacr ) ) + &
+            &                dl_za2 * dl_zacr2* LOG( COSH( (dl_zt-dl_zkth2)/dl_zacr2 ) ) )
+            dd_e3w  (jk) =             dl_za0 + &
+            &                          dl_za1 * TANH(      (dl_zw-dl_zkth)/dl_zacr   ) + &
+            &                          dl_za2 * TANH(      (dl_zw-dl_zkth2)/dl_zacr2 )
+            dd_e3t  (jk) =             dl_za0 + &
+            &                          dl_za1 * TANH(      (dl_zt-dl_zkth)/dl_zacr   ) + &
+            &                          dl_za2 * TANH(      (dl_zt-dl_zkth2)/dl_zacr2 )
+         END DO
+         dd_gdepw(1) = 0.e0   ! force first w-level to be exactly at zero
+
+      ENDIF
+
+   ! need to be like this to compute the pressure gradient with ISF.
+   ! If not, level beneath the ISF are not aligned (sum(e3t) /= depth)
+   ! define e3t_0 and e3w_0 as the differences between gdept and gdepw respectively
+      DO jk = 1, il_jpk-1
+         dd_e3t_1d(jk) = dd_gdepw(jk+1)-dd_gdepw(jk) 
+      END DO
+      dd_e3t_1d(il_jpk) = dd_e3t_1d(il_jpk-1) ! we don't care because this level is masked in NEMO
+
+      DO jk = 2, il_jpk
+         dd_e3w_1d(jk) = dd_gdept(jk) - dd_gdept(jk-1) 
+      END DO
+      dd_e3w_1d(1  ) = 2._dp * (dd_gdept(1) - dd_gdepw(1))
+
+      ! Control and  print
+      ! ==================
+
+      DO jk = 1, il_jpk
+         IF( dd_e3w(jk)  <= 0. .OR. dd_e3t(jk)  <= 0. )then
+            CALL logger_debug("VGRID ZGR Z: e3w or e3t <= 0 ")
+         ENDIF   
+
+         IF( dd_e3w_1d(jk)  <= 0. .OR. dd_e3t_1d(jk)  <= 0. )then
+            CALL logger_debug("VGRID ZGR Z: e3w_1d or e3t_1d <= 0 ")
+         ENDIF
+
+         IF( dd_gdepw(jk) < 0. .OR. dd_gdept(jk) < 0. )then
+            CALL logger_debug("VGRID ZGR Z: gdepw or gdept < 0 ")
+         ENDIF
+      END DO
+
+   END SUBROUTINE vgrid_zgr_z
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE vgrid_zgr_bat(dd_bathy, dd_gdepw, dd_hmin, dd_fill)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine
+   !>
+   !> @todo add subroutine description
+   !>
+   !> @param[inout] dd_bathy
+   !> @param[in] dd_gdepw
+   !> @param[in] dd_hmin
+   !> @param[in] dd_fill
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      REAL(dp), DIMENSION(:,:), INTENT(INOUT) :: dd_bathy 
+      REAL(dp), DIMENSION(:)  , INTENT(IN   ) :: dd_gdepw 
+      REAL(dp)                , INTENT(IN   ) :: dd_hmin
+      REAL(dp)                , INTENT(IN   ), OPTIONAL :: dd_fill
+
+      ! local
+      INTEGER(i4) :: il_jpk
+      
+      REAL(dp)    :: dl_hmin
+      REAL(dp)    :: dl_fill
+
+      ! loop indices
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+      il_jpk = SIZE(dd_gdepw(:))
+
+      dl_fill=0._dp
+      IF( PRESENT(dd_fill) ) dl_fill=dd_fill
+
+      IF( dd_hmin < 0._dp ) THEN
+         jk = - INT( dd_hmin )     ! from a nb of level
+      ELSE
+         jk = MINLOC( dd_gdepw, mask = dd_gdepw > dd_hmin, dim = 1 )  ! from a depth
+      ENDIF
+      
+      dl_hmin = dd_gdepw(jk+1) ! minimum depth = ik+1 w-levels 
+      WHERE( dd_bathy(:,:) <= 0._wp .OR. dd_bathy(:,:) == dl_fill )
+         dd_bathy(:,:) = dl_fill                         ! min=0     over the lands
+      ELSE WHERE
+         dd_bathy(:,:) = MAX(  dl_hmin , dd_bathy(:,:)  )   ! min=dl_hmin over the oceans
+      END WHERE
+      WRITE(*,*) 'Minimum ocean depth: ', dl_hmin, ' minimum number of ocean levels : ', jk      
+
+   END SUBROUTINE vgrid_zgr_bat
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE vgrid_zgr_zps(id_mbathy, dd_bathy, id_jpkmax, &
+         &                  dd_gdepw, dd_e3t,               &
+         &                  dd_e3zps_min, dd_e3zps_rat,     &
+         &                  dd_fill )
+   !-------------------------------------------------------------------
+   !> @brief This subroutine set the depth and vertical scale factor in partial step
+   !>      z-coordinate case 
+   !>
+   !> @details
+   !> ** Method  :   Partial steps : computes the 3D vertical scale factors
+   !>      of T-, U-, V-, W-, UW-, VW and F-points that are associated with
+   !>      a partial step representation of bottom topography.
+   !>
+   !>        The reference depth of model levels is defined from an analytical
+   !>      function the derivative of which gives the reference vertical
+   !>      scale factors.
+   !>      From  depth and scale factors reference, we compute there new value
+   !>      with partial steps  on 3d arrays ( i, j, k ).
+   !>
+   !>      w-level: 
+   !>          - gdepw_ps(i,j,k)  = fsdep(k)
+   !>          - e3w_ps(i,j,k) = dk(fsdep)(k)     = fse3(i,j,k)
+   !>      t-level: 
+   !>          - gdept_ps(i,j,k)  = fsdep(k+0.5)
+   !>          - e3t_ps(i,j,k) = dk(fsdep)(k+0.5) = fse3(i,j,k+0.5)
+   !>
+   !>      With the help of the bathymetric file ( bathymetry_depth_ORCA_R2.nc),
+   !>      we find the mbathy index of the depth at each grid point.
+   !>      This leads us to three cases:
+   !>          - bathy = 0 => mbathy = 0
+   !>          - 1 < mbathy < jpkm1    
+   !>          - bathy > gdepw(jpk) => mbathy = jpkm1  
+   !>
+   !>      Then, for each case, we find the new depth at t- and w- levels
+   !>      and the new vertical scale factors at t-, u-, v-, w-, uw-, vw- 
+   !>      and f-points.
+   !> 
+   !>        This routine is given as an example, it must be modified
+   !>      following the user s desiderata. nevertheless, the output as
+   !>      well as the way to compute the model levels and scale factors
+   !>      must be respected in order to insure second order accuracy
+   !>      schemes.
+   !>
+   !>  @warning 
+   !>         - gdept, gdepw and e3 are positives
+   !>         - gdept_ps, gdepw_ps and e3_ps are positives
+   !>
+   !> @author A. Bozec, G. Madec
+   !> @date February, 2009 - F90: Free form and module
+   !> @date February, 2009 
+   !> - A. de Miranda : rigid-lid + islands
+   !>
+   !> @note Reference : Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270.
+   !>
+   !> @param[inout] id_mbathy
+   !> @param[inout] dd_bathy
+   !> @param[inout] id_jpkmax 
+   !> @param[in] dd_gdepw
+   !> @param[in] dd_e3t 
+   !> @param[in] dd_e3zps_min
+   !> @param[in] dd_e3zps_rat
+   !> @param[in] dd_fill
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      INTEGER(i4), DIMENSION(:,:), INTENT(  OUT) :: id_mbathy
+      REAL(dp)   , DIMENSION(:,:), INTENT(INOUT) :: dd_bathy
+      INTEGER(i4)                , INTENT(INOUT) :: id_jpkmax
+      REAL(dp)   , DIMENSION(:)  , INTENT(IN   ) :: dd_gdepw
+      REAL(dp)   , DIMENSION(:)  , INTENT(IN   ) :: dd_e3t
+      REAL(dp)                   , INTENT(IN   ) :: dd_e3zps_min
+      REAL(dp)                   , INTENT(IN   ) :: dd_e3zps_rat
+      REAL(dp)                   , INTENT(IN   ), OPTIONAL :: dd_fill
+
+      ! local variable
+      REAL(dp) :: dl_zmax     ! Maximum depth
+      !REAL(dp) :: dl_zmin     ! Minimum depth
+      REAL(dp) :: dl_zdepth   ! Ajusted ocean depth to avoid too small e3t 
+      REAL(dp) :: dl_fill     
+
+      INTEGER(i4) :: il_jpk
+      INTEGER(i4) :: il_jpkm1
+      INTEGER(i4) :: il_jpiglo
+      INTEGER(i4) :: il_jpjglo
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      INTEGER(i4) :: jk
+      !----------------------------------------------------------------
+
+      il_jpk=SIZE(dd_gdepw(:))
+      il_jpiglo=SIZE(id_mbathy(:,:),DIM=1)
+      il_jpjglo=SIZE(id_mbathy(:,:),DIM=2)
+
+      dl_fill=0._dp
+      IF( PRESENT(dd_fill) ) dl_fill=dd_fill
+
+      ! Initialization of constant
+      dl_zmax = dd_gdepw(il_jpk) + dd_e3t(il_jpk) ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_1d(jpkm1) )
+
+      ! bounded value of bathy (min already set at the end of zgr_bat)
+      WHERE( dd_bathy(:,:) /= dl_fill )
+         dd_bathy(:,:) = MIN( dl_zmax ,  dd_bathy(:,:) )
+      END WHERE
+
+      ! bathymetry in level (from bathy_meter)
+      ! ===================
+      il_jpkm1=il_jpk-1
+      ! initialize mbathy to the maximum ocean level available
+      id_mbathy(:,:) = il_jpkm1
+
+      ! storage of land and island's number (zera and negative values) in mbathy
+      DO jj = 1, il_jpjglo
+         DO ji= 1, il_jpiglo
+            IF( dd_bathy(ji,jj) <= 0._dp )THEN
+               id_mbathy(ji,jj) = INT(dd_bathy(ji,jj),i4)
+            ELSEIF( dd_bathy(ji,jj) == dl_fill )THEN
+               id_mbathy(ji,jj) = 0_i4
+            ENDIF
+         END DO
+      END DO
+
+      ! Compute mbathy for ocean points (i.e. the number of ocean levels)
+      ! find the number of ocean levels such that the last level thickness
+      ! is larger than the minimum of e3zps_min and e3zps_rat * e3t (where
+      ! e3t is the reference level thickness
+
+      DO jk = il_jpkm1, 1, -1
+         dl_zdepth = dd_gdepw(jk) + MIN( dd_e3zps_min, dd_e3t(jk)*dd_e3zps_rat )
+
+         DO jj = 1, il_jpjglo
+            DO ji = 1, il_jpiglo
+               IF( dd_bathy(ji,jj) /= dl_fill )THEN
+                  IF( 0. < dd_bathy(ji,jj) .AND. &
+                  &       dd_bathy(ji,jj) <= dl_zdepth ) id_mbathy(ji,jj) = jk-1
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! ================
+      ! Bathymetry check
+      ! ================
+
+      CALL vgrid_zgr_bat_ctl( id_mbathy, id_jpkmax, il_jpk)
+
+   END SUBROUTINE vgrid_zgr_zps
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   SUBROUTINE vgrid_zgr_bat_ctl(id_mbathy, id_jpkmax, id_jpk)
+   !-------------------------------------------------------------------
+   !> @brief This subroutine check the bathymetry in levels 
+   !>
+   !> @details
+   !> ** Method  :   The array mbathy is checked to verified its consistency
+   !>      with the model options. in particular:
+   !>            mbathy must have at least 1 land grid-points (mbathy<=0)
+   !>                  along closed boundary.
+   !>            mbathy must be cyclic IF jperio=1.
+   !>            mbathy must be lower or equal to jpk-1.
+   !>            isolated ocean grid points are suppressed from mbathy
+   !>                  since they are only connected to remaining
+   !>                  ocean through vertical diffusion.
+   !>      C A U T I O N : mbathy will be modified during the initializa-
+   !>      tion phase to become the number of non-zero w-levels of a water
+   !>      column, with a minimum value of 1.
+   !>
+   !> ** Action  : - update mbathy: level bathymetry (in level index)
+   !>              - update bathy : meter bathymetry (in meters)
+   !>
+   !> @author G.Madec
+   !> @date Marsh, 2008 - Original code
+   !>
+   !> @param[in] id_mbathy 
+   !> @param[in] id_jpkmax
+   !> @param[in] id_jpk
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument      
+      INTEGER(i4), DIMENSION(:,:), INTENT(INOUT) :: id_mbathy
+      INTEGER(i4)                , INTENT(INOUT) :: id_jpkmax
+      INTEGER(i4)                , INTENT(INOUT) :: id_jpk
+
+      ! local variable
+      INTEGER(i4) :: il_jpiglo
+      INTEGER(i4) :: il_jpjglo
+
+      INTEGER(i4) :: il_icompt
+      INTEGER(i4) :: il_ibtest
+      INTEGER(i4) :: il_ikmax
+      INTEGER(i4) :: il_jpkm1
+
+      INTEGER(i4) :: il_jim
+      INTEGER(i4) :: il_jip
+      INTEGER(i4) :: il_jjm
+      INTEGER(i4) :: il_jjp
+
+      ! loop indices
+      INTEGER(i4) :: jl
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+      !----------------------------------------------------------------
+
+      il_jpiglo=SIZE(id_mbathy(:,:),DIM=1)
+      il_jpjglo=SIZE(id_mbathy(:,:),DIM=2)
+
+      ! ================
+      ! Bathymetry check
+      ! ================
+
+      ! suppress isolated ocean grid points'
+      il_icompt = 0
+
+      DO jl = 1, 2
+         DO jj = 1, il_jpjglo
+            DO ji = 1, il_jpiglo
+               il_jim=max(ji-1,1) ; il_jip=min(ji+1,il_jpiglo)
+               il_jjm=max(jj-1,1) ; il_jjp=min(jj+1,il_jpjglo)
+
+               if(il_jim==ji) il_jim=il_jip ; if(il_jip==ji) il_jip=il_jim
+               if(il_jjm==jj) il_jjm=il_jjp ; if(il_jjp==jj) il_jjp=il_jjm
+
+               il_ibtest = MAX( id_mbathy(il_jim,jj), id_mbathy(il_jip,jj),  &
+                                id_mbathy(ji,il_jjm),id_mbathy(ji,il_jjp) )
+
+               IF( il_ibtest < id_mbathy(ji,jj) ) THEN
+                  id_mbathy(ji,jj) = il_ibtest
+                  il_icompt = il_icompt + 1
+               ENDIF
+            END DO
+         END DO
+
+      END DO
+      IF( il_icompt == 0 ) THEN
+         CALL logger_info("VGRID ZGR BAT CTL:  no isolated ocean grid points")
+      ELSE
+         CALL logger_info("VGRID ZGR BAT CTL:"//TRIM(fct_str(il_icompt))//&
+         &              " ocean grid points suppressed")
+      ENDIF
+
+      id_mbathy(:,:) = MAX( 0, id_mbathy(:,:))
+
+      ! Number of ocean level inferior or equal to jpkm1
+
+      il_ikmax = 0
+      DO jj = 1, il_jpjglo
+         DO ji = 1, il_jpiglo
+            il_ikmax = MAX( il_ikmax, id_mbathy(ji,jj) )
+         END DO
+      END DO
+
+      id_jpkmax=id_jpk
+
+      il_jpkm1=id_jpk-1
+      IF( il_ikmax > il_jpkm1 ) THEN
+         CALL logger_error("VGRID ZGR BAT CTL: maximum number of ocean level = "//&
+         &              TRIM(fct_str(il_ikmax))//" >  jpk-1."//&
+         &              " Change jpk to "//TRIM(fct_str(il_ikmax+1))//&
+         &              " to use the exact ead bathymetry" )
+      ELSE IF( il_ikmax < il_jpkm1 ) THEN
+         id_jpkmax=il_ikmax+1
+      ENDIF
+
+   END SUBROUTINE vgrid_zgr_bat_ctl
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   FUNCTION vgrid_get_level(td_bathy, cd_namelist, td_dom, id_nlevel) &
+         & RESULT (tf_var)
+   !-------------------------------------------------------------------
+   !> @brief This function compute bathy level in T,U,V,F point, and return 
+   !> them as array of variable structure
+   !>
+   !> @details
+   !> Bathymetry is read on Bathymetry file, then bathy level is computed 
+   !> on T point, and finally fit to U,V,F point.
+   !>
+   !> you could specify :<br/>
+   !> - namelist where find parameter to set the depth of model levels
+   !> (default use GLORYS 75 levels parameters)
+   !> - domain structure to specify on e area to work on
+   !> - number of level to be used
+   !>
+   !> @author J.Paul
+   !> @date November, 2013 - Initial Version
+   !>
+   !> @param[in] td_bathy     Bathymetry file structure 
+   !> @param[in] cd_namelist  namelist 
+   !> @param[in] td_dom       domain structure
+   !> @param[in] id_nlevel    number of lelvel to be used 
+   !> @return array of level on T,U,V,F point (variable structure)
+   !-------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      ! Argument
+      TYPE(TMPP)      , INTENT(IN) :: td_bathy
+      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_namelist
+      TYPE(TDOM)      , INTENT(IN), OPTIONAL :: td_dom
+      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_nlevel
+
+      ! function
+      TYPE(TVAR), DIMENSION(ip_npoint)       :: tf_var
+
+      ! local variable
+      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_gdepw 
+      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_gdept 
+      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3w 
+      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3t
+      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3w_1d 
+      REAL(dp)   , DIMENSION(:)      , ALLOCATABLE :: dl_e3t_1d
+
+      INTEGER(i4)                                  :: il_status
+      INTEGER(i4)                                  :: il_fileid
+      INTEGER(i4)                                  :: il_jpkmax
+      INTEGER(i4), DIMENSION(2,2)                  :: il_xghost
+      INTEGER(i4), DIMENSION(:,:)    , ALLOCATABLE :: il_mbathy
+      INTEGER(i4), DIMENSION(:,:,:,:), ALLOCATABLE :: il_level
+      
+      LOGICAL                                      :: ll_exist
+
+      TYPE(TDIM) , DIMENSION(ip_maxdim)            :: tl_dim
+
+      TYPE(TDOM)                                   :: tl_dom
+
+      TYPE(TVAR)                                   :: tl_var
+
+      TYPE(TMPP)                                   :: tl_bathy
+
+      ! loop indices
+      INTEGER(i4) :: ji
+      INTEGER(i4) :: jj
+
+      INTEGER(i4) :: jip
+      INTEGER(i4) :: jjp
+
+      !namelist (intialise with GLORYS 75 levels parameters)
+      REAL(dp)                                :: dn_pp_to_be_computed = 0._dp
+      REAL(dp)                                :: dn_ppsur     = -3958.951371276829_dp
+      REAL(dp)                                :: dn_ppa0      =   103.9530096000000_dp
+      REAL(dp)                                :: dn_ppa1      =     2.4159512690000_dp
+      REAL(dp)                                :: dn_ppa2      =   100.7609285000000_dp
+      REAL(dp)                                :: dn_ppkth     =    15.3510137000000_dp
+      REAL(dp)                                :: dn_ppkth2    =    48.0298937200000_dp
+      REAL(dp)                                :: dn_ppacr     =     7.0000000000000_dp
+      REAL(dp)                                :: dn_ppacr2    =    13.000000000000_dp
+      REAL(dp)                                :: dn_ppdzmin   = 6._dp
+      REAL(dp)                                :: dn_pphmax    = 5750._dp
+      INTEGER(i4)                             :: in_nlevel    = 75
+
+      REAL(dp)                                :: dn_e3zps_min = 25._dp
+      REAL(dp)                                :: dn_e3zps_rat = 0.2_dp
+      !----------------------------------------------------------------
+      NAMELIST /namzgr/ &
+      &  dn_pp_to_be_computed, &
+      &  dn_ppsur,     &
+      &  dn_ppa0,      &
+      &  dn_ppa1,      &
+      &  dn_ppa2,      &
+      &  dn_ppkth,     &
+      &  dn_ppkth2,    &
+      &  dn_ppacr,     &
+      &  dn_ppacr2,    &
+      &  dn_ppdzmin,   &
+      &  dn_pphmax,    &
+      &  in_nlevel
+
+      NAMELIST /namzps/ &
+      &  dn_e3zps_min, &
+      &  dn_e3zps_rat
+      !----------------------------------------------------------------
+
+      IF( PRESENT(cd_namelist) )THEN
+         !1- read namelist
+         INQUIRE(FILE=TRIM(cd_namelist), EXIST=ll_exist)
+         IF( ll_exist )THEN
+ 
+            il_fileid=fct_getunit()
+
+            OPEN( il_fileid, FILE=TRIM(cd_namelist), &
+            &                FORM='FORMATTED',       &
+            &                ACCESS='SEQUENTIAL',    &
+            &                STATUS='OLD',           &
+            &                ACTION='READ',          &
+            &                IOSTAT=il_status)
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_fatal("VGRID GET LEVEL: ERROR opening "//&
+               &  TRIM(cd_namelist))
+            ENDIF
+
+            READ( il_fileid, NML = namzgr )
+            READ( il_fileid, NML = namzps )
+
+            CLOSE( il_fileid, IOSTAT=il_status )
+            CALL fct_err(il_status)
+            IF( il_status /= 0 )THEN
+               CALL logger_error("VGRID GET LEVELL: ERROR closing "//&
+               &  TRIM(cd_namelist))
+            ENDIF
+
+         ELSE
+
+            CALL logger_fatal("VGRID GET LEVEL: ERROR. can not find "//&
+            &  TRIM(cd_namelist))
+
+         ENDIF
+      ENDIF
+
+      ! copy structure
+      tl_bathy=mpp_copy(td_bathy)
+
+      ! get domain
+      IF( PRESENT(td_dom) )THEN
+         tl_dom=dom_copy(td_dom)
+      ELSE
+         CALL logger_debug("VGRID GET LEVEL: get dom from "//&
+         &  TRIM(tl_bathy%c_name))
+         tl_dom=dom_init(tl_bathy)
+      ENDIF
+
+      ! get ghost cell
+      il_xghost(:,:)=grid_get_ghost(tl_bathy)
+
+      ! open mpp files
+      CALL iom_dom_open(tl_bathy, tl_dom)
+
+      ! check namelist
+      IF( PRESENT(id_nlevel) ) in_nlevel=id_nlevel
+      IF( in_nlevel == 0 )THEN
+         CALL logger_fatal("VGRID GET LEVEL: number of level to be used "//&
+         &                 "is not specify. check namelist.")
+      ENDIF
+
+      ! read bathymetry
+      tl_var=iom_dom_read_var(tl_bathy,'bathymetry',tl_dom)
+      ! clean
+      CALL dom_clean(tl_dom)
+
+      ! remove ghost cell
+      CALL grid_del_ghost(tl_var, il_xghost(:,:))
+
+      ! force _FillValue (land) to be 0
+      WHERE( tl_var%d_value(:,:,1,1) == tl_var%d_fill )
+         tl_var%d_value(:,:,1,1)=0
+      END WHERE
+
+      ! clean
+      CALL iom_dom_close(tl_bathy)
+      CALL mpp_clean(tl_bathy)
+
+      ! compute vertical grid
+      ALLOCATE( dl_gdepw(in_nlevel), dl_gdept(in_nlevel) ) 
+      ALLOCATE(   dl_e3w(in_nlevel),   dl_e3t(in_nlevel) ) 
+      ALLOCATE(   dl_e3w_1d(in_nlevel),   dl_e3t_1d(in_nlevel) ) 
+      CALL vgrid_zgr_z( dl_gdepw(:), dl_gdept(:), dl_e3w(:), dl_e3t(:), &
+      &                 dl_e3w_1d, dl_e3t_1d, &
+      &                 dn_ppkth, dn_ppkth2, dn_ppacr, dn_ppacr2,       &
+      &                 dn_ppdzmin, dn_pphmax, dn_pp_to_be_computed,    &
+      &                 dn_ppa0, dn_ppa1, dn_ppa2, dn_ppsur )
+
+      ! compute bathy level on T point
+      ALLOCATE( il_mbathy(tl_var%t_dim(1)%i_len, &
+      &                   tl_var%t_dim(2)%i_len ) )
+      CALL vgrid_zgr_zps( il_mbathy(:,:), tl_var%d_value(:,:,1,1), il_jpkmax, &
+      &                   dl_gdepw(:), dl_e3t(:),               &
+      &                   dn_e3zps_min, dn_e3zps_rat )
+
+      DEALLOCATE( dl_gdepw, dl_gdept ) 
+      DEALLOCATE(   dl_e3w,   dl_e3t )
+
+      ! compute bathy level in T,U,V,F point
+      ALLOCATE( il_level(tl_var%t_dim(1)%i_len, &
+      &                  tl_var%t_dim(2)%i_len, &
+      &                  ip_npoint,1) )
+
+      DO jj=1,tl_var%t_dim(2)%i_len
+         DO ji= 1,tl_var%t_dim(1)%i_len
+
+         jip=MIN(ji+1,tl_var%t_dim(1)%i_len)
+         jjp=MIN(jj+1,tl_var%t_dim(2)%i_len)
+
+         ! T point
+         il_level(ji,jj,jp_T,1)=il_mbathy(ji,jj)
+         ! U point
+         il_level(ji,jj,jp_U,1)=MIN( il_mbathy(ji, jj ), il_mbathy(jip, jj ))
+         ! V point
+         il_level(ji,jj,jp_V,1)=MIN( il_mbathy(ji, jj ), il_mbathy(ji , jjp))
+         ! F point
+         il_level(ji,jj,jp_F,1)=MIN( il_mbathy(ji, jj ), il_mbathy(jip, jj ), &
+         &                           il_mbathy(ji, jjp), il_mbathy(jip, jjp))
+
+         ENDDO
+      ENDDO
+
+      DEALLOCATE( il_mbathy )
+
+      tl_dim(:)=dim_copy(tl_var%t_dim(:))
+      ! clean
+      CALL var_clean(tl_var)
+
+      ! only 2 first dimension to be used
+      tl_dim(3:4)%l_use=.FALSE.
+
+      tf_var(jp_T)=var_init('tlevel', il_level(:,:,jp_T:jp_T,:), td_dim=tl_dim(:))
+      tf_var(jp_U)=var_init('ulevel', il_level(:,:,jp_U:jp_U,:), td_dim=tl_dim(:))
+      tf_var(jp_V)=var_init('vlevel', il_level(:,:,jp_V:jp_V,:), td_dim=tl_dim(:))
+      tf_var(jp_F)=var_init('flevel', il_level(:,:,jp_F:jp_F,:), td_dim=tl_dim(:))
+
+      DEALLOCATE( il_level )
+
+      CALL grid_add_ghost( tf_var(jp_T), il_xghost(:,:) )
+      CALL grid_add_ghost( tf_var(jp_U), il_xghost(:,:) )
+      CALL grid_add_ghost( tf_var(jp_V), il_xghost(:,:) )
+      CALL grid_add_ghost( tf_var(jp_F), il_xghost(:,:) )
+
+      ! clean
+      CALL dim_clean(tl_dim(:))
+
+   END FUNCTION vgrid_get_level
+   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+END MODULE vgrid
+
Index: /utils/tools_ticket2413/SIREN/templates/README
===================================================================
--- /utils/tools_ticket2413/SIREN/templates/README	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/templates/README	(revision 12863)
@@ -0,0 +1,7 @@
+
+To be sure to use a template of namelist up to date, 
+run create_templates.py on the Siren program you want to use.
+
+Exemple:
+python create_templates.py create_bathy.f90 create_bathy.nam
+
Index: /utils/tools_ticket2413/SIREN/templates/create_templates.py
===================================================================
--- /utils/tools_ticket2413/SIREN/templates/create_templates.py	(revision 12863)
+++ /utils/tools_ticket2413/SIREN/templates/create_templates.py	(revision 12863)
@@ -0,0 +1,114 @@
+#!/usr/bin/python
+# -*- coding:Utf-8 -*-
+"""
+This script create template of namelist for Siren.
+
+see create_templates.py --help 
+"""
+import os
+import argparse
+import re
+
+def get_default(i,var):
+    """
+    Parameters
+    ----------
+    i: str
+       input filename
+    var: str
+       variable name
+    """
+    with open(i) as f:
+        for line in f:
+            line=line.strip()
+            if re.match('.*::.*'+var+'.*', line):
+                return line.split("::")[1].split("=")[1]
+
+
+def get_nam(i,o,d):
+    """
+    Copy input file in output file, line by line.
+    
+    If line contains filterlist parameter and src:
+        - copy the line without the src option
+        - copy the file to be include line by line
+
+    Parameters
+    ----------
+    i: str
+       input filename
+    o: str
+       output filename
+    d: bool
+       added default value
+    """
+    with open(i) as f:
+        inRecordingMode = False
+        for line in f:
+            line=line.strip()
+            if not inRecordingMode:
+                if line.startswith('NAMELIST'):
+                    inRecordingMode = True
+                    nam='&'+line.split('/')[1]
+                    cmt=''
+                    if re.match('^.*!<.*$', line):
+                        cmt='!< '+line.split('!<')[1]
+                    print("{0:10} {1}".format(nam,cmt),file=o)
+            else:
+                if line.startswith('NAMELIST') or not line:
+                    inRecordingMode = False
+                    print("/",file=o)
+                else:
+                    if not line.startswith('!'):
+                        var=line.split('&')[1].split(',')[0].split()[0]
+                        if re.match('^.*!<.*$', line):
+                            cmt='!< '+line.split('!<')[1]
+                        if d:
+                            val=get_default(i,var)
+                            print("\t {0:12} = {1:30} {2}".format(var,val,cmt),file=o)
+                        else:
+                            print("\t {0:12} = {1:30} {2}".format(var,"",cmt),file=o)
+
+
+
+def main():
+    """
+    Read Fortran src file and create template of namelist from it.
+    """
+    # define parser
+    parser = argparse.ArgumentParser(
+        prog="create_templates.py", description="Create template of namelist from Fortran src."
+    )
+    # positional arguments
+    parser.add_argument("input" , type=str, help="Fortran filename, to be read in Siren/src directory")
+    parser.add_argument("output", type=str, help="Output  filename, to be written in Siren/templates directory")
+    # optional arguments
+    parser.add_argument("-v", "--verbose", action="store_true", help="show more things")
+    parser.add_argument("-d", "--default", action="store_true", help="add default value for some variables")
+
+    # parse arguments
+    args = parser.parse_args()
+
+    if re.match('.*/.*', args.output):
+        raise NameError(
+                "Output filename must not be a path (should not contains /)."
+                )
+        print(args.output.split("/")[1])
+    fin=os.path.abspath(os.path.join("../src",args.input))
+    fout=os.path.abspath(os.path.join("../templates",args.output))
+    if args.verbose:
+        print("Input  file : {0}".format(fin))
+        print("Output file : {0}".format(fout))
+        if args.default:
+            print("\nAdd default value to some variables")
+
+    if not os.path.isfile(fin):
+        raise NameError(
+                "Can not find {0} in src directory".format(os.path.basename(fin))
+        )
+
+    with open(args.output,'w') as fout:
+        get_nam(fin,fout,args.default)
+
+if __name__ == "__main__":
+        main()
Index: /utils/tools_ticket2413/TOYATM/EXP/namcouple
===================================================================
--- /utils/tools_ticket2413/TOYATM/EXP/namcouple	(revision 12863)
+++ /utils/tools_ticket2413/TOYATM/EXP/namcouple	(revision 12863)
@@ -0,0 +1,124 @@
+# This is a typical input file for OASIS3-MCT, using NetCDF 
+# format for restart input files. OASIS3-MCT reads in this file 
+# at run time. Don't hesitate to ask precisions or make 
+# suggestions (oasishelp@cerfacs.fr)
+#
+# Any line beginning with # is ignored. Blank lines are not allowed
+####################################################################
+ $NFIELDS 
+12
+ $END
+############################################
+ $RUNTIME 
+259200
+ $END
+############################################
+ $NLOGPRT 
+1 0
+ $END
+############################################
+ $STRINGS 
+O_SSTSST ATSSTSST 1 28800 3 rst.nc EXPORTED
+182 149 180 90 torc lmdz
+P 2 P 0 
+CHECKIN SCRIPR CHECKOUT 
+INT=1
+BILINEAR LR SCALAR LATLON 1
+INT=1
+#
+ATSOLFLX O_QnsMix 1 28800 4 rst.nc EXPORTED
+180 90 182 149 lmdz torc
+P 0 P 2 
+CHECKIN BLASOLD SCRIPR CHECKOUT 
+INT=1
+10.  0
+BILINEAR LR SCALAR LATLON 1
+INT=1
+#
+ATSOLFLX O_QnsIce 1 28800 4 rst.nc EXPORTED
+180 90 182 149 lmdz torc
+P 0 P 2 
+CHECKIN BLASOLD SCRIPR CHECKOUT 
+INT=1
+10.  0
+BILINEAR LR SCALAR LATLON 1
+INT=1
+#
+ATSOLFLX O_QsrIce 1 28800 4 rst.nc EXPORTED
+180 90 182 149 lmdz torc
+P 0 P 2 
+CHECKIN BLASOLD SCRIPR CHECKOUT 
+INT=1
+10.  0
+BILINEAR LR SCALAR LATLON 1
+INT=1
+#
+ATSOLFLX O_QsrMix 1 28800 4 rst.nc EXPORTED
+180 90 182 149 lmdz torc
+P 0 P 2 
+CHECKIN BLASOLD SCRIPR CHECKOUT 
+INT=1
+10.  0
+BILINEAR LR SCALAR LATLON 1
+INT=1
+#
+ATSOLFLX O_dQnsdT 1 28800 4 rst.nc EXPORTED
+180 90 182 149 lmdz torc
+P 0 P 2 
+CHECKIN BLASOLD SCRIPR CHECKOUT 
+INT=1
+0.  0
+BILINEAR LR SCALAR LATLON 1
+INT=1
+#
+ATSOLFLX O_OTaux1 1 28800 4 rst.nc EXPORTED
+180 90 182 149 lmdz torc
+P 0 P 2 
+CHECKIN BLASOLD SCRIPR CHECKOUT 
+INT=1
+0.  0
+BILINEAR LR SCALAR LATLON 1
+INT=1
+#
+ATSOLFLX O_OTauy1 1 28800 4 rst.nc EXPORTED
+180 90 182 149 lmdz torc
+P 0 P 2 
+CHECKIN BLASOLD SCRIPR CHECKOUT 
+INT=1
+0.  0
+BILINEAR LR SCALAR LATLON 1
+INT=1
+#
+ATFLXEMP OTotRain 1 28800 3 rst.nc EXPORTED
+180 90 182 149 lmdz torc
+P 0 P 2 
+CHECKIN SCRIPR CHECKOUT 
+INT=1
+BILINEAR LR SCALAR LATLON 1
+INT=1
+#
+ATFLXEMP OTotSnow 1 28800 3 rst.nc EXPORTED
+180 90 182 149 lmdz torc
+P 0 P 2 
+CHECKIN SCRIPR CHECKOUT 
+INT=1
+BILINEAR LR SCALAR LATLON 1
+INT=1
+#
+ATFLXEMP OTotEvap 1 28800 3 rst.nc EXPORTED
+180 90 182 149 lmdz torc
+P 0 P 2 
+CHECKIN SCRIPR CHECKOUT 
+INT=1
+BILINEAR LR SCALAR LATLON 1
+INT=1
+#
+ATFLXEMP OIceEvap 1 28800 3 rst.nc EXPORTED
+180 90 182 149 lmdz torc
+P 0 P 2 
+CHECKIN SCRIPR CHECKOUT 
+INT=1
+BILINEAR LR SCALAR LATLON 1
+INT=1
+#
+ $END
Index: /utils/tools_ticket2413/TOYATM/src/toyatm.F90
===================================================================
--- /utils/tools_ticket2413/TOYATM/src/toyatm.F90	(revision 12863)
+++ /utils/tools_ticket2413/TOYATM/src/toyatm.F90	(revision 12863)
@@ -0,0 +1,337 @@
+!------------------------------------------------------------------------
+! Copyright 2018/03, CERFACS, Toulouse, France.
+! All rights reserved. Use is subject to OASIS3 license terms.
+!=============================================================================
+!
+PROGRAM TOYATM
+  !
+  USE netcdf
+  USE mod_oasis
+  !
+  IMPLICIT NONE
+  !
+  INTEGER, PARAMETER :: wp = 8
+  !
+  CHARACTER(len=30), PARAMETER   :: data_gridname='grids.nc' ! file with the grids
+  CHARACTER(len=30), PARAMETER   :: data_maskname='masks.nc' ! file with the masks
+  !
+  ! Component name (6 characters) same as in the namcouple
+  CHARACTER(len=6)   :: comp_name = 'toyatm'
+  CHARACTER(len=128) :: comp_out       ! name of the output log file
+  CHARACTER(len=4)   :: cl_grd_src     ! name of the source grid
+  !
+  ! Global grid parameters : 
+  INTEGER, PARAMETER :: nlon = 180
+  INTEGER, PARAMETER :: nlat = 90
+
+  REAL (kind=wp)   :: gg_lon(nlon,nlat)
+  REAL (kind=wp)   :: gg_lat(nlon,nlat)
+  INTEGER          :: gg_mask(nlon,nlat)
+  !
+  ! Exchanged local fields arrays
+  REAL (kind=wp), ALLOCATABLE :: field_send(:,:)
+  !
+  REAL (kind=wp), ALLOCATABLE :: field_recv(:,:)
+
+  INTEGER :: mype, npes ! rank and  number of pe
+  INTEGER :: localComm  ! local MPI communicator and Initialized
+  INTEGER :: comp_id    ! component identification
+  !
+  INTEGER :: il_paral(3) ! Decomposition for each proc
+  !
+  INTEGER :: ierror, ios
+  INTEGER, PARAMETER :: w_unit = 711
+  INTEGER :: FILE_Debug=1
+  !
+  ! Names of exchanged Fields
+  CHARACTER(len=8), DIMENSION(3), PARAMETER :: var_name = (/'ATSSTSST','ATSOLFLX','ATFLXEMP'/) ! 8 characters field
+  !
+  ! Used in oasis_def_var and oasis_def_var
+  INTEGER                       :: var_id(3)
+  INTEGER                       :: var_nodims(2) 
+  INTEGER                       :: var_type
+  !
+  INTEGER                       :: niter, time_step, ib, it_sec
+  !
+  ! Grid parameters definition
+  INTEGER                       :: part_id  ! use to connect the partition to the variables 
+  INTEGER                       :: var_sh(4) ! local dimensions of the arrays; 2 x rank (=4)
+  INTEGER :: ji, jj
+  INTEGER :: auxfileid, auxdimid(2), auxvarid(2)
+  !
+  ! NEMO namelist parameters
+  INTEGER                       :: numnam_cfg=80, nn_it000, nn_itend
+  INTEGER                       :: nn_stocklist, nn_rstctl, nn_no
+  LOGICAL                       :: ln_rst_list, ln_mskland  , ln_clobber,ln_cfmeta, ln_iscpl, ln_xios_read
+  LOGICAL                       :: ln_rstart, nn_date0, nn_time0, nn_leapy  , nn_istate, nn_stock, nn_write ,nn_chunksz, nn_euler,nn_wxios
+  CHARACTER (len=256)           :: cn_exp , cn_ocerst_in, cn_ocerst_indir, cn_ocerst_out, cn_ocerst_outdir
+  REAL (kind=wp)                :: rn_rdt
+  LOGICAL                       :: ln_linssh, ln_crs, ln_meshmask
+  REAL (kind=wp)                :: rn_isfhmin, rn_atfp
+  !
+  ! NEMO namelists
+!!  NAMELIST/namrun/ nn_it000, nn_itend
+!!  NAMELIST/namdom/ rn_rdt
+      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 &
+         &             nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     &
+         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     &
+         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, nn_euler  ,     &
+         &             ln_cfmeta, ln_iscpl, ln_xios_read, nn_wxios
+      NAMELIST/namdom/ ln_linssh, rn_isfhmin, rn_rdt, rn_atfp, ln_crs, ln_meshmask
+  !
+  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  INITIALISATION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  CALL oasis_init_comp (comp_id, comp_name, ierror )
+  IF (ierror /= 0) THEN
+      WRITE(0,*) 'oasis_init_comp abort by toyatm compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at oasis_init_comp')
+  ENDIF
+  !
+  CALL oasis_get_localcomm ( localComm, ierror )
+  IF (ierror /= 0) THEN
+      WRITE (0,*) 'oasis_get_localcomm abort by toyatm compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at oasis_get_localcomm')
+  ENDIF
+  !
+  ! Get MPI size and rank
+  CALL MPI_Comm_Size ( localComm, npes, ierror )
+  IF (ierror /= 0) THEN
+      WRITE(0,*) 'MPI_comm_size abort by toyatm compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at MPI_Comm_Size')
+  ENDIF
+  !
+  CALL MPI_Comm_Rank ( localComm, mype, ierror )
+  IF (ierror /= 0) THEN
+      WRITE (0,*) 'MPI_Comm_Rank abort by toyatm compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at MPI_Comm_Rank')
+  ENDIF
+  !
+  IF (mype == 0) THEN
+       FILE_Debug = 2
+       comp_out=comp_name//'.root'
+       OPEN(w_unit,file=TRIM(comp_out),form='formatted')
+  ENDIF
+  !
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) '-----------------------------------------------------------'
+      WRITE(w_unit,*) TRIM(comp_name), ' running with reals compiled as kind ',wp
+      WRITE(w_unit,*) '----------------------------------------------------------'
+      WRITE (w_unit,*) 'Number of processors :',npes
+      WRITE(w_unit,*) '----------------------------------------------------------'
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+  ! Simulation length definition (according to NEMO namelist_cfg)
+  !
+  OPEN (UNIT=numnam_cfg, FILE='namelist_cfg', STATUS='OLD' )
+  READ  ( numnam_cfg, namrun, IOSTAT = ios )
+  REWIND(numnam_cfg)
+  READ  ( numnam_cfg, namdom, IOSTAT = ios )
+  CLOSE(numnam_cfg)
+  !
+! Get time step and number of iterations from ocean
+  time_step = INT(rn_rdt)
+  niter = nn_itend - nn_it000 + 1 
+  !
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) '-----------------------------------------------------------'
+      WRITE (w_unit,*) 'Total time step # :', niter
+      WRITE (w_unit,*) 'Simulation length :', niter*time_step
+      WRITE(w_unit,*) '----------------------------------------------------------'
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  GRID DEFINITION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  ! Reading global grids.nc and masks.nc netcdf files
+  ! Get arguments giving source grid acronym and field type
+  ! 
+  cl_grd_src = 'lmdz'
+  !
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'Source grid name : ',cl_grd_src
+      CALL flush(w_unit)
+  ENDIF
+  !
+  !
+  ! Define global grid longitudes, latitudes, mask 
+  DO jj = 1, nlat
+     DO ji = 1, nlon
+        gg_lon(ji ,jj) = ( ji - 1 ) * ( 360. / nlon )
+        gg_lat(ji ,jj) = ( jj - 1 ) * ( 180. / nlon )
+     ENDDO
+  ENDDO
+
+  gg_mask(:,:) = 0.
+
+  ! Complete OASIS auxiliary files with yoy grid data
+  !
+  IF (mype == 0) THEN
+     ! Define longitude and latitude
+     CALL check_nf90( nf90_open( data_gridname, nf90_write, auxfileid ) )
+     CALL check_nf90( nf90_redef( auxfileid ) )
+     CALL check_nf90( nf90_def_dim( auxfileid, "toylon", nlon, auxdimid(1)) )
+     CALL check_nf90( nf90_def_dim( auxfileid, "toylat", nlat, auxdimid(2)) )
+     CALL check_nf90( nf90_def_var( auxfileid, cl_grd_src//'.lon', NF90_DOUBLE, auxdimid, auxvarid(1)))
+     CALL check_nf90( nf90_def_var( auxfileid, cl_grd_src//'.lat', NF90_DOUBLE, auxdimid, auxvarid(2)))
+     CALL check_nf90( nf90_enddef( auxfileid ) )
+     CALL check_nf90( nf90_put_var( auxfileid, auxvarid(1), gg_lon ) )
+     CALL check_nf90( nf90_put_var( auxfileid, auxvarid(2), gg_lat ) )
+     CALL check_nf90( nf90_close( auxfileid ) )
+
+     ! Define mask
+     CALL check_nf90( nf90_open( data_maskname, nf90_write, auxfileid ) )
+     CALL check_nf90( nf90_redef( auxfileid ) )
+     CALL check_nf90( nf90_def_dim( auxfileid, "toylon", nlon, auxdimid(1)) )
+     CALL check_nf90( nf90_def_dim( auxfileid, "toylat", nlat, auxdimid(2)) )
+     CALL check_nf90( nf90_def_var( auxfileid, cl_grd_src//'.msk', NF90_INT, auxdimid, auxvarid(1)))
+     CALL check_nf90( nf90_enddef( auxfileid ) )
+     CALL check_nf90( nf90_put_var( auxfileid, auxvarid(1), gg_mask ) )
+     CALL check_nf90( nf90_close( auxfileid ) )
+  ENDIF
+  !
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'After grid and mask reading'
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  PARTITION DEFINITION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !
+  !
+  il_paral(1) = 1  ! Apple decomposition
+  il_paral(2) = mype * nlon * nlat / npes
+  il_paral(3) = nlon * nlat / npes
+  IF ( mype > ( npes - 1 ) ) &
+     il_paral(3) =  nlon * nlat - ( mype * ( nlon * nlat / npes ) )
+  !
+  CALL oasis_def_partition (part_id, il_paral, ierror)
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  COUPLING LOCAL FIELD DECLARATION  
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  var_nodims(1) = 2    ! Rank of the field array is 2
+  var_nodims(2) = 1    ! Bundles always 1 for OASIS3
+  var_type = OASIS_Real
+  !
+  var_sh(1) = 1
+  var_sh(2) = il_paral(3)
+  var_sh(3) = 1 
+  var_sh(4) = 1
+  !
+  ! Declaration of the field associated with the partition (recv)
+  CALL oasis_def_var (var_id(1), var_name(1), part_id, &
+                      var_nodims, OASIS_In, var_sh, var_type, ierror)
+  IF (ierror /= 0) THEN
+      WRITE(w_unit,*) 'oasis_def_var abort by toyatm compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at oasis_def_var')
+  ENDIF
+
+  ! Declaration of the field associated with the partition (send)
+  CALL oasis_def_var (var_id(2), var_name(2), part_id, &
+                      var_nodims, OASIS_Out, var_sh, var_type, ierror)
+  IF (ierror /= 0) THEN
+      WRITE(w_unit,*) 'oasis_def_var abort by toyatm compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at oasis_def_var')
+  ENDIF
+  CALL oasis_def_var (var_id(3), var_name(3), part_id, &
+                      var_nodims, OASIS_Out, var_sh, var_type, ierror)
+  IF (ierror /= 0) THEN
+      WRITE(w_unit,*) 'oasis_def_var abort by toyatm compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at oasis_def_var')
+  ENDIF
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'After def_var'
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  TERMINATION OF DEFINITION PHASE 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  CALL oasis_enddef ( ierror )
+  IF (ierror /= 0) THEN
+      WRITE(w_unit,*) 'oasis_enddef abort by toyatm compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at oasis_enddef')
+  ENDIF
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'After enddef'
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !  SEND ARRAYS 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !
+  ! Allocate the fields send and received by the model1
+  !
+  ALLOCATE(field_send(var_sh(2),var_sh(4)), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating field_send'
+  ALLOCATE(field_recv(var_sh(2),var_sh(4)), STAT=ierror )
+  IF ( ierror /= 0 ) WRITE(w_unit,*) 'Error allocating field_recv'
+  !
+  DO ib=1, niter
+    it_sec = time_step * (ib-1) ! Time
+ 
+    ! QNS
+    field_send(:,:) = 1. 
+    !
+    CALL oasis_put(var_id(2), it_sec, field_send, ierror )
+    ! EMPs
+    field_send(:,:) = 10./ 86400.
+    CALL oasis_put(var_id(3), it_sec, field_send, ierror )
+    ! SST
+    CALL oasis_get(var_id(1), it_sec, &
+                   field_recv, &
+                   ierror )
+    !
+  END DO
+  !
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  !         TERMINATION 
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  IF (FILE_Debug >= 2) THEN
+      WRITE(w_unit,*) 'End of the program, before oasis_terminate'
+      CALL FLUSH(w_unit)
+  ENDIF
+  !
+  CALL oasis_terminate (ierror)
+  IF (ierror /= 0) THEN
+      WRITE(w_unit,*) 'oasis_terminate abort by toyatm compid ',comp_id
+      CALL oasis_abort(comp_id,comp_name,'Problem at oasis_terminate')
+  ENDIF
+  !
+CONTAINS
+
+
+   SUBROUTINE check_nf90(status, errorFlag)
+   !---------------------------------------------------------------------
+   !  Checks return code from nf90 library calls and warns if needed
+   !  If errorFlag is present then it just increments this flag (OMP use)
+   !
+   !---------------------------------------------------------------------
+      INTEGER, INTENT(IN   ) :: status
+      INTEGER, INTENT(INOUT), OPTIONAL :: errorFlag
+   !---------------------------------------------------------------------
+
+      IF( status /= nf90_noerr ) THEN
+         WRITE(w_unit,*) 'ERROR! : '//TRIM(nf90_strerror(status))
+         IF( PRESENT( errorFlag ) ) THEN
+            errorFlag = errorFlag + status
+         ELSE
+            WRITE(w_unit,*) "*** TOYATM failed on netcdf ***"
+            WRITE(w_unit,*)
+            STOP 5
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE check_nf90
+  !
+END PROGRAM TOYATM
+!
Index: /utils/tools_ticket2413/WEIGHTS/README
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/README	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/README	(revision 12863)
@@ -0,0 +1,316 @@
+nocsSCRIP v1.1 03/11/2010
+-------------------------
+
+Author: NOCS NEMO Team
+Contacts: Steven Alderson (sga@noc.soton.ac.uk)
+          Andrew Coward   (acc@noc.soton.ac.uk)
+
+Disclaimer
+
+This directory contains software for generating and manipulating interpolation
+weights for use with the Interpolation On the Fly (IOF) option in NEMO
+v3 onwards.  The utilities rely heavily on the Spherical Coordinate Remapping
+and Interpolation Package (SCRIP) which is freely available from Los Alamos
+(see copyright file). We make no claim to authorship of those parts of the
+SCRIP package we have used and included with this distribution.
+
+Unless otherwise indicated, all other software has been authored by an
+employee or employees of the National Oceanography Centre, Southampton, UK
+(NOCS).  NOCS operates as a collaboration between the Natural Environment
+Research Council (NERC) and the University of Southampton.  The public may
+copy and use this software without charge, provided that this Notice and any
+statement of authorship are reproduced on all copies.  Neither NERC nor the
+University makes any warranty, express or implied, or assumes any liability
+or responsibility for the use of this software.
+
+Introduction
+
+The IOF option enables forced ocean runs without the need to provide surface
+boundary data on the nemo grid. Atmospheric data are kept on their original
+grid(s) which typically have a coarser resolution than the ocean grid. IOF
+supports multiple source (atmospheric) grids and two interpolation methods
+(bilinear and bicubic).  Different combinations of source grid and method can
+be selected for each variable.  IOF is also compatible with AGRIF; allowing
+AGRIF nests to be used without the need to provide separate forcing data
+(only a separate set of weights fields).  Operational details are provided
+in the SBC chapter of the NEMO reference manual.
+
+Please note that the methods described here assume that the forcing datasets
+are unmasked. Where the original sources are masked it is the users'
+responsibility to ensure that an unmasked set is produced on the source
+grid with appropriate oceanic values in previously masked locations. This
+is particularly important for atmospheric variables which experience step
+changes at the land-sea boundary. For these, care must be taken to avoid
+contaminating oceanic values.
+
+The software is divided into several sub-directories:
+
+                         ./
+                          |
+     +-------------+--------------+--------------+
+  SCRIP1.4      nocsutil         src            bin
+
+SCRIP1.4 contains the unmodified copy (apart from compression of two sample netcdf
+files) of SCRIP version 1.4 from Los Alamos. 
+(http://climate.lanl.gov/Software/SCRIP).
+
+The bin directory contains python script freeform.py.
+This is run to reformat the code for use within the NEMO 3.3 fcm framework.
+It creates and populates a directory called 'src' with copied and modified versions
+of the SCRIP library routines (and derived programs from the nocsutil directory).  
+Changes are described in the src/CHANGES file.
+This script has already been run and only needs to be re-executed if SCRIP is updated.
+
+The src directory also contains the three programs used to generate a weights file.
+The three programs are:
+
+scripgrid.exe (scripgrid.F90) which creates two grid description files suitable for
+input to the scrip package. 
+
+scrip.exe (scrip.F90) which takes these descriptions and generates the required
+weights in the standard SCRIP format. This program is a version of the SCRIP
+program: scrip.f which has been modified to accept the name of its namelist
+file on the command line.
+
+scripshape.exe (scripshape.F90) which takes the output from scrip and rearranges
+the fields into a series of 2D fields more suited for input into NEMO using
+the iom_get routine.
+
+All three FORTRAN90 programs read domain information from their respective
+netCDF input files and dynamically allocate internal storage. They are
+thus independent of the target configuration and have been successfully
+tested with both ORCA2 and ORCA025 grids. Their suitably for use with larger
+grids has not been tested but should only be subject to limitations of
+the operating system and the memory available to the processing element.
+
+A separate tar file is available containing test data.
+This comprises an ORCA2 coordinates file and sample DFS4.1 input field that
+can be used for testing. Reference weights files generated using the two
+example namelists provided are located in its refout subdirectory.
+
+Installation is by use of the maketools script.
+E.g. change to the NEMOGCM/TOOLS directory and type:
+
+./maketools -help
+
+and, for example:
+
+./maketools -m gfortran_linux -n WEIGHTS
+
+
+Example Use
+-----------
+
+  cd data
+  ../scripgrid.exe  namelist_reshape_bilin    (creates remap_data_grid.nc 
+                                                and remap_nemo_grid.nc)
+  ../scrip.exe      namelist_reshape_bilin    (creates data_nemo_bilin.nc)
+
+  ../scripshape.exe namelist_reshape_bilin    (creates reshape_orca2_bilinear.nc)
+  
+[Note that because the gfortran compiler does not understand the iargc function 
+and getarg subroutine calls, command line namelist names can only be supplied if
+symbol ARGC is defined during compilation (eg add '#define ARGC' to the top of 
+the relevant program).  If not, the program asks for the name instead during execution.]
+
+Only the final output file is required for use with NEMO but the intermediate
+files can be checked against the examples in the test data (available separately).
+
+For bicubic mapping only scrip and scripshape need to be rerun (because the grid_inputs namelist
+entries are identical in the two namelist files, see Controls section below):
+ 
+  ../scrip.exe namelist_reshape_bicubic       (creates data_nemo_bicubic.nc)
+
+  ../scripshape.exe namelist_reshape_bicubic  (creates reshape_orca2_bicubic.nc)
+
+Controls
+--------
+
+The SCRIP derived utilities use SCRIP-style namelists to control their
+operation.  In the example above the same named file is used for both but within that
+file are two separate namelists:
+
+&grid_inputs
+    input_file = './snow_1m_TRP_1958.nc'
+    nemo_file = 'coordinates.nc'
+    datagrid_file = 'remap_data_grid.nc'
+    nemogrid_file = 'remap_nemo_grid.nc'
+    method = 'regular'
+    input_lon = 'lon'
+    input_lat = 'lat'
+    nemo_lon = 'glamt'
+    nemo_lat = 'gphit'
+    nemo_mask = 'none'
+    nemo_mask_value = 10
+    input_mask = 'none'
+    input_mask_value = 10
+/
+
+which is used by scripgrid, and:
+
+&remap_inputs
+    num_maps = 1
+    grid1_file = 'remap_data_grid.nc'
+    grid2_file = 'remap_nemo_grid.nc'
+    interp_file1 = 'data_nemo_bilin.nc'
+    interp_file2 = 'nemo_data_bilin.nc'
+    map1_name = 'data to nemo bilin Mapping'
+    map2_name = 'nemo to data bilin Mapping'
+    map_method = 'bilinear'
+    normalize_opt = 'frac'
+    output_opt = 'scrip'
+    restrict_type = 'latitude'
+    num_srch_bins = 90
+    luse_grid1_area = .false.
+    luse_grid2_area = .false.
+/
+
+which is used by scrip.
+
+scripshape also reads information from a namelist:
+
+&shape_inputs
+    interp_file = 'data_nemo_bilin.nc'
+    output_file = 'weights_bilin.nc'
+    ew_wrap     = 0
+/
+
+scripgrid.exe
+-------------
+
+scripgrid accesses the named files and coordinate data in order to produce
+the grid centre and corner locations required by scrip. In the example given,
+a file called 'coordinates.nc' must exist in the current directory. This is
+used by scripgrid as a nemo coordinates file and the correct corner
+locations appropriate to the named grid centres are obtained (i.e. since
+glamt is named, glamf and gphif will be used to provide corner coordinates).
+The nemo file need not be called 'coordinates.nc' (e.g. '1_coordinates.nc' instead),
+but must have longitude and latitude variables which start with the four 
+characters 'gphi' and 'glam' respectively.
+"input_file" file must contain at least one variable on a grid whose axes are
+described by the netcdf coordinate variables named in input_lon and input_lat.
+The program produces two grid description files, one corresponding to each
+input file, for use by the scrip program to calculate weights required to
+go from one to the other and back again.
+
+This step is independent of the mapping method (e.g. bilinear or bicubic)
+and so only one set of remap_data_grid.nc and remap_nemo_grid.nc files needs
+to be produced for each pair of source and destination grids.
+
+scrip.exe
+---------
+
+scrip takes the output files from scripgrid and creates a file of weights
+to use to interpolate between the two grids described. The example given
+only requests 1 map (from data to nemo); setting num_maps=2 will provide
+the reverse weights if required.
+ 
+ - num_maps is either 1 or 2 depending on whether the reverse 
+    transformation is required 
+
+ - grid1_file, grid2_file: two remap grid files are required 
+    as output by scripgrid
+
+ - interp_file1, interp_file2: one or two interp_file names are 
+    then supplied; these hold the weights to convert one grid to another
+
+ - map1_name, map2_name: the map_name variables are just descriptive
+
+ - map_method: can be 'bilinear' or 'bicubic'
+
+ - normalize_opt: should usually be 'frac' or else the user needs to do  
+    this scaling manually (this seems to the case for fractional ice cover)
+
+ - output_opt may be supplied and set to either 'scrip' or 'ncar-csm'
+
+ - restrict_type: should be 'latitude' or 'latlon' in which case 
+    num_srch_bins only are used in one or two directions
+
+ - use_grid_area fields override the scrip calculation of area in 
+    case the model gets slightly different answers, but the area needs 
+    to be supplied in the input files
+
+A conservative mapping scheme exists but is not yet working with NEMO grids.
+See the scrip package documentation for more details of these parameters.
+(http://climate.lanl.gov/Software/SCRIP/SCRIPusers.pdf)
+
+scripshape.exe
+--------------
+
+scripshape takes the output from scrip (e.g. data_nemo_bilin.nc ) and
+rearranges the source and destination indices and associated weights into
+sets of 2D fields each spanning the nemo grid. Each set is associated with
+each node involved in the interpolation scheme.  Thus for a bilinear mapping
+the weights file required by the IOF option includes the following fields:
+
+  double src01(lat, lon) ;   double dst01(lat, lon) ;   double wgt01(lat, lon) ;
+  double src02(lat, lon) ;   double dst02(lat, lon) ;   double wgt02(lat, lon) ;
+  double src03(lat, lon) ;   double dst03(lat, lon) ;   double wgt03(lat, lon) ;
+  double src04(lat, lon) ;   double dst04(lat, lon) ;   double wgt04(lat, lon) ;
+
+For a bicubic mapping the required fields are:
+
+  double src01(lat, lon) ;   double dst01(lat, lon) ;   double wgt01(lat, lon) ;
+  double src02(lat, lon) ;   double dst02(lat, lon) ;   double wgt02(lat, lon) ;
+  double src03(lat, lon) ;   double dst03(lat, lon) ;   double wgt03(lat, lon) ;
+  double src04(lat, lon) ;   double dst04(lat, lon) ;   double wgt04(lat, lon) ;
+  double src05(lat, lon) ;   double dst05(lat, lon) ;   double wgt05(lat, lon) ;
+  double src06(lat, lon) ;   double dst06(lat, lon) ;   double wgt06(lat, lon) ;
+  double src07(lat, lon) ;   double dst07(lat, lon) ;   double wgt07(lat, lon) ;
+  double src08(lat, lon) ;   double dst08(lat, lon) ;   double wgt08(lat, lon) ;
+  double src09(lat, lon) ;   double dst09(lat, lon) ;   double wgt09(lat, lon) ;
+  double src10(lat, lon) ;   double dst10(lat, lon) ;   double wgt10(lat, lon) ;
+  double src11(lat, lon) ;   double dst11(lat, lon) ;   double wgt11(lat, lon) ;
+  double src12(lat, lon) ;   double dst12(lat, lon) ;   double wgt12(lat, lon) ;
+  double src13(lat, lon) ;   double dst13(lat, lon) ;   double wgt13(lat, lon) ;
+  double src14(lat, lon) ;   double dst14(lat, lon) ;   double wgt14(lat, lon) ;
+  double src15(lat, lon) ;   double dst15(lat, lon) ;   double wgt15(lat, lon) ;
+  double src16(lat, lon) ;   double dst16(lat, lon) ;   double wgt16(lat, lon) ;
+
+This program also adds an attribute to the weights file for use by the fld_interp
+routine in fldread.F90.  This tells the model about the east-west cyclicity of the source grid.
+The value needs to be supplied in the scripshape namelist via the variable ew_wrap.
+It should have one of the values -1, 0, 1 or 2.  -1 means that the input grid is not
+cyclic; 0 means that it is cyclic but with no overlapping columns; and a value greater
+than zero represents the number of columns that overlap.  In fact it only has an effect 
+when using bicubic interpolation in which the model needs to know which additional columns
+have to be read in to correctly calculate gradient values.
+The weights file produced by scripshape is ready for use in NEMO. This file
+needs to by placed in the nemo working directory and needs to be named in the
+appropriate SBC namelist entry (e.g. namsbc_clio, namsbc_flux or namsbc_core).
+
+scripinterp.exe
+---------------
+
+Take data on an input grid and interpolate to the nemo grid using the weights
+calculated by the scrip program.
+Method
+Two namelists are used for configuration, eg
+
+&interp_inputs
+    input_file = "../data/wsx_av.nc"
+    interp_file = "data_nemo_bilin.nc"
+    input_name = "wsx"
+    input_start = 1,1,1,1
+    input_stride = 1,1,1,1
+    input_stop = 0,0,0,1
+    input_vars = 'time'
+/
+
+&interp_outputs
+    output_file = "taux_1m.nc"
+    output_mode = "create"
+    output_dims = 'x', 'y', 'time_counter'
+    output_scaling = "sozotaux|1.0", "time_counter|86400.0"
+    output_name = 'sozotaux'
+    output_lon = 'x'
+    output_lat = 'y'
+    output_vars = 'time_counter'
+    output_attributes = 'time_counter|units|seconds since 1995-00-00 00:00:00',
+                        'time_counter|calendar|noleap',
+                        'sozotaux|units|N/m2'
+/
+
+This program just multiplies by weights and sums over each contributing point,
+and then formats the output correctly for the model.
+
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/.log.dti
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/.log.dti	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/.log.dti	(revision 12863)
@@ -0,0 +1,16 @@
+96/10/22 13:08:53 opened .log.dti
+96/10/22 13:08:53 debug explicitly set to 0
+96/10/22 13:08:58 opened .log.dti
+96/10/22 13:08:58 debug explicitly set to 0
+96/10/22 13:09:56 opened .log.dti
+96/10/22 13:09:56 debug explicitly set to 0
+96/11/18 11:29:28 opened .log.dti
+96/11/18 11:29:28 debug explicitly set to 0
+96/11/18 11:29:31 opened .log.dti
+96/11/18 11:29:31 debug explicitly set to 0
+96/11/18 11:31:34 opened .log.dti
+96/11/18 11:31:34 debug explicitly set to 0
+96/11/20 09:09:51 opened .log.dti
+96/11/20 09:09:51 debug explicitly set to 0
+96/11/20 09:09:55 opened .log.dti
+96/11/20 09:09:55 debug explicitly set to 0
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/bugs
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/bugs	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/bugs	(revision 12863)
@@ -0,0 +1,58 @@
+************************************************************************
+
+Bug or issue                                          Reported   Fixed
+----------------------------------------------------  --------  --------
+
+Outstanding:
+
+Need parallel implementation of SCRIP                 07/01/00
+Latitude bins not very robust for sparse grids        10/27/98
+Deal with extrapolation for bilinear, bicubic         12/02/98
+Remove cyclic bndy assumptions from bilin, bicubic    12/02/98
+Problem with coordinate transform when both grids 
+  contain pole point as cell edge (note that in
+  such a case, turning off the coordinate transform
+  by setting thresholds >pi, <-pi may fix this)       12/03/98
+Bug in test configuration when SH transformation on   12/03/98
+
+Fixed in release 1.4:
+
+Conversion from polar projection back to lat/lon
+  space extremely sensitive near pole                 07/01/01  08/20/01
+Bilinear/cubic fails when cells overlap longitude cut 08/13/01  08/20/01
+Bilinear/cubic iteration converges to bad solution
+  for skewed cells                                    08/21/01  08/21/01
+Nearest-neighbor backup to bilinear/cubic fails       08/13/01  08/20/01
+Added feature to use input areas for normalization    06/20/00  07/01/00
+Added error checks on weights for conservative maps   06/20/00  07/01/00
+
+Fixed in release 1.3:
+
+Added new binning options to restrict searches        ...do not know...
+Optimized code for resizing arrays                    .................
+
+Fixed in release 1.2:
+
+Changed namelist input for map type to character      05/31/99  06/04/99
+Added new output option for CSM coupler               05/31/99  06/04/99
+Added additional normalization options for conserv    05/31/99  06/04/99
+Improper handling of grid pairs which share corners   01/29/99  02/04/99
+Uninitialized variables and subscripts out of range   01/22/99  01/25/99
+
+Fixed in release 1.1:
+
+Conservative remap assumed num_maps = 2               12/16/98  12/17/98
+Change units of grid quantities back to input units   12/04/98  12/17/98
+Add option for unnormalized conservative weights      12/04/98  12/17/98
+Update user's guide for recent changes                12/02/98  12/17/98
+Add different test fields                             11/18/98  12/02/98
+Add support for multiple remap test                   11/18/98  12/02/98
+Add bicubic module                                    11/18/98  12/17/98
+
+Fixed in release 1.02:
+
+Problems setting up latitude bins for polar cells     10/22/98  10/27/98
+Input latitudes out of range (due to machine pi/2)    10/27/98  10/27/98
+Bad coordinate transformation in south pole           10/22/98  11/02/98
+
+************************************************************************
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/doc/SCRIPusers.tex
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/doc/SCRIPusers.tex	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/doc/SCRIPusers.tex	(revision 12863)
@@ -0,0 +1,1113 @@
+\documentclass[12pt]{report}
+
+\title{A User's Guide for SCRIP: A {\em S}pherical {\em C}oordinate
+       {\em R}empping and {\em I}nterpolation {\em P}ackage }
+
+\author{Philip W. Jones}
+
+\begin{document}
+
+%\maketitle
+
+\begin{titlepage}
+
+\vspace{1in}
+
+\begin{center}
+{\Large{A User's Guide for SCRIP: A {\em S}pherical {\em C}oordinate
+       {\em R}emapping and {\em I}nterpolation {\em P}ackage }}
+\end{center}
+
+\vspace{1in}
+
+\begin{center}
+Version 1.4
+\end{center}
+
+\vspace{1in}
+
+\begin{center}
+Philip W. Jones \\
+Theoretical Division \\
+Los Alamos National Laboratory
+\end{center}
+
+\newpage
+
+\begin{center}
+{\bf COPYRIGHT NOTICE}
+\end{center}
+
+Copyright \copyright 1997, 1998 the Regents of the University of
+California.
+
+\vspace{0.5in}
+
+This software and ancillary information (herein called SOFTWARE) called
+SCRIP is made available under the terms described here.  The SOFTWARE
+has been approved for release with associated LA-CC Number 98-45.
+
+Unless otherwise indicated, this SOFTWARE has been authored by an
+employee or employees of the University of California, operator
+of Los Alamos National Laboratory under Contract No. W-7405-ENG-36
+with the United States Department of Energy.  The United States
+Government has rights to use, reproduce, and distribute this
+SOFTWARE.  The public may copy, distribute, prepare derivative
+works and publicly display this SOFTWARE without charge, provided
+that this Notice and any statement of authorship are reproduced
+on all copies.  Neither the Government nor the University makes
+any warranty, express or implied, or assumes any liability or
+responsibility for the use of this SOFTWARE.
+
+If SOFTWARE is modified to produce derivative works, such modified
+SOFTWARE should be clearly marked, so as not to confuse it with the
+version available from Los Alamos National Laboratory.
+
+
+\end{titlepage}
+
+\tableofcontents
+
+\chapter{Introduction}
+
+SCRIP is a software package used to generate interpolation weights
+for remapping fields from one grid to another in spherical geometry.
+The package currently supports four types of remappings.  The
+first is a conservative remapping scheme that
+is ideally suited to a coupled model context where the area-integrated
+field (e.g. water or heat flux) must be conserved.  The second
+type of mapping is a basic bilinear interpolation which has
+been slightly generalized to perform a local bilinear interpolation.
+A third method is a bicubic interpolation similar to the
+bilinear method.
+The last type of remapping is a distance-weighted average of
+nearest-neighbor points.  The bilinear and bicubic schemes can
+only be used with logically-rectangular grids; the other two methods
+can be used for any grid in spherical coordinates.
+
+SCRIP is available via the web at \newline
+http://climate.acl.lanl.gov/software/SCRIP/ \newline
+NOTE: This location has changed since the 1.2 release.
+
+The next chapter describes how to compile and run SCRIP, while
+the following sections describe the remapping methods in more
+detail.
+
+\chapter{Compiling and Running}
+
+The distribution file is a gzipped tarfile, so you must
+uncompress the file using ``gunzip'' and then extract SCRIP
+from the tar file using ``tar -xvf scrip1.4.tar''.  The extraction
+process will create a directory called SCRIP with two
+subdirectories named ``source'' and ``grids''.  The source
+directory contains all the source files and the makefile
+for building the package.  The grids directory contains
+some sample grid files and routines for creating or
+converting other grid files to the proper format.
+
+\section{Compiling}
+
+In order to compile SCRIP, you need access to a
+Fortran 90 compiler and a netCDF library (version 3 or
+later).  In the source directory, you must edit the
+makefile to insert the appropriate compiler and compiler
+options for whatever machine you happen to work on.  The
+makefile currently only has SGI compiler options.  In
+addition, you must edit the paths in the makefile to
+find the proper netCDF library - if netCDF is in your
+default path, you may delete the path altogether.
+
+Once the makefile has been edited to reflect your
+local environment, type ``make'' and let it
+build.  By default, the makefile builds two executables
+in the main SCRIP directory;
+the first executable is called scrip and computes
+all the necessary weights for a remapping.  The second
+executable is a simple test code scrip\_test which will
+test the weights output by scrip.
+
+\subsection{Compile-time Parameters}
+
+There are a few compile-time parameters that can
+be changed before compiling (see Table~\ref{tab:params}).
+For the most part, the
+defaults are adequate, but you may wish to change
+these at some point.  The use of these parameters
+will become clear in the chapters describing the
+remapping algorithms.
+
+\begin{table}
+\caption{Compile-time parameters \label{tab:params}}
+
+\begin{tabular}{|l|l|c|l|} \hline
+     Routine       &    Parameter     &  Default & Description  \\
+                   &      Name        &   Value  &              \\ \hline
+remap\_conserv.f   &  north\_thresh   &   1.42   &  threshold latitude (in  \\
+                   &                  &          &  radians) above which a  \\
+                   &                  &          &  coordinate transformation \\
+                   &                  &          &  is used to perform       \\
+                   &                  &          &  intersection calculation \\ \hline
+remap\_conserv.f   &  south\_thresh   &  -2.00   &  same for south pole \\ \hline
+remap\_conserv.f   &  max\_subseg     &  10000   &  maximum number of sub-  \\
+                   &                  &          &  segments allowed (to    \\
+                   &                  &          &  prevent infinite loop)  \\
+\hline
+remap\_bilinear.f  &  max\_iter       &   100    &  max number of iterations \\
+                   &                  &          &  to determine local i,j   \\ \hline
+remap\_bilinear.f  &  converge        & $1\times 10^{-10}$
+                                                 &  convergence criterion   \\
+                   &                  &          &  for bilinear iteration  \\
+\hline
+remap\_bicubic.f   &  max\_iter       &   100    &  max number of iterations \\
+                   &                  &          &  to determine local i,j   \\ \hline
+remap\_bicubic.f   &  converge        & $1\times 10^{-10}$
+                                                 &  convergence criterion   \\
+                   &                  &          &  for bicubic iteration  \\
+\hline
+remap\_distwgt.f   &  num\_neighbors  &    4     &  number of nearest       \\
+                   &                  &          &  neighbors to use for    \\
+                   &                  &          &  distance-weighted average\\
+\hline
+iounits.f          &  stdin           &    5     &  I/O unit reserved for \\
+                   &                  &          &  standard input \\ \hline
+iounits.f          &  stdout          &    6     &  I/O unit reserved for \\
+                   &                  &          &  standard output \\ \hline
+iounits.f          &  stderr          &    6     &  I/O unit reserved for \\
+                   &                  &          &  standard error output \\
+\hline
+timers.f           &  max\_timers     &   99     &  max number of CPU timers \\
+\hline
+\end{tabular}
+\end{table}
+
+\section{Running}
+
+Once the code is compiled, a few input files are needed.
+The first is a namelist input file and the other two
+required files are grid description files.
+
+\subsection{Namelist Input}
+
+The namelist input file must be called scrip\_in
+and contain a namelist as shown in Fig.~\ref{fig:nml}.
+
+\begin{figure}
+\caption{Required input namelist. \label{fig:nml}}
+\begin{verbatim}
+&remap_inputs
+    num_maps = 2
+    grid1_file = 'grid_1_file_name'
+    grid2_file = 'grid_2_file_name'
+    interp_file1 = 'map_1_output_file_name'
+    interp_file2 = 'map_2_output_file_name'
+    map1_name = 'name_for_mapping_1'
+    map2_name = 'name_for_mapping_2'
+    map_method = 'conservative'
+    normalize_opt = 'frac'
+    output_opt = 'scrip'
+    restrict_type = 'latitude'
+    num_srch_bins = 90
+    luse_grid1_area = .false.
+    luse_grid2_area = .false.
+/
+\end{verbatim}
+\end{figure}
+
+The num\_maps variable determines the number of mappings
+to be computed.  If you'd like mappings only from a source
+grid (grid 1) to a destination grid (grid 2), then
+num\_maps should be set to one.  If you'd also like weights
+for a remapping in the opposite direction (grid 2 to grid 1),
+then num\_maps should be set to two.
+
+The map\_method variable determines the method to be used
+for the mapping.  A conservative remapping is map\_method
+`conservative'; a bilinear mapping is map\_method `bilinear';
+a distance-weighted average is map\_method `distwgt'; a
+bicubic mapping is map\_method `bicubic'.
+
+The restrict\_type variable and num\_srch\_bins determines
+how the software restricts the range of grid points to search
+to avoid a full $N^2$ search.  There are currently two options
+for restrict\_type: `latitude' and `latlon'.  The first was used in
+all previous versions of SCRIP and restricts the search by
+dividing the grid points into num\_srch\_bins latitude bins.
+The `latlon' choice divides the spherical domain into
+latitude-longitude boxes and thus provides a way to
+restrict the longitude range as well.  Note that for the latlon
+option, the domain is divided by num\_srch\_bins in
+{\em each} direction so that the total number of bins is the
+square of num\_srch\_bins.  Generally, the larger the number
+of bins, the more the search can be restricted.  However if
+the number of bins is too large, more time will be taken
+restricting the search than the search itself.  For coarse
+grids, choosing the latitude option with 90 bins (one degree
+bins) is sufficient.
+
+The normalize\_opt variable is used to choose the normalization
+of the remappings for the conservative remapping method.
+By default, normalize\_opt is set to be `fracarea' and will
+include the destination area fraction in the output weights;
+other options are `none' and `destarea' (see chapter on the
+conservative remapping method). The latter two are useful when
+dealing with masks that are dynamic (e.g. variable ice fraction).
+Keep in mind that in such a case, the
+area fractions must be computed explicitly by the remapping
+routine at the time the remappings are actually computed
+(see the example in Fig.~\ref{fig:rmpfort}).
+
+The grid{\em x}\_file are names (with relative paths) of
+the grid input files.  The first grid file (grid1\_file)
+{\em must} be the source grid if num\_maps=1.  If this
+mapping uses the conservative remapping method, the first
+grid file must also be the grid with the master mask
+(e.g. a land mask) -- grid fractions on the second grid
+will be determined by this mask.
+
+Names of the output files for the remapping weights are
+determined by the interp\_file{\em x} filenames (again
+with paths).  Map 1 refers to a mapping from grid 1 to
+grid 2; map 2 is in the opposite direction.
+
+A descriptive name for the remappings are determined by
+the map{\em x}\_name variables.  These should be
+descriptive enough to know exactly which grids and
+methods were used.
+
+The output\_opt variable determines the format of the
+netCDF output file.  The two currently-supported options
+are `scrip' and `ncar-csm'.  The latter is to generate
+files for use in the NCAR CSM Flux Coupler for coupled
+climate modeling.  The primary difference between the
+formats is the choice of variable names.
+
+The two logical flags luse\_grid{\em x}\_area are
+for using an input area to normalize the conservative
+weights.  If these are set to true, the input grid
+files must contain the grid areas.  This option is
+provided primarily for making the weights consistent
+with internal model-computed areas (which may differ
+somewhat from the SCRIP-computed areas).
+
+\subsection{Grid Input Files}
+
+The grid input files are in netCDF format as shown
+by the sample ncdump grid output in Fig.~\ref{fig:ncgrid}.
+If you're unfamiliar with ncdump output, it's important to
+not that ncdump shows the array dimensions in C ordering.
+In Fortran, the order is reversed (e.g. arrays are
+dimensioned (grid\_corners,grid\_size).
+In the grids subdirectory of the distribution there
+are some fortran source codes for creating these
+grid files for some special cases.  See the README
+file in that subdirectory for details.
+
+\begin{figure}
+\caption{A sample input grid file. \label{fig:ncgrid}}
+\begin{verbatim}
+netcdf remap_grid_T42 {
+dimensions:
+        grid_size = 8192 ;
+        grid_corners = 4 ;
+        grid_rank = 2 ;
+
+variables:
+        long grid_dims(grid_rank) ;
+        double grid_center_lat(grid_size) ;
+                grid_center_lat:units = "radians" ;
+        double grid_center_lon(grid_size) ;
+                grid_center_lon:units = "radians" ;
+        long grid_imask(grid_size) ;
+                grid_imask:units = "unitless" ;
+        double grid_corner_lat(grid_size, grid_corners) ;
+                grid_corner_lat:units = "radians" ;
+        double grid_corner_lon(grid_size, grid_corners) ;
+                grid_corner_lon:units = "radians" ;
+
+// global attributes:
+                :title = "T42 Gaussian Grid" ;
+}
+\end{verbatim}
+\end{figure}
+
+The name of the grid is given as the title and will be used
+to specify the grid name throughout the remapping process.
+
+The grid\_size dimension is the total size of the grid; grid\_rank
+refers to the number of dimensions the grid array would have
+when used in a model code.  The number of corners (vertices) in
+each grid cell is given by grid\_corners.  Note that if your
+grid has a variable number of corners on grid cells, then you
+should set grid\_corners to be the highest value and use
+redundant points on cells with fewer corners.
+
+The integer array grid\_dims gives the length of each
+grid axis when used in a model code.  Because the remapping
+routines read the grid properties as a linear list of
+grid cells, the grid\_dims array is necessary for
+reconstructing the grid, particularly for a bilinear mapping
+where a logically rectangular structure is needed.
+
+The integer array grid\_imask is used to mask out grid cells
+which should not participate in the remapping.  The array
+should by zero for any points (e.g. land points) that do
+not participate in the remapping and one for all other points.
+
+Coordinate arrays provide the latitudes and longitudes of
+cell centers and cell corners.  Although the above reports
+the units as ``radians'', the code happily accepts ``degrees''
+as well.  The grid corner coordinates {\em must} be
+written in an order which traces the outside of a grid
+cell in a counterclockwise sense.  That is, when moving
+from corner 1 to corner 2 to corner 3, etc., the grid
+cell interior must always be to the left.
+
+\subsection{Output Files}
+
+The remapping output files are also in netCDF format
+and contain some grid information from each grid
+as well as the remapping addresses and weights.  An example
+ncdump of the output files is shown in Fig.~\ref{fig:ncrmp}.
+
+\begin{figure}
+\caption{A sample output file for mapping data in scrip format.
+\label{fig:ncrmp}}
+\begin{verbatim}
+netcdf rmp_POP43_to_T42_cnsrv {
+dimensions:
+        src_grid_size = 24576 ; dst_grid_size = 8192 ;
+        src_grid_corners = 4  ; dst_grid_corners = 4 ;
+        src_grid_rank = 2     ; dst_grid_rank = 2 ;
+        num_links = 42461 ; num_wgts = 3 ;
+variables:
+        long src_grid_dims(src_grid_rank) ;
+        long dst_grid_dims(dst_grid_rank) ;
+        double src_grid_center_lat(src_grid_size) ;
+        double dst_grid_center_lat(dst_grid_size) ;
+        double src_grid_center_lon(src_grid_size) ;
+        double dst_grid_center_lon(dst_grid_size) ;
+        long src_grid_imask(src_grid_size) ;
+        long dst_grid_imask(dst_grid_size) ;
+        double src_grid_corner_lat(src_grid_size, src_grid_corners) ;
+        double src_grid_corner_lon(src_grid_size, src_grid_corners) ;
+        double dst_grid_corner_lat(dst_grid_size, dst_grid_corners) ;
+        double dst_grid_corner_lon(dst_grid_size, dst_grid_corners) ;
+        double src_grid_area(src_grid_size) ;
+                src_grid_area:units = "square radians" ;
+        double dst_grid_area(dst_grid_size) ;
+                dst_grid_area:units = "square radians" ;
+        double src_grid_frac(src_grid_size) ;
+        double dst_grid_frac(dst_grid_size) ;
+        long src_address(num_links) ;
+        long dst_address(num_links) ;
+        double remap_matrix(num_links, num_wgts) ;
+// global attributes:
+         :title = "POP 4/3 to T42 Conservative Mapping" ;
+         :normalization = "fracarea" ;
+         :map_method = "Conservative remapping" ;
+         :history = "Created: 07-19-1999" ;
+         :conventions = "SCRIP" ;
+         :source_grid = "POP 4/3 Displaced-Pole T grid" ;
+         :dest_grid = "T42 Gaussian Grid" ;
+}
+\end{verbatim}
+\end{figure}
+
+The grid information is simply echoing the input grid file
+information and adding grid\_area and grid\_frac arrays.
+The grid\_area array currently is {\em only} computed by
+the conservative remapping option; the others will write
+arrays full of zeros for this field.  The grid\_frac array
+for the conservative remapping returns the area fraction
+of the grid cell which participates in the remapping based
+on the source grid mask.  For the other two remapping options,
+the grid\_frac array is one where the grid point participates
+in the remapping and zero otherwise, based again on the
+source grid mask (and {\em not} on the grid\_imask for that
+grid).
+
+The remapping data itself is written as if for a sparse matrix
+multiplication.  Again, the Fortran array must be dimensioned
+(num\_wgts,num\_links) rather than the C order shown in the
+ncdump.  The dimension num\_wgts refers to the number
+of weights for a given remapping and is one for bilinear and
+distance-weighted remappings.  For the conservative
+remapping, num\_wgts is 3 as it contains two additional
+weights for a second-order remapping.  The bicubic remappings
+require four weights as for gradients in each direction plus
+a term for the cross gradient.  The dimension num\_links
+is the number of unique address pairs in the remapping and is
+therefore the number of entries in a sparse matrix for the
+remapping.  The integer address arrays contain the source
+and destination address for each ``link''.  So, a Fortran code
+to complete the conservative remappings might look like that
+shown in Fig.~\ref{fig:rmpfort}.
+
+\begin{figure}
+\caption{Sample Fortran code for performing a first-order
+         conservative remap. \label{fig:rmpfort}}
+\begin{verbatim}
+
+dst_array = 0.0
+
+select case (normalize_opt)
+case ('fracarea')
+
+  do n=1,num_links
+    dst_array(dst_address(n)) = dst_array(dst_address(n)) +
+              remap_matrix(1,n)*src_array(src_address(n))
+  end do
+
+case ('destarea')
+
+  do n=1,num_links
+    dst_array(dst_address(n)) = dst_array(dst_address(n)) +
+             (remap_matrix(1,n)*src_array(src_address(n)))/
+             (dst_frac(dst_address(n)))
+  end do
+
+case ('none')
+
+  do n=1,num_links
+    dst_array(dst_address(n)) = dst_array(dst_address(n)) +
+             (remap_matrix(1,n)*src_array(src_address(n)))/
+       (dst_area(dst_address(n))*dst_frac(dst_address(n)))
+  end do
+
+end select
+
+\end{verbatim}
+\end{figure}
+
+The address arrays are sorted by destination address and are
+linear addresses that assume standard
+Fortran ordering. They can therefore be converted to logical
+address space if necessary.  For example, a point on a
+two-dimensional grid with logical coordinates $(i,j)$ will
+have a linear address $n$ given by
+$n=(j-1)*{\rm grid\_dims(1)} + i.$  Alternatively, if the
+code is run on a serial machine, the multi-dimensional arrays
+can be passed into linear dummy arrays and the addresses can
+be used directly.  Such a storage/sequence association may
+not be valid in a distributed-memory context however.
+The scrip\_test code shows an example of how the remappings
+can be implemented.
+
+\section{Testing}
+
+In order to test the weights computed by the SCRIP package,
+a simple test code is provided.  This code reads in the
+weights and remaps analytic fields.  Three choices for the
+analytic field are provided.  The first is a cosine bell
+function $f=2+\cos(\pi r/L)$, where $r$ is the distance from
+the center of the hill and $L$ is a length scale.  Such a
+function is useful for determining the effects of repeated
+applications.  The other two fields are representative of
+spherical harmonic wavefunctions.  A relatively smooth function
+$f=2+\cos^2\theta\cos(2\phi)$ is similar to a spherical
+harmonic with $\ell=2$ and $m=2$, where $\ell$ is the
+spherical harmonic order and $m$ is the azimuthal wave number.
+The function
+$f=2+\sin^{16}(2\theta)\cos(16\phi)$ is similar to a
+spherical harmonic with $\ell=32$ and $m=16$ and is useful
+for testing a field with relatively high spatial
+frequency and rapidly changing gradients.  The choice of
+which field is remapped in determined by the input namelist
+scrip\_test\_in.
+
+For
+conservative remappings, the test code tests three different
+remappings: the first is a first-order remapping, the second
+is a second-order remapping using only latitude gradients,
+and the third is a full second-order remapping.  The second
+is performed in order to determine which weights are
+causing problems when errors occur.  The code
+prints out three diagnostics to standard output and writes
+many quantities to a netCDF output file.
+
+First, it prints out the minimum and maximum of the source
+and destination (remapped) fields.  This is a test for
+monotonicity (although only the first-order conservative
+remapping is monotone by default).
+
+Second, the test code prints out the maximum and average
+relative error $\epsilon =
+|(F_{dst} - F_{analytic})/F_{analytic}|$, where
+$F_{analytic}$ is the source function evaluated at the
+destination grid points and $F_{dst}$ is the destination
+(remapped) field.  The errors here can sometimes be misleading.
+For example, if a conservative remapping is performed from
+a fine grid to a coarse grid, the destination array will
+contain the field averaged over many source cells, while
+$F_{analytic}$ is the analytic field evaluated at the cell
+center point.  Another instance which leads to relatively
+large errors is near mask boundaries where the remapped
+field is correctly returning values indicative of the edge
+of a grid cell, while $F_{analytic}$ is again computing
+cell-center values. To avoid the latter problem, the error is
+only computed where the destination grid fraction
+is greater than $0.999$.
+
+Lastly, the test code prints out the area-integrated
+field on the source and destination grids in order to
+test conservation.  This diagnostic returns zeros for
+all but conservative remappings.  For a first-order
+conservative remapping, these numbers should agree
+to machine accuracy.  For a second-order conservative
+remapping, they will be very close, but may not exactly
+agree due to mask boundary effects where it is not
+possible to perform the exact area integral.
+
+The netCDF output file from the test code contains
+the source and destination arrays as well as the
+error arrays so the error can be examined at every
+grid point to pinpoint problems.  The arrays in
+the netCDF file are written out in arrays with
+rank grid\_rank (e.g. two-dimensional grids are
+written as proper 2-d arrays rather than vectors
+of values).  These arrays can then be viewed using
+any visualization package.
+
+\chapter{Conservative Remapping}
+
+The SCRIP package implements a conservative remapping
+scheme described in detail in a separate paper
+(Jones, P.W. 1999 {\em Monthly Weather Review}, 
+{\bf 127}, 2204-2210).
+A brief outline will be given here to aid the
+user in understanding what this portion of the
+package does.
+
+To compute a flux on a new (destination) grid which
+results in the same energy or water exchange as a flux $f$ on an
+old (source) grid, the destination flux $F$ at a destination grid
+cell $k$ must satisfy
+\begin{equation}\label{eq:local}
+\overline{F}_k = {1\over{A_k}}\int\int_{A_k} fdA,
+\end{equation}
+where $\overline{F}$ is the area-averaged flux and $A_k$ is
+the area of cell $k$.
+Because the integral in (\ref{eq:local}) is over the area of
+the destination grid cell, only those cells on the source grid
+that are covered at least partly by the destination grid cell
+contribute to the value of the flux on the destination grid.
+If cell $k$ overlaps $N$ cells on the source grid, the
+remapping can be written as
+\begin{equation}\label{eq:rmpsum}
+\overline{F}_k =
+{1\over{A_k}} \sum_{n=1}^N \int\int_{A_{nk}} f_ndA,
+\end{equation}
+where $A_{nk}$ is the
+area of the source grid cell $n$ covered by the destination grid
+cell $k$, and $f_n$ is the local value of the flux in the source
+grid cell (see Figure~\ref{fig:grids}).  Note that (\ref{eq:rmpsum})
+is normalized by the destination area $A_k$ corresponding to
+the normalize\_opt value of `destarea'.  The sum of the weights
+for a destination cell $k$ in this case would be between 0 and 1
+and would be the area fraction if $f_n$ were identically 1
+everywhere on the source grid.  The normalization option
+`fracarea' would actually divide by the area of the source
+grid overlapped by cell $k$:
+\begin{equation}
+\sum_{n=1}^N \int\int_{A_{nk}}dA.
+\end{equation}
+For this normalization option, remapping a function $f$ which
+is 1 everywhere on the source grid would result in a function
+$F$ that is exactly one wherever the destination grid overlaps
+a non-masked source grid cell and zero otherwise.  A normalization
+option of `none' would result in the actual angular area
+participating in the remapping.
+
+Assuming $f_n$ is constant across a source grid cell,
+(\ref{eq:rmpsum})
+would lead to the first-order area-weighted schemes used in
+current coupled models.  A more accurate form of the remapping
+is obtained by using
+\begin{equation}\label{eq:gradient}
+f_n = \overline{f}_n +
+                   \nabla_n f\cdot({\vec{r}} - \vec{r}_n),
+\end{equation}
+where $\nabla_n f$ is the gradient of the flux in cell $n$ and
+$\vec{r}_n$ is the centroid of cell $n$ defined by
+\begin{equation}\label{eq:centroid}
+\vec{r}_n = {1\over{A_n}}\int\int_{A_n}\vec{r}dA.
+\end{equation}
+Such a distribution satisfies the conservation constraint and
+is equivalent to the first terms of a Taylor series expansion
+of $f$ around $\vec{r}_n$.  The remapping is thus
+second-order accurate if $\nabla_n f$ is at least a
+first-order approximation to the gradient.
+
+The remapping can now be expanded in spherical coordinates as
+\begin{equation}\label{eq:remap}
+\overline{F}_k = \sum_{n=1}^{N} \left[\overline{f}_n w_{1nk} +
+\left({{\partial f}\over{\partial \theta}}\right)_n w_{2nk} +
+\left({1\over{\cos\theta}}{{\partial f}\over{\partial \phi}}\right)_n w_{3nk}
+\right],
+\end{equation}
+where $\theta$ is latitude, $\phi$ is longitude and the
+three remapping weights are
+\begin{equation}\label{eq:weights1}
+w_{1nk} = {1\over{A_k}}\int\int_{A_{nk}}dA, \\
+\end{equation}
+\begin{eqnarray}\label{eq:weights2}
+w_{2nk} & = & {1\over{A_k}}\int\int_{A_{nk}}(\theta-\theta_n)dA \nonumber \\
+        & = & {1\over{A_k}}\int\int_{A_{nk}}\theta dA -
+              {{w_{1nk}}\over{A_n}}\int\int_{A_n}\theta dA,
+\end{eqnarray}
+and
+\begin{eqnarray}\label{eq:weights3}
+w_{3nk} & = & {1\over{A_k}}\int\int_{A_{nk}}\cos\theta(\phi-\phi_n)dA \nonumber \\
+        & = & {1\over{A_k}}\int\int_{A_{nk}}\phi\cos\theta dA -
+              {{w_{1nk}}\over{A_n}}\int\int_{A_n}\phi\cos\theta dA .
+\end{eqnarray}
+Again, if the gradient is zero, ({\ref{eq:remap}})
+reduces to a first-order area-weighted remapping.
+
+The area integrals in
+equations~(\ref{eq:weights1})--(\ref{eq:weights3})
+are computed by converting the area integrals into line
+integrals using the divergence theorem.
+Computing line integrals around the overlap regions
+is much simpler; one simply integrates first around every
+grid cell on the source grid, keeping track of intersections
+with destination grid lines, and then one integrates around every
+grid cell on the destination grid in a similar manner.  After
+the sweep of each grid, all overlap regions have been
+integrated.
+
+Choosing appropriate functions for the divergence, the integrals
+in equations~(\ref{eq:weights1})--(\ref{eq:weights3}) become
+\begin{equation}
+\int\int_{A_{nk}}dA = \oint_{C_{nk}} -\sin\theta d\phi,
+\end{equation}
+\begin{equation}
+\int\int_{A_{nk}}\theta dA =
+ \oint_{C_{nk}} [-\cos\theta-\theta\sin\theta]d\phi,
+\end{equation}
+\begin{equation}
+\int\int_{A_{nk}}\phi\cos\theta dA =
+\oint_{C_{nk}} -{\phi\over 2}[\sin\theta\cos\theta + \theta]d\phi,
+\end{equation}
+where $C_{nk}$ is the counterclockwise path around the region
+$A_{nk}$.  Computing these three line integrals during the
+sweeps of each grid provides all the information necessary
+for computing the remapping weights.
+
+\begin{figure}
+  \caption{An example of a triangular destination grid
+           cell $k$ overlapping
+           a quadrilateral source grid.  The region $A_{kn}$
+           is where cell $k$ overlaps the quadrilateral cell $n$.
+           Vectors
+           used by search and intersection routines are
+           also labelled. \label{fig:grids}}
+
+\begin{picture}(400,400)
+
+\put(100,0){\line(2,1){300}}
+\put(50,100){\line(2,1){300}}
+\put(0,200){\line(2,1){300}}
+%\put(0,150){\line(2,1){400}}
+
+\put(  0,200){\line(1,-2){100}}
+\put(100,250){\line(1,-2){100}}
+\put(200,300){\line(1,-2){100}}
+\put(300,350){\line(1,-2){100}}
+
+
+\put( 50,125){\line(1,0){200}}
+\put(250,125){\line(1,4){40}}
+{\thicklines
+\put(290,285){\vector(-3,-2){240}}
+\put(200,300){\vector(1,-2){50}}
+%\put(200,300){\vector(6,-1){90}}
+\put(200,300){\vector(4,-1){90}}
+}
+
+\put(250,295){$\vec{r}_{1b}$}
+\put(195,270){$\vec{r}_{12}$}
+\put(175,225){$\vec{r}_{be}$}
+
+\put(170,310){$(\theta_1,\phi_1)$}
+\put(255,200){$(\theta_2,\phi_2)$}
+\put(300,285){$(\theta_b,\phi_b)$}
+\put( 10,125){$(\theta_e,\phi_e)$}
+
+\put(200,300){\circle*{4}}
+\put(250,200){\circle*{4}}
+\put(290,285){\circle*{4}}
+\put( 50,125){\circle*{4}}
+
+\put(225,225){Cell $k$}
+\put(250,100){Cell $n$}
+\put(200,150){$A_{kn}$}
+
+\end{picture}
+\end{figure}
+
+\section{Search algorithms}\label{sec:search}
+
+As mentioned in the previous section, the algorithm for
+computing the remapping weights is relatively simple.  The
+process amounts to finding the location of the endpoint
+of a segment and then finding the next intersection with
+the other grid.  The line integrals are then computed and
+summed according to which grid cells are associated with
+that particular subsegment.
+The most time-consuming portion of the algorithm
+is finding which cell on one grid
+contains an endpoint from the other grid.  Optimal
+search algorithms can be written when the grid is
+well structured and regular.  However, if one requires
+a search algorithm that will work for any general
+grid, a hierarchy of search algorithms appears to
+work best.  In SCRIP, each grid cell address is
+assigned to one or more latitude bins.  When the
+search begins, only those cells belonging to the
+same latitude bin as the search point are used.
+The second stage checks the bounding box of each
+grid cell in the latitude bin.  The bounding box
+is formed by the cells minimum and maximum latitude
+and longitude.  This process further restricts
+the search to a small number of cells.
+
+Once the search has been restricted, a robust algorithm
+that works for most cases is a cross-product test.
+In this test, a cross product is computed between
+the vector corresponding to a cell side ($\vec{r}_{12}$ in
+Figure~\ref{fig:grids}) and a vector extending from the
+beginning of the cell side to the search point ($\vec{r}_{1b}$).
+If
+\begin{equation}\label{eq:cross}
+\vec{r}_{12} \times \vec{r}_{1b} > 0,
+\end{equation}
+the point lies to the left of the cell side.  If
+(\ref{eq:cross}) holds for every cell side, the
+point is enclosed by the cell.
+This test is not completely robust and will fail for
+grid cells that are non-convex.
+
+\section{Intersections}\label{sec:intersect}
+
+Once the location of an initial endpoint is found,
+it is necessary to check to see if the segment intersects
+with the cell side.  If the segment is parametrized as
+\begin{eqnarray}
+\theta &=& \theta_b + s_1 (\theta_e - \theta_b) \nonumber \\
+\phi   &=& \phi_b + s_1 (\phi_e - \phi_b)
+\end{eqnarray}
+and the cell side as
+\begin{eqnarray}
+\theta &=& \theta_1 + s_2 (\theta_2 - \theta_1) \nonumber \\
+\phi   &=& \phi_1 + s_2 (\phi_2 - \phi_1),
+\end{eqnarray}
+where $\theta_1, \phi_1, \theta_2, \phi_2, \theta_b,$ and
+$\theta_e$ are endpoints as shown in Figure~\ref{fig:grids},
+the intersection of the two lines occurs when $\theta$
+and $\phi$ are equal.  The linear system
+\begin{equation}
+\left[ \begin{array}{cc}
+(\theta_e - \theta_b) & (\theta_1 - \theta_2) \\
+(\phi_e - \phi_b) & (\phi_1 - \phi_2) \\
+\end{array} \right]
+\left[ \begin{array}{c} s_1 \\ s_2 \\ \end{array} \right] =
+\left[ \begin{array}{c}
+(\theta_1 - \theta_b) \\ (\phi_1 - \phi_b)  \\
+\end{array} \right]
+\end{equation}
+is then solved
+to determine $s_1$ and $s_2$ at the intersection point.
+If $s_1$ and $s_2$ are between zero and one, an
+intersection occurs with that cell side.
+
+It is important also to compute identical intersections
+during the sweeps of each grid.  To ensure that this
+will occur, the entire line segment is used to
+compute intersections rather than using a previous or
+next intersection as an endpoint.
+
+\section{Coincidences}
+
+Often, pairs of grids will share common lines (e.g. the
+Equator).  When this is the case, the method described
+above will double-count the contribution of these line
+segments.  Coincidences can be detected when computing
+cross products for the search algorithm described above.
+If the cross product is zero
+in this case, the endpoint lies on the cell side.  A
+second cross product between the line segment and the
+cell side can then be computed.  If the second cross
+product is also zero, the lines are coincident.
+Once a coincidence has been detected, the contribution
+of the coincident segment can be computed during the
+first sweep and ignored during the second sweep.
+
+\section{Spherical coordinates}\label{sec-sphere}
+
+Some aspects of the spherical coordinate system introduce
+additional problems for the method described above.
+Longitude is multiple valued on one line on the sphere,
+and this branch cut may be chosen differently by different
+grids.  Care must be taken when calculating intersections
+and line integrals to ensure that the proper
+longitude values are used.  A simple method is to always
+check to make sure the longitude is in the same interval
+as the source grid cell center.
+
+Another problem with computing weights in spherical
+coordinates is the treatment of the pole.  First, note
+that although the pole is physically a point, it is a
+line in latitude-longitude space and has a nonzero
+contribution to the weight integrals.  If a grid does
+not contain the pole explicitly as a grid vertex, the
+pole contribution must be added to the appropriate cells.
+The pole contribution can be computed analytically.
+
+The pole also creates problems for the search and
+intersection algorithms described above.  For example,
+a grid cell that overlaps the pole can result in a
+nonconvex cell in latitude-longitude coordinates.
+The cross-product test described above
+will fail in this case.  In addition, segments near
+the pole typically exhibit large changes in longitude
+even for very short segments.  In such a case, the
+linear parametrizations used above
+result in inaccuracies for determining the correct
+intersections.
+
+To avoid these problems, a coordinate transformation
+can be used poleward of a given threshold latitude
+(typically within one degree of the pole).  A possible
+transformation is the Lambert equivalent azimuthal projection
+\begin{eqnarray}
+X &=& 2\sin\left({\pi \over 4} - {\theta \over 2}\right)\cos\phi \nonumber \\
+Y &=& 2\sin\left({\pi \over 4} - {\theta \over 2}\right)\sin\phi
+\end{eqnarray}
+for the North Pole.  The transformation for the South
+Pole is similar.  This transformation is only used to
+compute intersections; line integrals are still computed
+in latitude-longitude coordinates.  Because intersections
+computed in the transformed coordinates can be different
+from those computed in latitude-longitude coordinates,
+line segments which cross the latitude threshold must be
+treated carefully.  To compute the intersections
+consistently for such a segment, intersections with the
+threshold latitude are detected and used as a normal
+grid intersection to provide a clean break between the
+two coordinate systems.
+
+\section{Conclusion}
+
+The implementation in the SCRIP code follows closely
+the description above.  The user should be able to
+follow and understand the process based on this
+description.
+
+\chapter{Bilinear Remapping}
+
+Standard bilinear interpolation schemes can be found
+in many textbooks.  Here we present a more general
+scheme which uses a local bilinear approximation
+to interpolate to a point in a quadrilateral grid.
+Consider the grid points shown in Fig.~\ref{fig:quad}
+labelled with logically-rectangular indices (e.g. $(i,j)$).
+
+\begin{figure}
+\caption{A general quadrilateral grid. \label{fig:quad}}
+\begin{picture}(400,400)
+
+\put(40,40){\line(2,1){200}}
+\put(240,140){\line(1,2){100}}
+\put(40,40){\line(1,2){100}}
+\put(140,240){\line(2,1){200}}
+
+\put(40,40){\circle*{4}}
+\put(240,140){\circle*{4}}
+\put(140,240){\circle*{4}}
+\put(340,340){\circle*{4}}
+\put(210,200){\circle*{4}}
+
+\put(30 , 20){1 $(i,j)$}
+\put(250,130){2 $(i+1,j)$}
+\put( 80,240){$(i,j+1)$ 4}
+\put(350,340){3 $(i+1,j+1)$}
+\put(200,200){$P$}
+
+\end{picture}
+\end{figure}
+
+Let the latitude-longitude coordinates of point
+1 be $(\theta(i,j),\phi(i,j))$, the coordinates of
+point 2 be $(\theta(i+1,j),\phi(i+1,j))$, etc.
+Now let $\alpha$ and $\beta$ be continuous local
+coordinates such that the coordinates $(\alpha,\beta)$
+of point 1 are $(0,0)$, point 2 are $(1,0)$, point
+3 are $(1,1)$ and point 4 are $(0,1)$.  If point $P$
+lies inside the cell formed by the four points above,
+the function $f$ at point $P$ can be approximated by
+\begin{eqnarray}\label{eq:bilinear}
+f_P & = & (1-\alpha)(1-\beta)f(i,j) + \alpha(1-\beta)f(i+1,j) + \nonumber \\
+    &   & \alpha\beta f(i+1,j+1) + (1-\alpha)\beta f(i,j+1)  \\
+    & = & w_1 f(i,j) + w_2 f(i+1,j) + w_3 f(i+1,j+1) + w_4 f(i,j+1). \nonumber
+\end{eqnarray}
+The remapping weights must therefore be computed by
+finding $\alpha$ and $\beta$ at point $P$.
+
+The latitude-longitude coordinates $(\theta,\phi)$ of
+point $P$ are known and can also be approximated by
+\begin{eqnarray}\label{eq:thetaphi}
+\theta & = & (1-\alpha)(1-\beta)\theta_1 + \alpha(1-\beta)\theta_2 + \nonumber
+          \alpha\beta \theta_3 + (1-\alpha)\beta \theta_4 \\
+\phi   & = & (1-\alpha)(1-\beta)\phi_1   + \alpha(1-\beta)\phi_2 +
+          \alpha\beta \phi_3 + (1-\alpha)\beta \phi_4.
+\end{eqnarray}
+Because (\ref{eq:thetaphi}) is nonlinear in $\alpha$ and $\beta$,
+we must linearize and iterate toward a solution.  Differentiating
+(\ref{eq:thetaphi}) results in
+\begin{equation}
+\left[\begin{array}{c} \delta\theta \\ \delta\phi \end{array}\right]
+= A
+\left[\begin{array}{c} \delta\alpha \\ \delta\beta \end{array}\right],
+\end{equation}
+where
+\begin{equation}
+A = \left[\begin{array}{cc}
+(\theta_2-\theta_1) + (\theta_1-\theta_4+\theta_3-\theta_2)\beta &
+(\theta_4-\theta_1) + (\theta_1-\theta_4+\theta_3-\theta_2)\alpha \\
+(\phi_2-\phi_1) + (\phi_1-\phi_4+\phi_3-\phi_2)\beta &
+(\phi_4-\phi_1) + (\phi_1-\phi_4+\phi_3-\phi_2)\alpha
+\end{array}\right].
+\end{equation}
+Inverting this system,
+\begin{equation}\label{eq:dalpha}
+\delta\alpha = \left|\begin{array}{cc}
+\delta\theta &
+(\theta_4-\theta_1) + (\theta_1-\theta_4+\theta_3-\theta_2)\alpha \\
+\delta\phi &
+(\phi_4-\phi_1) + (\phi_1-\phi_4+\phi_3-\phi_2)\alpha
+\end{array}\right| \div \det(A),
+\end{equation}
+and
+\begin{equation}\label{eq:dbeta}
+\delta\beta
+= \left|\begin{array}{cc}
+(\theta_2-\theta_1) + (\theta_1-\theta_4+\theta_3-\theta_2)\beta &
+\delta\theta \\
+(\phi_2-\phi_1) + (\phi_1-\phi_4+\phi_3-\phi_2)\beta &
+\delta\phi
+\end{array}\right| \div \det(A).
+\end{equation}
+Starting with an initial guess for $\alpha$ and $\beta$
+(say $\alpha=\beta=0$), equations~(\ref{eq:dalpha}) and
+(\ref{eq:dbeta}) can be iterated until
+$\delta\alpha$ and $\delta\beta$ are suitably small.  The
+weights can then be computed from (\ref{eq:bilinear}).  Note
+that for simple latitude-longitude grids, this iteration
+will converge in the first iteration.
+
+In order to compute the weights using this general bilinear
+iteration, it must be determined in which box the point $P$
+resides.  For this, the search algorithms outlined in the
+previous chapter are used with the exception that instead
+of using cell corners, the relevant box is formed by
+neighbor cell centers as shown in Fig.~\ref{fig:quad}.
+
+\chapter{Bicubic Remapping}
+
+The bicubic remapping exactly follows the bilinear remapping
+except that four weights for each corner point are required.
+Thus, num\_wts is set to four for this option.
+The bicubic remapping is
+\begin{eqnarray}\label{eq:bicubic}
+f_P & = & 
+    (1 - \beta^2(3-2\beta))(1 - \alpha^2(3-2\alpha))f(i  ,j  ) + \nonumber \\
+& & (1 - \beta^2(3-2\beta))     \alpha^2(3-2\alpha) f(i+1,j  ) + \nonumber \\
+& &      \beta^2(3-2\beta)      \alpha^2(3-2\alpha) f(i+1,j+1) + \nonumber \\
+& &      \beta^2(3-2\beta) (1 - \alpha^2(3-2\alpha))f(i  ,j+1) + \nonumber \\
+& & (1 - \beta^2(3-2\beta))\alpha  (\alpha-1)^2
+                        {{\partial f}\over{\partial i}}(i  ,j  ) + \nonumber \\
+& & (1 - \beta^2(3-2\beta))\alpha^2(\alpha-1)
+                        {{\partial f}\over{\partial i}}(i+1,j  ) + \nonumber \\
+& &      \beta^2(3-2\beta) \alpha^2(\alpha-1)
+                        {{\partial f}\over{\partial i}}(i+1,j+1) + \nonumber \\
+& &      \beta^2(3-2\beta) \alpha  (\alpha-1)^2
+                        {{\partial f}\over{\partial i}}(i  ,j+1) + \nonumber \\
+& & \beta  (\beta-1)^2(1 - \alpha^2(3-2\alpha))
+                        {{\partial f}\over{\partial j}}(i  ,j  ) + \nonumber \\
+& & \beta  (\beta-1)^2     \alpha^2(3-2\alpha)
+                        {{\partial f}\over{\partial j}}(i+1,j  ) + \nonumber \\
+& & \beta^2(\beta-1)       \alpha^2(3-2\alpha)
+                        {{\partial f}\over{\partial j}}(i+1,j+1) + \nonumber \\
+& & \beta^2(\beta-1)  (1 - \alpha^2(3-2\alpha))
+                        {{\partial f}\over{\partial j}}(i  ,j+1) + \nonumber \\
+& & \alpha  (\alpha-1)^2\beta  (\beta-1)^2
+           {{\partial^2 f}\over{\partial i \partial j}}(i  ,j  ) + \nonumber \\
+& & \alpha^2(\alpha-1)  \beta  (\beta-1)^2
+           {{\partial^2 f}\over{\partial i \partial j}}(i+1,j  ) + \nonumber \\
+& & \alpha^2(\alpha-1)  \beta^2(\beta-1)
+           {{\partial^2 f}\over{\partial i \partial j}}(i+1,j+1) + \nonumber \\
+& & \alpha  (\alpha-1)^2\beta^2(\beta-1)
+           {{\partial^2 f}\over{\partial i \partial j}}(i  ,j+1)
+\end{eqnarray}
+where $\alpha$ and $\beta$ are identical to those found in
+the bilinear case and are found using an identical algorithm.
+Note that unlike the conservative remappings, the gradients
+here are gradients with respect to the {\em logical} variable
+and not latitude or longitude.  Lastly, the four weights
+corresponding to each address pair correspond to the
+weight multiplying the field value at the point, the weight
+multiplying the gradient with respect to $i$, the weight
+multiplying the gradient with respect to $j$, and the weight
+multiplying the cross gradient in that order.
+
+\chapter{Distance-weighted Average Remapping}
+
+This scheme for remapping is probably the simplest
+in this package.  The code simply searches for the
+num\_neighbors nearest neighbors and computes the
+weights using
+\begin{equation}\label{eq:distwgt}
+w = {{1/(d+\epsilon)} \over
+     {\sum_n^{\rm num\_neighbors} [1/(d_n+\epsilon)]}},
+\end{equation}
+where $\epsilon$ is a small number to prevent
+dividing by zero, the sum is for normalization and
+$d$ is the distance from the destination grid point
+to the source grid point.  The distance is the angular
+distance
+\begin{equation}\label{eq:distance}
+d = \cos^{-1}\left(\cos\theta_d\cos\theta_s
+                  (\cos\phi_d\cos\phi_s + \sin\phi_d\sin\phi_s) +
+                   \sin\theta_d\sin\theta_s\right),
+\end{equation}
+where $\theta$ is latitude, $\phi$ is longitude and the
+subscripts $d,s$ denote destination and source grids,
+respectively.
+
+When finding nearest neighbors, the distance is not
+computed between the destination grid point and every
+source grid point.  Instead, the search is narrowed by
+sorting the two grids into latitude bins.  Only those
+source grid cells lying in the same latitude bin as
+the destination grid cell are checked to find the
+nearest neighbors.
+
+\chapter{Bugs}
+
+A file called `bugs' is included in the distribution
+which lists current outstanding bugs as well as a
+version history.  Any further bugs, comments, or suggestions
+should be sent to me at pwjones@lanl.gov.
+
+The code does not have very useful error messages to
+help diagnose problems so feel free to pester me with
+any problems you encounter.
+
+The package has also not been extensively tested on
+a variety of machines.  It works fine on SGI machines
+and IBM machines, but has not been run on other machines.
+It is pretty vanilla Fortran, so should be ok on
+machines with standard-compliant F90 compilers.
+
+\end{document}
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/grids/README
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/grids/README	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/grids/README	(revision 12863)
@@ -0,0 +1,17 @@
+
+      This directory contains some grid files in netCDF format
+      for use in the SCRIP remapping package.
+
+      In addition, there are several source codes for creating
+      netCDF files for use in SCRIP:
+
+      convertPOPT.f  - converts input grid files for the POP 
+                       ocean model to SCRIP netCDF format
+
+      convertgauss.f - creates a SCRIP netCDF grid file for
+                       a Gaussian lat/lon grid that a global
+                       spectral model would use
+
+      convert_old.f  - converts old grid files from a previous
+                       version of the SCRIP routines
+
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/grids/convertPOPT.f
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/grids/convertPOPT.f	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/grids/convertPOPT.f	(revision 12863)
@@ -0,0 +1,447 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This file converts a POP grid.dat file to a remapping grid file
+!     in netCDF format.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: convertPOPT.f,v 1.4 2001/08/21 21:22:56 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!***********************************************************************
+
+      program convertPOPT
+
+!-----------------------------------------------------------------------
+!
+!     This file converts a POP grid.dat file to a remapping grid file.
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+      use constants
+      use iounits
+      use netcdf_mod
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     variables that describe the grid
+!       4/3       nx = 192, ny = 128
+!       2/3 (mod) nx = 384, ny = 288
+!       x3p Greenland DP nx = 100, ny = 116
+!       x2p Greenland DP nx = 160, ny = 192
+!       x1p Greenland DP nx = 320, ny = 384
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter ::
+     &             nx = 320, ny = 384,
+     &             grid_size = nx*ny,
+     &             grid_rank = 2,
+     &             grid_corners = 4
+
+      integer (kind=int_kind), dimension(2) ::
+     &             grid_dims   ! size of each dimension
+
+      character(char_len), parameter :: 
+     &    grid_name = 'Greenland DP x1p',
+     &    grid_file_in  = '/scratch/pwjones/grid.320x384.da',
+     &    grid_topo_in  = '/scratch/pwjones/kmt.320x384.da',
+     &    grid_file_out = '/scratch/pwjones/Greenland_DP_x1p.nc'
+
+      real (kind=dbl_kind), parameter ::
+     &  radius    = 6370.0e5_dbl_kind       ! radius of Earth (cm)
+     &, area_norm = one/(radius*radius)
+
+!-----------------------------------------------------------------------
+!
+!     grid coordinates and masks
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(grid_size) ::
+     &             grid_imask
+
+      real (kind=dbl_kind), dimension(grid_size) ::
+     &             grid_area      ,  ! area as computed in POP
+     &             grid_center_lat,  ! lat/lon coordinates for
+     &             grid_center_lon   ! each grid center in radians
+
+      real (kind=dbl_kind), dimension(grid_corners,grid_size) ::
+     &             grid_corner_lat,  ! lat/lon coordinates for
+     &             grid_corner_lon   ! each grid corner in radians
+
+      real (kind=dbl_kind), dimension(nx,ny) ::
+     &             HTN, HTE          ! T-cell grid lengths
+
+!-----------------------------------------------------------------------
+!
+!     other local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: i, j, n, iunit, ocn_add, im1, jm1
+
+      integer (kind=int_kind) ::
+     &        ncstat,            ! general netCDF status variable
+     &        nc_grid_id,        ! netCDF grid dataset id
+     &        nc_gridsize_id,    ! netCDF grid size dim id
+     &        nc_gridcorn_id,    ! netCDF grid corner dim id
+     &        nc_gridrank_id,    ! netCDF grid rank dim id
+     &        nc_griddims_id,    ! netCDF grid dimensions id
+     &        nc_grdcntrlat_id,  ! netCDF grid center lat id
+     &        nc_grdcntrlon_id,  ! netCDF grid center lon id
+     &        nc_grdimask_id,    ! netCDF grid mask id
+     &        nc_gridarea_id,    ! netCDF grid area id
+     &        nc_grdcrnrlat_id,  ! netCDF grid corner lat id
+     &        nc_grdcrnrlon_id   ! netCDF grid corner lon id
+
+      integer (kind=int_kind), dimension(2) ::
+     &        nc_dims2_id        ! netCDF dim id array for 2-d arrays
+
+      real (kind=dbl_kind) :: tmplon, dxt, dyt
+
+!-----------------------------------------------------------------------
+!
+!     read in grid info
+!     lat/lon info is on velocity points which correspond
+!     to the NE corner (in logical space) of the grid cell.
+!
+!-----------------------------------------------------------------------
+
+      call get_unit(iunit)
+      open(unit=iunit, file=grid_topo_in, status='old', 
+     &     form='unformatted', access='direct', recl=grid_size*4)
+      read (unit=iunit,rec=1) grid_imask
+      call release_unit(iunit)
+
+      call get_unit(iunit)
+      open(unit=iunit, file=grid_file_in, status='old', 
+     &     form='unformatted', access='direct', recl=grid_size*8)
+      read (unit=iunit, rec=1) grid_corner_lat(3,:)
+      read (unit=iunit, rec=2) grid_corner_lon(3,:)
+      read (unit=iunit, rec=3) HTN
+      read (unit=iunit, rec=4) HTE
+      call release_unit(iunit)
+
+      grid_dims(1) = nx
+      grid_dims(2) = ny
+
+!-----------------------------------------------------------------------
+!
+!     convert KMT field to integer grid mask
+!
+!-----------------------------------------------------------------------
+
+      grid_imask = min(grid_imask, 1)
+
+!-----------------------------------------------------------------------
+!
+!     compute remaining corners
+!
+!-----------------------------------------------------------------------
+
+      do j=1,ny
+        do i=1,nx
+          ocn_add = (j-1)*nx + i
+          if (i .ne. 1) then
+            im1 = ocn_add - 1
+          else
+            im1 = ocn_add + nx - 1
+          endif
+
+          grid_corner_lat(4,ocn_add) = grid_corner_lat(3,im1)
+          grid_corner_lon(4,ocn_add) = grid_corner_lon(3,im1)
+        end do
+      end do
+
+      do j=2,ny
+        do i=1,nx
+          ocn_add = (j-1)*nx + i
+          jm1 = (j-2)*nx + i
+
+          grid_corner_lat(2,ocn_add) = grid_corner_lat(3,jm1)
+          grid_corner_lat(1,ocn_add) = grid_corner_lat(4,jm1)
+
+          grid_corner_lon(2,ocn_add) = grid_corner_lon(3,jm1)
+          grid_corner_lon(1,ocn_add) = grid_corner_lon(4,jm1)
+        end do
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     mock up the lower row boundaries
+!
+!-----------------------------------------------------------------------
+
+      do i=1,nx
+        grid_corner_lat(1,i) = -pih + tiny
+        grid_corner_lat(2,i) = -pih + tiny
+
+        grid_corner_lon(1,i) = grid_corner_lon(4,i)
+        grid_corner_lon(2,i) = grid_corner_lon(3,i)
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     correct for 0,2pi longitude crossings
+!
+!-----------------------------------------------------------------------
+
+      do ocn_add=1,grid_size
+        if (grid_corner_lon(1,ocn_add) > pi2) 
+     &      grid_corner_lon(1,ocn_add) = 
+     &      grid_corner_lon(1,ocn_add) - pi2
+        if (grid_corner_lon(1,ocn_add) < 0.0) 
+     &      grid_corner_lon(1,ocn_add) = 
+     &      grid_corner_lon(1,ocn_add) + pi2
+        do n=2,grid_corners
+          tmplon = grid_corner_lon(n  ,ocn_add) - 
+     &             grid_corner_lon(n-1,ocn_add) 
+          if (tmplon < -three*pih) grid_corner_lon(n,ocn_add) = 
+     &                             grid_corner_lon(n,ocn_add) + pi2
+          if (tmplon >  three*pih) grid_corner_lon(n,ocn_add) = 
+     &                             grid_corner_lon(n,ocn_add) - pi2
+        end do
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     compute ocean cell centers by averaging corner values
+!
+!-----------------------------------------------------------------------
+
+      do ocn_add=1,grid_size
+        grid_center_lat(ocn_add) = grid_corner_lat(1,ocn_add)
+        grid_center_lon(ocn_add) = grid_corner_lon(1,ocn_add)
+        do n=2,grid_corners
+          grid_center_lat(ocn_add) = grid_center_lat(ocn_add) + 
+     &                               grid_corner_lat(n,ocn_add)
+          grid_center_lon(ocn_add) = grid_center_lon(ocn_add) + 
+     &                               grid_corner_lon(n,ocn_add)
+        end do
+        grid_center_lat(ocn_add) = grid_center_lat(ocn_add)/
+     &                                  float(grid_corners)
+        grid_center_lon(ocn_add) = grid_center_lon(ocn_add)/
+     &                                  float(grid_corners)
+        if (grid_center_lon(ocn_add) > pi2) 
+     &      grid_center_lon(ocn_add) = grid_center_lon(ocn_add) - pi2
+        if (grid_center_lon(ocn_add) < 0.0) 
+     &      grid_center_lon(ocn_add) = grid_center_lon(ocn_add) + pi2
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     compute cell areas in same way as POP
+!
+!-----------------------------------------------------------------------
+
+      n = 0
+      do j=1,ny
+        if (j > 1) then
+          jm1 = j-1
+        else
+          jm1 = 1
+        endif
+        do i=1,nx
+          if (i > 1) then
+            im1 = i-1
+          else
+            im1 = nx
+          endif
+
+          n = n+1
+
+          dxt = half*(HTN(i,j) + HTN(i,jm1))
+          dyt = half*(HTE(i,j) + HTE(im1,j))
+          if (dxt == zero) dxt=one
+          if (dyt == zero) dyt=one
+
+          grid_area(n) = dxt*dyt*area_norm
+        end do
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     set up attributes for netCDF file
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** create netCDF dataset for this grid
+      !***
+
+      ncstat = nf_create (grid_file_out, NF_CLOBBER,
+     &                    nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, NF_GLOBAL, 'title',
+     &                          len_trim(grid_name), grid_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid size dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_size', grid_size, 
+     &                     nc_gridsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid rank dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_rank', grid_rank, 
+     &                     nc_gridrank_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_corners', grid_corners, 
+     &                     nc_gridcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid dim size array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_dims', NF_INT,
+     &                     1, nc_gridrank_id, nc_griddims_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_center_lat', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_grdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlat_id, 'units',
+     &                          7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_center_lon', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_grdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlon_id, 'units',
+     &                          7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_area', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_gridarea_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_imask', NF_INT,
+     &                     1, nc_gridsize_id, nc_grdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdimask_id, 'units',
+     &                          8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner latitude array
+      !***
+
+      nc_dims2_id(1) = nc_gridcorn_id
+      nc_dims2_id(2) = nc_gridsize_id
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_corner_lat', NF_DOUBLE,
+     &                     2, nc_dims2_id, nc_grdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcrnrlat_id, 'units',
+     &                          7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner longitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_corner_lon', NF_DOUBLE,
+     &                     2, nc_dims2_id, nc_grdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcrnrlon_id, 'units',
+     &                          7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     write grid data
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_put_var_int(nc_grid_id, nc_griddims_id, grid_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlat_id, 
+     &                           grid_center_lat)
+      ncstat = nf_put_var_int(nc_grid_id, nc_grdimask_id, grid_imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_gridarea_id, 
+     &                           grid_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlat_id, 
+     &                           grid_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlon_id, 
+     &                           grid_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcrnrlat_id, 
+     &                           grid_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcrnrlon_id, 
+     &                           grid_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_close(nc_grid_id)
+
+!***********************************************************************
+
+      end program convertPOPT
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/grids/convert_old.f
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/grids/convert_old.f	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/grids/convert_old.f	(revision 12863)
@@ -0,0 +1,287 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This file converts a POP grid.dat file to a remapping grid file
+!     in netCDF format.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: convert_old.f,v 1.2 2000/04/19 22:05:57 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!***********************************************************************
+
+      program convertPOPT
+
+!-----------------------------------------------------------------------
+!
+!     This file converts a POP grid.dat file to a remapping grid file.
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+      use constants
+      use iounits
+      use netcdf_mod
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     variables that describe the grid
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) ::
+     &             grid_size, grid_rank, grid_corners
+
+      integer (kind=int_kind), dimension(2) ::
+     &             grid_dims   ! size of each dimension
+
+      character(char_len) :: 
+     &             grid_name
+
+      character(char_len), parameter :: 
+     &             grid_file_in  = 'remap_grid_WWice.dat',
+     &             grid_file_out = 'remap_grid_WWice.nc'
+
+!-----------------------------------------------------------------------
+!
+!     grid coordinates and masks
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(:), allocatable ::
+     &             grid_imask
+
+      real (kind=dbl_kind), dimension(:), allocatable ::
+     &             grid_center_lat,  ! lat/lon coordinates for
+     &             grid_center_lon   ! each grid center in radians
+
+      real (kind=dbl_kind), dimension(:,:), allocatable ::
+     &             grid_corner_lat,  ! lat/lon coordinates for
+     &             grid_corner_lon   ! each grid corner in radians
+
+!-----------------------------------------------------------------------
+!
+!     other local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: i, j, n, iunit, ocn_add, im1, jm1
+
+      integer (kind=int_kind) ::
+     &        ncstat,            ! general netCDF status variable
+     &        nc_grid_id,        ! netCDF grid dataset id
+     &        nc_gridsize_id,    ! netCDF grid size dim id
+     &        nc_gridcorn_id,    ! netCDF grid corner dim id
+     &        nc_gridrank_id,    ! netCDF grid rank dim id
+     &        nc_griddims_id,    ! netCDF grid dimensions id
+     &        nc_grdcntrlat_id,  ! netCDF grid center lat id
+     &        nc_grdcntrlon_id,  ! netCDF grid center lon id
+     &        nc_grdimask_id,    ! netCDF grid mask id
+     &        nc_grdcrnrlat_id,  ! netCDF grid corner lat id
+     &        nc_grdcrnrlon_id   ! netCDF grid corner lon id
+
+      integer (kind=int_kind), dimension(2) ::
+     &        nc_dims2_id        ! netCDF dim id array for 2-d arrays
+
+      real (kind=dbl_kind) :: tmplon
+
+!-----------------------------------------------------------------------
+!
+!     read in grid info
+!     lat/lon info is on velocity points which correspond
+!     to the NE corner (in logical space) of the grid cell.
+!
+!-----------------------------------------------------------------------
+
+      call get_unit(iunit)
+      open(unit=iunit, file=grid_file_in, status='old', 
+     &     form='unformatted')
+
+      read(iunit) grid_name
+      read(iunit) grid_size, grid_corners, grid_rank, grid_dims
+
+      allocate( grid_center_lat(grid_size),
+     &		grid_center_lon(grid_size),
+     &		grid_imask     (grid_size),
+     &		grid_corner_lat(grid_corners, grid_size),
+     &		grid_corner_lon(grid_corners, grid_size) )
+
+      read(iunit) grid_center_lat
+      read(iunit) grid_center_lon
+      read(iunit) grid_corner_lat
+      read(iunit) grid_corner_lon
+      read(iunit) grid_imask
+      call release_unit(iunit)
+
+!-----------------------------------------------------------------------
+!
+!     set up attributes for netCDF file
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** create netCDF dataset for this grid
+      !***
+
+      ncstat = nf_create (grid_file_out, NF_CLOBBER,
+     &                    nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, NF_GLOBAL, 'title',
+     &                          len_trim(grid_name), grid_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid size dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_size', grid_size, 
+     &                     nc_gridsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid rank dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_rank', grid_rank, 
+     &                     nc_gridrank_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_corners', grid_corners, 
+     &                     nc_gridcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid dim size array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_dims', NF_INT,
+     &                     1, nc_gridrank_id, nc_griddims_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_center_lat', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_grdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlat_id, 'units',
+     &                          7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_center_lon', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_grdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlon_id, 'units',
+     &                          7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_imask', NF_INT,
+     &                     1, nc_gridsize_id, nc_grdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdimask_id, 'units',
+     &                          8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner latitude array
+      !***
+
+      nc_dims2_id(1) = nc_gridcorn_id
+      nc_dims2_id(2) = nc_gridsize_id
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_corner_lat', NF_DOUBLE,
+     &                     2, nc_dims2_id, nc_grdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcrnrlat_id, 'units',
+     &                          7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner longitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_corner_lon', NF_DOUBLE,
+     &                     2, nc_dims2_id, nc_grdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcrnrlon_id, 'units',
+     &                          7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     write grid data
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_put_var_int(nc_grid_id, nc_griddims_id, grid_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlat_id, 
+     &                           grid_center_lat)
+      ncstat = nf_put_var_int(nc_grid_id, nc_grdimask_id, grid_imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlat_id, 
+     &                           grid_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlon_id, 
+     &                           grid_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcrnrlat_id, 
+     &                           grid_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcrnrlon_id, 
+     &                           grid_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_close(nc_grid_id)
+
+!***********************************************************************
+
+      end program convertPOPT
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/grids/convertgauss.f
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/grids/convertgauss.f	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/grids/convertgauss.f	(revision 12863)
@@ -0,0 +1,506 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This program creates a remapping grid file for Gaussian lat/lon
+!     grids (for spectral transform codes).
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: convertgauss.f,v 1.3 2000/04/19 22:05:57 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!***********************************************************************
+
+      program convert_gauss
+
+!-----------------------------------------------------------------------
+!
+!     This file creates a remapping grid file for a Gaussian grid
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+      use constants
+      use iounits
+      use netcdf_mod
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     variables that describe the grid
+!
+!     T42: nx=128 ny=64
+!     T62: nx=192 ny=94
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter ::
+     &             nx = 192, ny = 94,
+     &             grid_size = nx*ny,
+     &             grid_rank = 2,
+     &             grid_corners = 4
+
+      character(char_len), parameter :: 
+     &             grid_name = 'T62 Gaussian Grid',
+     &             grid_file_out = 'remap_grid_T62.nc'
+
+      integer (kind=int_kind), dimension(grid_rank) ::
+     &             grid_dims
+
+!-----------------------------------------------------------------------
+!
+!     grid coordinates and masks
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(grid_size) ::
+     &             grid_imask
+
+      real (kind=dbl_kind), dimension(grid_size) ::
+     &             grid_center_lat,  ! lat/lon coordinates for
+     &             grid_center_lon   ! each grid center in degrees
+
+      real (kind=dbl_kind), dimension(grid_corners,grid_size) ::
+     &             grid_corner_lat,  ! lat/lon coordinates for
+     &             grid_corner_lon   ! each grid corner in degrees
+
+!-----------------------------------------------------------------------
+!
+!     other local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: i, j, iunit, atm_add
+
+      integer (kind=int_kind) ::
+     &        ncstat,            ! general netCDF status variable
+     &        nc_grid_id,        ! netCDF grid dataset id
+     &        nc_gridsize_id,    ! netCDF grid size dim id
+     &        nc_gridcorn_id,    ! netCDF grid corner dim id
+     &        nc_gridrank_id,    ! netCDF grid rank dim id
+     &        nc_griddims_id,    ! netCDF grid dimension size id
+     &        nc_grdcntrlat_id,  ! netCDF grid center lat id
+     &        nc_grdcntrlon_id,  ! netCDF grid center lon id
+     &        nc_grdimask_id,    ! netCDF grid mask id
+     &        nc_grdcrnrlat_id,  ! netCDF grid corner lat id
+     &        nc_grdcrnrlon_id   ! netCDF grid corner lon id
+
+      integer (kind=int_kind), dimension(2) ::
+     &        nc_dims2_id        ! netCDF dim id array for 2-d arrays
+
+      real (kind=dbl_kind) :: dlon, minlon, maxlon, centerlon,
+     &                              minlat, maxlat, centerlat
+
+      real (kind=dbl_kind), dimension(ny) :: gauss_root, gauss_wgt
+
+!-----------------------------------------------------------------------
+!
+!     compute longitudes of cell centers and corners.  set up alon
+!     array for search routine.
+!
+!-----------------------------------------------------------------------
+
+      grid_dims(1) = nx
+      grid_dims(2) = ny
+
+      dlon = 360./nx
+
+      do i=1,nx
+
+        centerlon = (i-1)*dlon
+        minlon = centerlon - half*dlon
+        maxlon = centerlon + half*dlon
+
+        do j=1,ny
+          atm_add = (j-1)*nx + i
+
+          grid_center_lon(atm_add  ) = centerlon
+          grid_corner_lon(1,atm_add) = minlon
+          grid_corner_lon(2,atm_add) = maxlon
+          grid_corner_lon(3,atm_add) = maxlon
+          grid_corner_lon(4,atm_add) = minlon
+        end do
+
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     compute Gaussian latitudes and store in gauss_wgt.
+!
+!-----------------------------------------------------------------------
+
+      call gquad(ny, gauss_root, gauss_wgt)
+      do j=1,ny
+        gauss_wgt(j) = pih - gauss_root(ny+1-j)
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     compute latitudes at cell centers and corners.  set up alat 
+!     array for search routine.
+!
+!-----------------------------------------------------------------------
+
+      do j=1,ny
+        centerlat = gauss_wgt(j)
+
+        if (j .eq. 1) then
+          minlat = -pih
+        else
+          minlat = ATAN((COS(gauss_wgt(j-1)) - 
+     &                   COS(gauss_wgt(j  )))/
+     &                  (SIN(gauss_wgt(j  )) - 
+     &                   SIN(gauss_wgt(j-1))))
+        endif
+
+        if (j .eq. ny) then
+          maxlat = pih
+        else
+          maxlat = ATAN((COS(gauss_wgt(j  )) - 
+     &                   COS(gauss_wgt(j+1)))/
+     &                  (SIN(gauss_wgt(j+1)) - 
+     &                   SIN(gauss_wgt(j  ))))
+        endif
+
+        do i=1,nx
+          atm_add = (j-1)*nx + i
+          grid_center_lat(atm_add  ) = centerlat*360./pi2
+          grid_corner_lat(1,atm_add) = minlat*360./pi2
+          grid_corner_lat(2,atm_add) = minlat*360./pi2
+          grid_corner_lat(3,atm_add) = maxlat*360./pi2
+          grid_corner_lat(4,atm_add) = maxlat*360./pi2
+        end do
+
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     define mask
+!
+!-----------------------------------------------------------------------
+
+      grid_imask = 1
+
+!-----------------------------------------------------------------------
+!
+!     set up attributes for netCDF file
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** create netCDF dataset for this grid
+      !***
+
+      ncstat = nf_create (grid_file_out, NF_CLOBBER,
+     &                    nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, NF_GLOBAL, 'title',
+     &                          len_trim(grid_name), grid_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid size dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_size', grid_size, 
+     &                     nc_gridsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_corners', grid_corners, 
+     &                     nc_gridcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid rank dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_rank', grid_rank, 
+     &                     nc_gridrank_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid dimension size array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_dims', NF_INT,
+     &                     1, nc_gridrank_id, nc_griddims_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_center_lat', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_grdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlat_id, 'units',
+     &                          7, 'degrees')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_center_lon', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_grdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlon_id, 'units',
+     &                          7, 'degrees')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_imask', NF_INT,
+     &                     1, nc_gridsize_id, nc_grdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdimask_id, 'units',
+     &                          8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner latitude array
+      !***
+
+      nc_dims2_id(1) = nc_gridcorn_id
+      nc_dims2_id(2) = nc_gridsize_id
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_corner_lat', NF_DOUBLE,
+     &                     2, nc_dims2_id, nc_grdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcrnrlat_id, 'units',
+     &                          7, 'degrees')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner longitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_corner_lon', NF_DOUBLE,
+     &                     2, nc_dims2_id, nc_grdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcrnrlon_id, 'units',
+     &                          7, 'degrees')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     write grid data
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_put_var_int(nc_grid_id, nc_griddims_id, grid_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_grid_id, nc_grdimask_id, grid_imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlat_id, 
+     &                           grid_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlon_id, 
+     &                           grid_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcrnrlat_id, 
+     &                           grid_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcrnrlon_id, 
+     &                           grid_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_close(nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end program convert_gauss
+
+!***********************************************************************
+
+      subroutine gquad(l,root,w)
+
+!-----------------------------------------------------------------------
+!
+!     This subroutine finds the l roots (in theta) and gaussian weights 
+!     associated with the legendre polynomial of degree l > 1.
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+      use constants
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     intent(in)
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: l
+
+!-----------------------------------------------------------------------
+!
+!     intent(out)
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), dimension(l), intent(out) ::
+     &      root, w
+
+!-----------------------------------------------------------------------
+!
+!     local
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: l1, l2, l22, l3, k, i, j
+
+      real (kind=dbl_kind) :: 
+     &     del,co,p1,p2,p3,t1,t2,slope,s,c,pp1,pp2,p00
+
+!-----------------------------------------------------------------------
+!
+!     Define useful constants.
+!
+!-----------------------------------------------------------------------
+
+      del= pi/float(4*l)
+      l1 = l+1
+      co = float(2*l+3)/float(l1**2)
+      p2 = 1.0
+      t2 = -del
+      l2 = l/2
+      k = 1
+      p00 = one/sqrt(two)
+
+!-----------------------------------------------------------------------
+!
+!     Start search for each root by looking for crossing point.
+!
+!-----------------------------------------------------------------------
+
+      do i=1,l2
+   10    t1 = t2
+         t2 = t1+del
+         p1 = p2
+         s = sin(t2)
+         c = cos(t2)
+         pp1 = 1.0
+         p3 = p00
+         do j=1,l1
+            pp2 = pp1
+            pp1 = p3
+            p3 = 2.0*sqrt((float(j**2)-0.250)/float(j**2))*c*pp1-
+     &           sqrt(float((2*j+1)*(j-1)*(j-1))/
+     &           float((2*j-3)*j*j))*pp2
+         end do
+         p2 = pp1
+         if ((k*p2).gt.0) goto 10
+
+!-----------------------------------------------------------------------
+!
+!        Now converge using Newton-Raphson.
+!
+!-----------------------------------------------------------------------
+
+         k = -k
+   20    continue
+            slope = (t2-t1)/(p2-p1)
+            t1 = t2
+            t2 = t2-slope*p2
+            p1 = p2
+            s = sin(t2)
+            c = cos(t2)
+            pp1 = 1.0
+            p3 = p00
+            do j=1,l1
+               pp2 = pp1
+               pp1 = p3
+               p3 = 2.0*sqrt((float(j**2)-0.250)/float(j**2))*c*pp1-
+     &              sqrt(float((2*j+1)*(j-1)*(j-1))/
+     &              float((2*j-3)*j*j))*pp2
+            end do
+            p2 = pp1
+         if (abs(p2).gt.1.e-10) goto 20
+         root(i) = t2
+         w(i) = co*(sin(t2)/p3)**2
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     If l is odd, take care of odd point.
+!
+!-----------------------------------------------------------------------
+
+      l22 = 2*l2
+      if (l22 .ne. l) then
+         l2 = l2+1
+         t2 = pi/2.0
+         root(l2) = t2
+         s = sin(t2)
+         c = cos(t2)
+         pp1 = 1.0
+         p3 = p00
+         do j=1,l1
+            pp2 = pp1
+            pp1 = p3
+            p3 = 2.0*sqrt((float(j**2)-0.250)/float(j**2))*c*pp1-
+     &           sqrt(float((2*j+1)*(j-1)*(j-1))/
+     &           float((2*j-3)*j*j))*pp2
+         end do
+         p2 = pp1
+         w(l2) = co/p3**2
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     Use symmetry to compute remaining roots and weights.
+!
+!-----------------------------------------------------------------------
+
+      l3 = l2+1
+      do i=l3,l
+         root(i) = pi-root(l-i+1)
+         w(i) = w(l-i+1)
+      end do
+
+!-----------------------------------------------------------------------
+
+      end subroutine gquad
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/grids/create_latlon.f
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/grids/create_latlon.f	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/grids/create_latlon.f	(revision 12863)
@@ -0,0 +1,305 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This program creates a remapping grid file for a lat/lon grid.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: create_latlon.f,v 1.1 2000/04/19 22:05:58 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!***********************************************************************
+
+      program create_latlon
+
+!-----------------------------------------------------------------------
+!
+!     This file creates a remapping grid file for a Gaussian grid
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+      use constants
+      use iounits
+      use netcdf_mod
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     variables that describe the grid
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter ::
+     &             nx = 360, ny = 180,
+     &             grid_size = nx*ny,
+     &             grid_rank = 2,
+     &             grid_corners = 4
+
+      character(char_len), parameter :: 
+     &             grid_name = 'Lat/lon 1 degree Grid',
+     &             grid_file_out = 'll1deg_grid.nc'
+
+      integer (kind=int_kind), dimension(grid_rank) ::
+     &             grid_dims
+
+!-----------------------------------------------------------------------
+!
+!     grid coordinates and masks
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(grid_size) ::
+     &             grid_imask
+
+      real (kind=dbl_kind), dimension(grid_size) ::
+     &             grid_center_lat,  ! lat/lon coordinates for
+     &             grid_center_lon   ! each grid center in degrees
+
+      real (kind=dbl_kind), dimension(grid_corners,grid_size) ::
+     &             grid_corner_lat,  ! lat/lon coordinates for
+     &             grid_corner_lon   ! each grid corner in degrees
+
+!-----------------------------------------------------------------------
+!
+!     other local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: i, j, iunit, atm_add
+
+      integer (kind=int_kind) ::
+     &        ncstat,            ! general netCDF status variable
+     &        nc_grid_id,        ! netCDF grid dataset id
+     &        nc_gridsize_id,    ! netCDF grid size dim id
+     &        nc_gridcorn_id,    ! netCDF grid corner dim id
+     &        nc_gridrank_id,    ! netCDF grid rank dim id
+     &        nc_griddims_id,    ! netCDF grid dimension size id
+     &        nc_grdcntrlat_id,  ! netCDF grid center lat id
+     &        nc_grdcntrlon_id,  ! netCDF grid center lon id
+     &        nc_grdimask_id,    ! netCDF grid mask id
+     &        nc_grdcrnrlat_id,  ! netCDF grid corner lat id
+     &        nc_grdcrnrlon_id   ! netCDF grid corner lon id
+
+      integer (kind=int_kind), dimension(2) ::
+     &        nc_dims2_id        ! netCDF dim id array for 2-d arrays
+
+      real (kind=dbl_kind) :: dlon, minlon, maxlon, centerlon,
+     &                        dlat, minlat, maxlat, centerlat
+
+!-----------------------------------------------------------------------
+!
+!     compute longitudes and latitudes of cell centers and corners.
+!
+!-----------------------------------------------------------------------
+
+      grid_dims(1) = nx
+      grid_dims(2) = ny
+
+      dlon = 360./nx
+      dlat = 180./ny
+
+      do j=1,ny
+
+        minlat = -90._dbl_kind + (j-1)*dlat
+        maxlat = -90._dbl_kind +  j   *dlat
+        centerlat = minlat + half*dlat
+
+        do i=1,nx
+          centerlon = (i-1)*dlon
+          minlon = centerlon - half*dlon
+          maxlon = centerlon + half*dlon
+
+          atm_add = (j-1)*nx + i
+
+          grid_center_lat(atm_add  ) = centerlat
+          grid_corner_lat(1,atm_add) = minlat
+          grid_corner_lat(2,atm_add) = minlat
+          grid_corner_lat(3,atm_add) = maxlat
+          grid_corner_lat(4,atm_add) = maxlat
+
+          grid_center_lon(atm_add  ) = centerlon
+          grid_corner_lon(1,atm_add) = minlon
+          grid_corner_lon(2,atm_add) = maxlon
+          grid_corner_lon(3,atm_add) = maxlon
+          grid_corner_lon(4,atm_add) = minlon
+        end do
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     define mask
+!
+!-----------------------------------------------------------------------
+
+      grid_imask = 1
+
+!-----------------------------------------------------------------------
+!
+!     set up attributes for netCDF file
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** create netCDF dataset for this grid
+      !***
+
+      ncstat = nf_create (grid_file_out, NF_CLOBBER,
+     &                    nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, NF_GLOBAL, 'title',
+     &                          len_trim(grid_name), grid_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid size dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_size', grid_size, 
+     &                     nc_gridsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_corners', grid_corners, 
+     &                     nc_gridcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid rank dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_rank', grid_rank, 
+     &                     nc_gridrank_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid dimension size array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_dims', NF_INT,
+     &                     1, nc_gridrank_id, nc_griddims_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_center_lat', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_grdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlat_id, 'units',
+     &                          7, 'degrees')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_center_lon', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_grdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlon_id, 'units',
+     &                          7, 'degrees')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_imask', NF_INT,
+     &                     1, nc_gridsize_id, nc_grdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdimask_id, 'units',
+     &                          8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner latitude array
+      !***
+
+      nc_dims2_id(1) = nc_gridcorn_id
+      nc_dims2_id(2) = nc_gridsize_id
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_corner_lat', NF_DOUBLE,
+     &                     2, nc_dims2_id, nc_grdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcrnrlat_id, 'units',
+     &                          7, 'degrees')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner longitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_corner_lon', NF_DOUBLE,
+     &                     2, nc_dims2_id, nc_grdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcrnrlon_id, 'units',
+     &                          7, 'degrees')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     write grid data
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_put_var_int(nc_grid_id, nc_griddims_id, grid_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_grid_id, nc_grdimask_id, grid_imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlat_id, 
+     &                           grid_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlon_id, 
+     &                           grid_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcrnrlat_id, 
+     &                           grid_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcrnrlon_id, 
+     &                           grid_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_close(nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end program create_latlon
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/grids/makefile
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/grids/makefile	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/grids/makefile	(revision 12863)
@@ -0,0 +1,59 @@
+#
+# Makefile for interpolation code
+# CVS:$Id: makefile,v 1.3 2000/04/19 22:05:59 pwjones Exp $
+#
+#COMP = xlf
+COMP = f90
+FLAGS = -O3 -64 -r10000 -I/usr/local/include 
+#FLAGS = -g
+LIB  = -lnetcdf 
+INCL = 
+SRCDIR  = ../source
+EXEDIR  = .
+OBJ  = \
+	kinds_mod.o \
+	constants.o \
+	iounits.o \
+	netcdf.o
+
+all: convertPOPT convertgauss create_latlon
+
+convertold: $(OBJ) convert_old.o
+	$(COMP) $(FLAGS) $(OBJ) convert_old.o $(LIB) -o $(EXEDIR)/convertold
+
+convertPOPT: $(OBJ) convertPOPT.o
+	$(COMP) $(FLAGS) $(OBJ) convertPOPT.o $(LIB) -o $(EXEDIR)/convertPOPT
+
+convertgauss: $(OBJ) convertgauss.o
+	$(COMP) $(FLAGS) $(OBJ) convertgauss.o $(LIB) -o $(EXEDIR)/convertgauss
+
+create_latlon: $(OBJ) create_latlon.o
+	$(COMP) $(FLAGS) $(OBJ) create_latlon.o $(LIB) -o $(EXEDIR)/create_latlon
+
+kinds_mod.o: $(SRCDIR)/kinds_mod.f $(INCL)
+	$(COMP) $(FLAGS) -c $(SRCDIR)/kinds_mod.f
+
+constants.o: $(SRCDIR)/constants.f kinds_mod.o $(INCL)
+	$(COMP) $(FLAGS) -c $(SRCDIR)/constants.f
+
+iounits.o: $(SRCDIR)/iounits.f kinds_mod.o constants.o $(INCL)
+	$(COMP) $(FLAGS) -c $(SRCDIR)/iounits.f
+
+netcdf.o: $(SRCDIR)/netcdf.f kinds_mod.o constants.o $(INCL)
+	$(COMP) $(FLAGS) -c $(SRCDIR)/netcdf.f
+
+convert_old.o: convert_old.f kinds_mod.o constants.o iounits.o netcdf.o $(INCL)
+	$(COMP) $(FLAGS) -c convert_old.f
+
+convertPOPT.o: convertPOPT.f kinds_mod.o constants.o iounits.o netcdf.o $(INCL)
+	$(COMP) $(FLAGS) -c convertPOPT.f
+
+convertgauss.o: convertgauss.f kinds_mod.o constants.o iounits.o netcdf.o $(INCL)
+	$(COMP) $(FLAGS) -c convertgauss.f
+
+create_latlon.o: create_latlon.f kinds_mod.o constants.o iounits.o netcdf.o $(INCL)
+	$(COMP) $(FLAGS) -c create_latlon.f
+
+clean: 
+	/bin/rm *.o *.mod
+
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/scrip_in
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/scrip_in	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/scrip_in	(revision 12863)
@@ -0,0 +1,16 @@
+&remap_inputs
+    num_maps = 2
+    grid1_file = 'grids/remap_grid_POP43.nc'
+    grid2_file = 'grids/remap_grid_T42.nc'
+    interp_file1 = 'rmp_POP43_to_T42_conserv.nc'
+    interp_file2 = 'rmp_T42_to_POP43_conserv.nc'
+    map1_name = 'POP43 to T42 Conservative Mapping'
+    map2_name = 'T42 to POP43 Conservative Mapping'
+    map_method = 'conservative'
+    normalize_opt = 'frac'
+    output_opt = 'scrip'
+    restrict_type = 'latitude'
+    num_srch_bins = 90 
+    luse_grid1_area = .false.
+    luse_grid2_area = .false.
+/
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/scrip_test_in
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/scrip_test_in	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/scrip_test_in	(revision 12863)
@@ -0,0 +1,5 @@
+&remap_inputs
+    field_choice = 2
+    interp_file = 'rmp_T42_to_POP43_conserv.nc'
+    output_file = 'out_T42_to_POP43_conserv.nc'
+/
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/constants.f
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/constants.f	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/constants.f	(revision 12863)
@@ -0,0 +1,65 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module defines common constants used in many routines.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: constants.f,v 1.2 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module constants
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod  ! defines common data types
+
+      implicit none
+
+      save
+
+!-----------------------------------------------------------------------
+
+      real (kind = dbl_kind), parameter :: 
+     &                        zero   = 0.0_dbl_kind,
+     &                        one    = 1.0_dbl_kind,
+     &                        two    = 2.0_dbl_kind,
+     &                        three  = 3.0_dbl_kind,
+     &                        four   = 4.0_dbl_kind,
+     &                        five   = 5.0_dbl_kind,
+     &                        half   = 0.5_dbl_kind,
+     &                        quart  = 0.25_dbl_kind,
+     &                        bignum = 1.e+20_dbl_kind,
+     &                        tiny   = 1.e-14_dbl_kind,
+     &                        pi     = 3.14159265359_dbl_kind,
+     &                        pi2    = two*pi,
+     &                        pih    = half*pi
+
+!-----------------------------------------------------------------------
+
+      end module constants
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/copyright
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/copyright	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/copyright	(revision 12863)
@@ -0,0 +1,26 @@
+!-----------------------------------------------------------------------
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!-----------------------------------------------------------------------
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/grids.f
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/grids.f	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/grids.f	(revision 12863)
@@ -0,0 +1,831 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module reads in and initializes two grids for remapping.
+!     NOTE: grid1 must be the master grid -- the grid that determines
+!           which cells participate (e.g. land mask) and the fractional
+!           area of grid2 cells that participate in the remapping.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: grids.f,v 1.6 2001/08/21 21:06:41 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module grids
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod    ! defines data types
+      use constants    ! common constants
+      use iounits      ! I/O unit manager
+      use netcdf_mod   ! netCDF stuff
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     variables that describe each grid
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), save ::
+     &             grid1_size, grid2_size, ! total points on each grid
+     &             grid1_rank, grid2_rank, ! rank of each grid
+     &             grid1_corners, grid2_corners ! number of corners
+                                                ! for each grid cell
+
+      integer (kind=int_kind), dimension(:), allocatable, save ::
+     &             grid1_dims, grid2_dims  ! size of each grid dimension
+
+      character(char_len), save :: 
+     &             grid1_name, grid2_name  ! name for each grid
+
+      character (char_len), save :: 
+     &             grid1_units, ! units for grid coords (degs/radians)
+     &             grid2_units  ! units for grid coords
+
+      real (kind=dbl_kind), parameter ::
+     &      deg2rad = pi/180.   ! conversion for deg to rads
+
+!-----------------------------------------------------------------------
+!
+!     grid coordinates and masks
+!
+!-----------------------------------------------------------------------
+
+      logical (kind=log_kind), dimension(:), allocatable, save ::
+     &             grid1_mask,        ! flag which cells participate
+     &             grid2_mask         ! flag which cells participate
+
+      real (kind=dbl_kind), dimension(:), allocatable, save ::
+     &             grid1_center_lat,  ! lat/lon coordinates for
+     &             grid1_center_lon,  ! each grid center in radians
+     &             grid2_center_lat, 
+     &             grid2_center_lon,
+     &             grid1_area,        ! tot area of each grid1 cell
+     &             grid2_area,        ! tot area of each grid2 cell
+     &             grid1_area_in,     ! area of grid1 cell from file
+     &             grid2_area_in,     ! area of grid2 cell from file
+     &             grid1_frac,        ! fractional area of grid cells
+     &             grid2_frac         ! participating in remapping
+
+      real (kind=dbl_kind), dimension(:,:), allocatable, save ::
+     &             grid1_corner_lat,  ! lat/lon coordinates for
+     &             grid1_corner_lon,  ! each grid corner in radians
+     &             grid2_corner_lat, 
+     &             grid2_corner_lon
+
+      logical (kind=log_kind), save ::
+     &             luse_grid_centers ! use centers for bounding boxes
+     &,            luse_grid1_area   ! use area from grid file
+     &,            luse_grid2_area   ! use area from grid file
+
+      real (kind=dbl_kind), dimension(:,:), allocatable, save ::
+     &             grid1_bound_box,  ! lat/lon bounding box for use
+     &             grid2_bound_box   ! in restricting grid searches
+
+!-----------------------------------------------------------------------
+!
+!     bins for restricting searches
+!
+!-----------------------------------------------------------------------
+
+      character (char_len), save ::
+     &        restrict_type  ! type of bins to use
+
+      integer (kind=int_kind), save ::
+     &        num_srch_bins  ! num of bins for restricted srch
+
+      integer (kind=int_kind), dimension(:,:), allocatable, save ::
+     &        bin_addr1, ! min,max adds for grid1 cells in this lat bin
+     &        bin_addr2  ! min,max adds for grid2 cells in this lat bin
+
+      real(kind=dbl_kind), dimension(:,:), allocatable, save ::
+     &        bin_lats   ! min,max latitude for each search bin
+     &,       bin_lons   ! min,max longitude for each search bin
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine grid_init(grid1_file, grid2_file)
+
+!-----------------------------------------------------------------------
+!
+!     this routine reads grid info from grid files and makes any
+!     necessary changes (e.g. for 0,2pi longitude range)
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) :: 
+     &             grid1_file, grid2_file  ! grid data files
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: 
+     &  n      ! loop counter
+     &, nele   ! element loop counter
+     &, iunit  ! unit number for opening files
+     &, i,j    ! logical 2d addresses
+     &, ip1,jp1
+     &, n_add, e_add, ne_add
+     &, nx, ny
+
+      integer (kind=int_kind) :: 
+     &         ncstat,           ! netCDF status variable
+     &         nc_grid1_id,       ! netCDF grid file id
+     &         nc_grid2_id,       ! netCDF grid file id
+     &         nc_grid1size_id,   ! netCDF grid size dim id
+     &         nc_grid2size_id,   ! netCDF grid size dim id
+     &         nc_grid1corn_id,   ! netCDF grid corner dim id
+     &         nc_grid2corn_id,   ! netCDF grid corner dim id
+     &         nc_grid1rank_id,   ! netCDF grid rank dim id
+     &         nc_grid2rank_id,   ! netCDF grid rank dim id
+     &         nc_grid1area_id,   ! netCDF grid rank dim id
+     &         nc_grid2area_id,   ! netCDF grid rank dim id
+     &         nc_grid1dims_id,   ! netCDF grid dimension size id
+     &         nc_grid2dims_id,   ! netCDF grid dimension size id
+     &         nc_grd1imask_id,   ! netCDF grid imask var id
+     &         nc_grd2imask_id,   ! netCDF grid imask var id
+     &         nc_grd1crnrlat_id, ! netCDF grid corner lat var id
+     &         nc_grd2crnrlat_id, ! netCDF grid corner lat var id
+     &         nc_grd1crnrlon_id, ! netCDF grid corner lon var id
+     &         nc_grd2crnrlon_id, ! netCDF grid corner lon var id
+     &         nc_grd1cntrlat_id, ! netCDF grid center lat var id
+     &         nc_grd2cntrlat_id, ! netCDF grid center lat var id
+     &         nc_grd1cntrlon_id, ! netCDF grid center lon var id
+     &         nc_grd2cntrlon_id  ! netCDF grid center lon var id
+
+      integer (kind=int_kind), dimension(:), allocatable :: 
+     &                            imask ! integer mask read from file
+
+      real (kind=dbl_kind) :: 
+     &  dlat,dlon           ! lat/lon intervals for search bins
+
+      real (kind=dbl_kind), dimension(4) ::
+     &  tmp_lats, tmp_lons  ! temps for computing bounding boxes
+
+!-----------------------------------------------------------------------
+!
+!     open grid files and read grid size/name data
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_open(grid1_file, NF_NOWRITE, nc_grid1_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_open(grid2_file, NF_NOWRITE, nc_grid2_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid1_id, 'grid_size', nc_grid1size_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid1_id, nc_grid1size_id, grid1_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid2_id, 'grid_size', nc_grid2size_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid2_id, nc_grid2size_id, grid2_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid1_id, 'grid_rank', nc_grid1rank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid1_id, nc_grid1rank_id, grid1_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid2_id, 'grid_rank', nc_grid2rank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid2_id, nc_grid2rank_id, grid2_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid1_id,'grid_corners',nc_grid1corn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid1_id,nc_grid1corn_id,grid1_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid2_id,'grid_corners',nc_grid2corn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid2_id,nc_grid2corn_id,grid2_corners)
+      call netcdf_error_handler(ncstat)
+
+      allocate( grid1_dims(grid1_rank),
+     &          grid2_dims(grid2_rank))
+
+      ncstat = nf_get_att_text(nc_grid1_id, nf_global, 'title',
+     &                         grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text(nc_grid2_id, nf_global, 'title',
+     &                         grid2_name)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     allocate grid coordinates/masks and read data
+!
+!-----------------------------------------------------------------------
+
+      allocate( grid1_mask      (grid1_size),
+     &          grid2_mask      (grid2_size),
+     &          grid1_center_lat(grid1_size), 
+     &          grid1_center_lon(grid1_size),
+     &          grid2_center_lat(grid2_size), 
+     &          grid2_center_lon(grid2_size),
+     &          grid1_area      (grid1_size),
+     &          grid2_area      (grid2_size),
+     &          grid1_frac      (grid1_size),
+     &          grid2_frac      (grid2_size),
+     &          grid1_corner_lat(grid1_corners, grid1_size),
+     &          grid1_corner_lon(grid1_corners, grid1_size),
+     &          grid2_corner_lat(grid2_corners, grid2_size),
+     &          grid2_corner_lon(grid2_corners, grid2_size),
+     &          grid1_bound_box (4            , grid1_size),
+     &          grid2_bound_box (4            , grid2_size))
+
+      allocate(imask(grid1_size))
+
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_dims', nc_grid1dims_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_imask', nc_grd1imask_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_center_lat', 
+     &                                   nc_grd1cntrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_center_lon', 
+     &                                   nc_grd1cntrlon_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_corner_lat', 
+     &                                   nc_grd1crnrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_corner_lon', 
+     &                                   nc_grd1crnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_grid1_id, nc_grid1dims_id, grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_grid1_id, nc_grd1imask_id, imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid1_id, nc_grd1cntrlat_id, 
+     &                                       grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid1_id, nc_grd1cntrlon_id, 
+     &                                       grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid1_id, nc_grd1crnrlat_id, 
+     &                                       grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid1_id, nc_grd1crnrlon_id, 
+     &                                       grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (luse_grid1_area) then
+        allocate (grid1_area_in(grid1_size))
+        ncstat = nf_inq_varid(nc_grid1_id, 'grid_area', nc_grid1area_id)
+        call netcdf_error_handler(ncstat)
+        ncstat = nf_get_var_double(nc_grid1_id, nc_grid1area_id, 
+     &                                          grid1_area_in)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      grid1_area = zero
+      grid1_frac = zero
+
+!-----------------------------------------------------------------------
+!
+!     initialize logical mask and convert lat/lon units if required
+!
+!-----------------------------------------------------------------------
+
+      where (imask == 1)
+        grid1_mask = .true.
+      elsewhere
+        grid1_mask = .false.
+      endwhere
+      deallocate(imask)
+
+      grid1_units = ' '
+      ncstat = nf_get_att_text(nc_grid1_id, nc_grd1cntrlat_id, 'units',
+     &                         grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+
+        grid1_center_lat = grid1_center_lat*deg2rad
+        grid1_center_lon = grid1_center_lon*deg2rad
+
+      case ('radians')
+
+        !*** no conversion necessary
+
+      case default
+
+        print *,'unknown units supplied for grid1 center lat/lon: '
+        print *,'proceeding assuming radians'
+
+      end select
+
+      grid1_units = ' '
+      ncstat = nf_get_att_text(nc_grid1_id, nc_grd1crnrlat_id, 'units',
+     &                         grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+
+        grid1_corner_lat = grid1_corner_lat*deg2rad
+        grid1_corner_lon = grid1_corner_lon*deg2rad
+
+      case ('radians')
+
+        !*** no conversion necessary
+
+      case default
+
+        print *,'unknown units supplied for grid1 corner lat/lon: '
+        print *,'proceeding assuming radians'
+
+      end select
+
+      ncstat = nf_close(nc_grid1_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     read data for grid 2
+!
+!-----------------------------------------------------------------------
+
+      allocate(imask(grid2_size))
+
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_dims', nc_grid2dims_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_imask', nc_grd2imask_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_center_lat', 
+     &                                   nc_grd2cntrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_center_lon', 
+     &                                   nc_grd2cntrlon_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_corner_lat', 
+     &                                   nc_grd2crnrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_corner_lon', 
+     &                                   nc_grd2crnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_grid2_id, nc_grid2dims_id, grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_grid2_id, nc_grd2imask_id, imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid2_id, nc_grd2cntrlat_id, 
+     &                                       grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid2_id, nc_grd2cntrlon_id, 
+     &                                       grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid2_id, nc_grd2crnrlat_id, 
+     &                                       grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid2_id, nc_grd2crnrlon_id, 
+     &                                       grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (luse_grid2_area) then
+        allocate (grid2_area_in(grid2_size))
+        ncstat = nf_inq_varid(nc_grid2_id, 'grid_area', nc_grid2area_id)
+        call netcdf_error_handler(ncstat)
+        ncstat = nf_get_var_double(nc_grid2_id, nc_grid2area_id, 
+     &                                          grid2_area_in)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      grid2_area = zero
+      grid2_frac = zero
+
+!-----------------------------------------------------------------------
+!
+!     initialize logical mask and convert lat/lon units if required
+!
+!-----------------------------------------------------------------------
+
+      where (imask == 1)
+        grid2_mask = .true.
+      elsewhere
+        grid2_mask = .false.
+      endwhere
+      deallocate(imask)
+
+      grid2_units = ' '
+      ncstat = nf_get_att_text(nc_grid2_id, nc_grd2cntrlat_id, 'units',
+     &                         grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+
+        grid2_center_lat = grid2_center_lat*deg2rad
+        grid2_center_lon = grid2_center_lon*deg2rad
+
+      case ('radians')
+
+        !*** no conversion necessary
+
+      case default
+
+        print *,'unknown units supplied for grid2 center lat/lon: '
+        print *,'proceeding assuming radians'
+
+      end select
+
+      grid2_units = ' '
+      ncstat = nf_get_att_text(nc_grid2_id, nc_grd2crnrlat_id, 'units',
+     &                         grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+
+        grid2_corner_lat = grid2_corner_lat*deg2rad
+        grid2_corner_lon = grid2_corner_lon*deg2rad
+
+      case ('radians')
+
+        !*** no conversion necessary
+
+      case default
+
+        print *,'no units supplied for grid2 corner lat/lon: '
+        print *,'proceeding assuming radians'
+
+      end select
+
+      ncstat = nf_close(nc_grid2_id)
+      call netcdf_error_handler(ncstat)
+
+
+!-----------------------------------------------------------------------
+!
+!     convert longitudes to 0,2pi interval
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_center_lon .gt. pi2)  grid1_center_lon =
+     &                                   grid1_center_lon - pi2
+      where (grid1_center_lon .lt. zero) grid1_center_lon =
+     &                                   grid1_center_lon + pi2
+      where (grid2_center_lon .gt. pi2)  grid2_center_lon =
+     &                                   grid2_center_lon - pi2
+      where (grid2_center_lon .lt. zero) grid2_center_lon =
+     &                                   grid2_center_lon + pi2
+      where (grid1_corner_lon .gt. pi2)  grid1_corner_lon =
+     &                                   grid1_corner_lon - pi2
+      where (grid1_corner_lon .lt. zero) grid1_corner_lon =
+     &                                   grid1_corner_lon + pi2
+      where (grid2_corner_lon .gt. pi2)  grid2_corner_lon =
+     &                                   grid2_corner_lon - pi2
+      where (grid2_corner_lon .lt. zero) grid2_corner_lon =
+     &                                   grid2_corner_lon + pi2
+
+!-----------------------------------------------------------------------
+!
+!     make sure input latitude range is within the machine values
+!     for +/- pi/2 
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_center_lat >  pih) grid1_center_lat =  pih
+      where (grid1_corner_lat >  pih) grid1_corner_lat =  pih
+      where (grid1_center_lat < -pih) grid1_center_lat = -pih
+      where (grid1_corner_lat < -pih) grid1_corner_lat = -pih
+
+      where (grid2_center_lat >  pih) grid2_center_lat =  pih
+      where (grid2_corner_lat >  pih) grid2_corner_lat =  pih
+      where (grid2_center_lat < -pih) grid2_center_lat = -pih
+      where (grid2_corner_lat < -pih) grid2_corner_lat = -pih
+
+!-----------------------------------------------------------------------
+!
+!     compute bounding boxes for restricting future grid searches
+!
+!-----------------------------------------------------------------------
+
+      if (.not. luse_grid_centers) then
+        grid1_bound_box(1,:) = minval(grid1_corner_lat, DIM=1)
+        grid1_bound_box(2,:) = maxval(grid1_corner_lat, DIM=1)
+        grid1_bound_box(3,:) = minval(grid1_corner_lon, DIM=1)
+        grid1_bound_box(4,:) = maxval(grid1_corner_lon, DIM=1)
+
+        grid2_bound_box(1,:) = minval(grid2_corner_lat, DIM=1)
+        grid2_bound_box(2,:) = maxval(grid2_corner_lat, DIM=1)
+        grid2_bound_box(3,:) = minval(grid2_corner_lon, DIM=1)
+        grid2_bound_box(4,:) = maxval(grid2_corner_lon, DIM=1)
+
+      else
+
+        nx = grid1_dims(1)
+        ny = grid1_dims(2)
+
+        do n=1,grid1_size
+
+          !*** find N,S and NE points to this grid point
+
+          j = (n - 1)/nx +1
+          i = n - (j-1)*nx
+
+          if (i < nx) then
+            ip1 = i + 1
+          else
+            !*** assume cyclic
+            ip1 = 1
+            !*** but if it is not, correct
+            e_add = (j - 1)*nx + ip1
+            if (abs(grid1_center_lat(e_add) - 
+     &              grid1_center_lat(n   )) > pih) then
+              ip1 = i
+            endif
+          endif
+
+          if (j < ny) then
+            jp1 = j+1
+          else
+            !*** assume cyclic
+            jp1 = 1
+            !*** but if it is not, correct
+            n_add = (jp1 - 1)*nx + i
+            if (abs(grid1_center_lat(n_add) - 
+     &              grid1_center_lat(n   )) > pih) then
+              jp1 = j
+            endif
+          endif
+
+          n_add = (jp1 - 1)*nx + i
+          e_add = (j - 1)*nx + ip1
+          ne_add = (jp1 - 1)*nx + ip1
+
+          !*** find N,S and NE lat/lon coords and check bounding box
+
+          tmp_lats(1) = grid1_center_lat(n)
+          tmp_lats(2) = grid1_center_lat(e_add)
+          tmp_lats(3) = grid1_center_lat(ne_add)
+          tmp_lats(4) = grid1_center_lat(n_add)
+
+          tmp_lons(1) = grid1_center_lon(n)
+          tmp_lons(2) = grid1_center_lon(e_add)
+          tmp_lons(3) = grid1_center_lon(ne_add)
+          tmp_lons(4) = grid1_center_lon(n_add)
+
+          grid1_bound_box(1,n) = minval(tmp_lats)
+          grid1_bound_box(2,n) = maxval(tmp_lats)
+          grid1_bound_box(3,n) = minval(tmp_lons)
+          grid1_bound_box(4,n) = maxval(tmp_lons)
+        end do
+
+        nx = grid2_dims(1)
+        ny = grid2_dims(2)
+
+        do n=1,grid2_size
+
+          !*** find N,S and NE points to this grid point
+
+          j = (n - 1)/nx +1
+          i = n - (j-1)*nx
+
+          if (i < nx) then
+            ip1 = i + 1
+          else
+            !*** assume cyclic
+            ip1 = 1
+            !*** but if it is not, correct
+            e_add = (j - 1)*nx + ip1
+            if (abs(grid2_center_lat(e_add) - 
+     &              grid2_center_lat(n   )) > pih) then
+              ip1 = i
+            endif
+          endif
+
+          if (j < ny) then
+            jp1 = j+1
+          else
+            !*** assume cyclic
+            jp1 = 1
+            !*** but if it is not, correct
+            n_add = (jp1 - 1)*nx + i
+            if (abs(grid2_center_lat(n_add) - 
+     &              grid2_center_lat(n   )) > pih) then
+              jp1 = j
+            endif
+          endif
+
+          n_add = (jp1 - 1)*nx + i
+          e_add = (j - 1)*nx + ip1
+          ne_add = (jp1 - 1)*nx + ip1
+
+          !*** find N,S and NE lat/lon coords and check bounding box
+
+          tmp_lats(1) = grid2_center_lat(n)
+          tmp_lats(2) = grid2_center_lat(e_add)
+          tmp_lats(3) = grid2_center_lat(ne_add)
+          tmp_lats(4) = grid2_center_lat(n_add)
+
+          tmp_lons(1) = grid2_center_lon(n)
+          tmp_lons(2) = grid2_center_lon(e_add)
+          tmp_lons(3) = grid2_center_lon(ne_add)
+          tmp_lons(4) = grid2_center_lon(n_add)
+
+          grid2_bound_box(1,n) = minval(tmp_lats)
+          grid2_bound_box(2,n) = maxval(tmp_lats)
+          grid2_bound_box(3,n) = minval(tmp_lons)
+          grid2_bound_box(4,n) = maxval(tmp_lons)
+        end do
+
+      endif
+
+      where (abs(grid1_bound_box(4,:) - grid1_bound_box(3,:)) > pi)
+        grid1_bound_box(3,:) = zero
+        grid1_bound_box(4,:) = pi2
+      end where
+
+      where (abs(grid2_bound_box(4,:) - grid2_bound_box(3,:)) > pi)
+        grid2_bound_box(3,:) = zero
+        grid2_bound_box(4,:) = pi2
+      end where
+
+      !***
+      !*** try to check for cells that overlap poles
+      !***
+
+      where (grid1_center_lat > grid1_bound_box(2,:))
+     &  grid1_bound_box(2,:) = pih
+
+      where (grid1_center_lat < grid1_bound_box(1,:))
+     &  grid1_bound_box(1,:) = -pih
+
+      where (grid2_center_lat > grid2_bound_box(2,:))
+     &  grid2_bound_box(2,:) = pih
+
+      where (grid2_center_lat < grid2_bound_box(1,:))
+     &  grid2_bound_box(1,:) = -pih
+
+!-----------------------------------------------------------------------
+!
+!     set up and assign address ranges to search bins in order to 
+!     further restrict later searches
+!
+!-----------------------------------------------------------------------
+
+      select case (restrict_type)
+
+      case ('latitude')
+        write(stdout,*) 'Using latitude bins to restrict search.'
+
+        allocate(bin_addr1(2,num_srch_bins))
+        allocate(bin_addr2(2,num_srch_bins))
+        allocate(bin_lats (2,num_srch_bins))
+        allocate(bin_lons (2,num_srch_bins))
+
+        dlat = pi/num_srch_bins
+
+        do n=1,num_srch_bins
+          bin_lats(1,n) = (n-1)*dlat - pih
+          bin_lats(2,n) =     n*dlat - pih
+          bin_lons(1,n) = zero
+          bin_lons(2,n) = pi2
+          bin_addr1(1,n) = grid1_size + 1
+          bin_addr1(2,n) = 0
+          bin_addr2(1,n) = grid2_size + 1
+          bin_addr2(2,n) = 0
+        end do
+
+        do nele=1,grid1_size
+          do n=1,num_srch_bins
+            if (grid1_bound_box(1,nele) <= bin_lats(2,n) .and.
+     &          grid1_bound_box(2,nele) >= bin_lats(1,n)) then
+              bin_addr1(1,n) = min(nele,bin_addr1(1,n))
+              bin_addr1(2,n) = max(nele,bin_addr1(2,n))
+            endif
+          end do
+        end do
+
+        do nele=1,grid2_size
+          do n=1,num_srch_bins
+            if (grid2_bound_box(1,nele) <= bin_lats(2,n) .and.
+     &          grid2_bound_box(2,nele) >= bin_lats(1,n)) then
+              bin_addr2(1,n) = min(nele,bin_addr2(1,n))
+              bin_addr2(2,n) = max(nele,bin_addr2(2,n))
+            endif
+          end do
+        end do
+
+      case ('latlon')
+        write(stdout,*) 'Using lat/lon boxes to restrict search.'
+
+        dlat = pi /num_srch_bins
+        dlon = pi2/num_srch_bins
+
+        allocate(bin_addr1(2,num_srch_bins*num_srch_bins))
+        allocate(bin_addr2(2,num_srch_bins*num_srch_bins))
+        allocate(bin_lats (2,num_srch_bins*num_srch_bins))
+        allocate(bin_lons (2,num_srch_bins*num_srch_bins))
+
+        n = 0
+        do j=1,num_srch_bins
+        do i=1,num_srch_bins
+          n = n + 1
+
+          bin_lats(1,n) = (j-1)*dlat - pih
+          bin_lats(2,n) =     j*dlat - pih
+          bin_lons(1,n) = (i-1)*dlon
+          bin_lons(2,n) =     i*dlon
+          bin_addr1(1,n) = grid1_size + 1
+          bin_addr1(2,n) = 0
+          bin_addr2(1,n) = grid2_size + 1
+          bin_addr2(2,n) = 0
+        end do
+        end do
+
+        num_srch_bins = num_srch_bins**2
+
+        do nele=1,grid1_size
+          do n=1,num_srch_bins
+            if (grid1_bound_box(1,nele) <= bin_lats(2,n) .and.
+     &          grid1_bound_box(2,nele) >= bin_lats(1,n) .and.
+     &          grid1_bound_box(3,nele) <= bin_lons(2,n) .and.
+     &          grid1_bound_box(4,nele) >= bin_lons(1,n)) then
+              bin_addr1(1,n) = min(nele,bin_addr1(1,n))
+              bin_addr1(2,n) = max(nele,bin_addr1(2,n))
+            endif
+          end do
+        end do
+
+        do nele=1,grid2_size
+          do n=1,num_srch_bins
+            if (grid2_bound_box(1,nele) <= bin_lats(2,n) .and.
+     &          grid2_bound_box(2,nele) >= bin_lats(1,n) .and.
+     &          grid2_bound_box(3,nele) <= bin_lons(2,n) .and.
+     &          grid2_bound_box(4,nele) >= bin_lons(1,n)) then
+              bin_addr2(1,n) = min(nele,bin_addr2(1,n))
+              bin_addr2(2,n) = max(nele,bin_addr2(2,n))
+            endif
+          end do
+        end do
+
+      case default
+        stop 'unknown search restriction method'
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine grid_init
+
+!***********************************************************************
+
+      end module grids
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/iounits.f
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/iounits.f	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/iounits.f	(revision 12863)
@@ -0,0 +1,154 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module is a dynamic I/O unit manager.  It keeps track of
+!     which units are in use and reserves units for stdin, stdout, and
+!     stderr.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: iounits.f,v 1.2 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module iounits
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod   ! defines data types
+
+      implicit none
+
+!-----------------------------------------------------------------------
+
+      logical (kind=log_kind), dimension(99), save ::
+     &    unit_free   ! flags to determine whether unit is free for use
+
+      integer (kind=int_kind), parameter ::
+     &    stdin  = 5, ! reserves unit for standard input
+     &    stdout = 6, ! reserves unit for standard output
+     &    stderr = 6  ! reserves unit for standard error
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine get_unit(iunit)
+
+!-----------------------------------------------------------------------
+!
+!     This routine returns the next available I/O unit number.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(out) ::
+     &     iunit   ! next free I/O unit
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n
+
+      logical (kind=log_kind), save :: first_call = .true.
+
+!-----------------------------------------------------------------------
+!
+!     if this is the first call, reserve stdout, stdin and stderr
+!
+!-----------------------------------------------------------------------
+
+      if (first_call) then
+        unit_free = .true.
+        unit_free(stdin)  = .false.
+        unit_free(stdout) = .false.
+        unit_free(stderr) = .false.
+        first_call = .false.
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     search for next available unit
+!
+!-----------------------------------------------------------------------
+
+      srch_unit: do n=1,99
+        if (unit_free(n)) then
+          iunit = n
+          unit_free(n) = .false.
+          exit srch_unit
+        endif
+      end do srch_unit
+
+!-----------------------------------------------------------------------
+
+      end subroutine get_unit
+
+!***********************************************************************
+
+      subroutine release_unit(iunit)
+
+!-----------------------------------------------------------------------
+!
+!     This routine releases the specified unit and closes the file.
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::
+     &     iunit   ! I/O unit to release
+
+!-----------------------------------------------------------------------
+!
+!     closes I/O unit and declares it free
+!
+!-----------------------------------------------------------------------
+
+      unit_free(iunit) = .true.
+      close(iunit)
+
+!-----------------------------------------------------------------------
+
+      end subroutine release_unit
+
+!***********************************************************************
+
+      end module iounits
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/kinds_mod.f
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/kinds_mod.f	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/kinds_mod.f	(revision 12863)
@@ -0,0 +1,53 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module defines the F90 kind parameter for common data types.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: kinds_mod.f,v 1.2 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module kinds_mod
+
+!-----------------------------------------------------------------------
+
+      implicit none
+      save
+
+!-----------------------------------------------------------------------
+
+      integer, parameter :: char_len  = 80,
+     &                      int_kind  = kind(1),
+     &                      log_kind  = kind(.true.),
+     &                      real_kind = selected_real_kind(6),
+     &                      dbl_kind  = selected_real_kind(13)
+
+!-----------------------------------------------------------------------
+
+      end module kinds_mod
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/makefile
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/makefile	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/makefile	(revision 12863)
@@ -0,0 +1,122 @@
+#!/bin/csh
+#
+# Makefile for interpolation code
+#
+# CVS:$Id: makefile,v 1.7 2000/04/19 21:46:44 pwjones Exp $
+#
+#COMPILE = xlf
+COMPILE = f90
+FLAGS = -O3 -r10000 -64 -I/usr/local/include
+#FLAGS = -g -DEBUG:div_check=3:subscript_check=ON:trap_uninitialized=ON:verbose_runtime=ON -r10000 -64 -I/usr/local/include 
+LIB  =  -lnetcdf 
+INCLUDE = 
+SRCDIR  = .
+EXEDIR  = ..
+OBJSET  = \
+	kinds_mod.o \
+	constants.o \
+	iounits.o \
+	netcdf.o \
+	grids.o \
+	remap_vars.o \
+	remap_distwgt.o \
+	remap_conserv.o \
+	remap_bilinear.o \
+	remap_bicubic.o \
+	timers.o \
+	remap_write.o \
+	scrip.o
+
+OBJTEST  = \
+	kinds_mod.o \
+	constants.o \
+	iounits.o \
+	netcdf.o \
+	grids.o \
+	timers.o \
+	remap_vars.o \
+	remap_read.o \
+	remap.o
+
+all: $(EXEDIR)/scrip $(EXEDIR)/scrip_test
+
+$(EXEDIR)/scrip: $(OBJSET)
+	$(COMPILE) $(FLAGS) $(OBJSET) $(LIB) -o $(EXEDIR)/scrip
+
+$(EXEDIR)/scrip_test: $(OBJTEST) scrip_test.o
+	$(COMPILE) $(FLAGS) $(OBJTEST) scrip_test.o $(LIB) \
+	-o $(EXEDIR)/scrip_test
+
+scrip_test_repeat: $(OBJTEST) scrip_test_repeat.o
+	$(COMPILE) $(FLAGS) $(OBJTEST) scrip_test_repeat.o $(LIB) \
+	-o $(EXEDIR)/scrip_test_repeat
+
+kinds_mod.o: $(SRCDIR)/kinds_mod.f $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/kinds_mod.f
+
+constants.o: $(SRCDIR)/constants.f kinds_mod.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/constants.f
+
+iounits.o: $(SRCDIR)/iounits.f kinds_mod.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/iounits.f
+
+netcdf.o: $(SRCDIR)/netcdf.f kinds_mod.o constants.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/netcdf.f
+
+grids.o: $(SRCDIR)/grids.f kinds_mod.o constants.o iounits.o netcdf.o \
+	$(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/grids.f
+
+remap_vars.o: $(SRCDIR)/remap_vars.f kinds_mod.o constants.o grids.o \
+	$(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/remap_vars.f
+
+remap_conserv.o: $(SRCDIR)/remap_conserv.f kinds_mod.o constants.o \
+		timers.o remap_vars.o grids.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/remap_conserv.f
+
+remap_distwgt.o: $(SRCDIR)/remap_distwgt.f kinds_mod.o constants.o \
+		remap_vars.o grids.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/remap_distwgt.f
+
+remap_bilinear.o: $(SRCDIR)/remap_bilinear.f kinds_mod.o constants.o \
+		remap_vars.o grids.o timers.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/remap_bilinear.f
+
+remap_bicubic.o: $(SRCDIR)/remap_bicubic.f kinds_mod.o constants.o \
+		remap_vars.o grids.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/remap_bicubic.f
+
+timers.o: $(SRCDIR)/timers.f kinds_mod.o constants.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/timers.f
+
+remap_write.o: $(SRCDIR)/remap_write.f kinds_mod.o constants.o \
+		netcdf.o remap_vars.o grids.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/remap_write.f
+
+remap_read.o: $(SRCDIR)/remap_read.f kinds_mod.o constants.o netcdf.o \
+		remap_vars.o grids.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/remap_read.f
+
+remap.o: $(SRCDIR)/remap.f kinds_mod.o constants.o 
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/remap.f
+
+scrip.o: $(SRCDIR)/scrip.f kinds_mod.o constants.o iounits.o timers.o \
+		remap_vars.o grids.o remap_conserv.o remap_distwgt.o \
+		remap_bilinear.o remap_bicubic.o remap_write.o \
+		$(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/scrip.f
+
+scrip_test.o: $(SRCDIR)/scrip_test.f kinds_mod.o constants.o iounits.o \
+		netcdf.o remap_vars.o grids.o remap.o remap_read.o \
+		$(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/scrip_test.f
+
+scrip_test_repeat.o: $(SRCDIR)/scrip_test_repeat.f kinds_mod.o \
+		constants.o netcdf.o \
+		iounits.o remap_vars.o grids.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/scrip_test_repeat.f
+
+clean: 
+	/bin/rm *.o *.mod
+
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/netcdf.f
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/netcdf.f	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/netcdf.f	(revision 12863)
@@ -0,0 +1,79 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module contains the netCDF include file and a netcdf error
+!     handling routine.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: netcdf.f,v 1.2 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module netcdf_mod
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+      use constants
+
+      implicit none
+
+      include 'netcdf.inc'
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine netcdf_error_handler(istat)
+
+!-----------------------------------------------------------------------
+!
+!     This routine provides a simple interface to netCDF error message
+!     routine.
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: 
+     &    istat   ! integer status returned by netCDF function call
+
+!-----------------------------------------------------------------------
+
+      if (istat /= NF_NOERR) then
+        print *,'Error in netCDF: ',nf_strerror(istat)
+        stop
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine netcdf_error_handler
+
+!***********************************************************************
+
+      end module netcdf_mod
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/remap.f
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/remap.f	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/remap.f	(revision 12863)
@@ -0,0 +1,165 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this routine performs a remapping based on addresses and weights
+!     computed in a setup phase
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap.f,v 1.5 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_mod
+
+!-----------------------------------------------------------------------
+!
+!     this module contains the routines for performing the actual
+!     remappings
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod    ! defines common data types
+      use constants    ! defines common constants
+
+      implicit none
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap(dst_array, map_wts, dst_add, src_add, 
+     &                 src_array, src_grad1, src_grad2, src_grad3)
+
+!-----------------------------------------------------------------------
+!
+!     performs the remapping based on weights computed elsewhere
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input arrays
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(:), intent(in) ::
+     &     dst_add,     ! destination address for each link
+     &     src_add      ! source      address for each link
+
+      real (kind=dbl_kind), dimension(:,:), intent(in) ::
+     &     map_wts      ! remapping weights for each link
+
+      real (kind=dbl_kind), dimension(:), intent(in) ::
+     &     src_array    ! array with source field to be remapped
+
+      real (kind=dbl_kind), dimension(:), intent(in), optional ::
+     &     src_grad1    ! gradient arrays on source grid necessary for
+     &,    src_grad2    ! higher-order remappings
+     &,    src_grad3
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), dimension(:), intent(inout) ::
+     &     dst_array    ! array for remapped field on destination grid
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, iorder
+
+!-----------------------------------------------------------------------
+!
+!     check the order of the interpolation
+!
+!-----------------------------------------------------------------------
+
+      if (present(src_grad1)) then
+        iorder = 2
+      else
+        iorder = 1
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     first order remapping
+!
+!-----------------------------------------------------------------------
+
+      dst_array = zero
+
+      select case (iorder)
+      case(1)
+
+        do n=1,size(dst_add)
+          dst_array(dst_add(n)) = dst_array(dst_add(n)) + 
+     &                            src_array(src_add(n))*map_wts(1,n)
+        end do
+
+!-----------------------------------------------------------------------
+!
+!     second order remapping
+!
+!-----------------------------------------------------------------------
+
+      case(2)
+
+        if (size(map_wts,DIM=1) == 3) then
+          do n=1,size(dst_add)
+            dst_array(dst_add(n)) = dst_array(dst_add(n)) +
+     &                              src_array(src_add(n))*map_wts(1,n) +
+     &                              src_grad1(src_add(n))*map_wts(2,n) +
+     &                              src_grad2(src_add(n))*map_wts(3,n)
+          end do
+        else if (size(map_wts,DIM=1) == 4) then
+          do n=1,size(dst_add)
+            dst_array(dst_add(n)) = dst_array(dst_add(n)) +
+     &                              src_array(src_add(n))*map_wts(1,n) +
+     &                              src_grad1(src_add(n))*map_wts(2,n) +
+     &                              src_grad2(src_add(n))*map_wts(3,n) +
+     &                              src_grad3(src_add(n))*map_wts(4,n)
+          end do
+        endif
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine remap
+
+!***********************************************************************
+
+      end module remap_mod
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/remap_bicubic.f
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/remap_bicubic.f	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/remap_bicubic.f	(revision 12863)
@@ -0,0 +1,844 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for performing an 
+!     bicubic interpolation.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_bicubic.f,v 1.5 2001/08/22 18:20:41 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_bicubic
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common constants
+      use grids         ! module containing grid info
+      use remap_vars    ! module containing remap info
+
+      implicit none
+
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter ::
+     &    max_iter = 100   ! max iteration count for i,j iteration
+
+      real (kind=dbl_kind), parameter ::
+     &     converge = 1.e-10_dbl_kind  ! convergence criterion
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap_bicub
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the weights for a bicubic interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,icount,
+     &     dst_add,        ! destination address
+     &     iter,           ! iteration counter
+     &     nmap            ! index of current map being computed
+
+      integer (kind=int_kind), dimension(4) :: 
+     &     src_add         ! address for the four source points
+
+      real (kind=dbl_kind), dimension(4)  ::
+     &     src_lats,       ! latitudes  of four bilinear corners
+     &     src_lons        ! longitudes of four bilinear corners
+
+      real (kind=dbl_kind), dimension(4,4)  ::
+     &     wgts            ! bicubic weights for four corners
+
+      real (kind=dbl_kind) ::
+     &     plat, plon,       ! lat/lon coords of destination point
+     &     iguess, jguess,   ! current guess for bilinear coordinate
+     &     thguess, phguess, ! current guess for lat/lon coordinate
+     &     deli, delj,       ! corrections to i,j
+     &     dth1, dth2, dth3, ! some latitude  differences
+     &     dph1, dph2, dph3, ! some longitude differences
+     &     dthp, dphp,       ! difference between point and sw corner
+     &     mat1, mat2, mat3, mat4, ! matrix elements
+     &     determinant,      ! matrix determinant
+     &     sum_wgts,         ! sum of weights for normalization
+     &     w1,w2,w3,w4,w5,w6,w7,w8, ! 16 bicubic weight functions
+     &     w9,w10,w11,w12,w13,w14,w15,w16
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+
+      nmap = 1
+      if (grid1_rank /= 2) then
+        stop 'Can not do bicubic interpolation when grid_rank /= 2'
+      endif
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop1: do dst_add = 1, grid2_size
+
+        if (.not. grid2_mask(dst_add)) cycle grid_loop1
+
+        plat = grid2_center_lat(dst_add)
+        plon = grid2_center_lon(dst_add)
+
+!-----------------------------------------------------------------------
+!
+!       find nearest square of grid points on source grid
+!
+!-----------------------------------------------------------------------
+
+        call grid_search_bicub(src_add, src_lats, src_lons, 
+     &                         plat, plon, grid1_dims,
+     &                         grid1_center_lat, grid1_center_lon,
+     &                         grid1_bound_box, bin_addr1, bin_addr2)
+
+        !***
+        !*** check to see if points are land points
+        !***
+
+        if (src_add(1) > 0) then
+          do n=1,4
+            if (.not. grid1_mask(src_add(n))) src_add(1) = 0
+          end do
+        endif
+
+!-----------------------------------------------------------------------
+!
+!       if point found, find local i,j coordinates for weights
+!
+!-----------------------------------------------------------------------
+
+        if (src_add(1) > 0) then
+
+          grid2_frac(dst_add) = one
+
+          !***
+          !*** iterate to find i,j for bicubic approximation
+          !***
+
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          if (dph1 >  three*pih) dph1 = dph1 - pi2
+          if (dph2 >  three*pih) dph2 = dph2 - pi2
+          if (dph3 >  three*pih) dph3 = dph3 - pi2
+          if (dph1 < -three*pih) dph1 = dph1 + pi2
+          if (dph2 < -three*pih) dph2 = dph2 + pi2
+          if (dph3 < -three*pih) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+
+          iguess = half
+          jguess = half
+
+          iter_loop1: do iter=1,max_iter
+
+            dthp = plat - src_lats(1) - dth1*iguess -
+     &                    dth2*jguess - dth3*iguess*jguess
+            dphp = plon - src_lons(1)
+
+            if (dphp >  three*pih) dphp = dphp - pi2
+            if (dphp < -three*pih) dphp = dphp + pi2
+
+            dphp = dphp - dph1*iguess - dph2*jguess - 
+     &                    dph3*iguess*jguess
+
+            mat1 = dth1 + dth3*jguess
+            mat2 = dth2 + dth3*iguess
+            mat3 = dph1 + dph3*jguess
+            mat4 = dph2 + dph3*iguess
+
+            determinant = mat1*mat4 - mat2*mat3
+
+            deli = (dthp*mat4 - mat2*dphp)/determinant
+            delj = (mat1*dphp - dthp*mat3)/determinant
+
+            if (abs(deli) < converge .and. 
+     &          abs(delj) < converge) exit iter_loop1
+
+            iguess = iguess + deli
+            jguess = jguess + delj
+
+          end do iter_loop1
+
+          if (iter <= max_iter) then
+
+!-----------------------------------------------------------------------
+!
+!           successfully found i,j - compute weights
+!
+!-----------------------------------------------------------------------
+
+            wgts(1,1) = (one - jguess**2*(three-two*jguess))*
+     &                  (one - iguess**2*(three-two*iguess))
+            wgts(1,2) = (one - jguess**2*(three-two*jguess))*
+     &                         iguess**2*(three-two*iguess)
+            wgts(1,3) =        jguess**2*(three-two*jguess)*
+     &                         iguess**2*(three-two*iguess)
+            wgts(1,4) =        jguess**2*(three-two*jguess)*
+     &                  (one - iguess**2*(three-two*iguess))
+            wgts(2,1) = (one - jguess**2*(three-two*jguess))*
+     &                         iguess*(iguess-one)**2
+            wgts(2,2) = (one - jguess**2*(three-two*jguess))*
+     &                         iguess**2*(iguess-one)
+            wgts(2,3) =        jguess**2*(three-two*jguess)*
+     &                         iguess**2*(iguess-one)
+            wgts(2,4) =        jguess**2*(three-two*jguess)*
+     &                         iguess*(iguess-one)**2
+            wgts(3,1) =        jguess*(jguess-one)**2*
+     &                  (one - iguess**2*(three-two*iguess))
+            wgts(3,2) =        jguess*(jguess-one)**2*
+     &                         iguess**2*(three-two*iguess)
+            wgts(3,3) =        jguess**2*(jguess-one)*
+     &                         iguess**2*(three-two*iguess)
+            wgts(3,4) =        jguess**2*(jguess-one)*
+     &                  (one - iguess**2*(three-two*iguess))
+            wgts(4,1) =        iguess*(iguess-one)**2*
+     &                         jguess*(jguess-one)**2
+            wgts(4,2) =        iguess**2*(iguess-one)*
+     &                         jguess*(jguess-one)**2
+            wgts(4,3) =        iguess**2*(iguess-one)*
+     &                         jguess**2*(jguess-one)
+            wgts(4,4) =        iguess*(iguess-one)**2*
+     &                         jguess**2*(jguess-one)
+
+            call store_link_bicub(dst_add, src_add, wgts, nmap)
+
+          else
+            stop 'Iteration for i,j exceed max iteration count'
+          endif
+
+!-----------------------------------------------------------------------
+!
+!       search for bilinear failed - use a distance-weighted
+!       average instead (this is typically near the pole)
+!
+!-----------------------------------------------------------------------
+
+        else if (src_add(1) < 0) then
+
+          src_add = abs(src_add)
+
+          icount = 0
+          do n=1,4
+            if (grid1_mask(src_add(n))) then
+              icount = icount + 1
+            else
+              src_lats(n) = zero
+            endif
+          end do
+
+          if (icount > 0) then
+            !*** renormalize weights
+
+            sum_wgts = sum(src_lats)
+            wgts(1,1) = src_lats(1)/sum_wgts
+            wgts(1,2) = src_lats(2)/sum_wgts
+            wgts(1,3) = src_lats(3)/sum_wgts
+            wgts(1,4) = src_lats(4)/sum_wgts
+            wgts(2:4,:) = zero
+
+            grid2_frac(dst_add) = one
+            call store_link_bicub(dst_add, src_add, wgts, nmap)
+          endif
+
+        endif
+      end do grid_loop1
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid2 to grid1 if necessary
+!
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+
+      nmap = 2
+      if (grid2_rank /= 2) then
+        stop 'Can not do bicubic interpolation when grid_rank /= 2'
+      endif
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop2: do dst_add = 1, grid1_size
+
+        if (.not. grid1_mask(dst_add)) cycle grid_loop2
+
+        plat = grid1_center_lat(dst_add)
+        plon = grid1_center_lon(dst_add)
+
+        !***
+        !*** find nearest square of grid points on source grid
+        !***
+
+        call grid_search_bicub(src_add, src_lats, src_lons, 
+     &                         plat, plon, grid2_dims,
+     &                         grid2_center_lat, grid2_center_lon,
+     &                         grid2_bound_box, bin_addr2, bin_addr1)
+
+        !***
+        !*** check to see if points are land points
+        !***
+
+        if (src_add(1) > 0) then
+          do n=1,4
+            if (.not. grid2_mask(src_add(n))) src_add(1) = 0
+          end do
+        endif
+
+        !***
+        !*** if point found, find i,j coordinates for weights
+        !***
+
+        if (src_add(1) > 0) then
+
+          grid1_frac(dst_add) = one
+
+          !***
+          !*** iterate to find i,j for bilinear approximation
+          !***
+
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          if (dph1 >  pi) dph1 = dph1 - pi2
+          if (dph2 >  pi) dph2 = dph2 - pi2
+          if (dph3 >  pi) dph3 = dph3 - pi2
+          if (dph1 < -pi) dph1 = dph1 + pi2
+          if (dph2 < -pi) dph2 = dph2 + pi2
+          if (dph3 < -pi) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+
+          iguess = zero
+          jguess = zero
+
+          iter_loop2: do iter=1,max_iter
+
+            dthp = plat - src_lats(1) - dth1*iguess -
+     &                    dth2*jguess - dth3*iguess*jguess
+            dphp = plon - src_lons(1)
+
+            if (dphp >  pi) dphp = dphp - pi2
+            if (dphp < -pi) dphp = dphp + pi2
+
+            dphp = dphp - dph1*iguess - dph2*jguess - 
+     &                    dph3*iguess*jguess
+
+            mat1 = dth1 + dth3*jguess
+            mat2 = dth2 + dth3*iguess
+            mat3 = dph1 + dph3*jguess
+            mat4 = dph2 + dph3*iguess
+
+            determinant = mat1*mat4 - mat2*mat3
+
+            deli = (dthp*mat4 - mat2*dphp)/determinant
+            delj = (mat1*dphp - dthp*mat3)/determinant
+
+            if (abs(deli) < converge .and. 
+     &          abs(delj) < converge) exit iter_loop2
+
+            iguess = iguess + deli
+            jguess = jguess + delj
+
+          end do iter_loop2
+
+          if (iter <= max_iter) then
+
+            !***
+            !*** successfully found i,j - compute weights
+            !***
+
+            wgts(1,1) = (one - jguess**2*(three-two*jguess))*
+     &                  (one - iguess**2*(three-two*iguess))
+            wgts(1,2) = (one - jguess**2*(three-two*jguess))*
+     &                         iguess**2*(three-two*iguess)
+            wgts(1,3) =        jguess**2*(three-two*jguess)*
+     &                         iguess**2*(three-two*iguess)
+            wgts(1,4) =        jguess**2*(three-two*jguess)*
+     &                  (one - iguess**2*(three-two*iguess))
+            wgts(2,1) = (one - jguess**2*(three-two*jguess))*
+     &                         iguess*(iguess-one)**2
+            wgts(2,2) = (one - jguess**2*(three-two*jguess))*
+     &                         iguess**2*(iguess-one)
+            wgts(2,3) =        jguess**2*(three-two*jguess)*
+     &                         iguess**2*(iguess-one)
+            wgts(2,4) =        jguess**2*(three-two*jguess)*
+     &                         iguess*(iguess-one)**2
+            wgts(3,1) =        jguess*(jguess-one)**2*
+     &                  (one - iguess**2*(three-two*iguess))
+            wgts(3,2) =        jguess*(jguess-one)**2*
+     &                         iguess**2*(three-two*iguess)
+            wgts(3,3) =        jguess**2*(jguess-one)*
+     &                         iguess**2*(three-two*iguess)
+            wgts(3,4) =        jguess**2*(jguess-one)*
+     &                  (one - iguess**2*(three-two*iguess))
+            wgts(4,1) =        iguess*(iguess-one)**2*
+     &                         jguess*(jguess-one)**2
+            wgts(4,2) =        iguess**2*(iguess-one)*
+     &                         jguess*(jguess-one)**2
+            wgts(4,3) =        iguess**2*(iguess-one)*
+     &                         jguess**2*(jguess-one)
+            wgts(4,4) =        iguess*(iguess-one)**2*
+     &                         jguess**2*(jguess-one)
+
+            call store_link_bicub(dst_add, src_add, wgts, nmap)
+
+          else
+            stop 'Iteration for i,j exceed max iteration count'
+          endif
+
+        !***
+        !*** search for bilinear failed - us a distance-weighted
+        !*** average instead
+        !***
+
+        else if (src_add(1) < 0) then
+
+          src_add = abs(src_add)
+
+          icount = 0
+          do n=1,4
+            if (grid2_mask(src_add(n))) then
+              icount = icount + 1
+            else
+              src_lats(n) = zero
+            endif
+          end do
+
+          if (icount > 0) then
+            !*** renormalize weights
+
+            sum_wgts = sum(src_lats)
+            wgts(1,1) = src_lats(1)/sum_wgts
+            wgts(1,2) = src_lats(2)/sum_wgts
+            wgts(1,3) = src_lats(3)/sum_wgts
+            wgts(1,4) = src_lats(4)/sum_wgts
+            wgts(2:4,:) = zero
+
+            grid1_frac(dst_add) = one
+            call store_link_bicub(dst_add, src_add, wgts, nmap)
+          endif
+
+        endif
+      end do grid_loop2
+
+      endif ! nmap=2
+
+!-----------------------------------------------------------------------
+
+      end subroutine remap_bicub
+
+!***********************************************************************
+
+      subroutine grid_search_bicub(src_add, src_lats, src_lons, 
+     &                             plat, plon, src_grid_dims,
+     &                             src_center_lat, src_center_lon,
+     &                             src_bound_box,
+     &                             src_bin_add, dst_bin_add)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the location of the search point plat, plon
+!     in the source grid and returns the corners needed for a bicubic
+!     interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(4), intent(out) ::
+     &        src_add  ! address of each corner point enclosing P
+
+      real (kind=dbl_kind), dimension(4), intent(out) ::
+     &        src_lats, ! latitudes  of the four corner points
+     &        src_lons  ! longitudes of the four corner points
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), intent(in) ::
+     &        plat,   ! latitude  of the search point
+     &        plon    ! longitude of the search point
+
+      integer (kind=int_kind), dimension(2), intent(in) ::
+     &        src_grid_dims  ! size of each src grid dimension
+
+      real (kind=dbl_kind), dimension(:), intent(in) ::
+     &        src_center_lat, ! latitude  of each src grid center 
+     &        src_center_lon  ! longitude of each src grid center
+
+      real (kind=dbl_kind), dimension(:,:), intent(in) ::
+     &        src_bound_box   ! bounding box for src grid search
+
+      integer (kind=int_kind), dimension(:,:), intent(in) ::
+     &        src_bin_add,    ! search bins for restricting
+     &        dst_bin_add     ! searches
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, srch_add,   ! dummy indices
+     &    nx, ny,            ! dimensions of src grid
+     &    min_add, max_add,  ! addresses for restricting search
+     &    i, j, jp1, ip1, n_add, e_add, ne_add  ! addresses
+
+      real (kind=dbl_kind) ::  ! vectors for cross-product check
+     &      vec1_lat, vec1_lon,
+     &      vec2_lat, vec2_lon, cross_product, cross_product_last,
+     &      coslat_dst, sinlat_dst, coslon_dst, sinlon_dst,
+     &      dist_min, distance ! for computing dist-weighted avg
+
+!-----------------------------------------------------------------------
+!
+!     restrict search first using search bins. 
+!
+!-----------------------------------------------------------------------
+
+      src_add = 0
+
+      min_add = size(src_center_lat)
+      max_add = 1
+      do n=1,num_srch_bins
+        if (plat >= bin_lats(1,n) .and. plat <= bin_lats(2,n) .and.
+     &      plon >= bin_lons(1,n) .and. plon <= bin_lons(2,n)) then
+          min_add = min(min_add, src_bin_add(1,n))
+          max_add = max(max_add, src_bin_add(2,n))
+        endif
+      end do
+ 
+!-----------------------------------------------------------------------
+!
+!     now perform a more detailed search 
+!
+!-----------------------------------------------------------------------
+
+      nx = src_grid_dims(1)
+      ny = src_grid_dims(2)
+
+      srch_loop: do srch_add = min_add,max_add
+
+        if (plat <= src_bound_box(2,srch_add) .and. 
+     &      plat >= src_bound_box(1,srch_add) .and.
+     &      plon <= src_bound_box(4,srch_add) .and. 
+     &      plon >= src_bound_box(3,srch_add)) then
+
+          !***
+          !*** we are within bounding box so get really serious
+          !***
+
+          !*** find N,S and NE points to this grid point
+
+          j = (srch_add - 1)/nx +1
+          i = srch_add - (j-1)*nx
+
+          if (i < nx) then
+            ip1 = i + 1
+          else
+            ip1 = 1
+          endif
+
+          if (j < ny) then
+            jp1 = j+1
+          else
+            jp1 = 1
+          endif
+
+          n_add = (jp1 - 1)*nx + i
+          e_add = (j - 1)*nx + ip1
+          ne_add = (jp1 - 1)*nx + ip1
+
+          !***
+          !*** find N,S and NE lat/lon coords and check bounding box
+          !***
+
+          src_lats(1) = src_center_lat(srch_add)
+          src_lats(2) = src_center_lat(e_add)
+          src_lats(3) = src_center_lat(ne_add)
+          src_lats(4) = src_center_lat(n_add)
+
+          src_lons(1) = src_center_lon(srch_add)
+          src_lons(2) = src_center_lon(e_add)
+          src_lons(3) = src_center_lon(ne_add)
+          src_lons(4) = src_center_lon(n_add)
+
+          !***
+          !*** for consistency, we must make sure all lons are in
+          !*** same 2pi interval
+          !***
+
+          vec1_lon = src_lons(1) - plon
+          if (vec1_lon > pi) then
+            src_lons(1) = src_lons(1) - pi2
+          else if (vec1_lon < -pi) then
+            src_lons(1) = src_lons(1) + pi2
+          endif
+          do n=2,4
+            vec1_lon = src_lons(n) - src_lons(1)
+            if (vec1_lon > pi) then
+              src_lons(n) = src_lons(n) - pi2
+            else if (vec1_lon < -pi) then
+              src_lons(n) = src_lons(n) + pi2
+            endif
+          end do
+
+          corner_loop: do n=1,4
+            next_n = MOD(n,4) + 1
+
+            !***
+            !*** here we take the cross product of the vector making 
+            !*** up each box side with the vector formed by the vertex
+            !*** and search point.  if all the cross products are 
+            !*** same sign, the point is contained in the box.
+            !***
+
+            vec1_lat = src_lats(next_n) - src_lats(n)
+            vec1_lon = src_lons(next_n) - src_lons(n)
+            vec2_lat = plat - src_lats(n)
+            vec2_lon = plon - src_lons(n)
+
+            !***
+            !*** check for 0,2pi crossings
+            !***
+
+            if (vec1_lon >  three*pih) then
+              vec1_lon = vec1_lon - pi2
+            else if (vec1_lon < -three*pih) then
+              vec1_lon = vec1_lon + pi2
+            endif
+            if (vec2_lon >  three*pih) then
+              vec2_lon = vec2_lon - pi2
+            else if (vec2_lon < -three*pih) then
+              vec2_lon = vec2_lon + pi2
+            endif
+
+            cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+
+            !***
+            !*** if cross product is less than zero, this cell
+            !*** doesn't work
+            !***
+
+            if (n==1) cross_product_last = cross_product
+            if (cross_product*cross_product_last < zero) then
+              exit corner_loop
+            else
+              cross_product_last = cross_product
+            endif
+
+          end do corner_loop
+
+          !***
+          !*** if cross products all positive, we found the location
+          !***
+
+          if (n > 4) then
+            src_add(1) = srch_add
+            src_add(2) = e_add
+            src_add(3) = ne_add
+            src_add(4) = n_add
+
+            return
+          endif
+
+          !***
+          !*** otherwise move on to next cell
+          !***
+
+        endif !bounding box check
+      end do srch_loop
+
+      !***
+      !*** if no cell found, point is likely either in a box that
+      !*** straddles either pole or is outside the grid.  fall back
+      !*** to a distance-weighted average of the four closest
+      !*** points.  go ahead and compute weights here, but store
+      !*** in src_lats and return -add to prevent the parent
+      !*** routine from computing bilinear weights
+      !***
+
+      coslat_dst = cos(plat)
+      sinlat_dst = sin(plat)
+      coslon_dst = cos(plon)
+      sinlon_dst = sin(plon)
+
+      dist_min = bignum
+      src_lats = bignum
+      do srch_add = min_add,max_add
+        distance = acos(coslat_dst*cos(src_center_lat(srch_add))*
+     &                 (coslon_dst*cos(src_center_lon(srch_add)) +
+     &                  sinlon_dst*sin(src_center_lon(srch_add)))+
+     &                  sinlat_dst*sin(src_center_lat(srch_add)))
+
+        if (distance < dist_min) then
+          sort_loop: do n=1,4
+            if (distance < src_lats(n)) then
+              do i=4,n+1,-1
+                src_add (i) = src_add (i-1)
+                src_lats(i) = src_lats(i-1)
+              end do
+              src_add (n) = -srch_add
+              src_lats(n) = distance
+              dist_min = src_lats(4)
+              exit sort_loop
+            endif
+          end do sort_loop
+        endif
+      end do
+
+      src_lons = one/(src_lats + tiny)
+      distance = sum(src_lons)
+      src_lats = src_lons/distance
+
+!-----------------------------------------------------------------------
+
+      end subroutine grid_search_bicub 
+
+!***********************************************************************
+
+      subroutine store_link_bicub(dst_add, src_add, weights, nmap)
+
+!-----------------------------------------------------------------------
+!
+!     this routine stores the address and weight for four links 
+!     associated with one destination point in the appropriate address 
+!     and weight arrays and resizes those arrays if necessary.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::
+     &        dst_add,  ! address on destination grid
+     &        nmap      ! identifies which direction for mapping
+
+      integer (kind=int_kind), dimension(4), intent(in) ::
+     &        src_add   ! addresses on source grid
+
+      real (kind=dbl_kind), dimension(4,4), intent(in) ::
+     &        weights ! array of remapping weights for these links
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, ! dummy index
+     &       num_links_old          ! placeholder for old link number
+
+!-----------------------------------------------------------------------
+!
+!     increment number of links and check to see if remap arrays need
+!     to be increased to accomodate the new link.  then store the
+!     link.
+!
+!-----------------------------------------------------------------------
+
+      select case (nmap)
+      case(1)
+
+        num_links_old  = num_links_map1
+        num_links_map1 = num_links_old + 4
+
+        if (num_links_map1 > max_links_map1) 
+     &     call resize_remap_vars(1,resize_increment)
+
+        do n=1,4
+          grid1_add_map1(num_links_old+n) = src_add(n)
+          grid2_add_map1(num_links_old+n) = dst_add
+          wts_map1    (:,num_links_old+n) = weights(:,n)
+        end do
+
+      case(2)
+
+        num_links_old  = num_links_map2
+        num_links_map2 = num_links_old + 4
+
+        if (num_links_map2 > max_links_map2) 
+     &     call resize_remap_vars(2,resize_increment)
+
+        do n=1,4
+          grid1_add_map2(num_links_old+n) = dst_add
+          grid2_add_map2(num_links_old+n) = src_add(n)
+          wts_map2    (:,num_links_old+n) = weights(:,n)
+        end do
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine store_link_bicub
+
+!***********************************************************************
+
+      end module remap_bicubic
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/remap_bilinear.f
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/remap_bilinear.f	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/remap_bilinear.f	(revision 12863)
@@ -0,0 +1,781 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for performing an 
+!     bilinear interpolation.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_bilinear.f,v 1.6 2001/08/22 18:20:40 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_bilinear
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common constants
+      use grids         ! module containing grid info
+      use remap_vars    ! module containing remap info
+
+      implicit none
+
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter ::
+     &    max_iter = 100   ! max iteration count for i,j iteration
+
+      real (kind=dbl_kind), parameter ::
+     &     converge = 1.e-10_dbl_kind  ! convergence criterion
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap_bilin
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the weights for a bilinear interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,icount,
+     &     dst_add,        ! destination address
+     &     iter,           ! iteration counter
+     &     nmap            ! index of current map being computed
+
+      integer (kind=int_kind), dimension(4) :: 
+     &     src_add         ! address for the four source points
+
+      real (kind=dbl_kind), dimension(4)  ::
+     &     src_lats,       ! latitudes  of four bilinear corners
+     &     src_lons,       ! longitudes of four bilinear corners
+     &     wgts            ! bilinear weights for four corners
+
+      real (kind=dbl_kind) ::
+     &     plat, plon,       ! lat/lon coords of destination point
+     &     iguess, jguess,   ! current guess for bilinear coordinate
+     &     thguess, phguess, ! current guess for lat/lon coordinate
+     &     deli, delj,       ! corrections to i,j
+     &     dth1, dth2, dth3, ! some latitude  differences
+     &     dph1, dph2, dph3, ! some longitude differences
+     &     dthp, dphp,       ! difference between point and sw corner
+     &     mat1, mat2, mat3, mat4, ! matrix elements
+     &     determinant,      ! matrix determinant
+     &     sum_wgts          ! sum of weights for normalization
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+
+      nmap = 1
+      if (grid1_rank /= 2) then
+        stop 'Can not do bilinear interpolation when grid_rank /= 2'
+      endif
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop1: do dst_add = 1, grid2_size
+
+        if (.not. grid2_mask(dst_add)) cycle grid_loop1
+
+        plat = grid2_center_lat(dst_add)
+        plon = grid2_center_lon(dst_add)
+
+        !***
+        !*** find nearest square of grid points on source grid
+        !***
+
+        call grid_search_bilin(src_add, src_lats, src_lons, 
+     &                         plat, plon, grid1_dims,
+     &                         grid1_center_lat, grid1_center_lon,
+     &                         grid1_bound_box, bin_addr1, bin_addr2)
+
+        !***
+        !*** check to see if points are land points
+        !***
+
+        if (src_add(1) > 0) then
+          do n=1,4
+            if (.not. grid1_mask(src_add(n))) src_add(1) = 0
+          end do
+        endif
+
+        !***
+        !*** if point found, find local i,j coordinates for weights
+        !***
+
+        if (src_add(1) > 0) then
+
+          grid2_frac(dst_add) = one
+
+          !***
+          !*** iterate to find i,j for bilinear approximation
+          !***
+
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          if (dph1 >  three*pih) dph1 = dph1 - pi2
+          if (dph2 >  three*pih) dph2 = dph2 - pi2
+          if (dph3 >  three*pih) dph3 = dph3 - pi2
+          if (dph1 < -three*pih) dph1 = dph1 + pi2
+          if (dph2 < -three*pih) dph2 = dph2 + pi2
+          if (dph3 < -three*pih) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+
+          iguess = half
+          jguess = half
+
+          iter_loop1: do iter=1,max_iter
+
+            dthp = plat - src_lats(1) - dth1*iguess -
+     &                    dth2*jguess - dth3*iguess*jguess
+            dphp = plon - src_lons(1)
+
+            if (dphp >  three*pih) dphp = dphp - pi2
+            if (dphp < -three*pih) dphp = dphp + pi2
+
+            dphp = dphp - dph1*iguess - dph2*jguess - 
+     &                    dph3*iguess*jguess
+
+            mat1 = dth1 + dth3*jguess
+            mat2 = dth2 + dth3*iguess
+            mat3 = dph1 + dph3*jguess
+            mat4 = dph2 + dph3*iguess
+
+            determinant = mat1*mat4 - mat2*mat3
+
+            deli = (dthp*mat4 - mat2*dphp)/determinant
+            delj = (mat1*dphp - dthp*mat3)/determinant
+
+            if (abs(deli) < converge .and. 
+     &          abs(delj) < converge) exit iter_loop1
+
+            iguess = iguess + deli
+            jguess = jguess + delj
+
+          end do iter_loop1
+
+          if (iter <= max_iter) then
+
+            !***
+            !*** successfully found i,j - compute weights
+            !***
+
+            wgts(1) = (one-iguess)*(one-jguess)
+            wgts(2) = iguess*(one-jguess)
+            wgts(3) = iguess*jguess
+            wgts(4) = (one-iguess)*jguess
+
+            call store_link_bilin(dst_add, src_add, wgts, nmap)
+
+          else
+            print *,'Point coords: ',plat,plon
+            print *,'Dest grid lats: ',src_lats
+            print *,'Dest grid lons: ',src_lons
+            print *,'Dest grid addresses: ',src_add
+            print *,'Current i,j : ',iguess, jguess
+            stop 'Iteration for i,j exceed max iteration count'
+          endif
+
+        !***
+        !*** search for bilinear failed - use a distance-weighted
+        !*** average instead (this is typically near the pole)
+        !***
+
+        else if (src_add(1) < 0) then
+
+          src_add = abs(src_add)
+          icount = 0
+          do n=1,4
+            if (grid1_mask(src_add(n))) then
+              icount = icount + 1
+            else
+              src_lats(n) = zero
+            endif
+          end do
+
+          if (icount > 0) then
+            !*** renormalize weights
+
+            sum_wgts = sum(src_lats)
+            wgts(1) = src_lats(1)/sum_wgts
+            wgts(2) = src_lats(2)/sum_wgts
+            wgts(3) = src_lats(3)/sum_wgts
+            wgts(4) = src_lats(4)/sum_wgts
+
+            grid2_frac(dst_add) = one
+            call store_link_bilin(dst_add, src_add, wgts, nmap)
+          endif
+
+        endif
+      end do grid_loop1
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid2 to grid1 if necessary
+!
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+
+      nmap = 2
+      if (grid2_rank /= 2) then
+        stop 'Can not do bilinear interpolation when grid_rank /= 2'
+      endif
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop2: do dst_add = 1, grid1_size
+
+        if (.not. grid1_mask(dst_add)) cycle grid_loop2
+
+        plat = grid1_center_lat(dst_add)
+        plon = grid1_center_lon(dst_add)
+
+        !***
+        !*** find nearest square of grid points on source grid
+        !***
+
+        call grid_search_bilin(src_add, src_lats, src_lons, 
+     &                         plat, plon, grid2_dims,
+     &                         grid2_center_lat, grid2_center_lon,
+     &                         grid2_bound_box, bin_addr2, bin_addr1)
+
+        !***
+        !*** check to see if points are land points
+        !***
+
+        if (src_add(1) > 0) then
+          do n=1,4
+            if (.not. grid2_mask(src_add(n))) src_add(1) = 0
+          end do
+        endif
+
+        !***
+        !*** if point found, find i,j coordinates for weights
+        !***
+
+        if (src_add(1) > 0) then
+
+          grid1_frac(dst_add) = one
+
+          !***
+          !*** iterate to find i,j for bilinear approximation
+          !***
+
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          if (dph1 >  pi) dph1 = dph1 - pi2
+          if (dph2 >  pi) dph2 = dph2 - pi2
+          if (dph3 >  pi) dph3 = dph3 - pi2
+          if (dph1 < -pi) dph1 = dph1 + pi2
+          if (dph2 < -pi) dph2 = dph2 + pi2
+          if (dph3 < -pi) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+
+          iguess = zero
+          jguess = zero
+
+          iter_loop2: do iter=1,max_iter
+
+            dthp = plat - src_lats(1) - dth1*iguess -
+     &                    dth2*jguess - dth3*iguess*jguess
+            dphp = plon - src_lons(1)
+
+            if (dphp >  pi) dphp = dphp - pi2
+            if (dphp < -pi) dphp = dphp + pi2
+
+            dphp = dphp - dph1*iguess - dph2*jguess - 
+     &                    dph3*iguess*jguess
+
+            mat1 = dth1 + dth3*jguess
+            mat2 = dth2 + dth3*iguess
+            mat3 = dph1 + dph3*jguess
+            mat4 = dph2 + dph3*iguess
+
+            determinant = mat1*mat4 - mat2*mat3
+
+            deli = (dthp*mat4 - mat2*dphp)/determinant
+            delj = (mat1*dphp - dthp*mat3)/determinant
+
+            if (abs(deli) < converge .and. 
+     &          abs(delj) < converge) exit iter_loop2
+
+            iguess = iguess + deli
+            jguess = jguess + delj
+
+          end do iter_loop2
+
+          if (iter <= max_iter) then
+
+            !***
+            !*** successfully found i,j - compute weights
+            !***
+
+            wgts(1) = (one-iguess)*(one-jguess)
+            wgts(2) = iguess*(one-jguess)
+            wgts(3) = iguess*jguess
+            wgts(4) = (one-iguess)*jguess
+
+            call store_link_bilin(dst_add, src_add, wgts, nmap)
+
+          else
+            print *,'Point coords: ',plat,plon
+            print *,'Dest grid lats: ',src_lats
+            print *,'Dest grid lons: ',src_lons
+            print *,'Dest grid addresses: ',src_add
+            print *,'Current i,j : ',iguess, jguess
+            stop 'Iteration for i,j exceed max iteration count'
+          endif
+
+        !***
+        !*** search for bilinear failed - us a distance-weighted
+        !*** average instead
+        !***
+
+        else if (src_add(1) < 0) then
+
+          src_add = abs(src_add)
+          icount = 0
+          do n=1,4
+            if (grid2_mask(src_add(n))) then
+              icount = icount + 1
+            else
+              src_lats(n) = zero
+            endif
+          end do
+
+          if (icount > 0) then
+            !*** renormalize weights
+
+            sum_wgts = sum(src_lats)
+            wgts(1) = src_lats(1)/sum_wgts
+            wgts(2) = src_lats(2)/sum_wgts
+            wgts(3) = src_lats(3)/sum_wgts
+            wgts(4) = src_lats(4)/sum_wgts
+
+            grid1_frac(dst_add) = one
+            call store_link_bilin(dst_add, src_add, wgts, nmap)
+          endif
+
+        endif
+      end do grid_loop2
+
+      endif ! nmap=2
+
+!-----------------------------------------------------------------------
+
+      end subroutine remap_bilin
+
+!***********************************************************************
+
+      subroutine grid_search_bilin(src_add, src_lats, src_lons, 
+     &                             plat, plon, src_grid_dims,
+     &                             src_center_lat, src_center_lon,
+     &                             src_grid_bound_box,
+     &                             src_bin_add, dst_bin_add)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the location of the search point plat, plon
+!     in the source grid and returns the corners needed for a bilinear
+!     interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(4), intent(out) ::
+     &        src_add  ! address of each corner point enclosing P
+
+      real (kind=dbl_kind), dimension(4), intent(out) ::
+     &        src_lats, ! latitudes  of the four corner points
+     &        src_lons  ! longitudes of the four corner points
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), intent(in) ::
+     &        plat,   ! latitude  of the search point
+     &        plon    ! longitude of the search point
+
+      integer (kind=int_kind), dimension(2), intent(in) ::
+     &        src_grid_dims  ! size of each src grid dimension
+
+      real (kind=dbl_kind), dimension(:), intent(in) ::
+     &        src_center_lat, ! latitude  of each src grid center 
+     &        src_center_lon  ! longitude of each src grid center
+
+      real (kind=dbl_kind), dimension(:,:), intent(in) ::
+     &        src_grid_bound_box ! bound box for source grid
+
+      integer (kind=int_kind), dimension(:,:), intent(in) ::
+     &        src_bin_add,    ! latitude bins for restricting
+     &        dst_bin_add     ! searches
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, srch_add,   ! dummy indices
+     &    nx, ny,            ! dimensions of src grid
+     &    min_add, max_add,  ! addresses for restricting search
+     &    i, j, jp1, ip1, n_add, e_add, ne_add  ! addresses
+
+      real (kind=dbl_kind) ::  ! vectors for cross-product check
+     &      vec1_lat, vec1_lon,
+     &      vec2_lat, vec2_lon, cross_product, cross_product_last,
+     &      coslat_dst, sinlat_dst, coslon_dst, sinlon_dst,
+     &      dist_min, distance ! for computing dist-weighted avg
+
+!-----------------------------------------------------------------------
+!
+!     restrict search first using bins
+!
+!-----------------------------------------------------------------------
+
+      src_add = 0
+
+      min_add = size(src_center_lat)
+      max_add = 1
+      do n=1,num_srch_bins
+        if (plat >= bin_lats(1,n) .and. plat <= bin_lats(2,n) .and.
+     &      plon >= bin_lons(1,n) .and. plon <= bin_lons(2,n)) then
+          min_add = min(min_add, src_bin_add(1,n))
+          max_add = max(max_add, src_bin_add(2,n))
+        endif
+      end do
+ 
+!-----------------------------------------------------------------------
+!
+!     now perform a more detailed search 
+!
+!-----------------------------------------------------------------------
+
+      nx = src_grid_dims(1)
+      ny = src_grid_dims(2)
+
+      srch_loop: do srch_add = min_add,max_add
+
+        !*** first check bounding box
+
+        if (plat <= src_grid_bound_box(2,srch_add) .and. 
+     &      plat >= src_grid_bound_box(1,srch_add) .and.
+     &      plon <= src_grid_bound_box(4,srch_add) .and. 
+     &      plon >= src_grid_bound_box(3,srch_add)) then
+
+          !***
+          !*** we are within bounding box so get really serious
+          !***
+
+          !*** determine neighbor addresses
+
+          j = (srch_add - 1)/nx +1
+          i = srch_add - (j-1)*nx
+
+          if (i < nx) then
+            ip1 = i + 1
+          else
+            ip1 = 1
+          endif
+
+          if (j < ny) then
+            jp1 = j+1
+          else
+            jp1 = 1
+          endif
+
+          n_add = (jp1 - 1)*nx + i
+          e_add = (j - 1)*nx + ip1
+          ne_add = (jp1 - 1)*nx + ip1
+
+          src_lats(1) = src_center_lat(srch_add)
+          src_lats(2) = src_center_lat(e_add)
+          src_lats(3) = src_center_lat(ne_add)
+          src_lats(4) = src_center_lat(n_add)
+
+          src_lons(1) = src_center_lon(srch_add)
+          src_lons(2) = src_center_lon(e_add)
+          src_lons(3) = src_center_lon(ne_add)
+          src_lons(4) = src_center_lon(n_add)
+
+          !***
+          !*** for consistency, we must make sure all lons are in
+          !*** same 2pi interval
+          !***
+
+          vec1_lon = src_lons(1) - plon
+          if (vec1_lon >  pi) then
+            src_lons(1) = src_lons(1) - pi2
+          else if (vec1_lon < -pi) then
+            src_lons(1) = src_lons(1) + pi2
+          endif
+          do n=2,4
+            vec1_lon = src_lons(n) - src_lons(1)
+            if (vec1_lon >  pi) then
+              src_lons(n) = src_lons(n) - pi2
+            else if (vec1_lon < -pi) then
+              src_lons(n) = src_lons(n) + pi2
+            endif
+          end do
+
+          corner_loop: do n=1,4
+            next_n = MOD(n,4) + 1
+
+            !***
+            !*** here we take the cross product of the vector making 
+            !*** up each box side with the vector formed by the vertex
+            !*** and search point.  if all the cross products are 
+            !*** positive, the point is contained in the box.
+            !***
+
+            vec1_lat = src_lats(next_n) - src_lats(n)
+            vec1_lon = src_lons(next_n) - src_lons(n)
+            vec2_lat = plat - src_lats(n)
+            vec2_lon = plon - src_lons(n)
+
+            !***
+            !*** check for 0,2pi crossings
+            !***
+
+            if (vec1_lon >  three*pih) then
+              vec1_lon = vec1_lon - pi2
+            else if (vec1_lon < -three*pih) then
+              vec1_lon = vec1_lon + pi2
+            endif
+            if (vec2_lon >  three*pih) then
+              vec2_lon = vec2_lon - pi2
+            else if (vec2_lon < -three*pih) then
+              vec2_lon = vec2_lon + pi2
+            endif
+
+            cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+
+            !***
+            !*** if cross product is less than zero, this cell
+            !*** doesn't work
+            !***
+
+            if (n == 1) cross_product_last = cross_product
+            if (cross_product*cross_product_last < zero) 
+     &          exit corner_loop
+            cross_product_last = cross_product
+
+          end do corner_loop
+
+          !***
+          !*** if cross products all same sign, we found the location
+          !***
+
+          if (n > 4) then
+            src_add(1) = srch_add
+            src_add(2) = e_add
+            src_add(3) = ne_add
+            src_add(4) = n_add
+
+            return
+          endif
+
+          !***
+          !*** otherwise move on to next cell
+          !***
+
+        endif !bounding box check
+      end do srch_loop
+
+      !***
+      !*** if no cell found, point is likely either in a box that
+      !*** straddles either pole or is outside the grid.  fall back
+      !*** to a distance-weighted average of the four closest
+      !*** points.  go ahead and compute weights here, but store
+      !*** in src_lats and return -add to prevent the parent
+      !*** routine from computing bilinear weights
+      !***
+
+      !print *,'Could not find location for ',plat,plon
+      !print *,'Using nearest-neighbor average for this point'
+
+      coslat_dst = cos(plat)
+      sinlat_dst = sin(plat)
+      coslon_dst = cos(plon)
+      sinlon_dst = sin(plon)
+
+      dist_min = bignum
+      src_lats = bignum
+      do srch_add = min_add,max_add
+        distance = acos(coslat_dst*cos(src_center_lat(srch_add))*
+     &                 (coslon_dst*cos(src_center_lon(srch_add)) +
+     &                  sinlon_dst*sin(src_center_lon(srch_add)))+
+     &                  sinlat_dst*sin(src_center_lat(srch_add)))
+
+        if (distance < dist_min) then
+          sort_loop: do n=1,4
+            if (distance < src_lats(n)) then
+              do i=4,n+1,-1
+                src_add (i) = src_add (i-1)
+                src_lats(i) = src_lats(i-1)
+              end do
+              src_add (n) = -srch_add
+              src_lats(n) = distance
+              dist_min = src_lats(4)
+              exit sort_loop
+            endif
+          end do sort_loop
+        endif
+      end do
+
+      src_lons = one/(src_lats + tiny)
+      distance = sum(src_lons)
+      src_lats = src_lons/distance
+
+!-----------------------------------------------------------------------
+
+      end subroutine grid_search_bilin 
+
+!***********************************************************************
+
+      subroutine store_link_bilin(dst_add, src_add, weights, nmap)
+
+!-----------------------------------------------------------------------
+!
+!     this routine stores the address and weight for four links 
+!     associated with one destination point in the appropriate address 
+!     and weight arrays and resizes those arrays if necessary.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::
+     &        dst_add,  ! address on destination grid
+     &        nmap      ! identifies which direction for mapping
+
+      integer (kind=int_kind), dimension(4), intent(in) ::
+     &        src_add   ! addresses on source grid
+
+      real (kind=dbl_kind), dimension(4), intent(in) ::
+     &        weights ! array of remapping weights for these links
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, ! dummy index
+     &       num_links_old          ! placeholder for old link number
+
+!-----------------------------------------------------------------------
+!
+!     increment number of links and check to see if remap arrays need
+!     to be increased to accomodate the new link.  then store the
+!     link.
+!
+!-----------------------------------------------------------------------
+
+      select case (nmap)
+      case(1)
+
+        num_links_old  = num_links_map1
+        num_links_map1 = num_links_old + 4
+
+        if (num_links_map1 > max_links_map1) 
+     &     call resize_remap_vars(1,resize_increment)
+
+        do n=1,4
+          grid1_add_map1(num_links_old+n) = src_add(n)
+          grid2_add_map1(num_links_old+n) = dst_add
+          wts_map1    (1,num_links_old+n) = weights(n)
+        end do
+
+      case(2)
+
+        num_links_old  = num_links_map2
+        num_links_map2 = num_links_old + 4
+
+        if (num_links_map2 > max_links_map2) 
+     &     call resize_remap_vars(2,resize_increment)
+
+        do n=1,4
+          grid1_add_map2(num_links_old+n) = dst_add
+          grid2_add_map2(num_links_old+n) = src_add(n)
+          wts_map2    (1,num_links_old+n) = weights(n)
+        end do
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine store_link_bilin
+
+!***********************************************************************
+
+      end module remap_bilinear
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/remap_conserv.f
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/remap_conserv.f	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/remap_conserv.f	(revision 12863)
@@ -0,0 +1,2197 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for computing addresses
+!     and weights for a conservative interpolation  between any two 
+!     grids on a sphere.  the weights are computed by performing line 
+!     integrals around all overlap regions of the two grids.  see 
+!     Dukowicz and Kodis, SIAM J. Sci. Stat. Comput. 8, 305 (1987) and
+!     Jones, P.W. Monthly Weather Review (submitted).
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_conserv.f,v 1.10 2001/08/21 21:05:13 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_conservative
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod    ! defines common data types
+      use constants    ! defines common constants
+      use timers       ! module for timing
+      use grids        ! module containing grid information
+      use remap_vars   ! module containing remap information
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), save :: 
+     &        num_srch_cells ! num cells in restricted search arrays
+
+      integer (kind=int_kind), dimension(:), allocatable, save :: 
+     &        srch_add       ! global address of cells in srch arrays
+
+      real (kind=dbl_kind), parameter :: 
+     &     north_thresh = 1.45_dbl_kind, ! threshold for coord transf.
+     &     south_thresh =-2.00_dbl_kind  ! threshold for coord transf.
+
+      real (kind=dbl_kind), dimension(:,:), allocatable, save ::
+     &     srch_corner_lat,  ! lat of each corner of srch cells
+     &     srch_corner_lon   ! lon of each corner of srch cells
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap_conserv
+
+!-----------------------------------------------------------------------
+!
+!     this routine traces the perimeters of every grid cell on each
+!     grid checking for intersections with the other grid and computing
+!     line integrals for each subsegment.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter :: 
+     &        max_subseg = 10000 ! max number of subsegments per segment
+                                 ! to prevent infinite loop
+
+      integer (kind=int_kind) :: 
+     &        grid1_add,  ! current linear address for grid1 cell
+     &        grid2_add,  ! current linear address for grid2 cell
+     &        min_add,    ! addresses for restricting search of
+     &        max_add,    !   destination grid
+     &        n, nwgt,    ! generic counters
+     &        corner,     ! corner of cell that segment starts from
+     &        next_corn,  ! corner of cell that segment ends on
+     &        num_subseg  ! number of subsegments 
+
+      logical (kind=log_kind) :: 
+     &        lcoinc,  ! flag for coincident segments
+     &        lrevers, ! flag for reversing direction of segment
+     &        lbegin   ! flag for first integration of a segment
+
+      logical (kind=log_kind), dimension(:), allocatable ::
+     &        srch_mask   ! mask for restricting searches
+
+      real (kind=dbl_kind) ::
+     &     intrsct_lat, intrsct_lon,       ! lat/lon of next intersect
+     &     beglat, endlat, beglon, endlon, ! endpoints of current seg.
+     &     norm_factor                     ! factor for normalizing wts
+
+      real (kind=dbl_kind), dimension(:), allocatable ::
+     &       grid2_centroid_lat, grid2_centroid_lon, ! centroid coords
+     &       grid1_centroid_lat, grid1_centroid_lon  ! on each grid
+
+      real (kind=dbl_kind), dimension(2) :: begseg ! begin lat/lon for
+                                                   ! full segment
+
+      real (kind=dbl_kind), dimension(6) :: weights ! local wgt array
+
+!-----------------------------------------------------------------------
+!
+!     initialize centroid arrays
+!
+!-----------------------------------------------------------------------
+
+      allocate( grid1_centroid_lat(grid1_size),
+     &          grid1_centroid_lon(grid1_size),
+     &          grid2_centroid_lat(grid2_size),
+     &          grid2_centroid_lon(grid2_size))
+
+      grid1_centroid_lat = zero
+      grid1_centroid_lon = zero
+      grid2_centroid_lat = zero
+      grid2_centroid_lon = zero
+
+!-----------------------------------------------------------------------
+!
+!     integrate around each cell on grid1
+!
+!-----------------------------------------------------------------------
+
+      allocate(srch_mask(grid2_size))
+
+      print *,'grid1 sweep '
+      do grid1_add = 1,grid1_size
+
+        !***
+        !*** restrict searches first using search bins
+        !***
+
+        call timer_start(1)
+        min_add = grid2_size
+        max_add = 1
+        do n=1,num_srch_bins
+          if (grid1_add >= bin_addr1(1,n) .and.
+     &        grid1_add <= bin_addr1(2,n)) then
+            min_add = min(min_add, bin_addr2(1,n))
+            max_add = max(max_add, bin_addr2(2,n))
+          endif
+        end do
+
+        !***
+        !*** further restrict searches using bounding boxes
+        !***
+
+        num_srch_cells = 0
+        do grid2_add = min_add,max_add
+          srch_mask(grid2_add) = (grid2_bound_box(1,grid2_add) <= 
+     &                            grid1_bound_box(2,grid1_add)) .and.
+     &                           (grid2_bound_box(2,grid2_add) >= 
+     &                            grid1_bound_box(1,grid1_add)) .and.
+     &                           (grid2_bound_box(3,grid2_add) <= 
+     &                            grid1_bound_box(4,grid1_add)) .and.
+     &                           (grid2_bound_box(4,grid2_add) >= 
+     &                            grid1_bound_box(3,grid1_add))
+
+          if (srch_mask(grid2_add)) num_srch_cells = num_srch_cells+1
+        end do
+
+        !***
+        !*** create search arrays
+        !***
+
+        allocate(srch_add(num_srch_cells),
+     &           srch_corner_lat(grid2_corners,num_srch_cells),
+     &           srch_corner_lon(grid2_corners,num_srch_cells))
+
+        n = 0
+        gather1: do grid2_add = min_add,max_add
+          if (srch_mask(grid2_add)) then
+            n = n+1
+            srch_add(n) = grid2_add
+            srch_corner_lat(:,n) = grid2_corner_lat(:,grid2_add)
+            srch_corner_lon(:,n) = grid2_corner_lon(:,grid2_add)
+          endif
+        end do gather1
+        call timer_stop(1)
+
+        !***
+        !*** integrate around this cell
+        !***
+
+        do corner = 1,grid1_corners
+          next_corn = mod(corner,grid1_corners) + 1
+
+          !***
+          !*** define endpoints of the current segment
+          !***
+
+          beglat = grid1_corner_lat(corner,grid1_add)
+          beglon = grid1_corner_lon(corner,grid1_add)
+          endlat = grid1_corner_lat(next_corn,grid1_add)
+          endlon = grid1_corner_lon(next_corn,grid1_add)
+          lrevers = .false.
+
+          !***
+          !*** to ensure exact path taken during both
+          !*** sweeps, always integrate segments in the same 
+          !*** direction (SW to NE).
+          !***
+
+          if ((endlat < beglat) .or.
+     &        (endlat == beglat .and. endlon < beglon)) then 
+            beglat = grid1_corner_lat(next_corn,grid1_add)
+            beglon = grid1_corner_lon(next_corn,grid1_add)
+            endlat = grid1_corner_lat(corner,grid1_add)
+            endlon = grid1_corner_lon(corner,grid1_add)
+            lrevers = .true.
+          endif
+
+          begseg(1) = beglat
+          begseg(2) = beglon
+          lbegin = .true.
+          num_subseg = 0
+
+          !***
+          !*** if this is a constant-longitude segment, skip the rest 
+          !*** since the line integral contribution will be zero.
+          !***
+
+          if (endlon /= beglon) then
+
+          !***
+          !*** integrate along this segment, detecting intersections 
+          !*** and computing the line integral for each sub-segment
+          !***
+
+          do while (beglat /= endlat .or. beglon /= endlon)
+
+            !***
+            !*** prevent infinite loops if integration gets stuck
+            !*** near cell or threshold boundary
+            !***
+
+            num_subseg = num_subseg + 1
+            if (num_subseg > max_subseg) then
+              stop 'integration stalled: num_subseg exceeded limit'
+            endif
+
+            !***
+            !*** find next intersection of this segment with a grid
+            !*** line on grid 2.
+            !***
+
+            call timer_start(2)
+            call intersection(grid2_add,intrsct_lat,intrsct_lon,lcoinc,
+     &                        beglat, beglon, endlat, endlon, begseg, 
+     &                        lbegin, lrevers)
+            call timer_stop(2)
+            lbegin = .false.
+
+            !***
+            !*** compute line integral for this subsegment.
+            !***
+
+            call timer_start(3)
+            if (grid2_add /= 0) then
+              call line_integral(weights, num_wts,
+     &                         beglon, intrsct_lon, beglat, intrsct_lat,
+     &                         grid1_center_lat(grid1_add), 
+     &                         grid1_center_lon(grid1_add),
+     &                         grid2_center_lat(grid2_add), 
+     &                         grid2_center_lon(grid2_add))
+            else
+              call line_integral(weights, num_wts,
+     &                         beglon, intrsct_lon, beglat, intrsct_lat,
+     &                         grid1_center_lat(grid1_add), 
+     &                         grid1_center_lon(grid1_add),
+     &                         grid1_center_lat(grid1_add), 
+     &                         grid1_center_lon(grid1_add))
+            endif
+            call timer_stop(3)
+
+            !***
+            !*** if integrating in reverse order, change
+            !*** sign of weights
+            !***
+
+            if (lrevers) then
+              weights = -weights
+            endif
+
+            !***
+            !*** store the appropriate addresses and weights. 
+            !*** also add contributions to cell areas and centroids.
+            !***
+
+            !if (grid1_add == 119247) then
+            !  print *,grid1_add,grid2_add,corner,weights(1)
+            !  print *,grid1_corner_lat(:,grid1_add)
+            !  print *,grid1_corner_lon(:,grid1_add)
+            !  print *,grid2_corner_lat(:,grid2_add)
+            !  print *,grid2_corner_lon(:,grid2_add)
+            !  print *,beglat,beglon,intrsct_lat,intrsct_lon
+            !endif
+
+            if (grid2_add /= 0) then
+              if (grid1_mask(grid1_add)) then
+                call timer_start(4)
+                call store_link_cnsrv(grid1_add, grid2_add, weights)
+                call timer_stop(4)
+                grid1_frac(grid1_add) = grid1_frac(grid1_add) + 
+     &                                  weights(1)
+                grid2_frac(grid2_add) = grid2_frac(grid2_add) + 
+     &                                  weights(num_wts+1)
+              endif
+
+            endif
+
+            grid1_area(grid1_add) = grid1_area(grid1_add) + weights(1)
+            grid1_centroid_lat(grid1_add) = 
+     &      grid1_centroid_lat(grid1_add) + weights(2)
+            grid1_centroid_lon(grid1_add) = 
+     &      grid1_centroid_lon(grid1_add) + weights(3)
+
+            !***
+            !*** reset beglat and beglon for next subsegment.
+            !***
+
+            beglat = intrsct_lat
+            beglon = intrsct_lon
+          end do
+
+          endif
+
+          !***
+          !*** end of segment
+          !***
+
+        end do
+
+        !***
+        !*** finished with this cell: deallocate search array and
+        !*** start on next cell
+
+        deallocate(srch_add, srch_corner_lat, srch_corner_lon)
+
+      end do
+
+      deallocate(srch_mask)
+
+!-----------------------------------------------------------------------
+!
+!     integrate around each cell on grid2
+!
+!-----------------------------------------------------------------------
+
+      allocate(srch_mask(grid1_size))
+
+      print *,'grid2 sweep '
+      do grid2_add = 1,grid2_size
+
+        !***
+        !*** restrict searches first using search bins
+        !***
+
+        call timer_start(5)
+        min_add = grid1_size
+        max_add = 1
+        do n=1,num_srch_bins
+          if (grid2_add >= bin_addr2(1,n) .and.
+     &        grid2_add <= bin_addr2(2,n)) then
+            min_add = min(min_add, bin_addr1(1,n))
+            max_add = max(max_add, bin_addr1(2,n))
+          endif
+        end do
+
+        !***
+        !*** further restrict searches using bounding boxes
+        !***
+
+        num_srch_cells = 0
+        do grid1_add = min_add, max_add
+          srch_mask(grid1_add) = (grid1_bound_box(1,grid1_add) <= 
+     &                            grid2_bound_box(2,grid2_add)) .and.
+     &                           (grid1_bound_box(2,grid1_add) >= 
+     &                            grid2_bound_box(1,grid2_add)) .and.
+     &                           (grid1_bound_box(3,grid1_add) <= 
+     &                            grid2_bound_box(4,grid2_add)) .and.
+     &                           (grid1_bound_box(4,grid1_add) >= 
+     &                            grid2_bound_box(3,grid2_add))
+
+          if (srch_mask(grid1_add)) num_srch_cells = num_srch_cells+1
+        end do
+
+        allocate(srch_add(num_srch_cells),
+     &           srch_corner_lat(grid1_corners,num_srch_cells),
+     &           srch_corner_lon(grid1_corners,num_srch_cells))
+
+        n = 0
+        gather2: do grid1_add = min_add,max_add
+          if (srch_mask(grid1_add)) then
+            n = n+1
+            srch_add(n) = grid1_add
+            srch_corner_lat(:,n) = grid1_corner_lat(:,grid1_add)
+            srch_corner_lon(:,n) = grid1_corner_lon(:,grid1_add)
+          endif
+        end do gather2
+        call timer_stop(5)
+
+        !***
+        !*** integrate around this cell
+        !***
+
+        do corner = 1,grid2_corners
+          next_corn = mod(corner,grid2_corners) + 1
+
+          beglat = grid2_corner_lat(corner,grid2_add)
+          beglon = grid2_corner_lon(corner,grid2_add)
+          endlat = grid2_corner_lat(next_corn,grid2_add)
+          endlon = grid2_corner_lon(next_corn,grid2_add)
+          lrevers = .false.
+
+          !***
+          !*** to ensure exact path taken during both
+          !*** sweeps, always integrate in the same direction
+          !***
+
+          if ((endlat < beglat) .or.
+     &        (endlat == beglat .and. endlon < beglon)) then 
+            beglat = grid2_corner_lat(next_corn,grid2_add)
+            beglon = grid2_corner_lon(next_corn,grid2_add)
+            endlat = grid2_corner_lat(corner,grid2_add)
+            endlon = grid2_corner_lon(corner,grid2_add)
+            lrevers = .true.
+          endif
+
+          begseg(1) = beglat
+          begseg(2) = beglon
+          lbegin = .true.
+
+          !***
+          !*** if this is a constant-longitude segment, skip the rest 
+          !*** since the line integral contribution will be zero.
+          !***
+
+          if (endlon /= beglon) then
+          num_subseg = 0
+
+          !***
+          !*** integrate along this segment, detecting intersections 
+          !*** and computing the line integral for each sub-segment
+          !***
+
+          do while (beglat /= endlat .or. beglon /= endlon)
+
+            !***
+            !*** prevent infinite loops if integration gets stuck
+            !*** near cell or threshold boundary
+            !***
+
+            num_subseg = num_subseg + 1
+            if (num_subseg > max_subseg) then
+              stop 'integration stalled: num_subseg exceeded limit'
+            endif
+
+            !***
+            !*** find next intersection of this segment with a line 
+            !*** on grid 2.
+            !***
+
+            call timer_start(6)
+            call intersection(grid1_add,intrsct_lat,intrsct_lon,lcoinc,
+     &                        beglat, beglon, endlat, endlon, begseg,
+     &                        lbegin, lrevers)
+            call timer_stop(6)
+            lbegin = .false.
+
+            !***
+            !*** compute line integral for this subsegment.
+            !***
+
+            call timer_start(7)
+            if (grid1_add /= 0) then
+              call line_integral(weights, num_wts,
+     &                         beglon, intrsct_lon, beglat, intrsct_lat,
+     &                         grid1_center_lat(grid1_add), 
+     &                         grid1_center_lon(grid1_add),
+     &                         grid2_center_lat(grid2_add), 
+     &                         grid2_center_lon(grid2_add))
+            else
+              call line_integral(weights, num_wts,
+     &                         beglon, intrsct_lon, beglat, intrsct_lat,
+     &                         grid2_center_lat(grid2_add), 
+     &                         grid2_center_lon(grid2_add),
+     &                         grid2_center_lat(grid2_add), 
+     &                         grid2_center_lon(grid2_add))
+            endif
+            call timer_stop(7)
+
+            if (lrevers) then
+              weights = -weights
+            endif
+
+            !***
+            !*** store the appropriate addresses and weights. 
+            !*** also add contributions to cell areas and centroids.
+            !*** if there is a coincidence, do not store weights
+            !*** because they have been captured in the previous loop.
+            !*** the grid1 mask is the master mask
+            !***
+
+            !if (grid1_add == 119247) then
+            !  print *,grid1_add,grid2_add,corner,weights(1)
+            !  print *,grid1_corner_lat(:,grid1_add)
+            !  print *,grid1_corner_lon(:,grid1_add)
+            !  print *,grid2_corner_lat(:,grid2_add)
+            !  print *,grid2_corner_lon(:,grid2_add)
+            !  print *,beglat,beglon,intrsct_lat,intrsct_lon
+            !endif
+
+            if (.not. lcoinc .and. grid1_add /= 0) then
+              if (grid1_mask(grid1_add)) then
+                call timer_start(8)
+                call store_link_cnsrv(grid1_add, grid2_add, weights)
+                call timer_stop(8)
+                grid1_frac(grid1_add) = grid1_frac(grid1_add) + 
+     &                                  weights(1)
+                grid2_frac(grid2_add) = grid2_frac(grid2_add) + 
+     &                                  weights(num_wts+1)
+              endif
+
+            endif
+
+            grid2_area(grid2_add) = grid2_area(grid2_add) + 
+     &                                      weights(num_wts+1)
+            grid2_centroid_lat(grid2_add) = 
+     &      grid2_centroid_lat(grid2_add) + weights(num_wts+2)
+            grid2_centroid_lon(grid2_add) = 
+     &      grid2_centroid_lon(grid2_add) + weights(num_wts+3)
+
+            !***
+            !*** reset beglat and beglon for next subsegment.
+            !***
+
+            beglat = intrsct_lat
+            beglon = intrsct_lon
+          end do
+
+          endif
+
+          !***
+          !*** end of segment
+          !***
+
+        end do
+
+        !***
+        !*** finished with this cell: deallocate search array and
+        !*** start on next cell
+
+        deallocate(srch_add, srch_corner_lat, srch_corner_lon)
+
+      end do
+
+      deallocate(srch_mask)
+
+!-----------------------------------------------------------------------
+!
+!     correct for situations where N/S pole not explicitly included in
+!     grid (i.e. as a grid corner point). if pole is missing from only
+!     one grid, need to correct only the area and centroid of that 
+!     grid.  if missing from both, do complete weight calculation.
+!
+!-----------------------------------------------------------------------
+
+      !*** North Pole
+      weights(1) =  pi2
+      weights(2) =  pi*pi
+      weights(3) =  zero
+      weights(4) =  pi2
+      weights(5) =  pi*pi
+      weights(6) =  zero
+
+      grid1_add = 0
+      pole_loop1: do n=1,grid1_size
+        if (grid1_area(n) < -three*pih .and.
+     &      grid1_center_lat(n) > zero) then
+          grid1_add = n
+          exit pole_loop1
+        endif
+      end do pole_loop1
+
+      grid2_add = 0
+      pole_loop2: do n=1,grid2_size
+        if (grid2_area(n) < -three*pih .and.
+     &      grid2_center_lat(n) > zero) then
+          grid2_add = n
+          exit pole_loop2
+        endif
+      end do pole_loop2
+
+      if (grid1_add /=0) then
+        grid1_area(grid1_add) = grid1_area(grid1_add) + weights(1)
+        grid1_centroid_lat(grid1_add) = 
+     &  grid1_centroid_lat(grid1_add) + weights(2)
+        grid1_centroid_lon(grid1_add) =
+     &  grid1_centroid_lon(grid1_add) + weights(3)
+      endif
+
+      if (grid2_add /=0) then
+        grid2_area(grid2_add) = grid2_area(grid2_add) + 
+     &                                  weights(num_wts+1)
+        grid2_centroid_lat(grid2_add) = 
+     &  grid2_centroid_lat(grid2_add) + weights(num_wts+2)
+        grid2_centroid_lon(grid2_add) =
+     &  grid2_centroid_lon(grid2_add) + weights(num_wts+3)
+      endif
+
+      if (grid1_add /= 0 .and. grid2_add /=0) then
+        call store_link_cnsrv(grid1_add, grid2_add, weights)
+
+        grid1_frac(grid1_add) = grid1_frac(grid1_add) + 
+     &                          weights(1)
+        grid2_frac(grid2_add) = grid2_frac(grid2_add) + 
+     &                          weights(num_wts+1)
+      endif
+
+      !*** South Pole
+      weights(1) =  pi2
+      weights(2) = -pi*pi
+      weights(3) =  zero
+      weights(4) =  pi2
+      weights(5) = -pi*pi
+      weights(6) =  zero
+
+      grid1_add = 0
+      pole_loop3: do n=1,grid1_size
+        if (grid1_area(n) < -three*pih .and.
+     &      grid1_center_lat(n) < zero) then
+          grid1_add = n
+          exit pole_loop3
+        endif
+      end do pole_loop3
+
+      grid2_add = 0
+      pole_loop4: do n=1,grid2_size
+        if (grid2_area(n) < -three*pih .and.
+     &      grid2_center_lat(n) < zero) then
+          grid2_add = n
+          exit pole_loop4
+        endif
+      end do pole_loop4
+
+      if (grid1_add /=0) then
+        grid1_area(grid1_add) = grid1_area(grid1_add) + weights(1)
+        grid1_centroid_lat(grid1_add) = 
+     &  grid1_centroid_lat(grid1_add) + weights(2)
+        grid1_centroid_lon(grid1_add) =
+     &  grid1_centroid_lon(grid1_add) + weights(3)
+      endif
+
+      if (grid2_add /=0) then
+        grid2_area(grid2_add) = grid2_area(grid2_add) + 
+     &                                  weights(num_wts+1)
+        grid2_centroid_lat(grid2_add) = 
+     &  grid2_centroid_lat(grid2_add) + weights(num_wts+2)
+        grid2_centroid_lon(grid2_add) =
+     &  grid2_centroid_lon(grid2_add) + weights(num_wts+3)
+      endif
+
+      if (grid1_add /= 0 .and. grid2_add /=0) then
+        call store_link_cnsrv(grid1_add, grid2_add, weights)
+
+        grid1_frac(grid1_add) = grid1_frac(grid1_add) + 
+     &                          weights(1)
+        grid2_frac(grid2_add) = grid2_frac(grid2_add) + 
+     &                          weights(num_wts+1)
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     finish centroid computation
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_area /= zero)
+        grid1_centroid_lat = grid1_centroid_lat/grid1_area
+        grid1_centroid_lon = grid1_centroid_lon/grid1_area
+      end where
+
+      where (grid2_area /= zero)
+        grid2_centroid_lat = grid2_centroid_lat/grid2_area
+        grid2_centroid_lon = grid2_centroid_lon/grid2_area
+      end where
+
+!-----------------------------------------------------------------------
+!
+!     include centroids in weights and normalize using destination
+!     area if requested
+!
+!-----------------------------------------------------------------------
+
+      do n=1,num_links_map1
+        grid1_add = grid1_add_map1(n)
+        grid2_add = grid2_add_map1(n)
+        do nwgt=1,num_wts
+          weights(        nwgt) = wts_map1(nwgt,n)
+          if (num_maps > 1) then
+            weights(num_wts+nwgt) = wts_map2(nwgt,n)
+          endif
+        end do
+
+        select case(norm_opt)
+        case (norm_opt_dstarea)
+          if (grid2_area(grid2_add) /= zero) then
+            if (luse_grid2_area) then
+              norm_factor = one/grid2_area_in(grid2_add)
+            else
+              norm_factor = one/grid2_area(grid2_add)
+            endif
+          else
+            norm_factor = zero
+          endif
+        case (norm_opt_frcarea)
+          if (grid2_frac(grid2_add) /= zero) then
+            if (luse_grid2_area) then
+              norm_factor = grid2_area(grid2_add)/
+     &                     (grid2_frac(grid2_add)*
+     &                      grid2_area_in(grid2_add))
+            else
+              norm_factor = one/grid2_frac(grid2_add)
+            endif
+          else
+            norm_factor = zero
+          endif
+        case (norm_opt_none)
+          norm_factor = one
+        end select
+
+        wts_map1(1,n) =  weights(1)*norm_factor
+        wts_map1(2,n) = (weights(2) - weights(1)*
+     &                              grid1_centroid_lat(grid1_add))*
+     &                              norm_factor
+        wts_map1(3,n) = (weights(3) - weights(1)*
+     &                              grid1_centroid_lon(grid1_add))*
+     &                              norm_factor
+
+        if (num_maps > 1) then
+          select case(norm_opt)
+          case (norm_opt_dstarea)
+            if (grid1_area(grid1_add) /= zero) then
+              if (luse_grid1_area) then
+                norm_factor = one/grid1_area_in(grid1_add)
+              else
+                norm_factor = one/grid1_area(grid1_add)
+              endif
+            else
+              norm_factor = zero
+            endif
+          case (norm_opt_frcarea)
+            if (grid1_frac(grid1_add) /= zero) then
+              if (luse_grid1_area) then
+                norm_factor = grid1_area(grid1_add)/
+     &                       (grid1_frac(grid1_add)*
+     &                        grid1_area_in(grid1_add))
+              else
+                norm_factor = one/grid1_frac(grid1_add)
+              endif
+            else
+              norm_factor = zero
+            endif
+          case (norm_opt_none)
+            norm_factor = one
+          end select
+
+          wts_map2(1,n) =  weights(num_wts+1)*norm_factor
+          wts_map2(2,n) = (weights(num_wts+2) - weights(num_wts+1)*
+     &                                grid2_centroid_lat(grid2_add))*
+     &                                norm_factor
+          wts_map2(3,n) = (weights(num_wts+3) - weights(num_wts+1)*
+     &                                grid2_centroid_lon(grid2_add))*
+     &                                norm_factor
+        endif
+
+      end do
+
+      print *, 'Total number of links = ',num_links_map1
+
+      where (grid1_area /= zero) grid1_frac = grid1_frac/grid1_area
+      where (grid2_area /= zero) grid2_frac = grid2_frac/grid2_area
+
+!-----------------------------------------------------------------------
+!
+!     perform some error checking on final weights
+!
+!-----------------------------------------------------------------------
+
+      grid2_centroid_lat = zero
+      grid2_centroid_lon = zero
+
+      do n=1,grid1_size
+        if (grid1_area(n) < -.01) then
+          print *,'Grid 1 area error: ',n,grid1_area(n)
+        endif
+        if (grid1_centroid_lat(n) < -pih-.01 .or.
+     &      grid1_centroid_lat(n) >  pih+.01) then
+          print *,'Grid 1 centroid lat error: ',n,grid1_centroid_lat(n)
+        endif
+        grid1_centroid_lat(n) = zero
+        grid1_centroid_lon(n) = zero
+      end do
+
+      do n=1,grid2_size
+        if (grid2_area(n) < -.01) then
+          print *,'Grid 2 area error: ',n,grid2_area(n)
+        endif
+        if (grid2_centroid_lat(n) < -pih-.01 .or.
+     &      grid2_centroid_lat(n) >  pih+.01) then
+          print *,'Grid 2 centroid lat error: ',n,grid2_centroid_lat(n)
+        endif
+        grid2_centroid_lat(n) = zero
+        grid2_centroid_lon(n) = zero
+      end do
+
+      do n=1,num_links_map1
+        grid1_add = grid1_add_map1(n)
+        grid2_add = grid2_add_map1(n)
+        
+        if (wts_map1(1,n) < -.01) then
+          print *,'Map 1 weight < 0 ',grid1_add,grid2_add,wts_map1(1,n)
+        endif
+        if (norm_opt /= norm_opt_none .and. wts_map1(1,n) > 1.01) then
+          print *,'Map 1 weight > 1 ',grid1_add,grid2_add,wts_map1(1,n)
+        endif
+        grid2_centroid_lat(grid2_add) = 
+     &  grid2_centroid_lat(grid2_add) + wts_map1(1,n)
+
+        if (num_maps > 1) then
+          if (wts_map2(1,n) < -.01) then
+            print *,'Map 2 weight < 0 ',grid1_add,grid2_add,
+     &                                  wts_map2(1,n)
+          endif
+          if (norm_opt /= norm_opt_none .and. wts_map2(1,n) > 1.01) then
+            print *,'Map 2 weight < 0 ',grid1_add,grid2_add,
+     &                                  wts_map2(1,n)
+          endif
+          grid1_centroid_lat(grid1_add) = 
+     &    grid1_centroid_lat(grid1_add) + wts_map2(1,n)
+        endif
+      end do
+
+      do n=1,grid2_size
+        select case(norm_opt)
+        case (norm_opt_dstarea)
+          norm_factor = grid2_frac(grid2_add)
+        case (norm_opt_frcarea)
+          norm_factor = one
+        case (norm_opt_none)
+          if (luse_grid2_area) then
+            norm_factor = grid2_area_in(grid2_add)
+          else
+            norm_factor = grid2_area(grid2_add)
+          endif
+        end select
+        if (abs(grid2_centroid_lat(grid2_add)-norm_factor) > .01) then
+          print *,'Error: sum of wts for map1 ',grid2_add,
+     &            grid2_centroid_lat(grid2_add),norm_factor
+        endif
+      end do
+
+      if (num_maps > 1) then
+        do n=1,grid1_size
+          select case(norm_opt)
+          case (norm_opt_dstarea)
+            norm_factor = grid1_frac(grid1_add)
+          case (norm_opt_frcarea)
+            norm_factor = one
+          case (norm_opt_none)
+            if (luse_grid1_area) then
+              norm_factor = grid1_area_in(grid1_add)
+            else
+              norm_factor = grid1_area(grid1_add)
+            endif
+          end select
+          if (abs(grid1_centroid_lat(grid1_add)-norm_factor) > .01) then
+            print *,'Error: sum of wts for map2 ',grid1_add,
+     &              grid1_centroid_lat(grid1_add),norm_factor
+          endif
+        end do
+      endif
+!-----------------------------------------------------------------------
+
+      end subroutine remap_conserv
+
+!***********************************************************************
+
+      subroutine intersection(location,intrsct_lat,intrsct_lon,lcoinc,
+     &                        beglat, beglon, endlat, endlon, begseg,
+     &                        lbegin, lrevers)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the next intersection of a destination grid 
+!     line with the line segment given by beglon, endlon, etc.
+!     a coincidence flag is returned if the segment is entirely 
+!     coincident with an ocean grid line.  the cells in which to search
+!     for an intersection must have already been restricted in the
+!     calling routine.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     intent(in): 
+!
+!-----------------------------------------------------------------------
+
+      logical (kind=log_kind), intent(in) ::
+     &     lbegin, ! flag for first integration along this segment
+     &     lrevers ! flag whether segment integrated in reverse
+
+      real (kind=dbl_kind), intent(in) :: 
+     &     beglat, beglon,  ! beginning lat/lon endpoints for segment
+     &     endlat, endlon   ! ending    lat/lon endpoints for segment
+
+      real (kind=dbl_kind), dimension(2), intent(inout) :: 
+     &     begseg ! begin lat/lon of full segment
+
+!-----------------------------------------------------------------------
+!
+!     intent(out): 
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(out) ::
+     &        location  ! address in destination array containing this
+                        ! segment
+
+      logical (kind=log_kind), intent(out) ::
+     &        lcoinc    ! flag segments which are entirely coincident
+                        ! with a grid line
+
+      real (kind=dbl_kind), intent(out) ::
+     &     intrsct_lat, intrsct_lon ! lat/lon coords of next intersect.
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, cell, srch_corners, pole_loc
+
+      integer (kind=int_kind), save :: 
+     &     last_loc  ! save location when crossing threshold
+
+      logical (kind=log_kind) :: 
+     &     loutside  ! flags points outside grid
+
+      logical (kind=log_kind), save :: 
+     &     lthresh = .false.  ! flags segments crossing threshold bndy
+
+      real (kind=dbl_kind) ::
+     &     lon1, lon2,       ! local longitude variables for segment
+     &     lat1, lat2,       ! local latitude  variables for segment
+     &     grdlon1, grdlon2, ! local longitude variables for grid cell
+     &     grdlat1, grdlat2, ! local latitude  variables for grid cell
+     &     vec1_lat, vec1_lon, ! vectors and cross products used
+     &     vec2_lat, vec2_lon, ! during grid search
+     &     cross_product, 
+     &     eps, offset,        ! small offset away from intersect
+     &     s1, s2, determ,     ! variables used for linear solve to
+     &     mat1, mat2, mat3, mat4, rhs1, rhs2  ! find intersection
+
+      real (kind=dbl_kind), save ::
+     &     intrsct_lat_off, intrsct_lon_off ! lat/lon coords offset 
+                                            ! for next search
+
+!-----------------------------------------------------------------------
+!
+!     initialize defaults, flags, etc.
+!
+!-----------------------------------------------------------------------
+
+      location = 0
+      lcoinc = .false.
+      intrsct_lat = endlat
+      intrsct_lon = endlon
+
+      if (num_srch_cells == 0) return
+
+      if (beglat > north_thresh .or. beglat < south_thresh) then
+
+        if (lthresh) location = last_loc
+        call pole_intersection(location,
+     &               intrsct_lat,intrsct_lon,lcoinc,lthresh,
+     &               beglat, beglon, endlat, endlon, begseg, lrevers)
+        if (lthresh) then
+          last_loc = location
+          intrsct_lat_off = intrsct_lat
+          intrsct_lon_off = intrsct_lon
+        endif
+        return
+
+      endif
+
+      loutside = .false.
+      if (lbegin) then
+        lat1 = beglat
+        lon1 = beglon
+      else
+        lat1 = intrsct_lat_off
+        lon1 = intrsct_lon_off
+      endif
+      lat2 = endlat
+      lon2 = endlon
+      if ((lon2-lon1) > three*pih) then
+        lon2 = lon2 - pi2
+      else if ((lon2-lon1) < -three*pih) then
+        lon2 = lon2 + pi2
+      endif
+      s1 = zero
+
+!-----------------------------------------------------------------------
+!
+!     search for location of this segment in ocean grid using cross
+!     product method to determine whether a point is enclosed by a cell
+!
+!-----------------------------------------------------------------------
+
+      call timer_start(12)
+      srch_corners = size(srch_corner_lat,DIM=1)
+      srch_loop: do
+
+        !***
+        !*** if last segment crossed threshold, use that location
+        !***
+
+        if (lthresh) then
+          do cell=1,num_srch_cells
+            if (srch_add(cell) == last_loc) then
+              location = last_loc
+              eps = tiny
+              exit srch_loop
+            endif
+          end do
+        endif
+
+        !***
+        !*** otherwise normal search algorithm
+        !***
+
+        cell_loop: do cell=1,num_srch_cells
+          corner_loop: do n=1,srch_corners
+            next_n = MOD(n,srch_corners) + 1
+
+            !***
+            !*** here we take the cross product of the vector making 
+            !*** up each cell side with the vector formed by the vertex
+            !*** and search point.  if all the cross products are 
+            !*** positive, the point is contained in the cell.
+            !***
+
+            vec1_lat = srch_corner_lat(next_n,cell) - 
+     &                 srch_corner_lat(n     ,cell)
+            vec1_lon = srch_corner_lon(next_n,cell) - 
+     &                 srch_corner_lon(n     ,cell)
+            vec2_lat = lat1 - srch_corner_lat(n,cell)
+            vec2_lon = lon1 - srch_corner_lon(n,cell)
+
+            !***
+            !*** if endpoint coincident with vertex, offset
+            !*** the endpoint
+            !***
+
+            if (vec2_lat == 0 .and. vec2_lon == 0) then
+              lat1 = lat1 + 1.d-10*(lat2-lat1)
+              lon1 = lon1 + 1.d-10*(lon2-lon1)
+              vec2_lat = lat1 - srch_corner_lat(n,cell)
+              vec2_lon = lon1 - srch_corner_lon(n,cell)
+            endif
+
+            !***
+            !*** check for 0,2pi crossings
+            !***
+
+            if (vec1_lon >  pi) then
+              vec1_lon = vec1_lon - pi2
+            else if (vec1_lon < -pi) then
+              vec1_lon = vec1_lon + pi2
+            endif
+            if (vec2_lon >  pi) then
+              vec2_lon = vec2_lon - pi2
+            else if (vec2_lon < -pi) then
+              vec2_lon = vec2_lon + pi2
+            endif
+
+            cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+
+            !***
+            !*** if the cross product for a side is zero, the point 
+            !***   lies exactly on the side or the side is degenerate
+            !***   (zero length).  if degenerate, set the cross 
+            !***   product to a positive number.  otherwise perform 
+            !***   another cross product between the side and the 
+            !***   segment itself. 
+            !*** if this cross product is also zero, the line is 
+            !***   coincident with the cell boundary - perform the 
+            !***   dot product and only choose the cell if the dot 
+            !***   product is positive (parallel vs anti-parallel).
+            !***
+
+            if (cross_product == zero) then
+              if (vec1_lat /= zero .or. vec1_lon /= zero) then
+                vec2_lat = lat2 - lat1
+                vec2_lon = lon2 - lon1
+
+                if (vec2_lon >  pi) then
+                  vec2_lon = vec2_lon - pi2
+                else if (vec2_lon < -pi) then
+                  vec2_lon = vec2_lon + pi2
+                endif
+
+                cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+              else
+                cross_product = one
+              endif
+
+              if (cross_product == zero) then
+                lcoinc = .true.
+                cross_product = vec1_lon*vec2_lon + vec1_lat*vec2_lat
+                if (lrevers) cross_product = -cross_product
+              endif
+            endif
+
+            !***
+            !*** if cross product is less than zero, this cell
+            !*** doesn't work
+            !***
+
+            if (cross_product < zero) exit corner_loop
+
+          end do corner_loop
+
+          !***
+          !*** if cross products all positive, we found the location
+          !***
+
+          if (n > srch_corners) then
+            location = srch_add(cell)
+
+            !***
+            !*** if the beginning of this segment was outside the
+            !*** grid, invert the segment so the intersection found
+            !*** will be the first intersection with the grid
+            !***
+
+            if (loutside) then
+              lat2 = beglat
+              lon2 = beglon
+              location = 0
+              eps  = -tiny
+            else
+              eps  = tiny
+            endif
+
+            exit srch_loop
+          endif
+
+          !***
+          !*** otherwise move on to next cell
+          !***
+
+        end do cell_loop
+
+        !***
+        !*** if still no cell found, the point lies outside the grid.
+        !***   take some baby steps along the segment to see if any
+        !***   part of the segment lies inside the grid.  
+        !***
+
+        loutside = .true.
+        s1 = s1 + 0.001_dbl_kind
+        lat1 = beglat + s1*(endlat - beglat)
+        lon1 = beglon + s1*(lon2   - beglon)
+
+        !***
+        !*** reached the end of the segment and still outside the grid
+        !*** return no intersection
+        !***
+
+        if (s1 >= one) return
+
+      end do srch_loop
+      call timer_stop(12)
+
+!-----------------------------------------------------------------------
+!
+!     now that a cell is found, search for the next intersection.
+!     loop over sides of the cell to find intersection with side
+!     must check all sides for coincidences or intersections
+!
+!-----------------------------------------------------------------------
+
+      call timer_start(13)
+      intrsct_loop: do n=1,srch_corners
+        next_n = mod(n,srch_corners) + 1
+
+        grdlon1 = srch_corner_lon(n     ,cell)
+        grdlon2 = srch_corner_lon(next_n,cell)
+        grdlat1 = srch_corner_lat(n     ,cell)
+        grdlat2 = srch_corner_lat(next_n,cell)
+
+        !***
+        !*** set up linear system to solve for intersection
+        !***
+
+        mat1 = lat2 - lat1
+        mat2 = grdlat1 - grdlat2
+        mat3 = lon2 - lon1
+        mat4 = grdlon1 - grdlon2
+        rhs1 = grdlat1 - lat1
+        rhs2 = grdlon1 - lon1
+
+        if (mat3 >  pi) then
+          mat3 = mat3 - pi2
+        else if (mat3 < -pi) then
+          mat3 = mat3 + pi2
+        endif
+        if (mat4 >  pi) then
+          mat4 = mat4 - pi2
+        else if (mat4 < -pi) then
+          mat4 = mat4 + pi2
+        endif
+        if (rhs2 >  pi) then
+          rhs2 = rhs2 - pi2
+        else if (rhs2 < -pi) then
+          rhs2 = rhs2 + pi2
+        endif
+
+        determ = mat1*mat4 - mat2*mat3
+
+        !***
+        !*** if the determinant is zero, the segments are either 
+        !***   parallel or coincident.  coincidences were detected 
+        !***   above so do nothing.
+        !*** if the determinant is non-zero, solve for the linear 
+        !***   parameters s for the intersection point on each line 
+        !***   segment.
+        !*** if 0<s1,s2<1 then the segment intersects with this side.
+        !***   return the point of intersection (adding a small
+        !***   number so the intersection is off the grid line).
+        !***
+
+        if (abs(determ) > 1.e-30) then
+
+          s1 = (rhs1*mat4 - mat2*rhs2)/determ
+          s2 = (mat1*rhs2 - rhs1*mat3)/determ
+
+          if (s2 >= zero .and. s2 <= one .and.
+     &        s1 >  zero. and. s1 <= one) then
+
+            !***
+            !*** recompute intersection based on full segment
+            !*** so intersections are consistent for both sweeps
+            !***
+
+            if (.not. loutside) then
+              mat1 = lat2 - begseg(1)
+              mat3 = lon2 - begseg(2)
+              rhs1 = grdlat1 - begseg(1)
+              rhs2 = grdlon1 - begseg(2)
+            else
+              mat1 = begseg(1) - endlat
+              mat3 = begseg(2) - endlon
+              rhs1 = grdlat1 - endlat
+              rhs2 = grdlon1 - endlon
+            endif
+
+            if (mat3 >  pi) then
+              mat3 = mat3 - pi2
+            else if (mat3 < -pi) then
+              mat3 = mat3 + pi2
+            endif
+            if (rhs2 >  pi) then
+              rhs2 = rhs2 - pi2
+            else if (rhs2 < -pi) then
+              rhs2 = rhs2 + pi2
+            endif
+
+            determ = mat1*mat4 - mat2*mat3
+
+            !***
+            !*** sometimes due to roundoff, the previous 
+            !*** determinant is non-zero, but the lines
+            !*** are actually coincident.  if this is the
+            !*** case, skip the rest.
+            !***
+
+            if (determ /= zero) then
+              s1 = (rhs1*mat4 - mat2*rhs2)/determ
+              s2 = (mat1*rhs2 - rhs1*mat3)/determ
+
+              offset = s1 + eps/determ
+              if (offset > one) offset = one
+
+              if (.not. loutside) then
+                intrsct_lat = begseg(1) + mat1*s1
+                intrsct_lon = begseg(2) + mat3*s1
+                intrsct_lat_off = begseg(1) + mat1*offset
+                intrsct_lon_off = begseg(2) + mat3*offset
+              else
+                intrsct_lat = endlat + mat1*s1
+                intrsct_lon = endlon + mat3*s1
+                intrsct_lat_off = endlat + mat1*offset
+                intrsct_lon_off = endlon + mat3*offset
+              endif
+              exit intrsct_loop
+            endif
+
+          endif
+        endif
+
+        !***
+        !*** no intersection this side, move on to next side
+        !***
+
+      end do intrsct_loop
+      call timer_stop(13)
+
+!-----------------------------------------------------------------------
+!
+!     if the segment crosses a pole threshold, reset the intersection
+!     to be the threshold latitude.  only check if this was not a
+!     threshold segment since sometimes coordinate transform can end
+!     up on other side of threshold again.
+!
+!-----------------------------------------------------------------------
+
+      if (lthresh) then
+        if (intrsct_lat < north_thresh .or. intrsct_lat > south_thresh)
+     &      lthresh = .false.
+      else if (lat1 > zero .and. intrsct_lat > north_thresh) then
+        intrsct_lat = north_thresh + tiny
+        intrsct_lat_off = north_thresh + eps*mat1
+        s1 = (intrsct_lat - begseg(1))/mat1
+        intrsct_lon     = begseg(2) + s1*mat3
+        intrsct_lon_off = begseg(2) + (s1+eps)*mat3
+        last_loc = location
+        lthresh = .true.
+      else if (lat1 < zero .and. intrsct_lat < south_thresh) then
+        intrsct_lat = south_thresh - tiny
+        intrsct_lat_off = south_thresh + eps*mat1
+        s1 = (intrsct_lat - begseg(1))/mat1
+        intrsct_lon     = begseg(2) + s1*mat3
+        intrsct_lon_off = begseg(2) + (s1+eps)*mat3
+        last_loc = location
+        lthresh = .true.
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine intersection
+
+!***********************************************************************
+
+      subroutine pole_intersection(location,
+     &                 intrsct_lat,intrsct_lon,lcoinc,lthresh,
+     &                 beglat, beglon, endlat, endlon, begseg, lrevers)
+
+!-----------------------------------------------------------------------
+!
+!     this routine is identical to the intersection routine except
+!     that a coordinate transformation (using a Lambert azimuthal
+!     equivalent projection) is performed to treat polar cells more
+!     accurately.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     intent(in): 
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), intent(in) :: 
+     &     beglat, beglon,  ! beginning lat/lon endpoints for segment
+     &     endlat, endlon   ! ending    lat/lon endpoints for segment
+
+      real (kind=dbl_kind), dimension(2), intent(inout) :: 
+     &     begseg ! begin lat/lon of full segment
+
+      logical (kind=log_kind), intent(in) ::
+     &        lrevers   ! flag true if segment integrated in reverse
+
+!-----------------------------------------------------------------------
+!
+!     intent(out): 
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(inout) ::
+     &        location  ! address in destination array containing this
+                        ! segment -- also may contain last location on
+                        ! entry
+
+      logical (kind=log_kind), intent(out) ::
+     &        lcoinc    ! flag segment coincident with grid line
+
+      logical (kind=log_kind), intent(inout) ::
+     &        lthresh   ! flag segment crossing threshold boundary
+
+      real (kind=dbl_kind), intent(out) ::
+     &     intrsct_lat, intrsct_lon ! lat/lon coords of next intersect.
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, cell, srch_corners, pole_loc
+
+      logical (kind=log_kind) :: loutside ! flags points outside grid
+
+      real (kind=dbl_kind) :: pi4, rns, ! north/south conversion
+     &     x1, x2,       ! local x variables for segment
+     &     y1, y2,       ! local y variables for segment
+     &     begx, begy,   ! beginning x,y variables for segment
+     &     endx, endy,   ! beginning x,y variables for segment
+     &     begsegx, begsegy,   ! beginning x,y variables for segment
+     &     grdx1, grdx2, ! local x variables for grid cell
+     &     grdy1, grdy2, ! local y variables for grid cell
+     &     vec1_y, vec1_x, ! vectors and cross products used
+     &     vec2_y, vec2_x, ! during grid search
+     &     cross_product, eps, ! eps=small offset away from intersect
+     &     s1, s2, determ,     ! variables used for linear solve to
+     &     mat1, mat2, mat3, mat4, rhs1, rhs2  ! find intersection
+
+      real (kind=dbl_kind), dimension(:,:), allocatable ::
+     &     srch_corner_x,  ! x of each corner of srch cells
+     &     srch_corner_y   ! y of each corner of srch cells
+
+      !***
+      !*** save last intersection to avoid roundoff during coord
+      !*** transformation
+      !***
+
+      logical (kind=log_kind), save :: luse_last = .false.
+
+      real (kind=dbl_kind), save :: 
+     &     intrsct_x, intrsct_y  ! x,y for intersection
+
+      !***
+      !*** variables necessary if segment manages to hit pole
+      !***
+
+      integer (kind=int_kind), save :: 
+     &     avoid_pole_count = 0  ! count attempts to avoid pole
+
+      real (kind=dbl_kind), save :: 
+     &     avoid_pole_offset = tiny  ! endpoint offset to avoid pole
+
+!-----------------------------------------------------------------------
+!
+!     initialize defaults, flags, etc.
+!
+!-----------------------------------------------------------------------
+
+      if (.not. lthresh) location = 0
+      lcoinc = .false.
+      intrsct_lat = endlat
+      intrsct_lon = endlon
+
+      loutside = .false.
+      s1 = zero
+
+!-----------------------------------------------------------------------
+!
+!     convert coordinates
+!
+!-----------------------------------------------------------------------
+
+      allocate(srch_corner_x(size(srch_corner_lat,DIM=1),
+     &                       size(srch_corner_lat,DIM=2)),
+     &         srch_corner_y(size(srch_corner_lat,DIM=1),
+     &                       size(srch_corner_lat,DIM=2)))
+
+      if (beglat > zero) then
+        pi4 = quart*pi
+        rns = one
+      else
+        pi4 = -quart*pi
+        rns = -one
+      endif
+
+      if (luse_last) then
+        x1 = intrsct_x
+        y1 = intrsct_y
+      else
+        x1 = rns*two*sin(pi4 - half*beglat)*cos(beglon)
+        y1 =     two*sin(pi4 - half*beglat)*sin(beglon)
+        luse_last = .true.
+      endif
+      x2 = rns*two*sin(pi4 - half*endlat)*cos(endlon)
+      y2 =     two*sin(pi4 - half*endlat)*sin(endlon)
+      srch_corner_x = rns*two*sin(pi4 - half*srch_corner_lat)*
+     &                        cos(srch_corner_lon)
+      srch_corner_y =     two*sin(pi4 - half*srch_corner_lat)*
+     &                        sin(srch_corner_lon)
+
+      begx = x1
+      begy = y1
+      endx = x2
+      endy = y2
+      begsegx = rns*two*sin(pi4 - half*begseg(1))*cos(begseg(2))
+      begsegy =     two*sin(pi4 - half*begseg(1))*sin(begseg(2))
+      intrsct_x = endx
+      intrsct_y = endy
+
+!-----------------------------------------------------------------------
+!
+!     search for location of this segment in ocean grid using cross
+!     product method to determine whether a point is enclosed by a cell
+!
+!-----------------------------------------------------------------------
+
+      call timer_start(12)
+      srch_corners = size(srch_corner_lat,DIM=1)
+      srch_loop: do
+
+        !***
+        !*** if last segment crossed threshold, use that location
+        !***
+
+        if (lthresh) then
+          do cell=1,num_srch_cells
+            if (srch_add(cell) == location) then
+              eps = tiny
+              exit srch_loop
+            endif
+          end do
+        endif
+
+        !***
+        !*** otherwise normal search algorithm
+        !***
+
+        cell_loop: do cell=1,num_srch_cells
+          corner_loop: do n=1,srch_corners
+            next_n = MOD(n,srch_corners) + 1
+
+            !***
+            !*** here we take the cross product of the vector making 
+            !*** up each cell side with the vector formed by the vertex
+            !*** and search point.  if all the cross products are 
+            !*** positive, the point is contained in the cell.
+            !***
+
+            vec1_x = srch_corner_x(next_n,cell) - 
+     &               srch_corner_x(n     ,cell)
+            vec1_y = srch_corner_y(next_n,cell) - 
+     &               srch_corner_y(n     ,cell)
+            vec2_x = x1 - srch_corner_x(n,cell)
+            vec2_y = y1 - srch_corner_y(n,cell)
+
+            !***
+            !*** if endpoint coincident with vertex, offset
+            !*** the endpoint
+            !***
+
+            if (vec2_x == 0 .and. vec2_y == 0) then
+              x1 = x1 + 1.d-10*(x2-x1)
+              y1 = y1 + 1.d-10*(y2-y1)
+              vec2_x = x1 - srch_corner_x(n,cell)
+              vec2_y = y1 - srch_corner_y(n,cell)
+            endif
+
+            cross_product = vec1_x*vec2_y - vec2_x*vec1_y
+
+            !***
+            !*** if the cross product for a side is zero, the point 
+            !***   lies exactly on the side or the length of a side
+            !***   is zero.  if the length is zero set det > 0.
+            !***   otherwise, perform another cross 
+            !***   product between the side and the segment itself. 
+            !*** if this cross product is also zero, the line is 
+            !***   coincident with the cell boundary - perform the 
+            !***   dot product and only choose the cell if the dot 
+            !***   product is positive (parallel vs anti-parallel).
+            !***
+
+            if (cross_product == zero) then
+              if (vec1_x /= zero .or. vec1_y /= 0) then
+                vec2_x = x2 - x1
+                vec2_y = y2 - y1
+                cross_product = vec1_x*vec2_y - vec2_x*vec1_y
+              else
+                cross_product = one
+              endif
+
+              if (cross_product == zero) then
+                lcoinc = .true.
+                cross_product = vec1_x*vec2_x + vec1_y*vec2_y
+                if (lrevers) cross_product = -cross_product
+              endif
+            endif
+
+            !***
+            !*** if cross product is less than zero, this cell
+            !*** doesn't work
+            !***
+
+            if (cross_product < zero) exit corner_loop
+
+          end do corner_loop
+
+          !***
+          !*** if cross products all positive, we found the location
+          !***
+
+          if (n > srch_corners) then
+            location = srch_add(cell)
+
+            !***
+            !*** if the beginning of this segment was outside the
+            !*** grid, invert the segment so the intersection found
+            !*** will be the first intersection with the grid
+            !***
+
+            if (loutside) then
+              x2 = begx
+              y2 = begy
+              location = 0
+              eps  = -tiny
+            else
+              eps  = tiny
+            endif
+
+            exit srch_loop
+          endif
+
+          !***
+          !*** otherwise move on to next cell
+          !***
+
+        end do cell_loop
+
+        !***
+        !*** if no cell found, the point lies outside the grid.
+        !***   take some baby steps along the segment to see if any
+        !***   part of the segment lies inside the grid.  
+        !***
+
+        loutside = .true.
+        s1 = s1 + 0.001_dbl_kind
+        x1 = begx + s1*(x2 - begx)
+        y1 = begy + s1*(y2 - begy)
+
+        !***
+        !*** reached the end of the segment and still outside the grid
+        !*** return no intersection
+        !***
+
+        if (s1 >= one) then
+          deallocate(srch_corner_x, srch_corner_y)
+          luse_last = .false.
+          return
+        endif
+
+      end do srch_loop
+      call timer_stop(12)
+
+!-----------------------------------------------------------------------
+!
+!     now that a cell is found, search for the next intersection.
+!     loop over sides of the cell to find intersection with side
+!     must check all sides for coincidences or intersections
+!
+!-----------------------------------------------------------------------
+
+      call timer_start(13)
+      intrsct_loop: do n=1,srch_corners
+        next_n = mod(n,srch_corners) + 1
+
+        grdy1 = srch_corner_y(n     ,cell)
+        grdy2 = srch_corner_y(next_n,cell)
+        grdx1 = srch_corner_x(n     ,cell)
+        grdx2 = srch_corner_x(next_n,cell)
+
+        !***
+        !*** set up linear system to solve for intersection
+        !***
+
+        mat1 = x2 - x1
+        mat2 = grdx1 - grdx2
+        mat3 = y2 - y1
+        mat4 = grdy1 - grdy2
+        rhs1 = grdx1 - x1
+        rhs2 = grdy1 - y1
+
+        determ = mat1*mat4 - mat2*mat3
+
+        !***
+        !*** if the determinant is zero, the segments are either 
+        !***   parallel or coincident or one segment has zero length.  
+        !***   coincidences were detected above so do nothing.
+        !*** if the determinant is non-zero, solve for the linear 
+        !***   parameters s for the intersection point on each line 
+        !***   segment.
+        !*** if 0<s1,s2<1 then the segment intersects with this side.
+        !***   return the point of intersection (adding a small
+        !***   number so the intersection is off the grid line).
+        !***
+
+        if (abs(determ) > 1.e-30) then
+
+          s1 = (rhs1*mat4 - mat2*rhs2)/determ
+          s2 = (mat1*rhs2 - rhs1*mat3)/determ
+
+          if (s2 >= zero .and. s2 <= one .and.
+     &        s1 >  zero. and. s1 <= one) then
+
+            !***
+            !*** recompute intersection using entire segment
+            !*** for consistency between sweeps
+            !***
+
+            if (.not. loutside) then
+              mat1 = x2 - begsegx
+              mat3 = y2 - begsegy
+              rhs1 = grdx1 - begsegx
+              rhs2 = grdy1 - begsegy
+            else 
+              mat1 = x2 - endx
+              mat3 = y2 - endy
+              rhs1 = grdx1 - endx
+              rhs2 = grdy1 - endy
+            endif
+
+            determ = mat1*mat4 - mat2*mat3
+
+            !***
+            !*** sometimes due to roundoff, the previous 
+            !*** determinant is non-zero, but the lines
+            !*** are actually coincident.  if this is the
+            !*** case, skip the rest.
+            !***
+
+            if (determ /= zero) then
+              s1 = (rhs1*mat4 - mat2*rhs2)/determ
+              s2 = (mat1*rhs2 - rhs1*mat3)/determ
+
+              if (.not. loutside) then
+                intrsct_x = begsegx + s1*mat1
+                intrsct_y = begsegy + s1*mat3
+              else 
+                intrsct_x = endx + s1*mat1
+                intrsct_y = endy + s1*mat3
+              endif
+
+              !***
+              !*** convert back to lat/lon coordinates
+              !***
+
+              intrsct_lon = rns*atan2(intrsct_y,intrsct_x)
+              if (intrsct_lon < zero) 
+     &          intrsct_lon = intrsct_lon + pi2
+
+              if (abs(intrsct_x) > 1.d-10) then
+                intrsct_lat = (pi4 - 
+     &            asin(rns*half*intrsct_x/cos(intrsct_lon)))*two
+              else if (abs(intrsct_y) > 1.d-10) then
+                intrsct_lat = (pi4 - 
+     &            asin(half*intrsct_y/sin(intrsct_lon)))*two
+              else
+                intrsct_lat = two*pi4
+              endif
+
+              !***
+              !*** add offset in transformed space for next pass.
+              !***
+
+              if (s1 - eps/determ < one) then
+                intrsct_x = intrsct_x - mat1*(eps/determ)
+                intrsct_y = intrsct_y - mat3*(eps/determ)
+              else
+                if (.not. loutside) then
+                  intrsct_x = endx
+                  intrsct_y = endy
+                  intrsct_lat = endlat
+                  intrsct_lon = endlon
+                else 
+                  intrsct_x = begsegx
+                  intrsct_y = begsegy
+                  intrsct_lat = begseg(1)
+                  intrsct_lon = begseg(2)
+                endif
+              endif
+
+              exit intrsct_loop
+            endif
+          endif
+        endif
+
+        !***
+        !*** no intersection this side, move on to next side
+        !***
+
+      end do intrsct_loop
+      call timer_stop(13)
+
+      deallocate(srch_corner_x, srch_corner_y)
+
+!-----------------------------------------------------------------------
+!
+!     if segment manages to cross over pole, shift the beginning 
+!     endpoint in order to avoid hitting pole directly
+!     (it is ok for endpoint to be pole point)
+!
+!-----------------------------------------------------------------------
+
+      if (abs(intrsct_x) < 1.e-10 .and. abs(intrsct_y) < 1.e-10 .and.
+     &    (endx /= zero .and. endy /=0)) then
+        if (avoid_pole_count > 2) then
+           avoid_pole_count = 0
+           avoid_pole_offset = 10.*avoid_pole_offset
+        endif
+
+        cross_product = begsegx*(endy-begsegy) - begsegy*(endx-begsegx)
+        intrsct_lat = begseg(1)
+        if (cross_product*intrsct_lat > zero) then
+          intrsct_lon = beglon    + avoid_pole_offset
+          begseg(2)   = begseg(2) + avoid_pole_offset
+        else
+          intrsct_lon = beglon    - avoid_pole_offset
+          begseg(2)   = begseg(2) - avoid_pole_offset
+        endif
+
+        avoid_pole_count = avoid_pole_count + 1
+        luse_last = .false.
+      else
+        avoid_pole_count = 0
+        avoid_pole_offset = tiny
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     if the segment crosses a pole threshold, reset the intersection
+!     to be the threshold latitude and do not reuse x,y intersect
+!     on next entry.  only check if did not cross threshold last
+!     time - sometimes the coordinate transformation can place a
+!     segment on the other side of the threshold again
+!
+!-----------------------------------------------------------------------
+
+      if (lthresh) then
+        if (intrsct_lat > north_thresh .or. intrsct_lat < south_thresh)
+     &    lthresh = .false.
+      else if (beglat > zero .and. intrsct_lat < north_thresh) then
+        mat4 = endlat - begseg(1)
+        mat3 = endlon - begseg(2)
+        if (mat3 >  pi) mat3 = mat3 - pi2
+        if (mat3 < -pi) mat3 = mat3 + pi2
+        intrsct_lat = north_thresh - tiny
+        s1 = (north_thresh - begseg(1))/mat4
+        intrsct_lon = begseg(2) + s1*mat3
+        luse_last = .false.
+        lthresh = .true.
+      else if (beglat < zero .and. intrsct_lat > south_thresh) then
+        mat4 = endlat - begseg(1)
+        mat3 = endlon - begseg(2)
+        if (mat3 >  pi) mat3 = mat3 - pi2
+        if (mat3 < -pi) mat3 = mat3 + pi2
+        intrsct_lat = south_thresh + tiny
+        s1 = (south_thresh - begseg(1))/mat4
+        intrsct_lon = begseg(2) + s1*mat3
+        luse_last = .false.
+        lthresh = .true.
+      endif
+
+      !***
+      !*** if reached end of segment, do not use x,y intersect 
+      !*** on next entry
+      !***
+
+      if (intrsct_lat == endlat .and. intrsct_lon == endlon) then
+        luse_last = .false.
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine pole_intersection
+
+!***********************************************************************
+
+      subroutine line_integral(weights, num_wts, 
+     &                       in_phi1, in_phi2, theta1, theta2,
+     &                       grid1_lat, grid1_lon, grid2_lat, grid2_lon)
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the line integral of the flux function 
+!     that results in the interpolation weights.  the line is defined
+!     by the input lat/lon of the endpoints.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     intent(in):
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::
+     &        num_wts  ! number of weights to compute
+
+      real (kind=dbl_kind), intent(in) :: 
+     &     in_phi1, in_phi2,     ! longitude endpoints for the segment
+     &     theta1, theta2,       ! latitude  endpoints for the segment
+     &     grid1_lat, grid1_lon, ! reference coordinates for each
+     &     grid2_lat, grid2_lon  ! grid (to ensure correct 0,2pi interv.
+
+!-----------------------------------------------------------------------
+!
+!     intent(out):
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), dimension(2*num_wts), intent(out) ::
+     &     weights   ! line integral contribution to weights
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind) :: dphi, sinth1, sinth2, costh1, costh2, fac,
+     &                        phi1, phi2, phidiff1, phidiff2, sinint
+      real (kind=dbl_kind) :: f1, f2, fint
+
+!-----------------------------------------------------------------------
+!
+!     weights for the general case based on a trapezoidal approx to
+!     the integrals.
+!
+!-----------------------------------------------------------------------
+
+      sinth1 = SIN(theta1)
+      sinth2 = SIN(theta2)
+      costh1 = COS(theta1)
+      costh2 = COS(theta2)
+
+      dphi = in_phi1 - in_phi2
+      if (dphi >  pi) then
+        dphi = dphi - pi2
+      else if (dphi < -pi) then
+        dphi = dphi + pi2
+      endif
+      dphi = half*dphi
+
+!-----------------------------------------------------------------------
+!
+!     the first weight is the area overlap integral. the second and
+!     fourth are second-order latitude gradient weights.
+!
+!-----------------------------------------------------------------------
+
+      weights(        1) = dphi*(sinth1 + sinth2)
+      weights(num_wts+1) = dphi*(sinth1 + sinth2)
+      weights(        2) = dphi*(costh1 + costh2 + (theta1*sinth1 +
+     &                                              theta2*sinth2))
+      weights(num_wts+2) = dphi*(costh1 + costh2 + (theta1*sinth1 +
+     &                                              theta2*sinth2))
+
+!-----------------------------------------------------------------------
+!
+!     the third and fifth weights are for the second-order phi gradient
+!     component.  must be careful of longitude range.
+!
+!-----------------------------------------------------------------------
+
+      f1 = half*(costh1*sinth1 + theta1)
+      f2 = half*(costh2*sinth2 + theta2)
+
+      phi1 = in_phi1 - grid1_lon
+      if (phi1 >  pi) then
+        phi1 = phi1 - pi2
+      else if (phi1 < -pi) then
+        phi1 = phi1 + pi2
+      endif
+
+      phi2 = in_phi2 - grid1_lon
+      if (phi2 >  pi) then
+        phi2 = phi2 - pi2
+      else if (phi2 < -pi) then
+        phi2 = phi2 + pi2
+      endif
+
+      if ((phi2-phi1) <  pi .and. (phi2-phi1) > -pi) then
+        weights(3) = dphi*(phi1*f1 + phi2*f2)
+      else
+        if (phi1 > zero) then
+          fac = pi
+        else
+          fac = -pi
+        endif
+        fint = f1 + (f2-f1)*(fac-phi1)/abs(dphi)
+        weights(3) = half*phi1*(phi1-fac)*f1 -
+     &               half*phi2*(phi2+fac)*f2 +
+     &               half*fac*(phi1+phi2)*fint
+      endif
+
+      phi1 = in_phi1 - grid2_lon
+      if (phi1 >  pi) then
+        phi1 = phi1 - pi2
+      else if (phi1 < -pi) then
+        phi1 = phi1 + pi2
+      endif
+
+      phi2 = in_phi2 - grid2_lon
+      if (phi2 >  pi) then
+        phi2 = phi2 - pi2
+      else if (phi2 < -pi) then
+        phi2 = phi2 + pi2
+      endif
+
+      if ((phi2-phi1) <  pi .and. (phi2-phi1) > -pi) then
+        weights(num_wts+3) = dphi*(phi1*f1 + phi2*f2)
+      else
+        if (phi1 > zero) then
+          fac = pi
+        else
+          fac = -pi
+        endif
+        fint = f1 + (f2-f1)*(fac-phi1)/abs(dphi)
+        weights(num_wts+3) = half*phi1*(phi1-fac)*f1 -
+     &                       half*phi2*(phi2+fac)*f2 +
+     &                       half*fac*(phi1+phi2)*fint
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine line_integral
+
+!***********************************************************************
+
+      subroutine store_link_cnsrv(add1, add2, weights)
+
+!-----------------------------------------------------------------------
+!
+!     this routine stores the address and weight for this link in
+!     the appropriate address and weight arrays and resizes those
+!     arrays if necessary.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::
+     &        add1,  ! address on grid1
+     &        add2   ! address on grid2
+
+      real (kind=dbl_kind), dimension(:), intent(in) ::
+     &        weights ! array of remapping weights for this link
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: nlink, min_link, max_link ! link index
+
+      integer (kind=int_kind), dimension(:,:), allocatable, save ::
+     &        link_add1,  ! min,max link add to restrict search
+     &        link_add2   ! min,max link add to restrict search
+
+      logical (kind=log_kind), save :: first_call = .true.
+
+!-----------------------------------------------------------------------
+!
+!     if all weights are zero, do not bother storing the link
+!
+!-----------------------------------------------------------------------
+
+      if (all(weights == zero)) return
+
+!-----------------------------------------------------------------------
+!
+!     restrict the range of links to search for existing links
+!
+!-----------------------------------------------------------------------
+
+      if (first_call) then
+        allocate(link_add1(2,grid1_size), link_add2(2,grid2_size))
+        link_add1 = 0
+        link_add2 = 0
+        first_call = .false.
+        min_link = 1
+        max_link = 0
+      else
+        min_link = min(link_add1(1,add1),link_add2(1,add2))
+        max_link = max(link_add1(2,add1),link_add2(2,add2))
+        if (min_link == 0) then
+          min_link = 1
+          max_link = 0
+        endif
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     if the link already exists, add the weight to the current weight
+!     arrays
+!
+!-----------------------------------------------------------------------
+
+      do nlink=min_link,max_link
+        if (add1 == grid1_add_map1(nlink)) then
+        if (add2 == grid2_add_map1(nlink)) then
+
+          wts_map1(:,nlink) = wts_map1(:,nlink) + weights(1:num_wts)
+          if (num_maps == 2) then
+            wts_map2(:,nlink) = wts_map2(:,nlink) + 
+     &                                  weights(num_wts+1:2*num_wts)
+          endif
+          return
+
+        endif
+        endif
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     if the link does not yet exist, increment number of links and 
+!     check to see if remap arrays need to be increased to accomodate 
+!     the new link.  then store the link.
+!
+!-----------------------------------------------------------------------
+
+      num_links_map1  = num_links_map1 + 1
+      if (num_links_map1 > max_links_map1) 
+     &   call resize_remap_vars(1,resize_increment)
+
+      grid1_add_map1(num_links_map1) = add1
+      grid2_add_map1(num_links_map1) = add2
+      wts_map1    (:,num_links_map1) = weights(1:num_wts)
+
+      if (num_maps > 1) then
+        num_links_map2  = num_links_map2 + 1
+        if (num_links_map2 > max_links_map2) 
+     &     call resize_remap_vars(2,resize_increment)
+
+        grid1_add_map2(num_links_map2) = add1
+        grid2_add_map2(num_links_map2) = add2
+        wts_map2    (:,num_links_map2) = weights(num_wts+1:2*num_wts)
+      endif
+
+      if (link_add1(1,add1) == 0) link_add1(1,add1) = num_links_map1
+      if (link_add2(1,add2) == 0) link_add2(1,add2) = num_links_map1
+      link_add1(2,add1) = num_links_map1
+      link_add2(2,add2) = num_links_map1
+
+!-----------------------------------------------------------------------
+
+      end subroutine store_link_cnsrv
+
+!***********************************************************************
+
+      end module remap_conservative
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/remap_distwgt.f
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/remap_distwgt.f	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/remap_distwgt.f	(revision 12863)
@@ -0,0 +1,498 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for performing an 
+!     interpolation using a distance-weighted average of n nearest
+!     neighbors.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_distwgt.f,v 1.3 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_distance_weight
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common constants
+      use grids         ! module containing grid info
+      use remap_vars    ! module containing remap info
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter :: 
+     &     num_neighbors=4  ! num nearest neighbors to interpolate from
+
+      real (kind=dbl_kind), dimension(:), allocatable, save ::
+     &     coslat, sinlat, ! cosine, sine of grid lats (for distance)
+     &     coslon, sinlon, ! cosine, sine of grid lons (for distance)
+     &     wgtstmp         ! an array to hold the link weight
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap_distwgt
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the inverse-distance weights for a
+!     nearest-neighbor interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      logical (kind=log_kind), dimension(num_neighbors) ::
+     &     nbr_mask        ! mask at nearest neighbors
+
+      integer (kind=int_kind) :: n,
+     &     dst_add,        ! destination address
+     &     nmap            ! index of current map being computed
+
+      integer (kind=int_kind), dimension(num_neighbors) ::
+     &     nbr_add         ! source address at nearest neighbors
+
+      real (kind=dbl_kind), dimension(num_neighbors) ::
+     &     nbr_dist        ! angular distance four nearest neighbors
+
+      real (kind=dbl_kind) ::
+     &     coslat_dst,     ! cos(lat) of destination grid point
+     &     coslon_dst,     ! cos(lon) of destination grid point
+     &     sinlat_dst,     ! sin(lat) of destination grid point
+     &     sinlon_dst,     ! sin(lon) of destination grid point
+     &     dist_tot        ! sum of neighbor distances (for normalizing)
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+
+      nmap = 1
+
+      !***
+      !*** allocate wgtstmp to be consistent with store_link interface
+      !***
+
+      allocate (wgtstmp(num_wts))
+
+      !***
+      !*** compute cos, sin of lat/lon on source grid for distance
+      !*** calculations
+      !***
+
+      allocate (coslat(grid1_size), coslon(grid1_size),
+     &          sinlat(grid1_size), sinlon(grid1_size))
+
+      coslat = cos(grid1_center_lat)
+      coslon = cos(grid1_center_lon)
+      sinlat = sin(grid1_center_lat)
+      sinlon = sin(grid1_center_lon)
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop1: do dst_add = 1, grid2_size
+
+        if (.not. grid2_mask(dst_add)) cycle grid_loop1
+
+        coslat_dst = cos(grid2_center_lat(dst_add))
+        coslon_dst = cos(grid2_center_lon(dst_add))
+        sinlat_dst = sin(grid2_center_lat(dst_add))
+        sinlon_dst = sin(grid2_center_lon(dst_add))
+
+        !***
+        !*** find nearest grid points on source grid and
+        !*** distances to each point
+        !***
+
+        call grid_search_nbr(nbr_add, nbr_dist, 
+     &                       grid2_center_lat(dst_add),
+     &                       grid2_center_lon(dst_add),
+     &                       coslat_dst, coslon_dst, 
+     &                       sinlat_dst, sinlon_dst,
+     &                       bin_addr1, bin_addr2)
+
+        !***
+        !*** compute weights based on inverse distance
+        !*** if mask is false, eliminate those points
+        !***
+
+        dist_tot = zero
+        do n=1,num_neighbors
+          if (grid1_mask(nbr_add(n))) then
+            nbr_dist(n) = one/nbr_dist(n)
+            dist_tot = dist_tot + nbr_dist(n)
+            nbr_mask(n) = .true.
+          else
+            nbr_mask(n) = .false.
+          endif
+        end do
+
+        !***
+        !*** normalize weights and store the link
+        !***
+
+        do n=1,num_neighbors
+          if (nbr_mask(n)) then
+            wgtstmp(1) = nbr_dist(n)/dist_tot
+            call store_link_nbr(nbr_add(n), dst_add, wgtstmp, nmap)
+            grid2_frac(dst_add) = one
+          endif
+        end do
+
+      end do grid_loop1
+
+      deallocate (coslat, coslon, sinlat, sinlon)
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid2 to grid1 if necessary
+!
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+
+      nmap = 2
+
+      !***
+      !*** compute cos, sin of lat/lon on source grid for distance
+      !*** calculations
+      !***
+
+      allocate (coslat(grid2_size), coslon(grid2_size),
+     &          sinlat(grid2_size), sinlon(grid2_size))
+
+      coslat = cos(grid2_center_lat)
+      coslon = cos(grid2_center_lon)
+      sinlat = sin(grid2_center_lat)
+      sinlon = sin(grid2_center_lon)
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop2: do dst_add = 1, grid1_size
+
+        if (.not. grid1_mask(dst_add)) cycle grid_loop2
+
+        coslat_dst = cos(grid1_center_lat(dst_add))
+        coslon_dst = cos(grid1_center_lon(dst_add))
+        sinlat_dst = sin(grid1_center_lat(dst_add))
+        sinlon_dst = sin(grid1_center_lon(dst_add))
+
+        !***
+        !*** find four nearest grid points on source grid and
+        !*** distances to each point
+        !***
+
+        call grid_search_nbr(nbr_add, nbr_dist,
+     &                       grid1_center_lat(dst_add),
+     &                       grid1_center_lon(dst_add),
+     &                       coslat_dst, coslon_dst, 
+     &                       sinlat_dst, sinlon_dst,
+     &                       bin_addr2, bin_addr1)
+
+        !***
+        !*** compute weights based on inverse distance
+        !*** if mask is false, eliminate those points
+        !***
+
+        dist_tot = zero
+        do n=1,num_neighbors
+          if (grid2_mask(nbr_add(n))) then
+            nbr_dist(n) = one/nbr_dist(n)
+            dist_tot = dist_tot + nbr_dist(n)
+            nbr_mask(n) = .true.
+          else
+            nbr_mask(n) = .false.
+          endif
+        end do
+
+        !***
+        !*** normalize weights and store the link
+        !***
+
+        do n=1,num_neighbors
+          if (nbr_mask(n)) then
+            wgtstmp(1) = nbr_dist(n)/dist_tot
+            call store_link_nbr(dst_add, nbr_add(n), wgtstmp, nmap)
+            grid1_frac(dst_add) = one
+          endif
+        end do
+
+      end do grid_loop2
+
+      deallocate (coslat, coslon, sinlat, sinlon)
+
+      endif
+
+      deallocate(wgtstmp)
+
+!-----------------------------------------------------------------------
+
+      end subroutine remap_distwgt
+
+!***********************************************************************
+
+      subroutine grid_search_nbr(nbr_add, nbr_dist, plat, plon, 
+     &               coslat_dst, coslon_dst, sinlat_dst, sinlon_dst,
+     &               src_bin_add, dst_bin_add)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the closest num_neighbor points to a search 
+!     point and computes a distance to each of the neighbors.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(num_neighbors), intent(out) ::
+     &        nbr_add  ! address of each of the closest points
+
+      real (kind=dbl_kind), dimension(num_neighbors), intent(out) ::
+     &        nbr_dist ! distance to each of the closest points
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(:,:), intent(in) ::
+     &        src_bin_add, ! search bins for restricting search
+     &        dst_bin_add   
+
+      real (kind=dbl_kind), intent(in) ::
+     &        plat,         ! latitude  of the search point
+     &        plon,         ! longitude of the search point
+     &        coslat_dst,   ! cos(lat)  of the search point
+     &        coslon_dst,   ! cos(lon)  of the search point
+     &        sinlat_dst,   ! sin(lat)  of the search point
+     &        sinlon_dst    ! sin(lon)  of the search point
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, nmax, nadd, nchk, ! dummy indices
+     &        min_add, max_add, nm1, np1, i, j, ip1, im1, jp1, jm1
+
+      real (kind=dbl_kind) ::
+     &        distance      ! angular distance
+
+!-----------------------------------------------------------------------
+!
+!     loop over source grid and find nearest neighbors
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** restrict the search using search bins
+      !*** expand the bins to catch neighbors
+      !***
+
+      select case (restrict_type)
+      case('latitude')
+
+        do n=1,num_srch_bins
+          if (plat >= bin_lats(1,n) .and. plat <= bin_lats(2,n)) then
+            min_add = src_bin_add(1,n)
+            max_add = src_bin_add(2,n)
+
+            nm1 = max(n-1,1)
+            np1 = min(n+1,num_srch_bins)
+
+            min_add = min(min_add,src_bin_add(1,nm1))
+            max_add = max(max_add,src_bin_add(2,nm1))
+            min_add = min(min_add,src_bin_add(1,np1))
+            max_add = max(max_add,src_bin_add(2,np1))
+          endif
+        end do
+
+      case('latlon')
+
+        n = 0
+        nmax = nint(sqrt(real(num_srch_bins)))
+        do j=1,nmax
+        jp1 = min(j+1,nmax)
+        jm1 = max(j-1,1)
+        do i=1,nmax
+          ip1 = min(i+1,nmax)
+          im1 = max(i-1,1)
+
+          n = n+1
+          if (plat >= bin_lats(1,n) .and. plat <= bin_lats(2,n) .and.
+     &        plon >= bin_lons(1,n) .and. plon <= bin_lons(3,n)) then
+            min_add = src_bin_add(1,n)
+            max_add = src_bin_add(2,n)
+
+            nm1 = (jm1-1)*nmax + im1
+            np1 = (jp1-1)*nmax + ip1
+            nm1 = max(nm1,1)
+            np1 = min(np1,num_srch_bins)
+
+            min_add = min(min_add,src_bin_add(1,nm1))
+            max_add = max(max_add,src_bin_add(2,nm1))
+            min_add = min(min_add,src_bin_add(1,np1))
+            max_add = max(max_add,src_bin_add(2,np1))
+          endif
+        end do
+        end do
+
+      end select
+
+      !***
+      !*** initialize distance and address arrays
+      !***
+
+      nbr_add = 0
+      nbr_dist = bignum
+
+      do nadd=min_add,max_add
+
+        !***
+        !*** find distance to this point
+        !***
+
+        distance = acos(sinlat_dst*sinlat(nadd) +
+     &                  coslat_dst*coslat(nadd)*
+     &                 (coslon_dst*coslon(nadd) +
+     &                  sinlon_dst*sinlon(nadd)) )
+
+        !***
+        !*** store the address and distance if this is one of the
+        !*** smallest four so far
+        !***
+
+        check_loop: do nchk=1,num_neighbors
+          if (distance .lt. nbr_dist(nchk)) then
+            do n=num_neighbors,nchk+1,-1
+              nbr_add(n) = nbr_add(n-1)
+              nbr_dist(n) = nbr_dist(n-1)
+            end do
+            nbr_add(nchk) = nadd
+            nbr_dist(nchk) = distance
+            exit check_loop
+          endif
+        end do check_loop
+
+      end do
+
+!-----------------------------------------------------------------------
+
+      end subroutine grid_search_nbr 
+
+!***********************************************************************
+
+      subroutine store_link_nbr(add1, add2, weights, nmap)
+
+!-----------------------------------------------------------------------
+!
+!     this routine stores the address and weight for this link in
+!     the appropriate address and weight arrays and resizes those
+!     arrays if necessary.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::
+     &        add1,  ! address on grid1
+     &        add2,  ! address on grid2
+     &        nmap   ! identifies which direction for mapping
+
+      real (kind=dbl_kind), dimension(:), intent(in) ::
+     &        weights ! array of remapping weights for this link
+
+!-----------------------------------------------------------------------
+!
+!     increment number of links and check to see if remap arrays need
+!     to be increased to accomodate the new link.  then store the
+!     link.
+!
+!-----------------------------------------------------------------------
+
+      select case (nmap)
+      case(1)
+
+        num_links_map1  = num_links_map1 + 1
+
+        if (num_links_map1 > max_links_map1) 
+     &     call resize_remap_vars(1,resize_increment)
+
+        grid1_add_map1(num_links_map1) = add1
+        grid2_add_map1(num_links_map1) = add2
+        wts_map1    (:,num_links_map1) = weights
+
+      case(2)
+
+        num_links_map2  = num_links_map2 + 1
+
+        if (num_links_map2 > max_links_map2) 
+     &     call resize_remap_vars(2,resize_increment)
+
+        grid1_add_map2(num_links_map2) = add1
+        grid2_add_map2(num_links_map2) = add2
+        wts_map2    (:,num_links_map2) = weights
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine store_link_nbr
+
+!***********************************************************************
+
+      end module remap_distance_weight
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/remap_read.f
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/remap_read.f	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/remap_read.f	(revision 12863)
@@ -0,0 +1,1027 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This routine reads remapping information from files written
+!     by remap_setup.  If remapping in both directions are required,
+!     two input files must be specified.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_read.f,v 1.6 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_read
+
+!-----------------------------------------------------------------------
+!
+!     contains routines for reading a remap file
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines useful constants
+      use grids         ! includes all grid information
+      use netcdf_mod    ! module with netcdf vars and utilities
+      use remap_vars    ! module for all required remapping variables
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!     various netCDF ids for files variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), private :: ! netCDF ids
+     &         ncstat, nc_file_id,
+     &         nc_srcgrdsize_id, nc_dstgrdsize_id,
+     &         nc_srcgrdcorn_id, nc_dstgrdcorn_id,
+     &         nc_srcgrdrank_id, nc_dstgrdrank_id,
+     &         nc_srcgrddims_id, nc_dstgrddims_id,
+     &         nc_numlinks_id, nc_numwgts_id, 
+     &         nc_srcgrdimask_id, nc_dstgrdimask_id,
+     &         nc_srcgrdcntrlat_id, nc_srcgrdcntrlon_id,
+     &         nc_srcgrdcrnrlat_id, nc_srcgrdcrnrlon_id,
+     &         nc_srcgrdarea_id, nc_srcgrdfrac_id,
+     &         nc_dstgrdcntrlat_id, nc_dstgrdcntrlon_id,
+     &         nc_dstgrdcrnrlat_id, nc_dstgrdcrnrlon_id,
+     &         nc_dstgrdarea_id, nc_dstgrdfrac_id,
+     &         nc_srcgrdadd_id, nc_dstgrdadd_id, nc_rmpmatrix_id
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine read_remap(map_name, interp_file)
+
+!-----------------------------------------------------------------------
+!
+!     this driver routine reads some global attributes and then
+!     calls a specific read routine based on file conventions
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) ::
+     &  interp_file        ! filename for remap data
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(out) ::
+     &  map_name            ! name for mapping
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len) :: 
+     &   map_method       ! character string for map_type
+     &,  normalize_opt    ! character string for normalization option
+     &,  convention       ! character string for output convention
+
+!-----------------------------------------------------------------------
+!
+!     open file and read some global information
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_open(interp_file, NF_NOWRITE, nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map name
+      !***
+      map_name = ' '
+      ncstat = nf_get_att_text(nc_file_id, NF_GLOBAL, 'title',
+     &                         map_name)
+      call netcdf_error_handler(ncstat)
+
+      print *,'Reading remapping:',trim(map_name)
+      print *,'From file:',trim(interp_file)
+
+      !***
+      !*** normalization option
+      !***
+      normalize_opt = ' '
+      ncstat = nf_get_att_text(nc_file_id, NF_GLOBAL, 'normalization',
+     &                         normalize_opt)
+      call netcdf_error_handler(ncstat)
+
+      select case(normalize_opt)
+      case ('none')
+        norm_opt = norm_opt_none
+      case ('fracarea')
+        norm_opt = norm_opt_frcarea
+      case ('destarea')
+        norm_opt = norm_opt_dstarea
+      case default
+        print *,'normalize_opt = ',normalize_opt
+        stop 'Invalid normalization option'
+      end select
+
+      !***
+      !*** map method
+      !***
+      map_method = ' '
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'map_method',
+     &                          map_method)
+      call netcdf_error_handler(ncstat)
+
+      select case(map_method)
+      case('Conservative remapping')
+        map_type = map_type_conserv
+      case('Bilinear remapping')
+        map_type = map_type_bilinear
+      case('Distance weighted avg of nearest neighbors')
+        map_type = map_type_distwgt
+      case('Bicubic remapping')
+        map_type = map_type_bicubic
+      case default
+        print *,'map_type = ',map_method
+        stop 'Invalid Map Type'
+      end select
+
+      !***
+      !*** file convention
+      !***
+      convention = ' '
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'conventions',
+     &                          convention)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate read routine based on output convention
+!
+!-----------------------------------------------------------------------
+
+      select case(convention)
+      case ('SCRIP')
+        call read_remap_scrip
+      case ('NCAR-CSM')
+        call read_remap_csm
+      case default
+        print *,'convention = ',convention
+        stop 'unknown output file convention'
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine read_remap
+
+!***********************************************************************
+
+      subroutine read_remap_scrip
+
+!-----------------------------------------------------------------------
+!
+!     the routine reads a netCDF file to extract remapping info
+!     in SCRIP format
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) ::
+     &  grid1_name           ! grid name for source grid
+     &, grid2_name           ! grid name for dest   grid
+
+      integer (kind=int_kind) ::  
+     &  n                    ! dummy index
+
+      integer (kind=int_kind), dimension(:), allocatable ::
+     &  grid1_mask_int,      ! integer masks to determine
+     &  grid2_mask_int       ! cells that participate in map
+
+!-----------------------------------------------------------------------
+!
+!     read some additional global attributes
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** source and destination grid names
+      !***
+
+      grid1_name = ' '
+      grid2_name = ' '
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'source_grid',
+     &                          grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'dest_grid',
+     &                          grid2_name)
+      call netcdf_error_handler(ncstat)
+
+      print *,' '
+      print *,'Remapping between:',trim(grid1_name)
+      print *,'and ',trim(grid2_name)
+      print *,' '
+
+!-----------------------------------------------------------------------
+!
+!     read dimension information
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_inq_dimid(nc_file_id, 'src_grid_size', 
+     &                      nc_srcgrdsize_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdsize_id, grid1_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_size', 
+     &                      nc_dstgrdsize_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdsize_id, grid2_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'src_grid_corners', 
+     &                      nc_srcgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdcorn_id, 
+     &                       grid1_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_corners', 
+     &                      nc_dstgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdcorn_id, 
+     &                       grid2_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'src_grid_rank', 
+     &                      nc_srcgrdrank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdrank_id, 
+     &                       grid1_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_rank', 
+     &                      nc_dstgrdrank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdrank_id, 
+     &                       grid2_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'num_links', 
+     &                      nc_numlinks_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_numlinks_id, 
+     &                       num_links_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'num_wgts', 
+     &                      nc_numwgts_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_numwgts_id, num_wts)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     allocate arrays
+!
+!-----------------------------------------------------------------------
+
+      allocate( grid1_dims      (grid1_rank),
+     &          grid1_center_lat(grid1_size), 
+     &          grid1_center_lon(grid1_size),
+     &          grid1_area      (grid1_size),
+     &          grid1_frac      (grid1_size),
+     &          grid1_mask      (grid1_size),
+     &          grid1_mask_int  (grid1_size),
+     &          grid1_corner_lat(grid1_corners, grid1_size),
+     &          grid1_corner_lon(grid1_corners, grid1_size) )
+
+      allocate( grid2_dims      (grid2_rank),
+     &          grid2_center_lat(grid2_size), 
+     &          grid2_center_lon(grid2_size),
+     &          grid2_area      (grid2_size),
+     &          grid2_frac      (grid2_size),
+     &          grid2_mask      (grid2_size),
+     &          grid2_mask_int  (grid2_size),
+     &          grid2_corner_lat(grid2_corners, grid2_size),
+     &          grid2_corner_lon(grid2_corners, grid2_size) )
+
+      allocate( grid1_add_map1(num_links_map1),
+     &          grid2_add_map1(num_links_map1),
+     &          wts_map1(num_wts,num_links_map1) )
+
+!-----------------------------------------------------------------------
+!
+!     get variable ids
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_dims', 
+     &                      nc_srcgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_imask', 
+     &                      nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_center_lat', 
+     &                                   nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_center_lon', 
+     &                                   nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_corner_lat', 
+     &                                   nc_srcgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_corner_lon', 
+     &                                   nc_srcgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_area', 
+     &                                   nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_frac', 
+     &                                   nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_dims', 
+     &                      nc_dstgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_imask', 
+     &                      nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_center_lat', 
+     &                                   nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_center_lon', 
+     &                                   nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_corner_lat', 
+     &                                   nc_dstgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_corner_lon', 
+     &                                   nc_dstgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_area', 
+     &                                   nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_frac', 
+     &                                   nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_address', 
+     &                                   nc_srcgrdadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_address', 
+     &                                   nc_dstgrdadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'remap_matrix', 
+     &                                   nc_rmpmatrix_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     read all variables
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrddims_id, 
+     &                        grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrdimask_id, 
+     &                        grid1_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlat_id, 
+     &                                       grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlon_id, 
+     &                                       grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      grid1_units = ' '
+      ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcntrlat_id, 'units',
+     &                         grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+        grid1_center_lat = grid1_center_lat*deg2rad
+        grid1_center_lon = grid1_center_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid1 center lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlat_id, 
+     &                                       grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlon_id, 
+     &                                       grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      grid1_units = ' '
+      ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcrnrlat_id, 'units',
+     &                         grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+        grid1_corner_lat = grid1_corner_lat*deg2rad
+        grid1_corner_lon = grid1_corner_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid1 corner lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdarea_id, 
+     &                                       grid1_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdfrac_id, 
+     &                                       grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrddims_id, 
+     &                        grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrdimask_id, 
+     &                        grid2_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlat_id, 
+     &                                       grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlon_id, 
+     &                                       grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      grid2_units = ' '
+      ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcntrlat_id, 'units',
+     &                         grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+        grid2_center_lat = grid2_center_lat*deg2rad
+        grid2_center_lon = grid2_center_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid2 center lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlat_id, 
+     &                                       grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlon_id, 
+     &                                       grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      grid2_units = ' '
+      ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcrnrlat_id, 'units',
+     &                         grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+        grid2_corner_lat = grid2_corner_lat*deg2rad
+        grid2_corner_lon = grid2_corner_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid2 corner lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdarea_id, 
+     &                                       grid2_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdfrac_id, 
+     &                                       grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrdadd_id, 
+     &                        grid1_add_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrdadd_id, 
+     &                        grid2_add_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_rmpmatrix_id, 
+     &                                       wts_map1)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     initialize logical mask 
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_mask_int == 1)
+        grid1_mask = .true.
+      elsewhere
+        grid1_mask = .false.
+      endwhere
+      where (grid2_mask_int == 1)
+        grid2_mask = .true.
+      elsewhere
+        grid2_mask = .false.
+      endwhere
+      deallocate(grid1_mask_int, grid2_mask_int)
+
+!-----------------------------------------------------------------------
+!
+!     close input file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_close(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end subroutine read_remap_scrip
+
+!***********************************************************************
+
+      subroutine read_remap_csm
+
+!-----------------------------------------------------------------------
+!
+!     the routine reads a netCDF file to extract remapping info
+!     in NCAR-CSM format
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) ::
+     &  grid1_name           ! grid name for source grid
+     &, grid2_name           ! grid name for dest   grid
+
+      integer (kind=int_kind) ::
+     &  nc_numwgts1_id    ! extra netCDF id for num_wgts > 1 
+     &, nc_rmpmatrix2_id  ! extra netCDF id for high-order remap matrix
+
+      real (kind=dbl_kind), dimension(:),allocatable ::
+     &  wts1              ! CSM wants single array for 1st-order wts
+
+      real (kind=dbl_kind), dimension(:,:),allocatable ::
+     &  wts2              ! write remaining weights in different array
+
+      integer (kind=int_kind) ::  
+     &  n                    ! dummy index
+
+      integer (kind=int_kind), dimension(:), allocatable ::
+     &  grid1_mask_int,      ! integer masks to determine
+     &  grid2_mask_int       ! cells that participate in map
+
+!-----------------------------------------------------------------------
+!
+!     read some additional global attributes
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** source and destination grid names
+      !***
+
+      grid1_name = ' '
+      grid2_name = ' '
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'domain_a',
+     &                          grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'domain_b',
+     &                          grid2_name)
+      call netcdf_error_handler(ncstat)
+
+      print *,' '
+      print *,'Remapping between:',trim(grid1_name)
+      print *,'and ',trim(grid2_name)
+      print *,' '
+
+!-----------------------------------------------------------------------
+!
+!     read dimension information
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_inq_dimid(nc_file_id, 'n_a', nc_srcgrdsize_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdsize_id, grid1_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'n_b', nc_dstgrdsize_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdsize_id, grid2_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'nv_a', nc_srcgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdcorn_id, 
+     &                       grid1_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'nv_b', nc_dstgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdcorn_id, 
+     &                       grid2_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'src_grid_rank', 
+     &                      nc_srcgrdrank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdrank_id, 
+     &                       grid1_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_rank', 
+     &                      nc_dstgrdrank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdrank_id, 
+     &                       grid2_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'n_s', 
+     &                      nc_numlinks_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_numlinks_id, 
+     &                       num_links_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'num_wgts', 
+     &                      nc_numwgts_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_numwgts_id, num_wts)
+      call netcdf_error_handler(ncstat)
+
+      if (num_wts > 1) then
+        ncstat = nf_inq_dimid(nc_file_id, 'num_wgts1', 
+     &                        nc_numwgts1_id)
+        call netcdf_error_handler(ncstat)
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     allocate arrays
+!
+!-----------------------------------------------------------------------
+
+      allocate( grid1_dims      (grid1_rank),
+     &          grid1_center_lat(grid1_size), 
+     &          grid1_center_lon(grid1_size),
+     &          grid1_area      (grid1_size),
+     &          grid1_frac      (grid1_size),
+     &          grid1_mask      (grid1_size),
+     &          grid1_mask_int  (grid1_size),
+     &          grid1_corner_lat(grid1_corners, grid1_size),
+     &          grid1_corner_lon(grid1_corners, grid1_size) )
+
+      allocate( grid2_dims      (grid2_rank),
+     &          grid2_center_lat(grid2_size), 
+     &          grid2_center_lon(grid2_size),
+     &          grid2_area      (grid2_size),
+     &          grid2_frac      (grid2_size),
+     &          grid2_mask      (grid2_size),
+     &          grid2_mask_int  (grid2_size),
+     &          grid2_corner_lat(grid2_corners, grid2_size),
+     &          grid2_corner_lon(grid2_corners, grid2_size) )
+
+      allocate( grid1_add_map1(num_links_map1),
+     &          grid2_add_map1(num_links_map1),
+     &          wts_map1(num_wts,num_links_map1),
+     &          wts1(num_links_map1),
+     &          wts2(num_wts-1,num_links_map1) )
+
+!-----------------------------------------------------------------------
+!
+!     get variable ids
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_dims', 
+     &                      nc_srcgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'mask_a', 
+     &                      nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'yc_a', nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'xc_a', nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'yv_a', nc_srcgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'xv_a', nc_srcgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'area_a', nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'frac_a', nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_dims', 
+     &                      nc_dstgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'mask_b', 
+     &                      nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'yc_b', nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'xc_b', nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'yv_b', nc_dstgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'xv_b', nc_dstgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'area_b', nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'frac_b', nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'col', nc_srcgrdadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'row', nc_dstgrdadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'S', nc_rmpmatrix_id)
+      call netcdf_error_handler(ncstat)
+
+      if (num_wts > 1) then
+        ncstat = nf_inq_varid(nc_file_id, 'S2', nc_rmpmatrix2_id)
+        call netcdf_error_handler(ncstat)
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     read all variables
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrddims_id, 
+     &                        grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrdimask_id, 
+     &                        grid1_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlat_id, 
+     &                                       grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlon_id, 
+     &                                       grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcntrlat_id, 'units',
+     &                         grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+        grid1_center_lat = grid1_center_lat*deg2rad
+        grid1_center_lon = grid1_center_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid1 center lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlat_id, 
+     &                                       grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlon_id, 
+     &                                       grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcrnrlat_id, 'units',
+     &                         grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+        grid1_corner_lat = grid1_corner_lat*deg2rad
+        grid1_corner_lon = grid1_corner_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid1 corner lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdarea_id, 
+     &                                       grid1_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdfrac_id, 
+     &                                       grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrddims_id, 
+     &                        grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrdimask_id, 
+     &                        grid2_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlat_id, 
+     &                                       grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlon_id, 
+     &                                       grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcntrlat_id, 'units',
+     &                         grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+        grid2_center_lat = grid2_center_lat*deg2rad
+        grid2_center_lon = grid2_center_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid2 center lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlat_id, 
+     &                                       grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlon_id, 
+     &                                       grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+
+      ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcrnrlat_id, 'units',
+     &                         grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+        grid2_corner_lat = grid2_corner_lat*deg2rad
+        grid2_corner_lon = grid2_corner_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid2 corner lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdarea_id, 
+     &                                       grid2_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdfrac_id, 
+     &                                       grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrdadd_id, 
+     &                        grid1_add_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrdadd_id, 
+     &                        grid2_add_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_rmpmatrix_id, 
+     &                                       wts1)
+      wts_map1(1,:) = wts1
+      deallocate(wts1)
+
+      if (num_wts > 1) then
+        ncstat = nf_get_var_double(nc_file_id, nc_rmpmatrix2_id, 
+     &                                         wts2)
+        wts_map1(2:,:) = wts2
+        deallocate(wts2)
+      endif
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     initialize logical mask 
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_mask_int == 1)
+        grid1_mask = .true.
+      elsewhere
+        grid1_mask = .false.
+      endwhere
+      where (grid2_mask_int == 1)
+        grid2_mask = .true.
+      elsewhere
+        grid2_mask = .false.
+      endwhere
+      deallocate(grid1_mask_int, grid2_mask_int)
+
+!-----------------------------------------------------------------------
+!
+!     close input file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_close(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end subroutine read_remap_csm
+
+!***********************************************************************
+
+      end module remap_read
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/remap_vars.f
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/remap_vars.f	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/remap_vars.f	(revision 12863)
@@ -0,0 +1,302 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary variables for remapping between
+!     two grids.  also routines for resizing and initializing these
+!     variables.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_vars.f,v 1.5 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_vars
+
+      use kinds_mod
+      use constants
+      use grids
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter ::
+     &      norm_opt_none    = 1
+     &,     norm_opt_dstarea = 2
+     &,     norm_opt_frcarea = 3
+
+      integer (kind=int_kind), parameter ::
+     &      map_type_conserv  = 1
+     &,     map_type_bilinear = 2
+     &,     map_type_bicubic  = 3
+     &,     map_type_distwgt  = 4
+
+      integer (kind=int_kind), save :: 
+     &      max_links_map1  ! current size of link arrays
+     &,     num_links_map1  ! actual number of links for remapping
+     &,     max_links_map2  ! current size of link arrays
+     &,     num_links_map2  ! actual number of links for remapping
+     &,     num_maps        ! num of remappings for this grid pair
+     &,     num_wts         ! num of weights used in remapping
+     &,     map_type        ! identifier for remapping method
+     &,     norm_opt        ! option for normalization (conserv only)
+     &,     resize_increment ! default amount to increase array size
+
+      integer (kind=int_kind), dimension(:), allocatable, save ::
+     &      grid1_add_map1, ! grid1 address for each link in mapping 1
+     &      grid2_add_map1, ! grid2 address for each link in mapping 1
+     &      grid1_add_map2, ! grid1 address for each link in mapping 2
+     &      grid2_add_map2  ! grid2 address for each link in mapping 2
+
+      real (kind=dbl_kind), dimension(:,:), allocatable, save ::
+     &      wts_map1, ! map weights for each link (num_wts,max_links)
+     &      wts_map2  ! map weights for each link (num_wts,max_links)
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine init_remap_vars
+
+!-----------------------------------------------------------------------
+!
+!     this routine initializes some variables and provides an initial
+!     allocation of arrays (fairly large so frequent resizing 
+!     unnecessary).
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     determine the number of weights
+!
+!-----------------------------------------------------------------------
+
+      select case (map_type)
+      case(map_type_conserv)
+        num_wts = 3
+      case(map_type_bilinear)
+        num_wts = 1
+      case(map_type_bicubic)
+        num_wts = 4
+      case(map_type_distwgt)
+        num_wts = 1
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     initialize num_links and set max_links to four times the largest 
+!     of the destination grid sizes initially (can be changed later).
+!     set a default resize increment to increase the size of link
+!     arrays if the number of links exceeds the initial size
+!   
+!-----------------------------------------------------------------------
+
+      num_links_map1 = 0
+      max_links_map1 = 4*grid2_size
+      if (num_maps > 1) then
+        num_links_map2 = 0
+        max_links_map1 = max(4*grid1_size,4*grid2_size)
+        max_links_map2 = max_links_map1
+      endif
+
+      resize_increment = 0.1*max(grid1_size,grid2_size)
+
+!-----------------------------------------------------------------------
+!
+!     allocate address and weight arrays for mapping 1
+!   
+!-----------------------------------------------------------------------
+
+      allocate (grid1_add_map1(max_links_map1),
+     &          grid2_add_map1(max_links_map1),
+     &          wts_map1(num_wts, max_links_map1))
+
+!-----------------------------------------------------------------------
+!
+!     allocate address and weight arrays for mapping 2 if necessary 
+!   
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+        allocate (grid1_add_map2(max_links_map2),
+     &            grid2_add_map2(max_links_map2),
+     &            wts_map2(num_wts, max_links_map2))
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine init_remap_vars
+
+!***********************************************************************
+
+      subroutine resize_remap_vars(nmap, increment)
+
+!-----------------------------------------------------------------------
+!
+!     this routine resizes remapping arrays by increasing(decreasing)
+!     the max_links by increment
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::
+     &     nmap,      ! identifies which mapping array to resize
+     &     increment  ! the number of links to add(subtract) to arrays
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) ::
+     &   ierr,     ! error flag
+     &   mxlinks   ! size of link arrays
+
+      integer (kind=int_kind), dimension(:), allocatable ::
+     &   add1_tmp, ! temp array for resizing address arrays
+     &   add2_tmp  ! temp array for resizing address arrays
+
+      real (kind=dbl_kind), dimension(:,:), allocatable ::
+     &   wts_tmp   ! temp array for resizing weight arrays
+
+!-----------------------------------------------------------------------
+!
+!     resize map 1 arrays if required.
+!
+!-----------------------------------------------------------------------
+
+      select case (nmap)
+      case(1)
+
+        !***
+        !*** allocate temporaries to hold original values
+        !***
+
+        mxlinks = size(grid1_add_map1)
+        allocate (add1_tmp(mxlinks), add2_tmp(mxlinks), 
+     &            wts_tmp(num_wts,mxlinks))
+
+        add1_tmp = grid1_add_map1
+        add2_tmp = grid2_add_map1
+        wts_tmp  = wts_map1
+        
+        !***
+        !*** deallocate originals and increment max_links then
+        !*** reallocate arrays at new size
+        !***
+
+        deallocate (grid1_add_map1, grid2_add_map1, wts_map1)
+        max_links_map1 = mxlinks + increment
+        allocate (grid1_add_map1(max_links_map1),
+     &            grid2_add_map1(max_links_map1),
+     &            wts_map1(num_wts,max_links_map1))
+
+        !***
+        !*** restore original values from temp arrays and
+        !*** deallocate temps
+        !***
+
+        mxlinks = min(mxlinks, max_links_map1)
+        grid1_add_map1(1:mxlinks) = add1_tmp (1:mxlinks)
+        grid2_add_map1(1:mxlinks) = add2_tmp (1:mxlinks)
+        wts_map1    (:,1:mxlinks) = wts_tmp(:,1:mxlinks)
+        deallocate(add1_tmp, add2_tmp, wts_tmp)
+
+!-----------------------------------------------------------------------
+!
+!     resize map 2 arrays if required.
+!
+!-----------------------------------------------------------------------
+
+      case(2)
+
+        !***
+        !*** allocate temporaries to hold original values
+        !***
+
+        mxlinks = size(grid1_add_map2)
+        allocate (add1_tmp(mxlinks), add2_tmp(mxlinks), 
+     &            wts_tmp(num_wts,mxlinks),stat=ierr)
+        if (ierr .ne. 0) then
+          print *,'error allocating temps in resize: ',ierr
+          stop
+        endif
+
+        add1_tmp = grid1_add_map2
+        add2_tmp = grid2_add_map2
+        wts_tmp  = wts_map2
+        
+        !***
+        !*** deallocate originals and increment max_links then
+        !*** reallocate arrays at new size
+        !***
+
+        deallocate (grid1_add_map2, grid2_add_map2, wts_map2)
+        max_links_map2 = mxlinks + increment
+        allocate (grid1_add_map2(max_links_map2),
+     &            grid2_add_map2(max_links_map2),
+     &            wts_map2(num_wts,max_links_map2),stat=ierr)
+        if (ierr .ne. 0) then
+          print *,'error allocating new arrays in resize: ',ierr
+          stop
+        endif
+
+
+        !***
+        !*** restore original values from temp arrays and
+        !*** deallocate temps
+        !***
+
+        mxlinks = min(mxlinks, max_links_map2)
+        grid1_add_map2(1:mxlinks) = add1_tmp (1:mxlinks)
+        grid2_add_map2(1:mxlinks) = add2_tmp (1:mxlinks)
+        wts_map2    (:,1:mxlinks) = wts_tmp(:,1:mxlinks)
+        deallocate(add1_tmp, add2_tmp, wts_tmp)
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine resize_remap_vars
+
+!***********************************************************************
+
+      end module remap_vars
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/remap_write.f
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/remap_write.f	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/remap_write.f	(revision 12863)
@@ -0,0 +1,1763 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module contains routines for writing the remapping data to 
+!     a file.  Before writing the data for each mapping, the links are 
+!     sorted by destination grid address.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_write.f,v 1.7 2001/08/21 21:06:42 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_write
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common scalar constants
+      use grids         ! module containing grid information
+      use remap_vars    ! module containing remap information
+      use netcdf_mod    ! module with netCDF stuff
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), private :: 
+     &   map_method       ! character string for map_type
+     &,  normalize_opt    ! character string for normalization option
+     &,  history          ! character string for history information
+     &,  convention       ! character string for output convention
+
+      character(8), private :: 
+     &   cdate            ! character date string
+
+      integer (kind=int_kind), dimension(:), allocatable, private ::
+     &   src_mask_int     ! integer masks to determine
+     &,  dst_mask_int     ! cells that participate in map
+
+!-----------------------------------------------------------------------
+!
+!     various netCDF identifiers used by output routines
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), private ::
+     &   ncstat               ! error flag for netCDF calls 
+     &,  nc_file_id           ! id for netCDF file
+     &,  nc_srcgrdsize_id     ! id for source grid size
+     &,  nc_dstgrdsize_id     ! id for destination grid size
+     &,  nc_srcgrdcorn_id     ! id for number of source grid corners
+     &,  nc_dstgrdcorn_id     ! id for number of dest grid corners
+     &,  nc_srcgrdrank_id     ! id for source grid rank
+     &,  nc_dstgrdrank_id     ! id for dest grid rank
+     &,  nc_numlinks_id       ! id for number of links in mapping
+     &,  nc_numwgts_id        ! id for number of weights for mapping
+     &,  nc_srcgrddims_id     ! id for source grid dimensions
+     &,  nc_dstgrddims_id     ! id for dest grid dimensions
+     &,  nc_srcgrdcntrlat_id  ! id for source grid center latitude
+     &,  nc_dstgrdcntrlat_id  ! id for dest grid center latitude
+     &,  nc_srcgrdcntrlon_id  ! id for source grid center longitude
+     &,  nc_dstgrdcntrlon_id  ! id for dest grid center longitude
+     &,  nc_srcgrdimask_id    ! id for source grid mask
+     &,  nc_dstgrdimask_id    ! id for dest grid mask
+     &,  nc_srcgrdcrnrlat_id  ! id for latitude of source grid corners
+     &,  nc_srcgrdcrnrlon_id  ! id for longitude of source grid corners
+     &,  nc_dstgrdcrnrlat_id  ! id for latitude of dest grid corners
+     &,  nc_dstgrdcrnrlon_id  ! id for longitude of dest grid corners
+     &,  nc_srcgrdarea_id     ! id for area of source grid cells
+     &,  nc_dstgrdarea_id     ! id for area of dest grid cells
+     &,  nc_srcgrdfrac_id     ! id for area fraction on source grid
+     &,  nc_dstgrdfrac_id     ! id for area fraction on dest grid
+     &,  nc_srcadd_id         ! id for map source address
+     &,  nc_dstadd_id         ! id for map destination address
+     &,  nc_rmpmatrix_id      ! id for remapping matrix
+
+      integer (kind=int_kind), dimension(2), private ::
+     &   nc_dims2_id  ! netCDF ids for 2d array dims
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine write_remap(map1_name, map2_name, 
+     &                       interp_file1, interp_file2, output_opt)
+
+!-----------------------------------------------------------------------
+!
+!     calls correct output routine based on output format choice
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) ::
+     &            map1_name,    ! name for mapping grid1 to grid2
+     &            map2_name,    ! name for mapping grid2 to grid1
+     &            interp_file1, ! filename for map1 remap data
+     &            interp_file2, ! filename for map2 remap data
+     &            output_opt    ! option for output conventions
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     define some common variables to be used in all routines
+!
+!-----------------------------------------------------------------------
+
+      select case(norm_opt)
+      case (norm_opt_none)
+        normalize_opt = 'none'
+      case (norm_opt_frcarea)
+        normalize_opt = 'fracarea'
+      case (norm_opt_dstarea)
+        normalize_opt = 'destarea'
+      end select
+
+      select case(map_type)
+      case(map_type_conserv)
+        map_method = 'Conservative remapping'
+      case(map_type_bilinear)
+        map_method = 'Bilinear remapping'
+      case(map_type_distwgt)
+        map_method = 'Distance weighted avg of nearest neighbors'
+      case(map_type_bicubic)
+        map_method = 'Bicubic remapping'
+      case default
+        stop 'Invalid Map Type'
+      end select
+
+      call date_and_time(date=cdate)
+      write (history,1000) cdate(5:6),cdate(7:8),cdate(1:4)
+ 1000 format('Created: ',a2,'-',a2,'-',a4)
+
+!-----------------------------------------------------------------------
+!
+!     sort address and weight arrays
+!
+!-----------------------------------------------------------------------
+
+      call sort_add(grid2_add_map1, grid1_add_map1, wts_map1)
+      if (num_maps > 1) then
+        call sort_add(grid1_add_map2, grid2_add_map2, wts_map2)
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate output routine
+!
+!-----------------------------------------------------------------------
+
+      select case(output_opt)
+      case ('scrip')
+        call write_remap_scrip(map1_name, interp_file1, 1)
+      case ('ncar-csm')
+        call write_remap_csm  (map1_name, interp_file1, 1)
+      case default
+        stop 'unknown output file convention'
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate output routine for second mapping if required
+!
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+        select case(output_opt)
+        case ('scrip')
+          call write_remap_scrip(map2_name, interp_file2, 2)
+        case ('ncar-csm')
+          call write_remap_csm  (map2_name, interp_file2, 2)
+        case default
+          stop 'unknown output file convention'
+        end select
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine write_remap
+
+!***********************************************************************
+
+      subroutine write_remap_scrip(map_name, interp_file, direction)
+
+!-----------------------------------------------------------------------
+!
+!     writes remap data to a netCDF file using SCRIP conventions
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) ::
+     &            map_name     ! name for mapping 
+     &,           interp_file  ! filename for remap data
+
+      integer (kind=int_kind), intent(in) ::
+     &  direction              ! direction of map (1=grid1 to grid2
+                               !                   2=grid2 to grid1)
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len) ::
+     &  grid1_ctmp        ! character temp for grid1 names
+     &, grid2_ctmp        ! character temp for grid2 names
+
+      integer (kind=int_kind) ::
+     &  itmp1             ! integer temp
+     &, itmp2             ! integer temp
+     &, itmp3             ! integer temp
+     &, itmp4             ! integer temp
+
+!-----------------------------------------------------------------------
+!
+!     create netCDF file for mapping and define some global attributes
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_create (interp_file, NF_CLOBBER, nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map name
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'title',
+     &                          len_trim(map_name), map_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** normalization option
+      !***
+      ncstat = nf_put_att_text(nc_file_id, NF_GLOBAL, 'normalization',
+     &                         len_trim(normalize_opt), normalize_opt)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map method
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'map_method',
+     &                          len_trim(map_method), map_method)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** history
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'history',
+     &                          len_trim(history), history)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** file convention
+      !***
+      convention = 'SCRIP'
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'conventions',
+     &                          len_trim(convention), convention)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** source and destination grid names
+      !***
+
+      if (direction == 1) then
+        grid1_ctmp = 'source_grid'
+        grid2_ctmp = 'dest_grid'
+      else
+        grid1_ctmp = 'dest_grid'
+        grid2_ctmp = 'source_grid'
+      endif
+
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid1_ctmp),
+     &                          len_trim(grid1_name), grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid2_ctmp),
+     &                          len_trim(grid2_name), grid2_name)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     prepare netCDF dimension info
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** define grid size dimensions
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_size
+        itmp2 = grid2_size
+      else
+        itmp1 = grid2_size
+        itmp2 = grid1_size
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'src_grid_size', itmp1, 
+     &                     nc_srcgrdsize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'dst_grid_size', itmp2, 
+     &                     nc_dstgrdsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner dimension
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_corners
+        itmp2 = grid2_corners
+      else
+        itmp1 = grid2_corners
+        itmp2 = grid1_corners
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'src_grid_corners', 
+     &                     itmp1, nc_srcgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'dst_grid_corners', 
+     &                     itmp2, nc_dstgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid rank dimension
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_rank
+        itmp2 = grid2_rank
+      else
+        itmp1 = grid2_rank
+        itmp2 = grid1_rank
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'src_grid_rank', 
+     &                     itmp1, nc_srcgrdrank_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'dst_grid_rank', 
+     &                     itmp2, nc_dstgrdrank_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define map size dimensions
+      !***
+
+      if (direction == 1) then
+        itmp1 = num_links_map1
+      else
+        itmp1 = num_links_map2
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'num_links', 
+     &                     itmp1, nc_numlinks_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'num_wgts', 
+     &                     num_wts, nc_numwgts_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid dimensions
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_dims', NF_INT,
+     &                     1, nc_srcgrdrank_id, nc_srcgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_dims', NF_INT,
+     &                     1, nc_dstgrdrank_id, nc_dstgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     define all arrays for netCDF descriptors
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_center_lat', 
+     &                     NF_DOUBLE, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_center_lat', 
+     &                     NF_DOUBLE, 1, nc_dstgrdsize_id, 
+     &                     nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_center_lon', 
+     &                     NF_DOUBLE, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_center_lon', 
+     &                     NF_DOUBLE, 1, nc_dstgrdsize_id, 
+     &                     nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner lat/lon arrays
+      !***
+
+      nc_dims2_id(1) = nc_srcgrdcorn_id
+      nc_dims2_id(2) = nc_srcgrdsize_id
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_corner_lat', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_srcgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_corner_lon', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_srcgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      nc_dims2_id(1) = nc_dstgrdcorn_id
+      nc_dims2_id(2) = nc_dstgrdsize_id
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_corner_lat', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_dstgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_corner_lon', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_dstgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define units for all coordinate arrays
+      !***
+
+      if (direction == 1) then
+        grid1_ctmp = grid1_units
+        grid2_ctmp = grid2_units
+      else
+        grid1_ctmp = grid2_units
+        grid2_ctmp = grid1_units
+      endif
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlat_id, 
+     &                          'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlat_id, 
+     &                          'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlon_id, 
+     &                          'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlon_id, 
+     &                          'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlat_id, 
+     &                          'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlon_id, 
+     &                          'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlat_id, 
+     &                          'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlon_id, 
+     &                          'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_imask', NF_INT,
+     &                     1, nc_srcgrdsize_id, nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdimask_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_imask', NF_INT,
+     &                     1, nc_dstgrdsize_id, nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdimask_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_area', 
+     &                     NF_DOUBLE, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdarea_id, 
+     &                          'units', 14, 'square radians')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_area', 
+     &                     NF_DOUBLE, 1, nc_dstgrdsize_id, 
+     &                     nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdarea_id, 
+     &                          'units', 14, 'square radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid fraction arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_frac', 
+     &                     NF_DOUBLE, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdfrac_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_frac', 
+     &                     NF_DOUBLE, 1, nc_dstgrdsize_id, 
+     &                     nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdfrac_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define mapping arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_address', 
+     &                     NF_INT, 1, nc_numlinks_id, 
+     &                     nc_srcadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_address', 
+     &                     NF_INT, 1, nc_numlinks_id, 
+     &                     nc_dstadd_id)
+      call netcdf_error_handler(ncstat)
+
+      nc_dims2_id(1) = nc_numwgts_id
+      nc_dims2_id(2) = nc_numlinks_id
+
+      ncstat = nf_def_var (nc_file_id, 'remap_matrix', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_rmpmatrix_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     compute integer masks
+!
+!-----------------------------------------------------------------------
+
+      if (direction == 1) then
+        allocate (src_mask_int(grid1_size),
+     &            dst_mask_int(grid2_size))
+
+        where (grid2_mask)
+          dst_mask_int = 1
+        elsewhere
+          dst_mask_int = 0
+        endwhere
+
+        where (grid1_mask)
+          src_mask_int = 1
+        elsewhere
+          src_mask_int = 0
+        endwhere
+      else
+        allocate (src_mask_int(grid2_size),
+     &            dst_mask_int(grid1_size))
+
+        where (grid1_mask)
+          dst_mask_int = 1
+        elsewhere
+          dst_mask_int = 0
+        endwhere
+
+        where (grid2_mask)
+          src_mask_int = 1
+        elsewhere
+          src_mask_int = 0
+        endwhere
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     change units of lat/lon coordinates if input units different
+!     from radians
+!
+!-----------------------------------------------------------------------
+
+      if (grid1_units(1:7) == 'degrees' .and. direction == 1) then
+        grid1_center_lat = grid1_center_lat/deg2rad
+        grid1_center_lon = grid1_center_lon/deg2rad
+        grid1_corner_lat = grid1_corner_lat/deg2rad
+        grid1_corner_lon = grid1_corner_lon/deg2rad
+      endif
+
+      if (grid2_units(1:7) == 'degrees' .and. direction == 1) then
+        grid2_center_lat = grid2_center_lat/deg2rad
+        grid2_center_lon = grid2_center_lon/deg2rad
+        grid2_corner_lat = grid2_corner_lat/deg2rad
+        grid2_corner_lon = grid2_corner_lon/deg2rad
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     write mapping data
+!
+!-----------------------------------------------------------------------
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrddims_id
+        itmp2 = nc_dstgrddims_id
+      else
+        itmp2 = nc_srcgrddims_id
+        itmp1 = nc_dstgrddims_id
+      endif
+
+      ncstat = nf_put_var_int(nc_file_id, itmp1, grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, itmp2, grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, nc_srcgrdimask_id, 
+     &                        src_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, nc_dstgrdimask_id,
+     &                        dst_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      deallocate(src_mask_int, dst_mask_int)
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrdcntrlat_id
+        itmp2 = nc_srcgrdcntrlon_id
+        itmp3 = nc_srcgrdcrnrlat_id
+        itmp4 = nc_srcgrdcrnrlon_id
+      else
+        itmp1 = nc_dstgrdcntrlat_id
+        itmp2 = nc_dstgrdcntrlon_id
+        itmp3 = nc_dstgrdcrnrlat_id
+        itmp4 = nc_dstgrdcrnrlon_id
+      endif
+
+      ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp3, grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        itmp1 = nc_dstgrdcntrlat_id
+        itmp2 = nc_dstgrdcntrlon_id
+        itmp3 = nc_dstgrdcrnrlat_id
+        itmp4 = nc_dstgrdcrnrlon_id
+      else
+        itmp1 = nc_srcgrdcntrlat_id
+        itmp2 = nc_srcgrdcntrlon_id
+        itmp3 = nc_srcgrdcrnrlat_id
+        itmp4 = nc_srcgrdcrnrlon_id
+      endif
+
+      ncstat = nf_put_var_double(nc_file_id, itmp1, grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrdarea_id
+        itmp2 = nc_srcgrdfrac_id
+        itmp3 = nc_dstgrdarea_id
+        itmp4 = nc_dstgrdfrac_id
+      else
+        itmp1 = nc_dstgrdarea_id
+        itmp2 = nc_dstgrdfrac_id
+        itmp3 = nc_srcgrdarea_id
+        itmp4 = nc_srcgrdfrac_id
+      endif
+
+      if (luse_grid1_area) then
+        ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area_in)
+      else
+        ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area)
+      endif
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      if (luse_grid2_area) then
+        ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area_in)
+      else
+        ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area)
+      endif
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id, 
+     &                          grid1_add_map1)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id, 
+     &                          grid2_add_map1)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id, 
+     &                             wts_map1)
+        call netcdf_error_handler(ncstat)
+      else
+        ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id, 
+     &                          grid2_add_map2)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id, 
+     &                          grid1_add_map2)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id, 
+     &                             wts_map2)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      ncstat = nf_close(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end subroutine write_remap_scrip
+
+!***********************************************************************
+
+      subroutine write_remap_csm(map_name, interp_file, direction)
+
+!-----------------------------------------------------------------------
+!
+!     writes remap data to a netCDF file using NCAR-CSM conventions
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) ::
+     &            map_name     ! name for mapping 
+     &,           interp_file  ! filename for remap data
+
+      integer (kind=int_kind), intent(in) ::
+     &  direction              ! direction of map (1=grid1 to grid2
+                               !                   2=grid2 to grid1)
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len) ::
+     &  grid1_ctmp        ! character temp for grid1 names
+     &, grid2_ctmp        ! character temp for grid2 names
+
+      integer (kind=int_kind) ::
+     &  itmp1             ! integer temp
+     &, itmp2             ! integer temp
+     &, itmp3             ! integer temp
+     &, itmp4             ! integer temp
+     &, nc_numwgts1_id    ! extra netCDF id for additional weights
+     &, nc_src_isize_id   ! extra netCDF id for ni_a
+     &, nc_src_jsize_id   ! extra netCDF id for nj_a
+     &, nc_dst_isize_id   ! extra netCDF id for ni_b
+     &, nc_dst_jsize_id   ! extra netCDF id for nj_b
+     &, nc_rmpmatrix2_id  ! extra netCDF id for high-order remap matrix
+
+      real (kind=dbl_kind), dimension(:),allocatable ::
+     &  wts1              ! CSM wants single array for 1st-order wts
+
+      real (kind=dbl_kind), dimension(:,:),allocatable ::
+     &  wts2              ! write remaining weights in different array
+
+!-----------------------------------------------------------------------
+!
+!     create netCDF file for mapping and define some global attributes
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_create (interp_file, NF_CLOBBER, nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map name
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'title',
+     &                          len_trim(map_name), map_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** normalization option
+      !***
+      ncstat = nf_put_att_text(nc_file_id, NF_GLOBAL, 'normalization',
+     &                         len_trim(normalize_opt), normalize_opt)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map method
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'map_method',
+     &                          len_trim(map_method), map_method)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** history
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'history',
+     &                          len_trim(history), history)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** file convention
+      !***
+      convention = 'NCAR-CSM'
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'conventions',
+     &                          len_trim(convention), convention)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** source and destination grid names
+      !***
+
+      if (direction == 1) then
+        grid1_ctmp = 'domain_a'
+        grid2_ctmp = 'domain_b'
+      else
+        grid1_ctmp = 'domain_b'
+        grid2_ctmp = 'domain_a'
+      endif
+
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid1_ctmp),
+     &                          len_trim(grid1_name), grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid2_ctmp),
+     &                          len_trim(grid2_name), grid2_name)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     prepare netCDF dimension info
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** define grid size dimensions
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_size
+        itmp2 = grid2_size
+      else
+        itmp1 = grid2_size
+        itmp2 = grid1_size
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'n_a', itmp1, nc_srcgrdsize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'n_b', itmp2, nc_dstgrdsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner dimension
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_corners
+        itmp2 = grid2_corners
+      else
+        itmp1 = grid2_corners
+        itmp2 = grid1_corners
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'nv_a', itmp1, nc_srcgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'nv_b', itmp2, nc_dstgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid rank dimension
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_rank
+        itmp2 = grid2_rank
+      else
+        itmp1 = grid2_rank
+        itmp2 = grid1_rank
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'src_grid_rank', 
+     &                     itmp1, nc_srcgrdrank_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'dst_grid_rank', 
+     &                     itmp2, nc_dstgrdrank_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define first two dims as if 2-d cartesian domain
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_dims(1)
+        if (grid1_rank > 1) then
+          itmp2 = grid1_dims(2)
+        else
+          itmp2 = 0
+        endif
+        itmp3 = grid2_dims(1)
+        if (grid2_rank > 1) then
+          itmp4 = grid2_dims(2)
+        else
+          itmp4 = 0
+        endif
+      else
+        itmp1 = grid2_dims(1)
+        if (grid2_rank > 1) then
+          itmp2 = grid2_dims(2)
+        else
+          itmp2 = 0
+        endif
+        itmp3 = grid1_dims(1)
+        if (grid1_rank > 1) then
+          itmp4 = grid1_dims(2)
+        else
+          itmp4 = 0
+        endif
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'ni_a', itmp1, nc_src_isize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'nj_a', itmp2, nc_src_jsize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'ni_b', itmp3, nc_dst_isize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'nj_b', itmp4, nc_dst_jsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define map size dimensions
+      !***
+
+      if (direction == 1) then
+        itmp1 = num_links_map1
+      else
+        itmp1 = num_links_map2
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'n_s', itmp1, nc_numlinks_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'num_wgts', 
+     &                     num_wts, nc_numwgts_id)
+      call netcdf_error_handler(ncstat)
+
+      if (num_wts > 1) then
+        ncstat = nf_def_dim (nc_file_id, 'num_wgts1', 
+     &                       num_wts-1, nc_numwgts1_id)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      !***
+      !*** define grid dimensions
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_dims', NF_INT,
+     &                     1, nc_srcgrdrank_id, nc_srcgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_dims', NF_INT,
+     &                     1, nc_dstgrdrank_id, nc_dstgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     define all arrays for netCDF descriptors
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'yc_a',
+     &                     NF_DOUBLE, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'yc_b', 
+     &                     NF_DOUBLE, 1, nc_dstgrdsize_id, 
+     &                     nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'xc_a', 
+     &                     NF_DOUBLE, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'xc_b', 
+     &                     NF_DOUBLE, 1, nc_dstgrdsize_id, 
+     &                     nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner lat/lon arrays
+      !***
+
+      nc_dims2_id(1) = nc_srcgrdcorn_id
+      nc_dims2_id(2) = nc_srcgrdsize_id
+
+      ncstat = nf_def_var (nc_file_id, 'yv_a', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_srcgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'xv_a', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_srcgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      nc_dims2_id(1) = nc_dstgrdcorn_id
+      nc_dims2_id(2) = nc_dstgrdsize_id
+
+      ncstat = nf_def_var (nc_file_id, 'yv_b', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_dstgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'xv_b', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_dstgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** CSM wants all in degrees
+      !***
+
+      grid1_units = 'degrees'
+      grid2_units = 'degrees'
+
+      if (direction == 1) then
+        grid1_ctmp = grid1_units
+        grid2_ctmp = grid2_units
+      else
+        grid1_ctmp = grid2_units
+        grid2_ctmp = grid1_units
+      endif
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlat_id, 
+     &                          'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlat_id, 
+     &                          'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlon_id, 
+     &                          'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlon_id, 
+     &                          'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlat_id, 
+     &                          'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlon_id, 
+     &                          'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlat_id, 
+     &                          'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlon_id, 
+     &                          'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'mask_a', NF_INT,
+     &                     1, nc_srcgrdsize_id, nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdimask_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'mask_b', NF_INT,
+     &                     1, nc_dstgrdsize_id, nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdimask_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'area_a', 
+     &                     NF_DOUBLE, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdarea_id, 
+     &                          'units', 14, 'square radians')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'area_b', 
+     &                     NF_DOUBLE, 1, nc_dstgrdsize_id, 
+     &                     nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdarea_id, 
+     &                          'units', 14, 'square radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid fraction arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'frac_a', 
+     &                     NF_DOUBLE, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdfrac_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'frac_b', 
+     &                     NF_DOUBLE, 1, nc_dstgrdsize_id, 
+     &                     nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdfrac_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define mapping arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'col', 
+     &                     NF_INT, 1, nc_numlinks_id, 
+     &                     nc_srcadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'row', 
+     &                     NF_INT, 1, nc_numlinks_id, 
+     &                     nc_dstadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'S', 
+     &                     NF_DOUBLE, 1, nc_numlinks_id, 
+     &                     nc_rmpmatrix_id)
+      call netcdf_error_handler(ncstat)
+
+      if (num_wts > 1) then
+        nc_dims2_id(1) = nc_numwgts1_id
+        nc_dims2_id(2) = nc_numlinks_id
+
+        ncstat = nf_def_var (nc_file_id, 'S2', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_rmpmatrix2_id)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     compute integer masks
+!
+!-----------------------------------------------------------------------
+
+      if (direction == 1) then
+        allocate (src_mask_int(grid1_size),
+     &            dst_mask_int(grid2_size))
+
+        where (grid2_mask)
+          dst_mask_int = 1
+        elsewhere
+          dst_mask_int = 0
+        endwhere
+
+        where (grid1_mask)
+          src_mask_int = 1
+        elsewhere
+          src_mask_int = 0
+        endwhere
+      else
+        allocate (src_mask_int(grid2_size),
+     &            dst_mask_int(grid1_size))
+
+        where (grid1_mask)
+          dst_mask_int = 1
+        elsewhere
+          dst_mask_int = 0
+        endwhere
+
+        where (grid2_mask)
+          src_mask_int = 1
+        elsewhere
+          src_mask_int = 0
+        endwhere
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     change units of lat/lon coordinates if input units different
+!     from radians. if this is the second mapping, the conversion has
+!     alread been done.
+!
+!-----------------------------------------------------------------------
+
+      if (grid1_units(1:7) == 'degrees' .and. direction == 1) then
+        grid1_center_lat = grid1_center_lat/deg2rad
+        grid1_center_lon = grid1_center_lon/deg2rad
+        grid1_corner_lat = grid1_corner_lat/deg2rad
+        grid1_corner_lon = grid1_corner_lon/deg2rad
+      endif
+
+      if (grid2_units(1:7) == 'degrees' .and. direction == 1) then
+        grid2_center_lat = grid2_center_lat/deg2rad
+        grid2_center_lon = grid2_center_lon/deg2rad
+        grid2_corner_lat = grid2_corner_lat/deg2rad
+        grid2_corner_lon = grid2_corner_lon/deg2rad
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     write mapping data
+!
+!-----------------------------------------------------------------------
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrddims_id
+        itmp2 = nc_dstgrddims_id
+      else
+        itmp2 = nc_srcgrddims_id
+        itmp1 = nc_dstgrddims_id
+      endif
+
+      ncstat = nf_put_var_int(nc_file_id, itmp1, grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, itmp2, grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, nc_srcgrdimask_id, 
+     &                        src_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, nc_dstgrdimask_id,
+     &                        dst_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      deallocate(src_mask_int, dst_mask_int)
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrdcntrlat_id
+        itmp2 = nc_srcgrdcntrlon_id
+        itmp3 = nc_srcgrdcrnrlat_id
+        itmp4 = nc_srcgrdcrnrlon_id
+      else
+        itmp1 = nc_dstgrdcntrlat_id
+        itmp2 = nc_dstgrdcntrlon_id
+        itmp3 = nc_dstgrdcrnrlat_id
+        itmp4 = nc_dstgrdcrnrlon_id
+      endif
+
+      ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp3, grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        itmp1 = nc_dstgrdcntrlat_id
+        itmp2 = nc_dstgrdcntrlon_id
+        itmp3 = nc_dstgrdcrnrlat_id
+        itmp4 = nc_dstgrdcrnrlon_id
+      else
+        itmp1 = nc_srcgrdcntrlat_id
+        itmp2 = nc_srcgrdcntrlon_id
+        itmp3 = nc_srcgrdcrnrlat_id
+        itmp4 = nc_srcgrdcrnrlon_id
+      endif
+
+      ncstat = nf_put_var_double(nc_file_id, itmp1, grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrdarea_id
+        itmp2 = nc_srcgrdfrac_id
+        itmp3 = nc_dstgrdarea_id
+        itmp4 = nc_dstgrdfrac_id
+      else
+        itmp1 = nc_dstgrdarea_id
+        itmp2 = nc_dstgrdfrac_id
+        itmp3 = nc_srcgrdarea_id
+        itmp4 = nc_srcgrdfrac_id
+      endif
+
+      if (luse_grid1_area) then
+        ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area_in)
+      else
+        ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area)
+      endif
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      if (luse_grid2_area) then
+        ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area)
+      else
+        ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area)
+      endif
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id, 
+     &                          grid1_add_map1)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id, 
+     &                          grid2_add_map1)
+        call netcdf_error_handler(ncstat)
+
+        if (num_wts == 1) then
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id, 
+     &                               wts_map1)
+          call netcdf_error_handler(ncstat)
+        else
+          allocate(wts1(num_links_map1),wts2(num_wts-1,num_links_map1))
+
+          wts1 = wts_map1(1,:)
+          wts2 = wts_map1(2:,:)
+
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id, 
+     &                               wts1)
+          call netcdf_error_handler(ncstat)
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix2_id, 
+     &                               wts2)
+          call netcdf_error_handler(ncstat)
+          deallocate(wts1,wts2)
+        endif
+      else
+        ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id, 
+     &                          grid2_add_map2)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id, 
+     &                          grid1_add_map2)
+        call netcdf_error_handler(ncstat)
+
+        if (num_wts == 1) then
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id, 
+     &                               wts_map2)
+          call netcdf_error_handler(ncstat)
+        else
+          allocate(wts1(num_links_map2),wts2(num_wts-1,num_links_map2))
+
+          wts1 = wts_map2(1,:)
+          wts2 = wts_map2(2:,:)
+
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id, 
+     &                               wts1)
+          call netcdf_error_handler(ncstat)
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix2_id, 
+     &                               wts2)
+          call netcdf_error_handler(ncstat)
+          deallocate(wts1,wts2)
+        endif
+      endif
+
+      ncstat = nf_close(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end subroutine write_remap_csm
+
+!***********************************************************************
+
+      subroutine sort_add(add1, add2, weights)
+
+!-----------------------------------------------------------------------
+!
+!     this routine sorts address and weight arrays based on the
+!     destination address with the source address as a secondary
+!     sorting criterion.  the method is a standard heap sort.
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common scalar constants
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     Input and Output arrays
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(inout), dimension(:) ::
+     &        add1,       ! destination address array (num_links)
+     &        add2        ! source      address array
+
+      real (kind=dbl_kind), intent(inout), dimension(:,:) ::
+     &        weights     ! remapping weights (num_wts, num_links)
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) ::
+     &          num_links,          ! num of links for this mapping
+     &          num_wts,            ! num of weights for this mapping
+     &          add1_tmp, add2_tmp, ! temp for addresses during swap
+     &          nwgt,
+     &          lvl, final_lvl,     ! level indexes for heap sort levels
+     &          chk_lvl1, chk_lvl2, max_lvl
+
+      real (kind=dbl_kind), dimension(SIZE(weights,DIM=1)) ::
+     &          wgttmp              ! temp for holding wts during swap
+
+!-----------------------------------------------------------------------
+!
+!     determine total number of links to sort and number of weights
+!
+!-----------------------------------------------------------------------
+
+      num_links = SIZE(add1)
+      num_wts   = SIZE(weights, DIM=1)
+
+!-----------------------------------------------------------------------
+!
+!     start at the lowest level (N/2) of the tree and sift lower 
+!     values to the bottom of the tree, promoting the larger numbers
+!
+!-----------------------------------------------------------------------
+
+      do lvl=num_links/2,1,-1
+
+        final_lvl = lvl
+        add1_tmp = add1(lvl)
+        add2_tmp = add2(lvl)
+        wgttmp(:) = weights(:,lvl)
+
+        !***
+        !*** loop until proper level is found for this link, or reach
+        !*** bottom
+        !***
+
+        sift_loop1: do
+
+          !***
+          !*** find the largest of the two daughters
+          !***
+
+          chk_lvl1 = 2*final_lvl
+          chk_lvl2 = 2*final_lvl+1
+          if (chk_lvl1 .EQ. num_links) chk_lvl2 = chk_lvl1
+
+          if ((add1(chk_lvl1) >  add1(chk_lvl2)) .OR.
+     &       ((add1(chk_lvl1) == add1(chk_lvl2)) .AND.
+     &        (add2(chk_lvl1) >  add2(chk_lvl2)))) then
+            max_lvl = chk_lvl1
+          else 
+            max_lvl = chk_lvl2
+          endif
+
+          !***
+          !*** if the parent is greater than both daughters,
+          !*** the correct level has been found
+          !***
+
+          if ((add1_tmp .GT. add1(max_lvl)) .OR.
+     &       ((add1_tmp .EQ. add1(max_lvl)) .AND.
+     &        (add2_tmp .GT. add2(max_lvl)))) then
+            add1(final_lvl) = add1_tmp
+            add2(final_lvl) = add2_tmp
+            weights(:,final_lvl) = wgttmp(:)
+            exit sift_loop1
+
+          !***
+          !*** otherwise, promote the largest daughter and push
+          !*** down one level in the tree.  if haven't reached
+          !*** the end of the tree, repeat the process.  otherwise
+          !*** store last values and exit the loop
+          !***
+
+          else 
+            add1(final_lvl) = add1(max_lvl)
+            add2(final_lvl) = add2(max_lvl)
+            weights(:,final_lvl) = weights(:,max_lvl)
+
+            final_lvl = max_lvl
+            if (2*final_lvl > num_links) then
+              add1(final_lvl) = add1_tmp
+              add2(final_lvl) = add2_tmp
+              weights(:,final_lvl) = wgttmp(:)
+              exit sift_loop1
+            endif
+          endif
+        end do sift_loop1
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     now that the heap has been sorted, strip off the top (largest)
+!     value and promote the values below
+!
+!-----------------------------------------------------------------------
+
+      do lvl=num_links,3,-1
+
+        !***
+        !*** move the top value and insert it into the correct place
+        !***
+
+        add1_tmp = add1(lvl)
+        add1(lvl) = add1(1)
+
+        add2_tmp = add2(lvl)
+        add2(lvl) = add2(1)
+
+        wgttmp(:) = weights(:,lvl)
+        weights(:,lvl) = weights(:,1)
+
+        !***
+        !*** as above this loop sifts the tmp values down until proper 
+        !*** level is reached
+        !***
+
+        final_lvl = 1
+
+        sift_loop2: do
+
+          !***
+          !*** find the largest of the two daughters
+          !***
+
+          chk_lvl1 = 2*final_lvl
+          chk_lvl2 = 2*final_lvl+1
+          if (chk_lvl2 >= lvl) chk_lvl2 = chk_lvl1
+
+          if ((add1(chk_lvl1) >  add1(chk_lvl2)) .OR.
+     &       ((add1(chk_lvl1) == add1(chk_lvl2)) .AND.
+     &        (add2(chk_lvl1) >  add2(chk_lvl2)))) then
+            max_lvl = chk_lvl1
+          else 
+            max_lvl = chk_lvl2
+          endif
+
+          !***
+          !*** if the parent is greater than both daughters,
+          !*** the correct level has been found
+          !***
+
+          if ((add1_tmp >  add1(max_lvl)) .OR.
+     &       ((add1_tmp == add1(max_lvl)) .AND.
+     &        (add2_tmp >  add2(max_lvl)))) then
+            add1(final_lvl) = add1_tmp
+            add2(final_lvl) = add2_tmp
+            weights(:,final_lvl) = wgttmp(:)
+            exit sift_loop2
+
+          !***
+          !*** otherwise, promote the largest daughter and push
+          !*** down one level in the tree.  if haven't reached
+          !*** the end of the tree, repeat the process.  otherwise
+          !*** store last values and exit the loop
+          !***
+
+          else 
+            add1(final_lvl) = add1(max_lvl)
+            add2(final_lvl) = add2(max_lvl)
+            weights(:,final_lvl) = weights(:,max_lvl)
+
+            final_lvl = max_lvl
+            if (2*final_lvl >= lvl) then
+              add1(final_lvl) = add1_tmp
+              add2(final_lvl) = add2_tmp
+              weights(:,final_lvl) = wgttmp(:)
+              exit sift_loop2
+            endif
+          endif
+        end do sift_loop2
+      end do
+
+      !***
+      !*** swap the last two entries
+      !***
+
+
+      add1_tmp = add1(2)
+      add1(2)  = add1(1)
+      add1(1)  = add1_tmp
+
+      add2_tmp = add2(2)
+      add2(2)  = add2(1)
+      add2(1)  = add2_tmp
+
+      wgttmp (:)   = weights(:,2)
+      weights(:,2) = weights(:,1)
+      weights(:,1) = wgttmp (:)
+
+!-----------------------------------------------------------------------
+
+      end subroutine sort_add
+
+!***********************************************************************
+
+      end module remap_write
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/scrip.f
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/scrip.f	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/scrip.f	(revision 12863)
@@ -0,0 +1,214 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This routine is the driver for computing the addresses and weights 
+!     for interpolating between two grids on a sphere.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: scrip.f,v 1.6 2001/08/21 21:06:44 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      program scrip
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod                  ! module defining data types
+      use constants                  ! module for common constants
+      use iounits                    ! I/O unit manager
+      use timers                     ! CPU timers
+      use grids                      ! module with grid information
+      use remap_vars                 ! common remapping variables
+      use remap_conservative         ! routines for conservative remap
+      use remap_distance_weight      ! routines for dist-weight remap
+      use remap_bilinear             ! routines for bilinear interp
+      use remap_bicubic              ! routines for bicubic  interp
+      use remap_write                ! routines for remap output
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     input namelist variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) :: 
+     &           grid1_file,   ! filename of grid file containing grid1
+     &           grid2_file,   ! filename of grid file containing grid2
+     &           interp_file1, ! filename for output remap data (map1)
+     &           interp_file2, ! filename for output remap data (map2)
+     &           map1_name,    ! name for mapping from grid1 to grid2
+     &           map2_name,    ! name for mapping from grid2 to grid1
+     &           map_method,   ! choice for mapping method
+     &           normalize_opt,! option for normalizing weights
+     &           output_opt    ! option for output conventions
+
+      integer (kind=int_kind) ::
+     &           nmap          ! number of mappings to compute (1 or 2)
+
+      namelist /remap_inputs/ grid1_file, grid2_file, 
+     &                        interp_file1, interp_file2,
+     &                        map1_name, map2_name, num_maps,
+     &                        luse_grid1_area, luse_grid2_area,
+     &                        map_method, normalize_opt, output_opt,
+     &                        restrict_type, num_srch_bins
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,     ! dummy counter
+     &                           iunit  ! unit number for namelist file
+
+!-----------------------------------------------------------------------
+!
+!     initialize timers
+!
+!-----------------------------------------------------------------------
+
+      call timers_init
+      do n=1,max_timers
+        call timer_clear(n)
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     read input namelist
+!
+!-----------------------------------------------------------------------
+
+      grid1_file    = 'unknown'
+      grid2_file    = 'unknown'
+      interp_file1  = 'unknown'
+      interp_file2  = 'unknown'
+      map1_name     = 'unknown'
+      map2_name     = 'unknown'
+      luse_grid1_area = .false.
+      luse_grid2_area = .false.
+      num_maps      = 2
+      map_type      = 1
+      normalize_opt = 'fracarea'
+      output_opt    = 'scrip'
+      restrict_type = 'latitude'
+      num_srch_bins = 900
+
+      call get_unit(iunit)
+      open(iunit, file='scrip_in', status='old', form='formatted')
+      read(iunit, nml=remap_inputs)
+      call release_unit(iunit)
+
+      select case(map_method)
+      case ('conservative')
+        map_type = map_type_conserv
+        luse_grid_centers = .false.
+      case ('bilinear')
+        map_type = map_type_bilinear
+        luse_grid_centers = .true.
+      case ('bicubic')
+        map_type = map_type_bicubic
+        luse_grid_centers = .true.
+      case ('distwgt')
+        map_type = map_type_distwgt
+        luse_grid_centers = .true.
+      case default
+        stop 'unknown mapping method'
+      end select
+
+      select case(normalize_opt(1:4))
+      case ('none')
+        norm_opt = norm_opt_none
+      case ('frac')
+        norm_opt = norm_opt_frcarea
+      case ('dest')
+        norm_opt = norm_opt_dstarea
+      case default
+        stop 'unknown normalization option'
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     initialize grid information for both grids
+!
+!-----------------------------------------------------------------------
+
+      call grid_init(grid1_file, grid2_file)
+
+      write(stdout, *) ' Computing remappings between: ',grid1_name
+      write(stdout, *) '                          and  ',grid2_name
+
+!-----------------------------------------------------------------------
+!
+!     initialize some remapping variables.
+!
+!-----------------------------------------------------------------------
+
+      call init_remap_vars
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate interpolation setup routine based on type of
+!     remapping requested.
+!
+!-----------------------------------------------------------------------
+
+      select case(map_type)
+      case(map_type_conserv)
+        call remap_conserv
+      case(map_type_bilinear)
+        call remap_bilin
+      case(map_type_distwgt)
+        call remap_distwgt
+      case(map_type_bicubic)
+        call remap_bicub
+      case default
+        stop 'Invalid Map Type'
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     reduce size of remapping arrays and then write remapping info
+!     to a file.
+!
+!-----------------------------------------------------------------------
+
+      if (num_links_map1 /= max_links_map1) then
+        call resize_remap_vars(1, num_links_map1-max_links_map1)
+      endif
+      if ((num_maps > 1) .and. (num_links_map2 /= max_links_map2)) then
+        call resize_remap_vars(2, num_links_map2-max_links_map2)
+      endif
+
+      call write_remap(map1_name, map2_name, 
+     &                 interp_file1, interp_file2, output_opt)
+
+!-----------------------------------------------------------------------
+
+      end program scrip
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/scrip_test.f
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/scrip_test.f	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/scrip_test.f	(revision 12863)
@@ -0,0 +1,981 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this program is a short driver that tests the remappings using
+!     a simple analytic field.  the results are written in netCDF
+!     format.
+!
+!     CVS: $Id: scrip_test.f,v 1.6 2000/04/19 21:45:09 pwjones Exp $
+!
+!-----------------------------------------------------------------------
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      program remap_test
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod    ! defines common data types
+      use constants    ! defines common constants
+      use iounits      ! I/O unit manager
+      use netcdf_mod   ! netcdf I/O stuff
+      use grids        ! module containing grid info
+      use remap_vars   ! module containing remapping info
+      use remap_mod    ! module containing remapping routines
+      use remap_read   ! routines for reading remap files
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     input namelist variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) ::
+     &  field_choice   ! choice of field to be interpolated
+
+      character (char_len) :: 
+     &  interp_file,   ! filename containing remap data (map1)
+     &  output_file    ! filename for test results
+
+      namelist /remap_inputs/ field_choice, interp_file, output_file
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) :: 
+     &        map_name      ! name for mapping from grid1 to grid2
+
+      integer (kind=int_kind) ::    ! netCDF ids for files and arrays
+     &        ncstat, nc_outfile_id, 
+     &        nc_srcgrdcntrlat_id, nc_srcgrdcntrlon_id,
+     &        nc_dstgrdcntrlat_id, nc_dstgrdcntrlon_id,
+     &        nc_srcgrdrank_id, nc_dstgrdrank_id,
+     &        nc_srcgrdimask_id, nc_dstgrdimask_id,
+     &        nc_srcgrdarea_id, nc_dstgrdarea_id,
+     &        nc_srcgrdfrac_id, nc_dstgrdfrac_id,
+     &        nc_srcarray_id, nc_srcgradlat_id, nc_srcgradlon_id,
+     &        nc_dstarray1_id, nc_dstarray1a_id, nc_dstarray2_id,
+     &        nc_dsterror1_id, nc_dsterror1a_id, nc_dsterror2_id
+
+      integer (kind=int_kind), dimension(:), allocatable ::
+     &        nc_grid1size_id, nc_grid2size_id
+
+!-----------------------------------------------------------------------
+
+      character (char_len) :: 
+     &          dim_name    ! netCDF dimension name
+
+      integer (kind=int_kind) :: i,j,n,imin,imax,idiff,
+     &    ip1,im1,jp1,jm1,nx,ny, ! for computing bicub gradients
+     &    in,is,ie,iw,ine,inw,ise,isw,
+     &    iunit                  ! unit number for namelist file
+
+      integer (kind=int_kind), dimension(:), allocatable ::
+     &    grid1_imask, grid2_imask, grid2_count
+
+      real (kind=dbl_kind) ::
+     &    delew, delns,     ! variables for computing bicub gradients
+     &    length            ! length scale for cosine hill test field
+
+      real (kind=dbl_kind), dimension(:), allocatable ::
+     &    grid1_array, 
+     &    grid1_tmp, 
+     &    grad1_lat, 
+     &    grad1_lon, 
+     &    grad1_latlon, 
+     &    grad1_lat_zero, 
+     &    grad1_lon_zero, 
+     &    grid2_array, 
+     &    grid2_err,
+     &    grid2_tmp
+
+!-----------------------------------------------------------------------
+!
+!     read namelist for file and mapping info
+!
+!-----------------------------------------------------------------------
+
+      call get_unit(iunit)
+      open(iunit, file='scrip_test_in', status='old', form='formatted')
+      read(iunit, nml=remap_inputs)
+      call release_unit(iunit)
+      write(*,nml=remap_inputs)
+
+!-----------------------------------------------------------------------
+!
+!     read remapping data
+!
+!-----------------------------------------------------------------------
+
+      call read_remap(map_name, interp_file)
+
+!-----------------------------------------------------------------------
+!
+!     allocate arrays
+!
+!-----------------------------------------------------------------------
+
+      allocate (grid1_array    (grid1_size), 
+     &          grid1_tmp      (grid1_size),
+     &          grad1_lat      (grid1_size), 
+     &          grad1_lon      (grid1_size), 
+     &          grad1_lat_zero (grid1_size), 
+     &          grad1_lon_zero (grid1_size), 
+     &          grid1_imask    (grid1_size),
+     &          grid2_array    (grid2_size), 
+     &          grid2_err      (grid2_size),
+     &          grid2_tmp      (grid2_size),
+     &          grid2_imask    (grid2_size),
+     &          grid2_count    (grid2_size))
+
+      where (grid1_mask)
+        grid1_imask = 1
+      elsewhere
+        grid1_imask = 0
+      endwhere
+      where (grid2_mask)
+        grid2_imask = 1
+      elsewhere
+        grid2_imask = 0
+      endwhere
+
+!-----------------------------------------------------------------------
+!
+!     setup a NetCDF file for output
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** create netCDF dataset 
+      !***
+
+      ncstat = nf_create (output_file, NF_CLOBBER, nc_outfile_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, NF_GLOBAL, 'title',
+     &                          len_trim(map_name), map_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid size dimensions
+      !***
+
+      allocate( nc_grid1size_id(grid1_rank),
+     &          nc_grid2size_id(grid2_rank))
+
+      do n=1,grid1_rank
+        write(dim_name,1000) 'grid1_dim',n
+        ncstat = nf_def_dim (nc_outfile_id, dim_name, 
+     &                       grid1_dims(n), nc_grid1size_id(n))
+        call netcdf_error_handler(ncstat)
+      end do
+
+      do n=1,grid2_rank
+        write(dim_name,1000) 'grid2_dim',n
+        ncstat = nf_def_dim (nc_outfile_id, dim_name, 
+     &                       grid2_dims(n), nc_grid2size_id(n))
+        call netcdf_error_handler(ncstat)
+      end do
+ 1000 format(a9,i1)
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_center_lat', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_srcgrdcntrlat_id, 
+     &                          'units', 7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_center_lat', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_dstgrdcntrlat_id, 
+     &                          'units', 7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_center_lon', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_srcgrdcntrlon_id, 
+     &                          'units', 7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_center_lon', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_dstgrdcntrlon_id, 
+     &                          'units', 7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_imask', NF_INT,
+     &               grid1_rank, nc_grid1size_id, nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_srcgrdimask_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_imask', NF_INT,
+     &               grid2_rank, nc_grid2size_id, nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_dstgrdimask_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_area', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_area', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid fraction arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_frac', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_frac', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define source array
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_array', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcarray_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define gradient arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grad_lat', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgradlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grad_lon', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgradlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define destination arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_array1', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstarray1_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_array1a', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstarray1a_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_array2', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstarray2_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define error arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_error1', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dsterror1_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_error1a', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dsterror1a_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_error2', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dsterror2_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_outfile_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     write some grid info
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** write grid center latitude array
+      !***
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgrdcntrlat_id,
+     &                           grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstgrdcntrlat_id,
+     &                           grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** write grid center longitude array
+      !***
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgrdcntrlon_id,
+     &                           grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstgrdcntrlon_id,
+     &                           grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** write grid mask
+      !***
+
+      ncstat = nf_put_var_int(nc_outfile_id, nc_srcgrdimask_id,
+     &                        grid1_imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_outfile_id, nc_dstgrdimask_id,
+     &                        grid2_imask)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area arrays
+      !***
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgrdarea_id,
+     &                           grid1_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstgrdarea_id,
+     &                           grid2_area)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid fraction arrays
+      !***
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgrdfrac_id,
+     &                           grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstgrdfrac_id,
+     &                           grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     set up fields for test cases based on user choice
+!
+!-----------------------------------------------------------------------
+
+      select case (field_choice)
+      case(1)  !*** cosine hill at lon=pi and lat=0
+
+        length = 0.1*pi2
+
+        grid1_array = cos(grid1_center_lat)*cos(grid1_center_lon)
+        grid2_array = cos(grid2_center_lat)*cos(grid2_center_lon)
+
+        grid1_tmp = acos(-grid1_array)/length
+        grid2_tmp = acos(-grid2_array)/length
+
+        where (grid1_tmp <= one)
+          grad1_lat   = (pi/length)*sin(pi*grid1_tmp)*
+     &                  sin(grid1_center_lat)*cos(grid1_center_lon)/
+     &                  sqrt(one-grid1_array**2)
+          grad1_lon   = (pi/length)*sin(pi*grid1_tmp)*
+     &                  sin(grid1_center_lon)/
+     &                  sqrt(one-grid1_array**2)
+          grid1_array = two + cos(pi*grid1_tmp)
+        elsewhere
+          grid1_array = one
+          grad1_lat   = zero
+          grad1_lon   = zero
+        endwhere
+        
+        where (grid2_tmp <= one)
+          grid2_array = two + cos(pi*grid2_tmp)
+        elsewhere
+          grid2_array = one
+        endwhere
+        
+        where (.not. grid1_mask)
+          grid1_array = zero
+          grad1_lat   = zero
+          grad1_lon   = zero
+        end where
+
+        where (grid2_frac < .001) grid2_array = zero
+
+      case(2)  !*** pseudo-spherical harmonic l=2,m=2
+
+        where (grid1_mask)
+          grid1_array = two + cos(grid1_center_lat)**2*
+     &                    cos(two*grid1_center_lon)
+          grad1_lat   = -sin(two*grid1_center_lat)*
+     &                   cos(two*grid1_center_lon)
+          grad1_lon   = -two*cos(grid1_center_lat)*
+     &                   sin(two*grid1_center_lon)
+        elsewhere
+          grid1_array = zero
+          grad1_lat   = zero
+          grad1_lon   = zero
+        end where
+
+        where (grid2_frac > .001) 
+          grid2_array = two + cos(grid2_center_lat)**2*
+     &                        cos(two*grid2_center_lon)
+        elsewhere
+          grid2_array = zero
+        end where
+
+      case(3)  !*** pseudo-spherical harmonic l=32, m=16
+
+        where (grid1_mask)
+          grid1_array = two + sin(two*grid1_center_lat)**16*
+     &                        cos(16.*grid1_center_lon)
+          grad1_lat   = 32.*sin(two*grid1_center_lat)**15*
+     &                      cos(two*grid1_center_lat)*
+     &                      cos(16.*grid1_center_lon)
+          grad1_lon   = -32.*sin(two*grid1_center_lat)**15*
+     &                       sin(grid1_center_lat)*
+     &                   sin(16.*grid1_center_lon)
+        elsewhere
+          grid1_array = zero
+          grad1_lat   = zero
+          grad1_lon   = zero
+        end where
+
+        where (grid2_frac > .001) 
+          grid2_array = two + sin(two*grid2_center_lat)**16*
+     &                        cos(16.*grid2_center_lon)
+        elsewhere
+          grid2_array = zero
+        end where
+
+      case default
+
+        stop 'Bad choice for field to interpolate'
+
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     if bicubic, we need 3 gradients in logical space
+!
+!-----------------------------------------------------------------------
+
+      if (map_type == map_type_bicubic) then
+        allocate (grad1_latlon (grid1_size)) 
+
+        nx = grid1_dims(1)
+        ny = grid1_dims(2)
+
+        do n=1,grid1_size
+
+          grad1_lat(n) = zero
+          grad1_lon(n) = zero
+          grad1_latlon(n) = zero
+
+          if (grid1_mask(n)) then
+
+            delew = half
+            delns = half
+
+            j = (n-1)/nx + 1
+            i = n - (j-1)*nx
+
+            ip1 = i+1
+            im1 = i-1
+            jp1 = j+1
+            jm1 = j-1
+
+            if (ip1 > nx) ip1 = ip1 - nx
+            if (im1 < 1 ) im1 = nx
+            if (jp1 > ny) then
+              jp1 = j
+              delns = one
+            endif
+            if (jm1 < 1 ) then
+              jm1 = j
+              delns = one
+            endif
+
+            in  = (jp1-1)*nx + i
+            is  = (jm1-1)*nx + i
+            ie  = (j  -1)*nx + ip1
+            iw  = (j  -1)*nx + im1
+
+            ine = (jp1-1)*nx + ip1
+            inw = (jp1-1)*nx + im1
+            ise = (jm1-1)*nx + ip1
+            isw = (jm1-1)*nx + im1
+
+            !*** compute i-gradient
+
+            if (.not. grid1_mask(ie)) then
+              ie = n
+              delew = one
+            endif
+            if (.not. grid1_mask(iw)) then
+              iw = n
+              delew = one
+            endif
+ 
+            grad1_lat(n) = delew*(grid1_array(ie) - grid1_array(iw))
+
+            !*** compute j-gradient
+
+            if (.not. grid1_mask(in)) then
+              in = n
+              delns = one
+            endif
+            if (.not. grid1_mask(is)) then
+              is = n
+              delns = one
+            endif
+ 
+            grad1_lon(n) = delns*(grid1_array(in) - grid1_array(is))
+
+            !*** compute ij-gradient
+
+            delew = half
+            if (jp1 == j .or. jm1 == j) then
+              delns = one
+            else 
+              delns = half
+            endif
+
+            if (.not. grid1_mask(ine)) then
+              if (in /= n) then
+                ine = in
+                delew = one
+              else if (ie /= n) then
+                ine = ie
+                inw = iw
+                if (inw == n) delew = one
+                delns = one
+              else
+                ine = n
+                inw = iw
+                delew = one
+                delns = one
+              endif
+            endif
+
+            if (.not. grid1_mask(inw)) then
+              if (in /= n) then
+                inw = in
+                delew = one
+              else if (iw /= n) then
+                inw = iw
+                ine = ie
+                if (ie == n) delew = one
+                delns = one
+              else
+                inw = n
+                ine = ie
+                delew = one
+                delns = one
+              endif
+            endif
+
+            grad1_lat_zero(n) = delew*(grid1_array(ine) -
+     &                                 grid1_array(inw))
+
+            if (.not. grid1_mask(ise)) then
+              if (is /= n) then
+                ise = is
+                delew = one
+              else if (ie /= n) then
+                ise = ie
+                isw = iw
+                if (isw == n) delew = one
+                delns = one
+              else
+                ise = n
+                isw = iw
+                delew = one
+                delns = one
+              endif
+            endif
+
+            if (.not. grid1_mask(isw)) then
+              if (is /= n) then
+                isw = is
+                delew = one
+              else if (iw /= n) then
+                isw = iw
+                ise = ie
+                if (ie == n) delew = one
+                delns = one
+              else
+                isw = n
+                ise = ie
+                delew = one
+                delns = one
+              endif
+            endif
+
+            grad1_lon_zero(n) = delew*(grid1_array(ise) -
+     &                                 grid1_array(isw))
+
+            grad1_latlon(n) = delns*(grad1_lat_zero(n) -
+     &                               grad1_lon_zero(n))
+
+          endif
+        enddo
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     test a first-order map from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+
+      grad1_lat_zero = zero
+      grad1_lon_zero = zero
+
+      if (map_type /= map_type_bicubic) then
+        call remap(grid2_tmp, wts_map1, grid2_add_map1, grid1_add_map1,
+     &             grid1_array)
+      else
+        call remap(grid2_tmp, wts_map1, grid2_add_map1, grid1_add_map1,
+     &             grid1_array, src_grad1=grad1_lat,
+     &                          src_grad2=grad1_lon,
+     &                          src_grad3=grad1_latlon)
+      endif
+
+      if (map_type == map_type_conserv) then
+        select case (norm_opt)
+        case (norm_opt_none)
+          grid2_err = grid2_frac*grid2_area
+          where (grid2_err /= zero)
+            grid2_tmp = grid2_tmp/grid2_err
+          else where
+            grid2_tmp = zero
+          end where
+        case (norm_opt_frcarea)
+        case (norm_opt_dstarea)
+          where (grid2_frac /= zero)
+            grid2_tmp = grid2_tmp/grid2_frac
+          else where
+            grid2_tmp = zero
+          end where
+        end select
+      end if
+
+      where (grid2_frac > .999)
+        grid2_err = (grid2_tmp - grid2_array)/grid2_array
+      elsewhere 
+        grid2_err = zero
+      end where
+
+      print *,'First order mapping from grid1 to grid2:'
+      print *,'----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_tmp  ),maxval(grid2_tmp  )
+      print *,' Err2 min,max: ',minval(grid2_err),maxval(grid2_err)
+      print *,' Err2    mean: ',sum(abs(grid2_err))/
+     &                          count(grid2_frac > .999)
+
+      !***
+      !*** Conservation Test
+      !***
+
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_tmp  *grid2_area*grid2_frac)
+
+!-----------------------------------------------------------------------
+!
+!     write results to NetCDF file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcarray_id,
+     &                           grid1_array)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstarray1_id,
+     &                           grid2_tmp  )
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dsterror1_id,
+     &                           grid2_err)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     for conservative mappings:
+!     test a second-order map from grid1 to grid2 with only lat grads
+!
+!-----------------------------------------------------------------------
+
+      if (map_type == map_type_conserv) then
+
+        call remap(grid2_tmp, wts_map1, grid2_add_map1, grid1_add_map1,
+     &             grid1_array, src_grad1=grad1_lat,
+     &                          src_grad2=grad1_lon_zero) 
+
+        select case (norm_opt)
+        case (norm_opt_none)
+          grid2_err = grid2_frac*grid2_area
+          where (grid2_err /= zero)
+            grid2_tmp = grid2_tmp/grid2_err
+          else where
+            grid2_tmp = zero
+          end where
+        case (norm_opt_frcarea)
+        case (norm_opt_dstarea)
+          where (grid2_frac /= zero)
+            grid2_tmp = grid2_tmp/grid2_frac
+          else where
+            grid2_tmp = zero
+          end where
+        end select
+
+        where (grid2_frac > .999)
+          grid2_err = (grid2_tmp - grid2_array)/grid2_array
+        elsewhere 
+          grid2_err = zero
+        end where
+
+        print *,'Second order mapping from grid1 to grid2 (lat only):'
+        print *,'----------------------------------------'
+        print *,'Grid1 min,max: ',minval(grid1_array),
+     &                            maxval(grid1_array)
+        print *,'Grid2 min,max: ',minval(grid2_tmp  ),
+     &                            maxval(grid2_tmp  )
+        print *,' Err2 min,max: ',minval(grid2_err),maxval(grid2_err)
+        print *,' Err2    mean: ',sum(abs(grid2_err))/
+     &                            count(grid2_frac > .999)
+
+        !***
+        !*** Conservation Test
+        !***
+
+        print *,'Conservation:'
+        print *,'Grid1 Integral = ',
+     &          sum(grid1_array*grid1_area*grid1_frac)
+        print *,'Grid2 Integral = ',
+     &          sum(grid2_tmp  *grid2_area*grid2_frac)
+
+!-----------------------------------------------------------------------
+!
+!       write results to NetCDF file
+!
+!-----------------------------------------------------------------------
+
+        ncstat = nf_put_var_double(nc_outfile_id, nc_srcgradlat_id,
+     &                             grad1_lat)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_double(nc_outfile_id, nc_dstarray1a_id,
+     &                             grid2_tmp  )
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_double(nc_outfile_id, nc_dsterror1a_id,
+     &                             grid2_err)
+        call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     for conservative mappings:
+!     test a second-order map from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+
+        call remap(grid2_tmp,wts_map1,grid2_add_map1,grid1_add_map1,
+     &             grid1_array, src_grad1=grad1_lat,
+     &                          src_grad2=grad1_lon) 
+
+        select case (norm_opt)
+        case (norm_opt_none)
+          grid2_err = grid2_frac*grid2_area
+          where (grid2_err /= zero)
+            grid2_tmp = grid2_tmp/grid2_err
+          else where
+            grid2_tmp = zero
+          end where
+        case (norm_opt_frcarea)
+        case (norm_opt_dstarea)
+          where (grid2_frac /= zero)
+            grid2_tmp = grid2_tmp/grid2_frac
+          else where
+            grid2_tmp = zero
+          end where
+        end select
+
+        where (grid2_frac > .999)
+          grid2_err = (grid2_tmp - grid2_array)/grid2_array
+        elsewhere 
+          grid2_err = zero
+        end where
+
+        print *,'Second order mapping from grid1 to grid2:'
+        print *,'-----------------------------------------'
+        print *,'Grid1 min,max: ',minval(grid1_array),
+     &                            maxval(grid1_array)
+        print *,'Grid2 min,max: ',minval(grid2_tmp  ),
+     &                            maxval(grid2_tmp  )
+        print *,' Err2 min,max: ',minval(grid2_err),maxval(grid2_err)
+        print *,' Err2    mean: ',sum(abs(grid2_err))/
+     &                            count(grid2_frac > .999)
+
+        !***
+        !*** Conservation Test
+        !***
+
+        print *,'Conservation:'
+        print *,'Grid1 Integral = ',
+     &           sum(grid1_array*grid1_area*grid1_frac)
+        print *,'Grid2 Integral = ',
+     &           sum(grid2_tmp  *grid2_area*grid2_frac)
+
+!-----------------------------------------------------------------------
+!
+!       write results to NetCDF file
+!
+!-----------------------------------------------------------------------
+
+        ncstat = nf_put_var_double(nc_outfile_id, nc_srcgradlon_id,
+     &                             grad1_lon)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_double(nc_outfile_id, nc_dstarray2_id,
+     &                             grid2_tmp  )
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_double(nc_outfile_id, nc_dsterror2_id,
+     &                             grid2_err)
+        call netcdf_error_handler(ncstat)
+
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     close netCDF file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_close(nc_outfile_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     calculate some statistics
+!
+!-----------------------------------------------------------------------
+
+      grid2_count = zero
+      grid2_tmp   = zero
+      grid2_err   = zero
+
+      print *,'number of sparse matrix entries ',num_links_map1
+      do n=1,num_links_map1
+        grid2_count(grid2_add_map1(n)) = 
+     &  grid2_count(grid2_add_map1(n)) + 1
+        if (wts_map1(1,n) > one .or. wts_map1(1,n) < zero) then
+          grid2_tmp(grid2_add_map1(n)) = 
+     &    grid2_tmp(grid2_add_map1(n)) + 1
+          grid2_err(grid2_add_map1(n)) = max(abs(wts_map1(1,n)),
+     &    grid2_err(grid2_add_map1(n)) )
+        endif
+      end do
+
+      do n=1,grid2_size
+        if (grid2_tmp(n) > zero) print *,n,grid2_err(n)
+      end do
+
+      imin = minval(grid2_count, mask=(grid2_count > 0))
+      imax = maxval(grid2_count)
+      idiff =  (imax - imin)/10 + 1
+      print *,'total number of dest cells ',grid2_size
+      print *,'number of cells participating in remap ',
+     &   count(grid2_count > zero)
+      print *,'min no of entries/row = ',imin
+      print *,'max no of entries/row = ',imax
+
+      imax = imin + idiff
+      do n=1,10
+        print *,'num of rows with entries between ',imin,' - ',imax-1,
+     &     count(grid2_count >= imin .and. grid2_count < imax)
+        imin = imin + idiff
+        imax = imax + idiff
+      end do
+
+!-----------------------------------------------------------------------
+
+      end program remap_test
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/scrip_test_repeat.f
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/scrip_test_repeat.f	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/scrip_test_repeat.f	(revision 12863)
@@ -0,0 +1,709 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this program is a short driver that tests the remappings using
+!     a simple analytic field.  the results are written in netCDF
+!     format.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: scrip_test_repeat.f,v 1.3 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      program remap_test_repeat
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod    ! defines common data types
+      use constants    ! defines common constants
+      use iounits      ! I/O unit manager
+      use netcdf_mod   ! netcdf I/O stuff
+      use grids        ! module containing grid info
+      use remap_vars   ! module containing remapping info
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     interface for remap routine
+!
+!-----------------------------------------------------------------------
+
+      interface
+        subroutine remap(dst_array, map_wts, dst_add, src_add, 
+     &                   src_array, src_grad1, src_grad2, src_grad3)
+
+        use kinds_mod
+        use constants
+
+        implicit none
+
+        integer (kind=int_kind), dimension(:), intent(in) ::
+     &       dst_add, src_add 
+
+        real (kind=dbl_kind), dimension(:,:), intent(in) :: map_wts
+
+        real (kind=dbl_kind), dimension(:), intent(in) :: src_array
+
+        real (kind=dbl_kind), dimension(:), intent(in), optional ::
+     &     src_grad1, src_grad2, src_grad3
+
+        real (kind=dbl_kind), dimension(:), intent(inout) :: dst_array
+
+        end subroutine remap
+      end interface
+
+!-----------------------------------------------------------------------
+!
+!     input namelist variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) ::
+     &           field_choice, ! choice of field to be interpolated
+     &           num_repeats   ! number of times to repeat remappings
+
+      character (char_len) :: 
+     &           interp_file1, ! filename containing remap data (map1)
+     &           interp_file2, ! filename containing remap data (map2)
+     &           output_file   ! filename containing output test data
+
+      namelist /remap_inputs/ field_choice, num_repeats,
+     &                        interp_file1, interp_file2, output_file
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) :: 
+     &           map_name1,    ! name for mapping from grid1 to grid2
+     &           map_name2     ! name for mapping from grid2 to grid1
+
+      integer (kind=int_kind) ::    ! netCDF ids for files and arrays
+     &        n, ncstat, nc_outfile_id, 
+     &        nc_srcgrdcntrlat_id, nc_srcgrdcntrlon_id,
+     &        nc_dstgrdcntrlat_id, nc_dstgrdcntrlon_id,
+     &        nc_srcgrdrank_id, nc_dstgrdrank_id,
+     &        nc_srcgrdimask_id, nc_dstgrdimask_id,
+     &        nc_srcgrdarea_id, nc_dstgrdarea_id,
+     &        nc_srcgrdfrac_id, nc_dstgrdfrac_id,
+     &        nc_srcarray_id, nc_srcgradlat_id, nc_srcgradlon_id,
+     &        nc_dstarray1_id, nc_dstarray2_id,
+     &        nc_dsterror1_id, nc_dsterror2_id
+
+      integer (kind=int_kind), dimension(:), allocatable ::
+     &        nc_grid1size_id, nc_grid2size_id
+
+!-----------------------------------------------------------------------
+
+      character (char_len) :: 
+     &          dim_name    ! netCDF dimension name
+
+      integer (kind=int_kind) :: i,j,n,
+     &    iunit  ! unit number for namelist file
+
+      integer (kind=int_kind), dimension(:), allocatable ::
+     &    grid1_imask, grid2_imask
+
+      real (kind=dbl_kind) ::
+     &    length            ! length scale for cosine hill test field
+
+      real (kind=dbl_kind), dimension(:), allocatable ::
+     &    grid1_array, 
+     &    grid1_tmp, 
+     &    grad1_lat, 
+     &    grad1_lon, 
+     &    grid2_array, 
+     &    grid2_err,
+     &    grid2_tmp,
+     &    grad2_lat, 
+     &    grad2_lon  
+
+!-----------------------------------------------------------------------
+!
+!     read namelist for file and mapping info
+!
+!-----------------------------------------------------------------------
+
+      call get_unit(iunit)
+      open(iunit, file='repeat_test_in', status='old', form='formatted')
+      read(iunit, nml=remap_inputs)
+      call release_unit(iunit)
+      write(*,nml=remap_inputs)
+
+!-----------------------------------------------------------------------
+!
+!     read remapping data
+!
+!-----------------------------------------------------------------------
+
+      num_maps = 2
+
+      call read_remap(map_name1, map_name2, interp_file1, interp_file2)
+
+!-----------------------------------------------------------------------
+!
+!     allocate arrays
+!
+!-----------------------------------------------------------------------
+
+      allocate (grid1_array    (grid1_size), 
+     &          grid1_tmp      (grid1_size),
+     &          grad1_lat      (grid1_size), 
+     &          grad1_lon      (grid1_size), 
+     &          grid1_imask    (grid1_size),
+     &          grid2_array    (grid2_size), 
+     &          grid2_err      (grid2_size),
+     &          grid2_tmp      (grid2_size),
+     &          grad2_lat      (grid2_size), 
+     &          grad2_lon      (grid2_size), 
+     &          grid2_imask    (grid2_size))
+
+      where (grid1_mask)
+        grid1_imask = 1
+      elsewhere
+        grid1_imask = 0
+      endwhere
+      where (grid2_mask)
+        grid2_imask = 1
+      elsewhere
+        grid2_imask = 0
+      endwhere
+
+!-----------------------------------------------------------------------
+!
+!     setup a NetCDF file for output
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** create netCDF dataset 
+      !***
+
+      ncstat = nf_create (output_file, NF_CLOBBER, nc_outfile_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, NF_GLOBAL, 'title',
+     &                          len_trim(map_name1), map_name1)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid size dimensions
+      !***
+
+      allocate( nc_grid1size_id(grid1_rank),
+     &          nc_grid2size_id(grid2_rank))
+
+      do n=1,grid1_rank
+        write(dim_name,1000) 'grid1_dim',n
+        ncstat = nf_def_dim (nc_outfile_id, dim_name, 
+     &                       grid1_dims(n), nc_grid1size_id(n))
+        call netcdf_error_handler(ncstat)
+      end do
+
+      do n=1,grid2_rank
+        write(dim_name,1000) 'grid2_dim',n
+        ncstat = nf_def_dim (nc_outfile_id, dim_name, 
+     &                       grid2_dims(n), nc_grid2size_id(n))
+        call netcdf_error_handler(ncstat)
+      end do
+ 1000 format(a9,i1)
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_center_lat', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_srcgrdcntrlat_id, 
+     &                          'units', 7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_center_lat', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_dstgrdcntrlat_id, 
+     &                          'units', 7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_center_lon', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_srcgrdcntrlon_id, 
+     &                          'units', 7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_center_lon', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_dstgrdcntrlon_id, 
+     &                          'units', 7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_imask', NF_INT,
+     &               grid1_rank, nc_grid1size_id, nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_srcgrdimask_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_imask', NF_INT,
+     &               grid2_rank, nc_grid2size_id, nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_dstgrdimask_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_area', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_area', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid fraction arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_frac', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_frac', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define source array
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_array', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcarray_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define gradient arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grad_lat', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgradlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grad_lon', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgradlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define destination arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_array1', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstarray1_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_array2', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstarray2_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define error arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_error1', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dsterror1_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_error2', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dsterror2_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_outfile_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     write some grid info
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** write grid center latitude array
+      !***
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgrdcntrlat_id,
+     &                           grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstgrdcntrlat_id,
+     &                           grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** write grid center longitude array
+      !***
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgrdcntrlon_id,
+     &                           grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstgrdcntrlon_id,
+     &                           grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** write grid mask
+      !***
+
+      ncstat = nf_put_var_int(nc_outfile_id, nc_srcgrdimask_id,
+     &                        grid1_imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_outfile_id, nc_dstgrdimask_id,
+     &                        grid2_imask)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area arrays
+      !***
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgrdarea_id,
+     &                           grid1_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstgrdarea_id,
+     &                           grid2_area)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid fraction arrays
+      !***
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgrdfrac_id,
+     &                           grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstgrdfrac_id,
+     &                           grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     set up fields for test cases based on user choice
+!
+!-----------------------------------------------------------------------
+
+      select case (field_choice)
+      case(1)  !*** cosine hill at lon=pi and lat=0
+
+        length = 0.1*pi2
+
+        grid1_array = cos(grid1_center_lat)*cos(grid1_center_lon)
+        grid2_array = cos(grid2_center_lat)*cos(grid2_center_lon)
+
+        grid1_tmp = acos(-grid1_array)/length
+        grid2_tmp = acos(-grid2_array)/length
+
+        where (grid1_tmp <= one)
+          grad1_lat   = (pi/length)*sin(pi*grid1_tmp)*
+     &                  sin(grid1_center_lat)*cos(grid1_center_lon)/
+     &                  sqrt(one-grid1_array**2)
+          grad1_lon   = (pi/length)*sin(pi*grid1_tmp)*
+     &                  sin(grid1_center_lon)/
+     &                  sqrt(one-grid1_array**2)
+          grid1_array = two + cos(pi*grid1_tmp)
+        elsewhere
+          grid1_array = one
+          grad1_lat   = zero
+          grad1_lon   = zero
+        endwhere
+        
+        where (grid2_tmp <= one)
+          grad2_lat   = (pi/length)*sin(pi*grid2_tmp)*
+     &                  sin(grid2_center_lat)*cos(grid2_center_lon)/
+     &                  sqrt(one-grid2_array**2)
+          grad2_lon   = (pi/length)*sin(pi*grid2_tmp)*
+     &                  sin(grid2_center_lon)/
+     &                  sqrt(one-grid2_array**2)
+          grid2_array = two + cos(pi*grid2_tmp)
+        elsewhere
+          grid2_array = one
+          grad2_lat   = zero
+          grad2_lon   = zero
+        endwhere
+        
+        where (.not. grid1_mask)
+          grid1_array = zero
+          grad1_lat   = zero
+          grad1_lon   = zero
+        end where
+
+        where (.not. grid2_mask)
+          grid2_array = zero
+          grad2_lat   = zero
+          grad2_lon   = zero
+        end where
+
+      case(2)  !*** pseudo-spherical harmonic l=2,m=2
+
+        where (grid1_mask)
+          grid1_array = two + cos(grid1_center_lat)**2*
+     &                    cos(two*grid1_center_lon)
+          grad1_lat   = -sin(two*grid1_center_lat)*
+     &                   cos(two*grid1_center_lon)
+          grad1_lon   = -two*cos(grid1_center_lat)*
+     &                   sin(two*grid1_center_lon)
+        elsewhere
+          grid1_array = zero
+          grad1_lat   = zero
+          grad1_lon   = zero
+        end where
+
+        where (grid2_mask)
+          grid2_array = two + cos(grid2_center_lat)**2*
+     &                        cos(two*grid2_center_lon)
+          grad2_lat   = -sin(two*grid2_center_lat)*
+     &                   cos(two*grid2_center_lon)
+          grad2_lon   = -two*cos(grid2_center_lat)*
+     &                   sin(two*grid2_center_lon)
+        elsewhere
+          grid2_array = zero
+          grad2_lat   = zero
+          grad2_lon   = zero
+        end where
+
+      case(3)  !*** pseudo-spherical harmonic l=32, m=16
+
+        where (grid1_mask)
+          grid1_array = two + sin(two*grid1_center_lat)**16*
+     &                        cos(16.*grid1_center_lon)
+          grad1_lat   = 32.*sin(two*grid1_center_lat)**15*
+     &                      cos(two*grid1_center_lat)*
+     &                      cos(16.*grid1_center_lon)
+          grad1_lon   = -32.*sin(two*grid1_center_lat)**15*
+     &                       sin(grid1_center_lat)*
+     &                   sin(16.*grid1_center_lon)
+        elsewhere
+          grid1_array = zero
+          grad1_lat   = zero
+          grad1_lon   = zero
+        end where
+
+        where (grid2_mask)
+          grid2_array = two + sin(two*grid2_center_lat)**16*
+     &                        cos(16.*grid2_center_lon)
+          grad2_lat   = 32.*sin(two*grid2_center_lat)**15*
+     &                      cos(two*grid2_center_lat)*
+     &                      cos(16.*grid2_center_lon)
+          grad2_lon   = -32.*sin(two*grid2_center_lat)**15*
+     &                       sin(grid2_center_lat)*
+     &                   sin(16.*grid2_center_lon)
+        elsewhere
+          grid2_array = zero
+          grad2_lat   = zero
+          grad2_lon   = zero
+        end where
+
+      case default
+
+        stop 'Bad choice for field to interpolate'
+
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     test repeated first-order maps between grid1 and grid2
+!
+!-----------------------------------------------------------------------
+
+      call remap(grid2_tmp, wts_map1, grid2_add_map1, grid1_add_map1,
+     &           grid1_array)
+      do n=1,num_repeats
+        call remap(grid1_tmp, wts_map2, grid1_add_map2, grid2_add_map2,
+     &             grid2_tmp)
+        call remap(grid2_tmp, wts_map1, grid2_add_map1, grid1_add_map1,
+     &             grid1_tmp)
+      end do
+
+      where (grid2_frac > .999)
+        grid2_err = (grid2_tmp - grid2_array)/grid2_array
+      elsewhere 
+        grid2_err = zero
+      end where
+
+      print *,'First order mapping from grid1 to grid2:'
+      print *,'----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_tmp  ),maxval(grid2_tmp  )
+      print *,' Err2 min,max: ',minval(grid2_err),maxval(grid2_err)
+      print *,' Err2    mean: ',sum(abs(grid2_err))/
+     &                          count(grid2_frac > .001)
+
+      !***
+      !*** Conservation Test
+      !***
+
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_tmp  *grid2_area*grid2_frac)
+
+!-----------------------------------------------------------------------
+!
+!     write results to NetCDF file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcarray_id,
+     &                           grid1_array)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstarray1_id,
+     &                           grid2_tmp  )
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dsterror1_id,
+     &                           grid2_err)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     test repeated second-order mapppings between grid1 and grid2
+!
+!-----------------------------------------------------------------------
+
+      if (num_wts > 1) then
+
+      call remap(grid2_tmp  , wts_map1, grid2_add_map1, grid1_add_map1,
+     &           grid1_array, src_grad1=grad1_lat,
+     &                        src_grad2=grad1_lon) 
+
+      do n=1,num_repeats
+        call remap(grid1_tmp, wts_map2, grid1_add_map2, grid2_add_map2,
+     &             grid2_tmp, src_grad1=grad2_lat,
+     &                        src_grad2=grad2_lon) 
+
+        call remap(grid2_tmp, wts_map1, grid2_add_map1, grid1_add_map1,
+     &             grid1_tmp, src_grad1=grad1_lat,
+     &                        src_grad2=grad1_lon) 
+
+      end do
+
+      where (grid2_frac > .999)
+        grid2_err = (grid2_tmp - grid2_array)/grid2_array
+      elsewhere 
+        grid2_err = zero
+      end where
+
+      print *,'Second order mapping from grid1 to grid2:'
+      print *,'-----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_tmp  ),maxval(grid2_tmp  )
+      print *,' Err2 min,max: ',minval(grid2_err),maxval(grid2_err)
+      print *,' Err2    mean: ',sum(abs(grid2_err))/
+     &                          count(grid2_frac > .001)
+
+      !***
+      !*** Conservation Test
+      !***
+
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_tmp  *grid2_area*grid2_frac)
+
+!-----------------------------------------------------------------------
+!
+!     write results to NetCDF file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgradlon_id,
+     &                           grad1_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstarray2_id,
+     &                           grid2_tmp  )
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dsterror2_id,
+     &                           grid2_err)
+      call netcdf_error_handler(ncstat)
+
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     close netCDF file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_close(nc_outfile_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end program remap_test_repeat
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/timers.f
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/timers.f	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/SCRIP1.4/source/timers.f	(revision 12863)
@@ -0,0 +1,343 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module uses F90 cpu time routines to allowing setting of
+!     multiple CPU timers.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: timers.f,v 1.2 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module timers
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+
+      implicit none
+
+      integer (kind=int_kind), parameter ::  
+     &     max_timers = 99  ! max number of timers allowed
+
+      integer (kind=int_kind), save :: 
+     &     cycles_max       ! max value of clock allowed by system
+
+      integer (kind=int_kind), dimension(max_timers), save :: 
+     &     cycles1,         ! cycle number at start for each timer
+     &     cycles2          ! cycle number at stop  for each timer
+
+      real (kind=real_kind), save ::  
+     &     clock_rate       ! clock_rate in seconds for each cycle
+
+      real (kind=real_kind), dimension(max_timers), save ::  
+     &     cputime          ! accumulated cpu time in each timer
+
+      character (len=8), dimension(max_timers), save ::  
+     &     status           ! timer status string
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine timer_check(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine checks a given timer.  This is primarily used to
+!     periodically accumulate time in the timer to prevent timer cycles
+!     from wrapping around max_cycles.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::  
+     &    timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      if (status(timer) .eq. 'running') then
+        call timer_stop (timer)
+        call timer_start(timer)
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_check
+
+!***********************************************************************
+
+      subroutine timer_clear(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine resets a given timer.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::  
+     &    timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      cputime(timer) = 0.0_real_kind  ! clear the timer
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_clear
+
+!***********************************************************************
+
+      function timer_get(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine returns the result of a given timer.  This can be
+!     called instead of timer_print so that the calling routine can 
+!     print it in desired format.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::  
+     &    timer            ! timer number
+
+!-----------------------------------------------------------------------
+!
+!     Output Variables:
+!
+!-----------------------------------------------------------------------
+
+      real (kind=real_kind) ::  
+     &     timer_get   ! accumulated cputime in given timer
+
+!-----------------------------------------------------------------------
+
+      if (status(timer) .eq. 'stopped') then
+        timer_get = cputime(timer)
+      else
+        call timer_stop(timer)
+        timer_get = cputime(timer)
+        call timer_start(timer)
+      endif
+
+!-----------------------------------------------------------------------
+
+      end function timer_get
+
+!***********************************************************************
+
+      subroutine timer_print(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine prints the accumulated cpu time in given timer.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::  
+     &    timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      !--- 
+      !--- print the cputime accumulated for timer 
+      !--- make sure timer is stopped
+      !---
+
+      if (status(timer) .eq. 'stopped') then
+        write(*,"(' CPU time for timer',i3,':',1p,e16.8)")  
+     &       timer,cputime(timer)
+      else
+        call timer_stop(timer)
+        write(*,"(' CPU time for timer',i3,':',1p,e16.8)")  
+     &       timer,cputime(timer)
+        call timer_start(timer)
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_print
+
+!***********************************************************************
+
+      subroutine timer_start(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine starts a given timer.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::  
+     &    timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      !---
+      !--- Start the timer and change timer status.
+      !---
+
+      if (status(timer) .eq. 'stopped') then
+        call system_clock(count=cycles1(timer))
+        status(timer) = 'running'
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_start
+
+!***********************************************************************
+
+      subroutine timer_stop(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine stops a given timer.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::  
+     &    timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      if (status(timer) .eq. 'running') then
+
+        !---
+        !--- Stop the desired timer.
+        !---
+
+        call system_clock(count=cycles2(timer))
+
+        !---
+        !--- check and correct for cycle wrapping
+        !---
+
+        if (cycles2(timer) .ge. cycles1(timer)) then
+          cputime(timer) = cputime(timer) + clock_rate*  
+     &                     (cycles2(timer) - cycles1(timer))
+        else
+          cputime(timer) = cputime(timer) + clock_rate*  
+     &                (cycles2(timer) - cycles1(timer) + cycles_max)
+        endif
+
+        !---
+        !--- Change timer status.
+        !---
+
+        status(timer)='stopped'
+
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_stop
+
+!***********************************************************************
+
+      subroutine timers_init
+
+!-----------------------------------------------------------------------
+!
+!     This routine initializes some machine parameters necessary for
+!     computing cpu time from F90 intrinsics.
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: cycles ! count rate return by sys_clock
+
+!-----------------------------------------------------------------------
+
+      !---
+      !--- Initialize timer arrays and clock_rate.
+      !---
+
+      clock_rate = 0.0_real_kind
+      cycles1    = 0
+      cycles2    = 0
+      cputime    = 0.0_real_kind
+      status     = 'stopped'
+
+      !---
+      !--- Call F90 intrinsic system_clock to determine clock rate
+      !--- and maximum cycles.  If no clock available, print message.
+      !---
+
+      call system_clock(count_rate=cycles, count_max=cycles_max)
+
+      if (cycles /= 0) then
+        clock_rate = 1.0_real_kind/real(cycles)
+      else
+        clock_rate = 0.0_real_kind
+        print *, '--- No system clock available ---'
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timers_init
+
+!***********************************************************************
+
+      end module timers
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/bin/freeform.py
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/bin/freeform.py	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/bin/freeform.py	(revision 12863)
@@ -0,0 +1,115 @@
+#!/usr/bin/env python2.6
+
+import os
+import shutil
+
+def freer(oldname, newname, fdir, edits):
+
+    fin = file(os.path.join(fdir,oldname))
+    lines = fin.readlines()
+    fin.close()
+
+    if not os.path.exists('src'):
+        print "creating src directory"
+        os.mkdir('src')
+    fout = file(os.path.join('src',newname), 'w')
+
+    lastline = None
+    for nextline in lines:
+        for edit in edits:
+            nextline = nextline.replace(edit[0],edit[1])
+        if nextline.strip().startswith('&'):
+            parts = lastline.split('!')
+            if parts[0].endswith('\n'):
+                parts[0] = parts[0].replace('\n',' &\n')
+            else:
+                parts[0] = parts[0] + ' & '
+            lastline = '!'.join(parts)
+            nextline = nextline.replace('&',' ')
+        if lastline is not None:
+            fout.write(lastline)
+        lastline = nextline
+
+    # - write out last line (this assumes it is not a continuation line)
+    fout.write(lastline)
+
+def scrip(adir, apairs, edits=[]):
+
+    if not os.path.exists('src'):
+        print "creating src directory"
+        os.mkdir('src')
+
+    for (f1,f2) in apairs:
+        if not f2.endswith('.f90'):
+            shutil.copy(os.path.join(adir,f1), os.path.join('src',f2))
+        else:
+            freer(f1,f2,adir,edits)
+
+if __name__ == "__main__":
+
+    # - changes to scrip routines made here
+
+    pairs = [('constants.f', 'constants.f90'),
+              ('copyright', 'copyright'),
+              ('grids.f', 'grids.f90'),
+              ('iounits.f', 'iounits.f90'),
+              ('kinds_mod.f', 'kinds_mod.f90'),
+              ('netcdf.f', 'netcdf_mod.f90'),
+              ('remap.f', 'remap.f90'),
+              ('remap_bicubic.f', 'remap_bicubic.f90'),
+              ('remap_bilinear.f', 'remap_bilinear.f90'),
+              ('remap_conserv.f', 'remap_conserv.f90'),
+              ('remap_distwgt.f', 'remap_distwgt.f90'),
+              ('remap_read.f', 'remap_read.f90'),
+              ('remap_vars.f', 'remap_vars.f90'),
+              ('remap_write.f', 'remap_write.f90'),
+              ('timers.f', 'timers.f90')]
+
+    # - add some edits
+    # - note that this is very crude method since every line is inspected for the first string
+    # - in every input file
+    # - you have been warned!
+
+    ed1 = [" .and."]
+    ed2 = ["subroutine netcdf_error_handler(istat, mess)"]
+    ed3 = ["    &    istat   ! integer status returned by netCDF function call",
+           "      character (len=*), intent(in), optional :: mess"]
+    ed4 = ["       if (present(mess)) then",
+           "         print *,'Error in netCDF: ',nf_strerror(istat), 'Message: ',mess",
+           "       else",
+           "         print *,'Error in netCDF: ',nf_strerror(istat)",
+           "       endif"]
+
+    edits = [(". and.",'\n'.join(ed1)),
+             ("subroutine netcdf_error_handler(istat)", '\n'.join(ed2)),
+             ("    &    istat   ! integer status returned by netCDF function call", '\n'.join(ed3)),
+             ("        print *,'Error in netCDF: ',nf_strerror(istat)", '\n'.join(ed4))
+            ]
+    scrip('SCRIP1.4/source', pairs, edits)
+
+
+    # - on to NOCS routines
+
+    pairs = [('scrip.F90', 'scrip.F90'),
+             ('scripgrid.F90', 'scripgrid.F90'),
+             ('scripgrid_mod.F90', 'scripgrid_mod.F90'),
+             ('scripinterp.F90', 'scripinterp.F90'),
+             ('scripinterp_mod.F90', 'scripinterp_mod.F90'),
+             ('scripshape.F90', 'scripshape.F90')]
+    scrip('nocsutil', pairs)
+
+    changes = """
+      SCRIP code, version 1.4, from Los Alamos National Laboratory (http://climate.lanl.gov/Software/SCRIP)
+
+      Changes made at NOCS for inclusion of weights generation code in NEMO 3.3 and later:
+
+          - File extensions changed from '.f' to '.f90'
+          - File netcdf.f renamed as netcdf_mod.f90 to avoid clash with netcdf library module filename
+          - File netcdf.f modified to add error message to netcdf_error_handler
+          - Small bug in remap_conserv when using gfortran compiler: replace ". and." with " .and."
+          - continuation lines reformatted with '&' moved from the start of the continuation line to 
+            the end of the line before
+    """
+    fp = file("src/CHANGES_BY_NOCS","w")
+    fp.write(changes)
+    fp.close()
Index: /utils/tools_ticket2413/WEIGHTS/namelist_bicub
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/namelist_bicub	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/namelist_bicub	(revision 12863)
@@ -0,0 +1,101 @@
+&comments
+ -----------------------------------------------------------------------------------
+ - grid_inputs holds parameters for the scripgrid routine which reformats information 
+   about the input grids
+ - scripgrid always needs a coordinates.nc file in the
+   current directory and creates the remapped grid file correspondingly
+ - it uses the following namelist block to determine its actions
+     method:  only 'regular' is yet implemented, this assumes a cartesian grid
+     input_lon: name of longitude variable in the input_file
+     input_lat: name of latitude variable in the input_file
+     nemo_lon: name of longitude variable in the coordinates.nc
+     nemo_lat: name of latitude variable in the coordinates.nc
+/
+&grid_inputs
+    input_file = 'u_10.15JUNE2009_fill.nc'
+    nemo_file = 'coordinates_nordic1.nc'
+    datagrid_file = 'remap_core2_grid.nc'
+    nemogrid_file = 'remap_nordic1_grid.nc'
+    method = 'regular'
+    input_lon = 'lon'
+    input_lat = 'lat'
+    nemo_lon = 'glamt'
+    nemo_lat = 'gphit'
+    nemo_mask = 'none'
+    nemo_mask_value = 10
+    input_mask = 'none'
+    input_mask_value = 10
+/
+&comments
+ -----------------------------------------------------------------------------------
+ - remap_inputs holds parameters for the scrip routine which calculates the weights
+   needed to convert between two grids
+ - two remap grid files are required as output by scripgrid
+ - num_maps is either 1 or 2 depending on whether the reverse transformation is required
+ - one or two interp_file names are then supplied; these hold the weights to convert 
+   one grid to another
+ - the map_name variable is just descriptive
+ - map_method can be 'bilinear' 'bicubic' or 'conservative' (the latter untested)
+ - normalize_opt should usually be 'frac' or else the user needs to do this scaling
+   manually (this seems to the case for fractional ice cover)
+ - restrict_type should be 'latitude' or 'latlon' in which case num_srch_bins only are 
+   used in one or two directions
+ - use_grid_area fields override the scrip calculation of area in case the model gets
+   slightly different answers, but the area needs to be supplied in the input files
+ - output_opt may be supplied and set to either 'scrip' or 'ncar-csm'
+/
+&remap_inputs
+    num_maps = 1
+    grid1_file = 'remap_core2_grid.nc'
+    grid2_file = 'remap_nordic1_grid.nc'
+    interp_file1 = 'core2_nordic1_bicub.nc'
+    interp_file2 = 'nordic1_core2_bicub.nc'
+    map1_name = 'orca2 to nordic1 bicub Mapping'
+    map2_name = 'nordic1 to orca2 bicub Mapping'
+    map_method = 'bicubic'
+    normalize_opt = 'frac'
+    output_opt = 'scrip'
+    restrict_type = 'latitude'
+    num_srch_bins = 90 
+    luse_grid1_area = .false.
+    luse_grid2_area = .false.
+/
+
+&interp_inputs
+    input_file = "u_10.15JUNE2009_fill.nc"
+    interp_file = "core2_nordic1_bicub.nc"
+    input_name = "U_10_MOD"
+    input_start = 1,1,1,1
+    input_stride = 1,1,1,1
+    input_stop = 0,0,0,1
+    input_vars = 'initial_time0_hours'
+/
+
+&interp_outputs
+    output_file = "u_10.15JUNE2009_nordic1.nc"
+    output_mode = "create"
+    output_dims = 'x', 'y', 'time_counter'
+    output_scaling = "U_10_MOD|1.0", "time_counter|86400.0"
+    output_name = 'U_10_MOD'
+    output_lon = 'x'
+    output_lat = 'y'
+    output_vars = 'time_counter'
+    output_attributes = 'time_counter|units|seconds since 1995-00-00 00:00:00',
+                        'time_counter|calendar|noleap',
+                        'U_10_MOD|units|mm/s'
+/
+
+&comments
+ -----------------------------------------------------------------------------------
+ -  shape_inputs are the input fields required by scripshape.f90
+ -  first is the interpolation file created by scrip.f90 mapping data to model grid
+ -  second is the name of the output weights file to create
+ -  third is the east-west wrap to assume in the model (needed when calculating gradient 
+          terms in the bicubic scheme); the number is just the number of columns on one side
+          that are repeats of those on the opposite side (-1 for not cyclic)
+/
+&shape_inputs
+    interp_file = 'core2_nordic1_bicub.nc'
+    output_file = 'weights_core2_nordic1_bicub.nc'
+    ew_wrap     = 0
+/
Index: /utils/tools_ticket2413/WEIGHTS/namelist_bilin
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/namelist_bilin	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/namelist_bilin	(revision 12863)
@@ -0,0 +1,101 @@
+&comments
+ -----------------------------------------------------------------------------------
+ - grid_inputs holds parameters for the scripgrid routine which reformats information 
+   about the input grids
+ - scripgrid always needs a coordinates.nc file in the
+   current directory and creates the remapped grid file correspondingly
+ - it uses the following namelist block to determine its actions
+     method:  only 'regular' is yet implemented, this assumes a cartesian grid
+     input_lon: name of longitude variable in the input_file
+     input_lat: name of latitude variable in the input_file
+     nemo_lon: name of longitude variable in the coordinates.nc
+     nemo_lat: name of latitude variable in the coordinates.nc
+/
+&grid_inputs
+    input_file = 't_10.15JUNE2009_fill.nc'
+    nemo_file = 'coordinates_nordic1.nc'
+    datagrid_file = 'remap_core2_grid.nc'
+    nemogrid_file = 'remap_nordic1_grid.nc'
+    method = 'regular'
+    input_lon = 'lon'
+    input_lat = 'lat'
+    nemo_lon = 'glamt'
+    nemo_lat = 'gphit'
+    nemo_mask = 'none'
+    nemo_mask_value = 10
+    input_mask = 'none'
+    input_mask_value = 10
+/
+&comments
+ -----------------------------------------------------------------------------------
+ - remap_inputs holds parameters for the scrip routine which calculates the weights
+   needed to convert between two grids
+ - two remap grid files are required as output by scripgrid
+ - num_maps is either 1 or 2 depending on whether the reverse transformation is required
+ - one or two interp_file names are then supplied; these hold the weights to convert 
+   one grid to another
+ - the map_name variable is just descriptive
+ - map_method can be 'bilinear' 'bicubic' or 'conservative' (the latter untested)
+ - normalize_opt should usually be 'frac' or else the user needs to do this scaling
+   manually (this seems to the case for fractional ice cover)
+ - restrict_type should be 'latitude' or 'latlon' in which case num_srch_bins only are 
+   used in one or two directions
+ - use_grid_area fields override the scrip calculation of area in case the model gets
+   slightly different answers, but the area needs to be supplied in the input files
+ - output_opt may be supplied and set to either 'scrip' or 'ncar-csm'
+/
+&remap_inputs
+    num_maps = 1
+    grid1_file = 'remap_core2_grid.nc'
+    grid2_file = 'remap_nordic1_grid.nc'
+    interp_file1 = 'core2_nordic1_bilin.nc'
+    interp_file2 = 'nordic1_core2_bilin.nc'
+    map1_name = 'orca2 to nordic1 bilin Mapping'
+    map2_name = 'nordic1 to orca2 bilin Mapping'
+    map_method = 'bilinear'
+    normalize_opt = 'frac'
+    output_opt = 'scrip'
+    restrict_type = 'latitude'
+    num_srch_bins = 90 
+    luse_grid1_area = .false.
+    luse_grid2_area = .false.
+/
+
+&interp_inputs
+    input_file = "t_10.15JUNE2009_fill.nc"
+    interp_file = "core2_nordic1_bilin.nc"
+    input_name = "T_10_MOD"
+    input_start = 1,1,1,1
+    input_stride = 1,1,1,1
+    input_stop = 0,0,0,1
+    input_vars = 'initial_time0_hours'
+/
+
+&interp_outputs
+    output_file = "t_10.15JUNE2009_nordic1.nc"
+    output_mode = "create"
+    output_dims = 'x', 'y', 'time_counter'
+    output_scaling = "T_10_MOD|1.0", "time_counter|86400.0"
+    output_name = 'T_10_MOD'
+    output_lon = 'x'
+    output_lat = 'y'
+    output_vars = 'time_counter'
+    output_attributes = 'time_counter|units|seconds since 1995-00-00 00:00:00',
+                        'time_counter|calendar|noleap',
+                        'T_10_MOD|units|mm/s'
+/
+
+&comments
+ -----------------------------------------------------------------------------------
+ -  shape_inputs are the input fields required by scripshape.f90
+ -  first is the interpolation file created by scrip.f90 mapping data to model grid
+ -  second is the name of the output weights file to create
+ -  third is the east-west wrap to assume in the model (needed when calculating gradient 
+          terms in the bicubic scheme); the number is just the number of columns on one side
+          that are repeats of those on the opposite side (-1 for not cyclic)
+/
+&shape_inputs
+    interp_file = 'core2_nordic1_bilin.nc'
+    output_file = 'weights_core2_nordic1_bilin.nc'
+    ew_wrap     = 0
+/
Index: /utils/tools_ticket2413/WEIGHTS/nocsutil/CHANGES
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/nocsutil/CHANGES	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/nocsutil/CHANGES	(revision 12863)
@@ -0,0 +1,20 @@
+Release 1.1
+===========
+Modified for compilation by fcm in NEMO 3.3 framework.
+SCRIP 1.4 package included in unmodified form.
+python script added to transform into correct shape for fcm, producing copied code in 'src' directory
+
+scripshape.F90 now has one possible command line argument: the namelist file
+               from which it reads the names of the input and output files 
+               as well as the value for the cyclicity attribute
+
+Because gfortran doesnt understand ICHAR and GETCHAR system routines default behaviour of all programs
+is to ask for namelist filename during execution rather than reading it from the command line.
+Define symbol ARGC at compilation to return to original command line behaviour.
+
+Release 1.0
+===========
+Routines written by sga and acc at NOCS to use SCRIP library to produce weights
+
+Compilation by makefile and explicit compiler and options.
+
Index: /utils/tools_ticket2413/WEIGHTS/nocsutil/namelist_example_bilin
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/nocsutil/namelist_example_bilin	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/nocsutil/namelist_example_bilin	(revision 12863)
@@ -0,0 +1,101 @@
+&comments
+ -----------------------------------------------------------------------------------
+ - grid_inputs holds parameters for the scripgrid routine which reformats information 
+   about the input grids
+ - scripgrid always needs a coordinates.nc file in the
+   current directory and creates the remapped grid file correspondingly
+ - it uses the following namelist block to determine its actions
+     method:  only 'regular' is yet implemented, this assumes a cartesian grid
+     input_lon: name of longitude variable in the input_file
+     input_lat: name of latitude variable in the input_file
+     nemo_lon: name of longitude variable in the coordinates.nc
+     nemo_lat: name of latitude variable in the coordinates.nc
+/
+&grid_inputs
+    input_file = 'snow_1m_DUM_1958.nc'
+    nemo_file = 'coordinates.nc'
+    datagrid_file = 'remap_data_grid.nc'
+    nemogrid_file = 'remap_nemo_grid.nc'
+    method = 'regular'
+    input_lon = 'lon'
+    input_lat = 'lat'
+    nemo_lon = 'glamt'
+    nemo_lat = 'gphit'
+    nemo_mask = 'none'
+    nemo_mask_value = 10
+    input_mask = 'none'
+    input_mask_value = 10
+/
+&comments
+ -----------------------------------------------------------------------------------
+ - remap_inputs holds parameters for the scrip routine which calculates the weights
+   needed to convert between two grids
+ - two remap grid files are required as output by scripgrid
+ - num_maps is either 1 or 2 depending on whether the reverse transformation is required
+ - one or two interp_file names are then supplied; these hold the weights to convert 
+   one grid to another
+ - the map_name variable is just descriptive
+ - map_method can be 'bilinear' 'bicubic' or 'conservative' (the latter untested)
+ - normalize_opt should usually be 'frac' or else the user needs to do this scaling
+   manually (this seems to the case for fractional ice cover)
+ - restrict_type should be 'latitude' or 'latlon' in which case num_srch_bins only are 
+   used in one or two directions
+ - use_grid_area fields override the scrip calculation of area in case the model gets
+   slightly different answers, but the area needs to be supplied in the input files
+ - output_opt may be supplied and set to either 'scrip' or 'ncar-csm'
+/
+&remap_inputs
+    num_maps = 1
+    grid1_file = 'remap_data_grid.nc'
+    grid2_file = 'remap_nemo_grid.nc'
+    interp_file1 = 'data_nemo_bilin.nc'
+    interp_file2 = 'nemo_data_bilin.nc'
+    map1_name = 'data to nemo bilin Mapping'
+    map2_name = 'nemo to data bilin Mapping'
+    map_method = 'bilinear'
+    normalize_opt = 'frac'
+    output_opt = 'scrip'
+    restrict_type = 'latitude'
+    num_srch_bins = 90 
+    luse_grid1_area = .false.
+    luse_grid2_area = .false.
+/
+
+&interp_inputs
+    input_file = "snow_1m_DUM_1958.nc"
+    interp_file = "data_nemo_bilin.nc"
+    input_name = "snow"
+    input_start = 1,1,1,1
+    input_stride = 1,1,1,1
+    input_stop = 0,0,0,1
+    input_vars = 'initial_time0_hours'
+/
+
+&interp_outputs
+    output_file = "snow_orca.nc"
+    output_mode = "create"
+    output_dims = 'x', 'y', 'time_counter'
+    output_scaling = "snow|1.0", "time_counter|86400.0"
+    output_name = 'snow'
+    output_lon = 'x'
+    output_lat = 'y'
+    output_vars = 'time_counter'
+    output_attributes = 'time_counter|units|seconds since 1995-00-00 00:00:00',
+                        'time_counter|calendar|noleap',
+                        'snow|units|mm/s'
+/
+
+&comments
+ -----------------------------------------------------------------------------------
+ -  shape_inputs are the input fields required by scripshape.f90
+ -  first is the interpolation file created by scrip.f90 mapping data to model grid
+ -  second is the name of the output weights file to create
+ -  third is the east-west wrap to assume in the model (needed when calculating gradient 
+          terms in the bicubic scheme); the number is just the number of columns on one side
+          that are repeats of those on the opposite side (-1 for not cyclic)
+/
+&shape_inputs
+    interp_file = 'data_nemo_bilin.nc'
+    output_file = 'weights_bilin.nc'
+    ew_wrap     = 0
+/
Index: /utils/tools_ticket2413/WEIGHTS/nocsutil/scrip.F90
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/nocsutil/scrip.F90	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/nocsutil/scrip.F90	(revision 12863)
@@ -0,0 +1,232 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This routine is the driver for computing the addresses and weights 
+!     for interpolating between two grids on a sphere.
+!
+!     Modified slightly to get name of namelist file from command line - sga 2/12/05
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: scrip.f,v 1.6 2001/08/21 21:06:44 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      program scrip
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod                  ! module defining data types
+      use constants                  ! module for common constants
+      use iounits                    ! I/O unit manager
+      use timers                     ! CPU timers
+      use grids                      ! module with grid information
+      use remap_vars                 ! common remapping variables
+      use remap_conservative         ! routines for conservative remap
+      use remap_distance_weight      ! routines for dist-weight remap
+      use remap_bilinear             ! routines for bilinear interp
+      use remap_bicubic              ! routines for bicubic  interp
+      use remap_write                ! routines for remap output
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     input namelist variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) :: &
+         grid1_file,       &  ! filename of grid file containing grid1
+         grid2_file,       &  ! filename of grid file containing grid2
+         interp_file1,     &  ! filename for output remap data (map1)
+         interp_file2,     &  ! filename for output remap data (map2)
+         map1_name,        &  ! name for mapping from grid1 to grid2
+         map2_name,        &  ! name for mapping from grid2 to grid1
+         map_method,       &  ! choice for mapping method
+         normalize_opt,    &  ! option for normalizing weights
+         output_opt           ! option for output conventions
+
+      integer (kind=int_kind) :: &
+         nmap                 ! number of mappings to compute (1 or 2)
+
+      namelist /remap_inputs/ grid1_file, grid2_file,  &
+         interp_file1, interp_file2,                   &
+         map1_name, map2_name, num_maps,               &
+         luse_grid1_area, luse_grid2_area,             &
+         map_method, normalize_opt, output_opt,        &
+         restrict_type, num_srch_bins
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,   &  ! dummy counter
+                                 iunit   ! unit number for namelist file
+
+      character (char_len) :: nm_in
+#if defined ARGC
+      integer :: iargc
+      external iargc
+
+      if (iargc() == 1) then
+        call getarg(1, nm_in)
+      else
+        write(6,*) 'need name of namelist file'
+        stop
+      endif
+#else
+      write(6,*) 'enter name for namelist file'
+      read(5,*) nm_in
+#endif
+
+!-----------------------------------------------------------------------
+!
+!     initialize timers
+!
+!-----------------------------------------------------------------------
+
+      call timers_init
+      do n=1,max_timers
+        call timer_clear(n)
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     read input namelist
+!
+!-----------------------------------------------------------------------
+
+      grid1_file    = 'unknown'
+      grid2_file    = 'unknown'
+      interp_file1  = 'unknown'
+      interp_file2  = 'unknown'
+      map1_name     = 'unknown'
+      map2_name     = 'unknown'
+      luse_grid1_area = .false.
+      luse_grid2_area = .false.
+      num_maps      = 2
+      map_type      = 1
+      normalize_opt = 'fracarea'
+      output_opt    = 'scrip'
+      restrict_type = 'latitude'
+      num_srch_bins = 900
+
+      call get_unit(iunit)
+      open(iunit, file=nm_in, status='old', form='formatted')
+      read(iunit, nml=remap_inputs)
+      call release_unit(iunit)
+
+      select case(map_method)
+      case ('conservative')
+        map_type = map_type_conserv
+        luse_grid_centers = .false.
+      case ('bilinear')
+        map_type = map_type_bilinear
+        luse_grid_centers = .true.
+      case ('bicubic')
+        map_type = map_type_bicubic
+        luse_grid_centers = .true.
+      case ('distwgt')
+        map_type = map_type_distwgt
+        luse_grid_centers = .true.
+      case default
+        stop 'unknown mapping method'
+      end select
+
+      select case(normalize_opt(1:4))
+      case ('none')
+        norm_opt = norm_opt_none
+      case ('frac')
+        norm_opt = norm_opt_frcarea
+      case ('dest')
+        norm_opt = norm_opt_dstarea
+      case default
+        stop 'unknown normalization option'
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     initialize grid information for both grids
+!
+!-----------------------------------------------------------------------
+
+      call grid_init(grid1_file, grid2_file)
+
+      write(stdout, *) ' Computing remappings between: ',grid1_name
+      write(stdout, *) '                          and  ',grid2_name
+
+!-----------------------------------------------------------------------
+!
+!     initialize some remapping variables.
+!
+!-----------------------------------------------------------------------
+
+      call init_remap_vars
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate interpolation setup routine based on type of
+!     remapping requested.
+!
+!-----------------------------------------------------------------------
+
+      select case(map_type)
+      case(map_type_conserv)
+        call remap_conserv
+      case(map_type_bilinear)
+        call remap_bilin
+      case(map_type_distwgt)
+        call remap_distwgt
+      case(map_type_bicubic)
+        call remap_bicub
+      case default
+        stop 'Invalid Map Type'
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     reduce size of remapping arrays and then write remapping info
+!     to a file.
+!
+!-----------------------------------------------------------------------
+
+      if (num_links_map1 /= max_links_map1) then
+        call resize_remap_vars(1, num_links_map1-max_links_map1)
+      endif
+      if ((num_maps > 1) .and. (num_links_map2 /= max_links_map2)) then
+        call resize_remap_vars(2, num_links_map2-max_links_map2)
+      endif
+
+      call write_remap(map1_name, map2_name, &
+                       interp_file1, interp_file2, output_opt)
+
+!-----------------------------------------------------------------------
+
+      end program scrip
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/nocsutil/scripgrid.F90
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/nocsutil/scripgrid.F90	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/nocsutil/scripgrid.F90	(revision 12863)
@@ -0,0 +1,26 @@
+! ==============================================================================
+
+PROGRAM scripgrid
+
+  USE scripgrid_mod
+
+  CHARACTER(char_len) :: infile
+
+#if defined ARGC
+  INTEGER :: IARGC
+  EXTERNAL IARGC
+
+  if (IARGC() == 1) then
+    CALL GETARG(1, infile)
+    CALL convert( infile )
+  ELSE
+    write(6,*) 'need to supply a namelist file'
+  ENDIF
+#else
+  write(6,*) 'enter name of namelist file'
+  read(5,*) infile
+
+  CALL convert( infile )
+#endif
+
+END PROGRAM scripgrid
Index: /utils/tools_ticket2413/WEIGHTS/nocsutil/scripgrid_mod.F90
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/nocsutil/scripgrid_mod.F90	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/nocsutil/scripgrid_mod.F90	(revision 12863)
@@ -0,0 +1,759 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module creates grid description files for input to the SCRIP code
+!
+!-----------------------------------------------------------------------
+
+MODULE scripgrid_mod
+
+  USE kinds_mod
+  USE constants
+  USE iounits
+  USE netcdf
+  USE netcdf_mod
+  
+  IMPLICIT NONE
+
+  !-----------------------------------------------------------------------
+  !     module variables that describe the grid
+
+  INTEGER (kind=int_kind), parameter :: &
+       grid_rank = 2,         &
+       grid_corners = 4
+  INTEGER (kind=int_kind) :: nx, ny, grid_size
+  INTEGER (kind=int_kind), dimension(2) :: &
+       grid_dims,    &  ! size of x, y dimensions
+       grid_dim_ids     ! ids of the x, y dimensions
+  INTEGER (kind=int_kind), ALLOCATABLE, DIMENSION(:) :: &
+       grid_imask          ! land-sea mask
+  REAL (kind=int_kind), ALLOCATABLE, DIMENSION(:) :: &
+       grid_center_lat, &  ! lat/lon coordinates for
+       grid_center_lon     ! each grid center in degrees
+  REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:) :: &
+       grid_corner_lat, &  ! lat/lon coordinates for
+       grid_corner_lon     ! each grid corner in degrees
+  REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:,:) :: &
+       corner_lon, &
+       corner_lat
+  REAL (kind=dbl_kind), PARAMETER :: circle = 360.0
+
+  !-----------------------------------------------------------------------
+  !     module variables that describe the netcdf file
+
+  INTEGER (kind=int_kind) :: &
+       ncstat,           &   ! general netCDF status variable
+       ncid_in
+
+CONTAINS
+
+  ! ==============================================================================
+  
+  SUBROUTINE convert(nm_in)
+  
+    ! -----------------------------------------------------------------------------
+    ! - input variables
+  
+    CHARACTER(char_len), INTENT(in) ::  &
+      nm_in
+  
+    ! -----------------------------------------------------------------------------
+    ! - local variables
+  
+    CHARACTER(char_len) ::  &
+      nemo_file, input_file, method, input_lon, input_lat, datagrid_file, &
+      nemogrid_file, nemo_lon, nemo_lat, corn_lon, corn_lat, nemo_mask, input_mask
+    INTEGER (kind=int_kind), dimension(2) :: &
+      offset
+    INTEGER (kind=int_kind) :: &
+      iunit, nemo_mask_value, input_mask_value
+  
+    namelist /grid_inputs/ nemo_file, input_file, datagrid_file, nemogrid_file,  &
+                           method, input_lon, input_lat, nemo_lon, nemo_lat,     &
+                           nemo_mask, nemo_mask_value, input_mask, input_mask_value
+  
+    !-----------------------------------------------------------------------
+    ! - namelist describing the processing
+    !   note that mask_value is the minimum good value,
+    !   so that where the mask is less than the value is masked
+
+    nemo_file = "coordinates.nc"
+    nemo_lon = "glamt"
+    nemo_lat = "gphit"
+    input_lon = "lon"
+    input_lat = "lat"
+    input_mask = "none"
+    input_mask_value = 0
+    datagrid_file = 'remap_data_grid.nc'
+    nemogrid_file = 'remap_nemo_grid.nc'
+
+    call get_unit(iunit)
+    open(iunit, file=nm_in, status='old', form='formatted')
+    read(iunit, nml=grid_inputs) 
+    call release_unit(iunit)
+
+    if (nemo_lon(1:4) .ne. 'glam' .or. nemo_lat(1:4) .ne. 'gphi') then
+      write(6,*) 'lon name does not start with "glam" or lat name does not start with "gphi"'
+      stop
+    endif
+
+    ! set up the names of the corner variables for a given input
+    ! the offset represents what needs to be added to (i,j) to get to the correct 
+    ! element in the corner arrays to correspond to the point northeast of the center
+    if (nemo_lon(5:5) == "t") then
+      corn_lon = "glamf"
+      corn_lat = "gphif"
+      offset = (/ 0,0 /)
+    else if (nemo_lon(5:5) == "u") then
+      corn_lon = "glamv"
+      corn_lat = "gphiv"
+      offset = (/ 1,0 /)
+    else if (nemo_lon(5:5) == "v") then
+      corn_lon = "glamu"
+      corn_lat = "gphiu"
+      offset = (/ 0,1 /)
+    else
+      write(6,*) 'unknown nemo_lon name'
+      stop
+    endif
+
+    write(6,*) "processing " // trim(nemo_file)
+    call convertNEMO(nemo_file, nemo_lon, nemo_lat, corn_lon, corn_lat, &
+                     offset, nemogrid_file)
+
+    write(6,*) "processing regular grid"
+    call convertFLUX(input_file, input_lon, input_lat, &
+                     input_mask, input_mask_value, datagrid_file)
+
+  END SUBROUTINE convert
+  
+  ! ==============================================================================
+  
+  SUBROUTINE convertNEMO(grid_file_in, cent_lon, cent_lat, corn_lon, corn_lat, &
+                         off, grid_file_out)
+  
+    !-----------------------------------------------------------------------
+    !
+    !     This routine converts a NEMO coordinates.nc file to a remapping grid file.
+    !
+    
+    CHARACTER(char_len), INTENT(in) :: cent_lon, cent_lat, corn_lon, corn_lat
+    INTEGER (kind=int_kind), INTENT(in), DIMENSION(2) :: off
+    CHARACTER(char_len), INTENT(in) :: grid_file_out
+    CHARACTER(char_len), INTENT(in) :: grid_file_in
+
+    !-----------------------------------------------------------------------
+    !     module variables that describe the grid
+  
+    CHARACTER(char_len), parameter ::  &
+         grid_name = 'Remapped NEMO grid for SCRIP'
+  
+    !-----------------------------------------------------------------------
+    !     grid coordinates and masks
+  
+    REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:) :: &
+         clon, clat, &             ! expanded corner arrays
+         glam, &                   ! center longitude
+         gphi, &                   ! center latitude
+         glamc, &                  ! corner longitude
+         gphic                     ! corner latitude
+  
+    !-----------------------------------------------------------------------
+    !     other local variables
+  
+    INTEGER (kind=int_kind) :: i, j, n, iunit, im1, jm1, imid, isame, ic, jc
+    INTEGER (kind=int_kind) :: varid_lam, varid_phi, varid_lamc, varid_phic
+    INTEGER (kind=int_kind) :: jdim
+    INTEGER (kind=int_kind), dimension(4) :: grid_dimids  ! input fields have 4 dims
+    REAL (kind=dbl_kind) :: tmplon, dxt, dyt
+  
+    !-----------------------------------------------------------------------
+    !     read in grid info
+    !
+    !     For NEMO input grids, assume that variable names are glam, glamc etc.
+    !     Assume that 1st 2 dimensions of these variables are x and y directions.
+    !     These assumptions are made by NEMO, so should be valid for coordinates.nc.
+    !
+    ! write in nf90 calls (without error handling) and then think about 
+    ! making more readable by taking chunks into ncutil
+    !
+  
+    ncstat = nf90_open( grid_file_in, NF90_NOWRITE, ncid_in )
+    call netcdf_error_handler(ncstat)
+  
+    ! find dimids for 'glam'
+    ! use dimids to get dimlengths
+    ! allocate glam array
+    ! get glam from file 
+  
+    ncstat = nf90_inq_varid( ncid_in, cent_lon, varid_lam )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_inq_varid( ncid_in, corn_lon, varid_lamc )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_inq_varid( ncid_in, cent_lat, varid_phi )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_inq_varid( ncid_in, corn_lat, varid_phic )
+    call netcdf_error_handler(ncstat)
+  
+    ncstat = nf90_inquire_variable( ncid_in, varid_lam, dimids=grid_dimids(:) )
+    call netcdf_error_handler(ncstat)
+    DO jdim = 1, SIZE(grid_dims)
+       ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(jdim),  &
+                                        len=grid_dims(jdim) )
+       call netcdf_error_handler(ncstat)
+    END DO
+    nx = grid_dims(1)
+    ny = grid_dims(2)
+    grid_size = nx * ny
+    WRITE(*,FMT='("Input grid dimensions are:",2i6)') nx, ny
+    
+    ! assume that dimensions are all the same as glam
+    ALLOCATE( glam(nx,ny), glamc(nx,ny), gphi(nx,ny), gphic(nx,ny) )
+    ncstat = nf90_get_var( ncid_in, varid_lam, glam(:,:) )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_get_var( ncid_in, varid_lamc, glamc(:,:) )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_get_var( ncid_in, varid_phi, gphi(:,:) )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_get_var( ncid_in, varid_phic, gphic(:,:) )
+    call netcdf_error_handler(ncstat)
+    
+    !-----------------------------------------------------------------------
+    ! - Mask is all ocean for now
+  
+    ALLOCATE( grid_imask(grid_size) )
+    grid_imask(:) = 1
+  
+    !-----------------------------------------------------------------------
+    ! corners are arranged as follows:    4 3
+    !                                     1 2
+    !
+    ! Assume that cyclic grids have 2 wrap columns in coordinates.nc
+    !  (this is the case for ORCA grids)
+    !
+  
+    ! -----------------------------------------------------------------------------
+    ! create a single pair of arrays for the corners where clon(1,1) corresponds
+    ! to the south west corner of a box containing glam(1,1)
+    ! various special cases then apply
+    !   bottom row:  assume clon(:,j) = clon(:,j+1)
+  
+    ALLOCATE ( clon(nx+1,ny+1), clat(nx+1,ny+1) )
+
+    ! first the easy internal points
+    DO j = 2,ny
+      DO i = 2,nx
+        ic = i + off(1) - 1
+        jc = j + off(2) - 1
+        clon(i,j) = glamc(ic,jc)
+        clat(i,j) = gphic(ic,jc)
+      ENDDO
+    ENDDO
+
+    ! then the tricky boundary points
+    imid = (nx-1)/2 + 1
+    DO j = 1,ny+1,ny
+      DO i = 1,nx+1,nx
+        ic = i + off(1) - 1
+        jc = j + off(2) - 1
+        if (ic == 0 .and. jc == 0) then
+          clon(i,j) = glamc(nx,1)
+          clat(i,j) = gphic(nx,1) - (gphic(nx,2)-gphic(nx,1))
+        else if (ic == nx+1 .and. jc == 0) then
+          clon(i,j) = glamc(1,1)
+          clat(i,j) = gphic(1,1) - (gphic(1,2)-gphic(1,1))
+        else if (ic == 0 .and. jc == ny+1) then
+          isame = 2*imid - nx + 1
+          clon(i,j) = glamc(isame,jc-1)
+          clat(i,j) = gphic(isame,jc-1)
+        else if (ic == nx+1 .and. jc == ny+1) then
+          isame = 2*imid
+          clon(i,j) = glamc(isame,jc-1)
+          clat(i,j) = gphic(isame,jc-1)
+        else if (ic == 0) then
+          clon(i,j) = glamc(nx,jc)
+          clat(i,j) = gphic(nx,jc)
+        else if (jc == 0) then
+          clon(i,j) = glamc(ic,1)
+          clat(i,j) = gphic(ic,1) - (gphic(ic,2)-gphic(ic,1))
+        else if (ic == nx+1) then
+          clon(i,j) = glamc(1,jc)
+          clat(i,j) = gphic(1,jc)
+        else if (jc == ny+1) then
+          isame = 2*imid - ic + 1
+          clon(i,j) = glamc(isame,jc-1)
+          clat(i,j) = gphic(isame,jc-1)
+        endif
+      ENDDO
+    ENDDO
+
+    ALLOCATE ( corner_lon(4,nx,ny), corner_lat(4,nx,ny) )
+  
+    ! top-right corner
+    corner_lon(3,:,:) = clon(2:nx+1,2:ny+1)
+    corner_lat(3,:,:) = clat(2:nx+1,2:ny+1)
+  
+    ! top-left corner
+    corner_lon(4,:,:) = clon(1:nx,2:ny+1)
+    corner_lat(4,:,:) = clat(1:nx,2:ny+1)
+  
+    ! bottom-right corner 
+    corner_lon(2,:,:) = clon(2:nx+1,1:ny)
+    corner_lat(2,:,:) = clat(2:nx+1,1:ny)
+  
+    ! bottom-left corner
+    corner_lon(1,:,:) = clon(1:nx,1:ny)
+    corner_lat(1,:,:) = clat(1:nx,1:ny)
+  
+  ! For [N, E, W]-ward extrapolation near the poles, should we use stereographic (or
+  ! similar) projection?  This issue will come for V,F interpolation, and for all
+  ! grids with non-cyclic grids.
+  
+    ! -----------------------------------------------------------------------------
+    !     correct for 0,2pi longitude crossings
+    !      (In practice this means putting all corners into 0,2pi range
+    !       and ensuring that no box corners are miles from each other.
+    !       3pi/2 is used as threshold - I think this is quite arbitrary.)
+  
+    corner_lon(:,:,:) = MODULO( corner_lon(:,:,:), circle )
+    DO n = 2, grid_corners
+       WHERE    ( corner_lon(n,:,:) - corner_lon(n-1,:,:) < -three*circle*0.25 )
+          corner_lon(n,:,:) = corner_lon(n,:,:) + circle
+       ELSEWHERE( corner_lon(n,:,:) - corner_lon(n-1,:,:) >  three*circle*0.25 )
+          corner_lon(n,:,:) = corner_lon(n,:,:) - circle
+       END WHERE
+    END DO
+  
+    ! -----------------------------------------------------------------------------
+    ! - put longitudes on smooth grid 
+  
+ !  call mouldlon(glam,nx,ny)
+ !  call mouldlon(corner_lon(1,:,:),nx,ny)
+ !  call mouldlon(corner_lon(2,:,:),nx,ny)
+ !  call mouldlon(corner_lon(3,:,:),nx,ny)
+ !  call mouldlon(corner_lon(4,:,:),nx,ny)
+
+    ! -----------------------------------------------------------------------------
+    ! - reshape for SCRIP input format
+  
+    ALLOCATE( grid_center_lon(grid_size), grid_center_lat(grid_size) )
+    
+    grid_center_lon(:) = RESHAPE( glam(:,:), (/ grid_size /) )
+    grid_center_lat(:) = RESHAPE( gphi(:,:), (/ grid_size /) )
+  
+    DEALLOCATE( glam, gphi, glamc, gphic )
+  
+    ALLOCATE( grid_corner_lon(4, grid_size), grid_corner_lat(4, grid_size) )
+  
+    grid_corner_lon(:,:) = RESHAPE( corner_lon(:,:,:), (/ 4, grid_size /) )
+    grid_corner_lat(:,:) = RESHAPE( corner_lat(:,:,:), (/ 4, grid_size /) )
+  
+    DEALLOCATE( corner_lon, corner_lat )
+  
+    CALL createSCRIPgrid(grid_file_out, grid_name)
+  
+  END SUBROUTINE convertNEMO
+  
+  ! ==============================================================================
+  
+  SUBROUTINE convertFLUX(grid_file_in, name_lon, name_lat, &
+                         name_mask, value_mask, grid_file_out)
+  
+    !-----------------------------------------------------------------------
+    !
+    !     This routine creates a remapping grid file from an input grid.
+    !
+    !-----------------------------------------------------------------------
+    
+    CHARACTER(char_len), INTENT(in) ::  &
+         grid_file_in, name_lon, name_lat, name_mask, grid_file_out
+    INTEGER (kind=int_kind) :: value_mask
+  
+    !-----------------------------------------------------------------------
+    !     variables that describe the grid
+  
+    CHARACTER(char_len), parameter ::  &
+         grid_name = 'Remapped regular grid for SCRIP'
+  
+    !-----------------------------------------------------------------------
+    !     grid coordinates (note that a flux file just has lon and lat)
+  
+    REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:) :: &
+         lam, phi
+    REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:) :: &
+         glam, &                   ! longitude
+         gphi, &                   ! latitude
+         glamc, &
+         gphic
+    REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:) :: mask
+  
+    !-----------------------------------------------------------------------
+    !     other local variables
+  
+    INTEGER (kind=int_kind) :: i, j, n, iunit, im1, jm1
+    INTEGER (kind=int_kind) :: varid_lam, varid_phi, varid_mask
+    INTEGER (kind=int_kind) :: jdim, nspace
+    INTEGER (kind=int_kind), dimension(4) :: grid_dimids  ! input fields have 4 dims
+    REAL (kind=dbl_kind) :: tmplon, dxt, dyt
+  
+    !-----------------------------------------------------------------------
+    !     read in grid info
+    !
+    !     For NEMO input grids, assume that variable names are glam, glamc etc.
+    !     Assume that 1st 2 dimensions of these variables are x and y directions.
+    !     These assumptions are made by NEMO, so should be valid for coordinates.nc.
+    !
+    ! write in nf90 calls (without error handling) and then think about 
+    ! making more readable by taking chunks into ncutil
+  
+    ncstat = nf90_open( grid_file_in, NF90_NOWRITE, ncid_in )
+    call netcdf_error_handler(ncstat)
+  
+    ! find dimids for 'glamt'
+    ! use dimids to get dimlengths
+    ! allocate glam array
+    ! get glam from file 
+  
+    ncstat = nf90_inq_varid( ncid_in, name_lat, varid_phi )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_inq_varid( ncid_in, name_lon, varid_lam )
+    call netcdf_error_handler(ncstat)
+  
+    ncstat = nf90_inquire_variable( ncid_in, varid_lam, ndims=nspace )
+    call netcdf_error_handler(ncstat)
+
+    if (nspace == 1) then
+      ncstat = nf90_inquire_variable( ncid_in, varid_lam, dimids=grid_dimids(:1) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_variable( ncid_in, varid_phi, dimids=grid_dimids(2:) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(1), len=grid_dims(1) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(2), len=grid_dims(2) )
+      call netcdf_error_handler(ncstat)
+      nx = grid_dims(1)
+      ny = grid_dims(2)
+      grid_size = nx * ny
+      WRITE(*,FMT='("Input grid dimensions are:",2i6)') nx, ny
+    
+      ALLOCATE( lam(nx), phi(ny) )
+      write(6,*) 'double'
+      ncstat = nf90_get_var( ncid_in, varid_lam, lam )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_get_var( ncid_in, varid_phi, phi )
+      call netcdf_error_handler(ncstat)
+    
+      ALLOCATE( glam(nx,ny), gphi(nx,ny))
+      write(6,*) shape(lam),shape(phi)
+      glam(:,:) = SPREAD(lam,2,ny)
+      gphi(:,:) = SPREAD(phi,1,nx)
+    else
+
+      ncstat = nf90_inquire_variable( ncid_in, varid_lam, dimids=grid_dimids(:2) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(1), len=grid_dims(1) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(2), len=grid_dims(2) )
+      call netcdf_error_handler(ncstat)
+      nx = grid_dims(1)
+      ny = grid_dims(2)
+      grid_size = nx * ny
+      WRITE(*,FMT='("Input grid dimensions are:",2i6)') nx, ny
+    
+      ALLOCATE( glam(nx,ny), gphi(nx,ny))
+      ncstat = nf90_get_var( ncid_in, varid_lam, glam )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_get_var( ncid_in, varid_phi, gphi )
+      call netcdf_error_handler(ncstat)
+
+    endif
+    write(6,*) grid_size,nx,ny
+  
+    ALLOCATE(glamc(0:nx,0:ny), gphic(0:nx,0:ny) )
+
+    ! - for now a simple average to get top right box corners
+    ! - glamc(i,j), gphic(i,j) are top right coordinates of box containing 
+    ! - glam(i,j),gphi(i,j)
+    write(6,*) 'averaging'
+    write(6,*) size(gphic),size(gphi)
+    gphic(1:nx,1:ny-1) = 0.5*(gphi(:,1:ny-1)+gphi(:,2:ny))
+    write(6,*) size(glamc),size(glam)
+    glamc(1:nx-1,1:ny) = 0.5*(glam(1:nx-1,:)+glam(2:nx,:))
+  
+    ! - left and right column of longitudes 
+    write(6,*) 'columns'
+    glamc(nx,1:ny) = 1.5*glam(nx,:)-0.5*glam(nx-1,:)
+    glamc( 0,1:ny) = 1.5*glam(1,:)-0.5*glam(2,:)
+    glamc(nx, 0) = glamc(nx,1)
+    glamc( 0, 0) = glamc( 0,1)
+
+    ! - top and bottom row of latitudes by extrapolation
+    write(6,*) 'rows'
+    gphic(1:nx,ny) = 1.5*gphi(:,ny)-0.5*gphi(:,ny-1)
+    gphic(1:nx, 0) = 1.5*gphi(:,1)-0.5*gphi(:,2)
+    gphic( 0,ny) = gphic(1,ny)
+    gphic( 0, 0) = gphic(1, 0)
+
+    !-----------------------------------------------------------------------
+  
+    write(6,*) 'allocating'
+    ALLOCATE( grid_imask(grid_size) )
+    grid_imask(:) = 1
+    write(6,*) name_mask
+    if (trim(name_mask) /= "none") then
+      write(6,*) 'masking'
+      ncstat = nf90_inq_varid( ncid_in, name_mask, varid_mask )
+      call netcdf_error_handler(ncstat)
+      ALLOCATE( mask(nx,ny) )
+      write(6,*) 'reading mask'
+      ncstat = nf90_get_var( ncid_in, varid_mask, mask )
+      call netcdf_error_handler(ncstat)
+      write(6,*) 'setting mask'
+      WHERE ( RESHAPE(mask(:,:),(/ grid_size /)) < value_mask)
+        grid_imask = 0
+      END WHERE
+      write(6,*) 'masked'
+    END IF
+  
+    !-----------------------------------------------------------------------
+    ! corners are arranged as follows:    4 3
+    !                                     1 2
+  
+    ALLOCATE ( corner_lon(4,nx,ny), corner_lat(4,nx,ny) )
+  
+    ! - bottom-left corner
+    corner_lon(1,:,:) = glamc(0:nx-1, 0:ny-1 )
+    corner_lat(1,:,:) = gphic(0:nx-1, 0:ny-1 )
+  
+    ! - bottom-right corner 
+    corner_lon(2,:,:) = glamc(1:nx, 0:ny-1 )
+    corner_lat(2,:,:) = gphic(1:nx, 0:ny-1 )
+  
+    ! - top-right corner
+    corner_lon(3,:,:) = glamc(1:nx,1:ny)
+    corner_lat(3,:,:) = gphic(1:nx,1:ny)
+    write(6,*) corner_lat(3,nx-2:nx,ny)
+  
+    ! - top-left corner
+    corner_lon(4,:,:) = glamc(0:nx-1, 1:ny )
+    corner_lat(4,:,:) = gphic(0:nx-1, 1:ny )
+  
+  ! For [N, E, W]-ward extrapolation near the poles, should we use stereographic (or
+  ! similar) projection?  This issue will come for V,F interpolation, and for all
+  ! grids with non-cyclic grids.
+  
+    ! -----------------------------------------------------------------------------
+    !     correct for 0,2pi longitude crossings
+    !      (In practice this means putting all corners into 0,2pi range
+    !       and ensuring that no box corners are miles from each other.
+    !       3pi/2 is used as threshold - I think this is quite arbitrary.)
+  
+  ! corner_lon(:,:,:) = MODULO( corner_lon(:,:,:), circle )
+  ! DO n = 2, grid_corners
+  !    WHERE    ( corner_lon(n,:,:) - corner_lon(n-1,:,:) < -three*circle*0.25 )
+  !       corner_lon(n,:,:) = corner_lon(n,:,:) + circle
+  !    ELSEWHERE( corner_lon(n,:,:) - corner_lon(n-1,:,:) >  three*circle*0.25 )
+  !       corner_lon(n,:,:) = corner_lon(n,:,:) - circle
+  !    END WHERE
+  ! END DO
+  
+    ! -----------------------------------------------------------------------------
+    ! - reshape for SCRIP input format
+  
+    ALLOCATE( grid_center_lon(grid_size), grid_center_lat(grid_size) )
+    
+    grid_center_lon(:) = RESHAPE( glam(:,:), (/ grid_size /) )
+    grid_center_lat(:) = RESHAPE( gphi(:,:), (/ grid_size /) )
+  
+    DEALLOCATE( glam, gphi, glamc, gphic )
+  
+    ALLOCATE( grid_corner_lon(4, grid_size), grid_corner_lat(4, grid_size) )
+  
+    grid_corner_lon(:,:) = RESHAPE( corner_lon(:,:,:), (/ 4, grid_size /) )
+    grid_corner_lat(:,:) = RESHAPE( corner_lat(:,:,:), (/ 4, grid_size /) )
+  
+    DEALLOCATE( corner_lon, corner_lat )
+  
+    CALL createSCRIPgrid(grid_file_out, grid_name)
+  
+  END SUBROUTINE convertFLUX
+  
+  ! ==============================================================================
+  
+  SUBROUTINE mouldlon(lon_grid, nx, ny)
+
+    ! -----------------------------------------------------------------------------
+    ! - input variables
+
+    INTEGER, INTENT(in) :: nx, ny
+    REAL (kind=dbl_kind), INTENT(inout), DIMENSION(nx,ny) ::  &
+      lon_grid
+  
+    ! -----------------------------------------------------------------------------
+    ! - local variables
+
+    INTEGER :: ix, iy
+    REAL (kind=dbl_kind), DIMENSION(:,:), ALLOCATABLE ::  &
+      dlon
+    REAL :: step
+
+    ! -----------------------------------------------------------------------------
+    ! - try to eliminate any 360 degree steps in a grid of longitudes
+
+    ALLOCATE(dlon(nx,ny))
+
+    step = 0.75*circle
+    dlon(:,:) = 0
+    dlon(2:,:) = lon_grid(2:,:) - lon_grid(:nx-1,:)
+    WHERE (dlon > -step .AND. dlon < step)
+      dlon = 0.0
+    ELSEWHERE
+      dlon = -SIGN(circle,dlon)
+    END WHERE
+
+    ! - close your eyes this is nasty
+    DO ix = 2,nx
+      dlon(ix,:) = dlon(ix,:) + dlon(ix-1,:)
+    END DO
+    lon_grid = lon_grid + dlon
+
+  END SUBROUTINE mouldlon
+  
+  ! ==============================================================================
+  
+  SUBROUTINE createSCRIPgrid(grid_file_out, grid_name)
+  
+    ! -----------------------------------------------------------------------------
+    ! - input variables
+  
+    CHARACTER(char_len), INTENT(in) ::  &
+         grid_name, grid_file_out
+  
+    ! -----------------------------------------------------------------------------
+    ! - local variables that describe the netcdf file
+  
+    INTEGER (kind=int_kind) :: &
+         nc_grid_id,       &   ! netCDF grid dataset id
+         nc_gridsize_id,   &   ! netCDF grid size dim id
+         nc_gridcorn_id,   &   ! netCDF grid corner dim id
+         nc_gridrank_id,   &   ! netCDF grid rank dim id
+         nc_griddims_id,   &   ! netCDF grid dimensions id
+         nc_grdcntrlat_id, &   ! netCDF grid center lat id
+         nc_grdcntrlon_id, &   ! netCDF grid center lon id
+         nc_grdimask_id,   &   ! netCDF grid mask id
+         nc_gridarea_id,   &   ! netCDF grid area id
+         nc_grdcrnrlat_id, &   ! netCDF grid corner lat id
+         nc_grdcrnrlon_id      ! netCDF grid corner lon id
+  
+    ! -----------------------------------------------------------------------------
+    ! - create netCDF dataset for this grid
+    ! - rewrite in nf90 
+    ! - (bring out functional blocks into ncclear for readability)
+  
+    ncstat = nf90_create (grid_file_out, NF90_CLOBBER, nc_grid_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att (nc_grid_id, NF90_GLOBAL, 'title', grid_name)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid size dimension
+  
+    ncstat = nf90_def_dim (nc_grid_id, 'grid_size', grid_size, nc_gridsize_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid rank dimension
+  
+    ncstat = nf90_def_dim (nc_grid_id, 'grid_rank', grid_rank, nc_gridrank_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid corner dimension
+  
+    ncstat = nf90_def_dim (nc_grid_id, 'grid_corners', grid_corners, nc_gridcorn_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid dim size array
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_dims', NF90_INT, nc_gridrank_id, nc_griddims_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid mask
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_imask', NF90_INT, &
+                          nc_gridsize_id, nc_grdimask_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdimask_id, 'units', 'unitless')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid center latitude array
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_center_lat', NF90_DOUBLE, &
+                          nc_gridsize_id, nc_grdcntrlat_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdcntrlat_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid center longitude array
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_center_lon', NF90_DOUBLE, &
+                          nc_gridsize_id, nc_grdcntrlon_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdcntrlon_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid corner latitude array
+  
+    grid_dim_ids = (/ nc_gridcorn_id, nc_gridsize_id /)
+    ncstat = nf90_def_var(nc_grid_id, 'grid_corner_lat', NF90_DOUBLE, &
+                          grid_dim_ids, nc_grdcrnrlat_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdcrnrlat_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid corner longitude array
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_corner_lon', NF90_DOUBLE, &
+                          grid_dim_ids, nc_grdcrnrlon_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdcrnrlon_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! end definition stage
+  
+    ncstat = nf90_enddef(nc_grid_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! write grid data
+  
+    ncstat = nf90_put_var(nc_grid_id, nc_griddims_id, grid_dims)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdimask_id, grid_imask)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdcntrlat_id, grid_center_lat)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdcntrlon_id, grid_center_lon)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdcrnrlat_id, grid_corner_lat)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdcrnrlon_id, grid_corner_lon)
+    call netcdf_error_handler(ncstat)
+  
+    ncstat = nf90_close(nc_grid_id)
+    call netcdf_error_handler(ncstat)
+  
+    DEALLOCATE( grid_imask, grid_center_lon, grid_center_lat, &
+                grid_corner_lon, grid_corner_lat )
+  
+  
+  END SUBROUTINE createSCRIPgrid
+  
+END MODULE scripgrid_mod
+
Index: /utils/tools_ticket2413/WEIGHTS/nocsutil/scripinterp.F90
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/nocsutil/scripinterp.F90	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/nocsutil/scripinterp.F90	(revision 12863)
@@ -0,0 +1,24 @@
+! ==========================================================================
+
+program scripinterp
+
+  use scripinterp_mod
+
+  character (char_len) ::  nm_in
+#if defined ARGC
+  integer :: iargc
+  external iargc
+
+  if (iargc() == 1) then
+    call getarg(1, nm_in)
+    call process_grid(nm_in)
+  else
+    write(6,*) 'need the name of an input namelist'
+  endif
+#else
+  write(6,*) 'enter the name of an input namelist'
+  read(5,*) nm_in
+  call process_grid(nm_in)
+#endif
+
+end program scripinterp
Index: /utils/tools_ticket2413/WEIGHTS/nocsutil/scripinterp_mod.F90
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/nocsutil/scripinterp_mod.F90	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/nocsutil/scripinterp_mod.F90	(revision 12863)
@@ -0,0 +1,1031 @@
+! **************************************************************************
+
+  module scripinterp_mod
+
+! ==========================================================================
+
+  use kinds_mod    ! defines common data types
+  use constants    ! defines common constants
+  use iounits      ! I/O unit manager
+  use netcdf
+  use netcdf_mod   ! netcdf I/O stuff
+  use grids        ! module containing grid info
+  use remap_vars   ! module containing remapping info
+  use remap_mod    ! module containing remapping routines
+  use remap_read   ! routines for reading remap files
+
+  implicit none
+
+  real(kind=dbl_kind), dimension(:), allocatable ::   &
+    grid_out
+
+  integer(kind=int_kind) ::                           &  ! netCDF ids for files and arrays
+          ncstat, nc_outfile_id, nc_infile_id
+  integer (kind=int_kind), dimension(4) ::    &
+      input_dims, input_dimids, input_count
+  real (kind=dbl_kind), dimension(:), allocatable ::   &
+      scale
+  integer (kind=int_kind), dimension(:), allocatable ::        &
+      nc_xysize_id, nc_gridsize_id, nc_gridsize,           &
+      nc_variable_id
+  integer :: nc_lon_id, nc_lat_id, nc_array_id
+
+  character (char_len) ::  &
+          map_name      ! name for mapping from grid1 to grid2
+  character (1), parameter ::  &
+          separator = '|'
+  
+  ! - input namelist variables
+  
+  character (char_len) ::  &
+    input_file,            &  ! filename containing input fields
+    interp_file,           &  ! filename containing remap data (map1)
+    input_name                ! name of variable to grid
+  integer (kind=int_kind), dimension(4) :: &
+    input_stride,  &          ! how much of input array to process
+    input_start,   &          ! where to start
+    input_stop                ! and where to stop
+  character (char_len), dimension(4) ::  &
+    input_vars                ! input variables to be copied
+  
+  ! - output namelist variables
+  
+  character (char_len) ::  &
+    output_file,           &  ! filename for test results
+    output_mode,           &  ! 'create' or 'append'
+    output_name,           &  ! name of new grid variable
+    output_lat,            &  ! as it says
+    output_lon,            &  ! as it says
+    output_ydir               ! choose to invert output arrays in y direction
+  character (char_len), dimension(4) ::  &
+    output_dims,           &    ! name of new grid variable
+    output_vars                 ! variables to copy
+  character (char_len), dimension(10) ::  &
+    output_attributes,     &  ! attributes of stuff in output file
+    output_scaling             ! scaling factor to apply to input data to get
+                               ! correct units in output file
+contains
+
+! ==========================================================================
+
+  subroutine process_grid(nm_in)
+  
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+
+    character (char_len) ::  &
+      nm_in                    ! name of input namelist file
+  
+    !-----------------------------------------------------------------------
+    ! - local variables
+
+    integer (kind=int_kind), dimension(4) ::    &
+        astart, acount, plus_one
+    integer (kind=int_kind), dimension(3) ::    &
+        write_dims
+    integer (kind=int_kind) ::                  &
+      i1, i2, jdim, n, nx, ny, nloop,           &
+      nc_input_id, nc_input_rank,               &
+      vstart, vstride, numv
+
+    real (kind=dbl_kind), dimension(:), allocatable  ::    &
+      grid1_array
+    real (kind=dbl_kind), dimension(:,:), allocatable  ::    &
+      var_out
+
+    plus_one(:) = 1
+
+    !-----------------------------------------------------------------------
+
+    call read_mappings(nm_in)
+
+    !-----------------------------------------------------------------------
+    ! - read input grid
+    ! - WARNING - lots of assumptions here at the moment
+  
+    ncstat = nf90_open( input_file, NF90_NOWRITE, nc_infile_id )
+    call netcdf_error_handler(ncstat,"open")
+  
+    ncstat = nf90_inq_varid( nc_infile_id, input_name, nc_input_id )
+    call netcdf_error_handler(ncstat,"inq_varid")
+  
+    input_dims(:) = 0
+    ncstat = nf90_inquire_variable( nc_infile_id, nc_input_id,   &
+                  ndims=nc_input_rank, dimids=input_dimids(:) )
+    call netcdf_error_handler(ncstat,"inquire_variable")
+
+    do jdim = 1,nc_input_rank
+      ncstat = nf90_inquire_dimension(nc_infile_id,              &
+                    input_dimids(jdim), len=input_dims(jdim) )
+      call netcdf_error_handler(ncstat,"inquire_dimension")
+    enddo
+  
+    ! - dimids seem to be returned in storage order so the outer dimension of 
+    ! - the array as described by the netcdf file becomes the first dimension
+    ! - as far as f90 is concerned (confused? you will be!)
+
+    do jdim = 1,nc_input_rank
+      if (input_stop(jdim) == 0) then
+        input_stop(jdim) = input_dims(jdim)
+      endif
+      input_count(jdim) = input_stop(jdim) - input_start(jdim) + 1
+    enddo
+
+    ! - rashly we assume x followed by y
+    nx = input_dims(1)
+    ny = input_dims(2)
+    write(*,fmt='("Input grid dimensions are:",2i6)') nx, ny
+    if (nx*ny /= grid1_size) then
+      write(6,*) "mismatch between input grid and remap data"
+      stop
+    endif
+
+    ! - calculate number of horizontal slices to process
+    ! - at the moment this is not very general and will only work with 3 dimensions
+
+    acount(1:nc_input_rank) = &
+             (input_stop(1:nc_input_rank)-input_start(1:nc_input_rank)+1) / &
+             input_stride(1:nc_input_rank)
+    nloop = 1
+    do jdim = 1,nc_input_rank
+      nloop = nloop*acount(jdim)
+    enddo
+    nloop = nloop/grid1_size
+    write(6,*) "total slices requested: ",nloop
+
+    vstart = input_start(nc_input_rank)            ! ie extra var has outer dimension
+    vstride = input_stride(nc_input_rank)
+
+    ! - in general we cant read in the whole array so do it slice by slice
+    ! - slow but sure
+
+    write(6,*) "allocating input and output grids"
+    allocate( grid1_array(grid1_size))
+    allocate( grid_out(grid2_size) )
+
+    numv = 0
+    do n = 1,4
+      if (trim(input_vars(n)) /= '-' .and. &
+          trim(output_vars(n)) /= '-') numv = numv + 1
+    enddo
+
+    write_dims(1) = grid2_dims(1)
+    write_dims(2) = grid2_dims(2)
+    write_dims(3) = nloop
+    call define_grid(write_dims(1:3) , 2+numv)
+
+    astart(:) = input_start(:)
+    astart(3) = astart(3) - input_stride(3)
+    acount(:) = 1
+    acount(1) = nx
+    acount(2) = ny
+
+    do n = 1,nloop
+
+      write(6,*) "processing slice: ",n
+      astart(3) = astart(3) + input_stride(3)
+      ncstat = nf90_get_var(nc_infile_id, nc_input_id, grid1_array,  &
+                            start=astart(1:nc_input_rank),              &
+                            count=acount(1:nc_input_rank))
+      call netcdf_error_handler(ncstat,"get_var")
+
+      call calculate_grid(grid1_array, grid_out)
+
+      call write_grid(grid_out, n, write_dims(1:2) , 2)
+
+    enddo
+
+    ! ---------------------------------------------------------------------
+    ! - now for any extra variables to copy
+
+    if (numv > 0) then
+
+      write(6,*) "reading ",numv," extra variables"
+      allocate( var_out(nloop,numv) )
+  
+      do n = 1,numv
+        write(6,*) "looking for variable: ",trim(input_vars(n))
+        ncstat = nf90_inq_varid( nc_infile_id, trim(input_vars(n)), nc_input_id )
+        call netcdf_error_handler(ncstat,"inq_varid")
+      
+        input_dims(:) = 0
+        ncstat = nf90_inquire_variable( nc_infile_id, nc_input_id,   &
+                      ndims=nc_input_rank, dimids=input_dimids(:) )
+        call netcdf_error_handler(ncstat,"inquire_variable")
+  
+        if (nc_input_rank /= 1) then
+          write(6,*) 'sorry, only rank 1 variables can be copied'
+          cycle
+        endif
+        ncstat = nf90_inquire_dimension(nc_infile_id,              &
+                      input_dimids(1), len=input_dims(1) )
+        call netcdf_error_handler(ncstat,"inquire_dimension")
+  
+        ncstat = nf90_get_var(nc_infile_id, nc_input_id, var_out(1:nloop,n),  &
+                              start=(/ vstart /), stride=(/ vstride /))
+        call netcdf_error_handler(ncstat,"get_var")
+      enddo
+  
+      call write_extra(var_out, numv+2)
+      deallocate(var_out)
+
+    endif
+
+    ncstat = nf90_close(nc_outfile_id)
+    call netcdf_error_handler(ncstat,"out close")
+    ncstat = nf90_close(nc_infile_id)
+    call netcdf_error_handler(ncstat,"in close")
+
+    ! ---------------------------------------------------------------------
+
+    deallocate( grid1_array, grid_out)
+
+    ! ---------------------------------------------------------------------
+
+  end subroutine process_grid
+
+  ! ==========================================================================
+
+  subroutine define_grid(thedims, therank)
+
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+    
+    integer (kind=int_kind) :: &
+      therank
+    integer (kind=int_kind), dimension(therank) :: &
+      thedims
+
+    !-----------------------------------------------------------------------
+    ! - local variables
+
+    integer ::               &
+      k, n, ilon, ilat, icolon, i1, i2, natt, nvar, id, jd, kd, nd
+    character (char_len) ::  &
+      aname, vname, att
+    real (kind=dbl_kind) ::   s
+
+    ! - netcdf variables
+
+    integer :: xtype
+
+    !-----------------------------------------------------------------------
+    ! -  define grid size dimensions
+  
+    allocate(nc_xysize_id(grid2_rank))
+    allocate(nc_gridsize_id(therank))
+    allocate(nc_gridsize(therank))
+    allocate(nc_variable_id(therank-2))
+    
+    !-----------------------------------------------------------------------
+    ! - setup a NetCDF file for output
+  
+    xtype = NF90_FLOAT
+
+    write(6,*) 'creating output file'
+    ncstat = nf90_create (output_file, NF90_CLOBBER, nc_outfile_id)
+    call netcdf_error_handler(ncstat,"create")
+  
+    write(6,*) 'setting global attributes'
+    ncstat = nf90_put_att(nc_outfile_id, NF90_GLOBAL, 'title', map_name)
+    call netcdf_error_handler(ncstat,"put_att")
+  
+    write(6,*) 'setting dimensions'
+    do n=1,therank
+      if (n .eq. therank .and. therank .gt. 2) then
+        write(6,*) '    unlimited dim ',trim(output_dims(n)),' size: ',thedims(n)
+        ncstat = nf90_def_dim (nc_outfile_id, output_dims(n), NF90_UNLIMITED, &
+                               nc_gridsize_id(n))
+      else
+        write(6,*) '    dim ',trim(output_dims(n)),' size: ',thedims(n)
+        ncstat = nf90_def_dim (nc_outfile_id, output_dims(n), thedims(n), &
+                               nc_gridsize_id(n))
+      endif
+      call netcdf_error_handler(ncstat,"def_dim")
+    end do
+    nc_gridsize(:) = thedims(1:therank)
+
+    ! - at the moment there is an assumption here that the ordering is (lon,lat)
+
+    ilon = 1
+    ilat = 2
+    nc_xysize_id(1) = nc_gridsize_id(ilon)
+    nc_xysize_id(2) = nc_gridsize_id(ilat)
+
+    ! ----------------------------------------------------------------
+    ! -  define grid center longitude array
+  
+    write(6,*) 'defining longitude variable'
+    ncstat = nf90_def_var (nc_outfile_id, output_lon,   &
+                         xtype, nc_xysize_id,   &
+                         nc_lon_id)
+    call netcdf_error_handler(ncstat,"def_var")
+  
+    ncstat = nf90_put_att (nc_outfile_id, nc_lon_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat,"put_att")
+  
+    ! ----------------------------------------------------------------
+    ! -  define grid center latitude array
+  
+    write(6,*) 'defining latitude variable'
+    ncstat = nf90_def_var (nc_outfile_id, output_lat,     &
+                         xtype, nc_xysize_id,   &
+                         nc_lat_id)
+    call netcdf_error_handler(ncstat,"def_var")
+  
+    ncstat = nf90_put_att (nc_outfile_id, nc_lat_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat,"put_att")
+  
+    ! ----------------------------------------------------------------
+    ! -  define copy variables array
+  
+    write(6,*) 'defining copy variables'
+    do n = 3,therank
+      ncstat = nf90_def_var (nc_outfile_id, output_vars(n-2),   &
+                           xtype, nc_gridsize_id(n),    &
+                           nc_variable_id(n-2))
+      call netcdf_error_handler(ncstat,"def_var")
+    enddo
+  
+    ! ----------------------------------------------------------------
+    ! -  define output array
+  
+    write(6,*) 'defining grid variable'
+    ncstat = nf90_def_var (nc_outfile_id, output_name,               &
+                         xtype, nc_gridsize_id,    &
+                         nc_array_id)
+    call netcdf_error_handler(ncstat,"def_var")
+  
+    ! ----------------------------------------------------------------
+    ! - output attributes has to come after all other definitions
+    ! - this code currently a bit murky, needs a rewrite
+  
+    ncstat = nf90_inquire (nc_outfile_id, nVariables=nvar)
+    call netcdf_error_handler(ncstat,"inquire")
+    do n = 1,10
+      att = trim(output_attributes(n))
+      natt = len(att)
+      if (att /= '-') then
+        i1 = index(att,separator)
+        aname = att(1:i1-1)
+        do k = 1,nvar
+          ncstat = nf90_inquire_variable(nc_outfile_id, k, vname)
+          call netcdf_error_handler(ncstat,"inquire_variable")
+          if (vname == aname) then
+            i2 = index(att,separator,.true.)
+            ncstat = nf90_put_att (nc_outfile_id, k, &
+                                   att(i1+1:i2-1), att(i2+1:natt))
+            call netcdf_error_handler(ncstat,"put_att")
+            exit      ! from innermost do
+          endif
+        enddo
+      endif
+    enddo
+  
+    ! output scaling
+
+    allocate (scale(nvar))
+    scale(:) = 1.0
+
+    do n = 1,10
+      att = trim(output_scaling(n))
+      natt = len(att)
+      if (att /= '-') then
+        i1 = index(att,separator)
+        aname = att(1:i1-1)
+        do k = 1,nvar
+          ncstat = nf90_inquire_variable(nc_outfile_id, k, vname)
+          call netcdf_error_handler(ncstat,"inquire_variable")
+          if (vname == aname) then
+            i2 = index(att,separator,.true.)
+            read(att(i2+1:natt),*) scale(k)
+            call netcdf_error_handler(ncstat,"put_att")
+            exit      ! from innermost do
+          endif
+        enddo
+      endif
+    enddo
+  
+    ! ----------------------------------------------------------------
+    ! -  end definition stage
+  
+    ncstat = nf90_enddef(nc_outfile_id)
+    call netcdf_error_handler(ncstat,"enddef")
+ 
+  end subroutine define_grid
+
+  ! ==========================================================================
+
+  subroutine write_grid(thegrid, thelevel, thedims, therank)
+
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+    
+    integer (kind=int_kind), intent(in) :: &
+      therank, thelevel
+    real (kind=dbl_kind), dimension(:), intent(in) ::   &
+      thegrid
+    integer (kind=int_kind), dimension(therank) :: &
+      thedims
+
+    !-----------------------------------------------------------------------
+    ! - local variables
+
+    integer ::               &
+      k, n, ilon, ilat, icolon, j1, j2, dj, natt, nvar, id, jd, kd, nd
+    character (char_len) ::  &
+      aname, vname, att
+    real (kind=dbl_kind), dimension(:,:,:), allocatable ::   &
+      data
+    real (kind=dbl_kind) ::   s
+    real (kind=dbl_kind), parameter :: todeg = 57.295779513082323
+    integer (kind=int_kind), dimension(3) ::   &
+      start
+
+    ! - netcdf variables
+
+    integer :: xtype
+
+    !-----------------------------------------------------------------------
+    ! - write results to NetCDF file
+  
+    allocate (data(thedims(1),thedims(2),1))
+    if (output_ydir .eq. 'invert') then
+      j1 = thedims(2)
+      j2 = 1
+      dj = -1
+    else
+      j1 = 1
+      j2 = thedims(2)
+      dj = 1
+    endif
+
+    if (thelevel .eq. 1) then
+
+      ! -  grid center latitude array
+  
+      write(6,*) 'writing latitude variable'
+      s = scale(nc_lat_id)
+      nd = 0
+      do jd = j1,j2,dj
+        do id =1,thedims(1)
+          nd = nd + 1
+          data(id,jd,1) = s*todeg*grid2_center_lat(nd)
+        enddo
+      enddo
+      ncstat = nf90_put_var(nc_outfile_id, nc_lat_id, data(:,:,1))
+      call netcdf_error_handler(ncstat,"put_var")
+  
+      ! -  grid center longitude array
+  
+      write(6,*) 'writing longitude variable'
+      s = scale(nc_lon_id)
+      nd = 0
+      do jd = j1,j2,dj
+        do id =1,thedims(1)
+          nd = nd + 1
+          data(id,jd,1) = s*todeg*grid2_center_lon(nd)
+        enddo
+      enddo
+      ncstat = nf90_put_var(nc_outfile_id, nc_lon_id, data(:,:,1))
+      call netcdf_error_handler(ncstat,"put_var")
+
+    endif
+
+    !-----------------------------------------------------------------------
+    ! -  new grid
+
+    write(6,*) 'writing grid variable'
+    n = therank
+    s = scale(nc_array_id)
+    nd = 0
+    do jd = j1,j2,dj
+      do id =1,thedims(1)
+        nd = nd + 1
+        data(id,jd,1) = thegrid(nd)
+      enddo
+    enddo
+    write(6,*) 'scaling data '
+    data(:,:,1) = s*data(:,:,1)
+    start(:) = (/ 1, 1, thelevel /)
+    ncstat = nf90_put_var(nc_outfile_id, nc_array_id, data, start)
+    call netcdf_error_handler(ncstat,"put_var")
+    deallocate(data)
+
+  end subroutine write_grid
+
+  ! ==========================================================================
+
+  subroutine write_extra(thevars, therank)
+
+    real (kind=dbl_kind), dimension(:,:), intent(in) ::   &
+      thevars
+    real (kind=dbl_kind), dimension(:), allocatable ::   &
+      thedata
+    integer (kind=int_kind), intent(in) :: &
+      therank
+    real (kind=dbl_kind) ::   s
+    integer :: n
+
+    allocate( thedata(size(thevars,1)) )
+
+    ! -  copy variable arrays
+
+    write(6,*) 'writing copy variables'
+    do n = 3,therank
+      s = scale(nc_variable_id(n-2))
+      thedata(:) = s*thevars(:,n-2)
+      ncstat = nf90_put_var(nc_outfile_id, nc_variable_id(n-2), thedata)
+      call netcdf_error_handler(ncstat,"put_var")
+    enddo
+
+    deallocate( thedata )
+
+  end subroutine write_extra
+
+  ! ==========================================================================
+
+  subroutine close_grid()
+
+  !     close netCDF file
+  
+    write(6,*) 'closing file'
+    ncstat = nf90_close(nc_outfile_id)
+    call netcdf_error_handler(ncstat,"close")
+  
+  end subroutine close_grid
+
+  ! ==========================================================================
+
+  subroutine read_mappings(nm_in)
+
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+
+    character (char_len) ::  &
+      nm_in                    ! name of input namelist file
+  
+    !-----------------------------------------------------------------------
+    ! - local variables
+  
+    character (char_len) ::   &
+              dim_name    ! netCDF dimension name
+  
+    integer (kind=int_kind) ::     &
+        iunit                                                ! unit number for namelist file
+  
+    !-----------------------------------------------------------------------
+    ! - namelist block
+
+    namelist /interp_inputs/ input_file, interp_file, input_name, &
+                             input_stride, input_start, input_stop, &
+                             input_vars
+    namelist /interp_outputs/ output_dims, output_file, output_mode, output_name, &
+                              output_lat, output_lon, output_ydir,  &
+                              output_scaling, output_vars, output_attributes
+  
+    !-----------------------------------------------------------------------
+    ! - read namelist for file and mapping info
+  
+    input_stride(:) = 1
+    input_start(:) = 1
+    input_stop(:) = 0
+    output_scaling(:) = '-'
+    input_vars(:) = '-'
+    output_lon = '-'
+    output_lat = '-'
+    output_vars(:) = '-'
+    output_ydir = 'none'
+    output_attributes(:) = '-'
+
+    call get_unit(iunit)
+    open(iunit, file=nm_in, status='old', form='formatted')
+    read(iunit, nml=interp_inputs)
+    read(iunit, nml=interp_outputs)
+    call release_unit(iunit)
+    write(*,nml=interp_inputs)
+    write(*,nml=interp_outputs)
+    if (trim(output_mode) == "create") then
+      if (trim(output_lon) == '-' .or. trim(output_lat) == '-') then
+        write(6,*) 'if creating, need to supply lon and lat names'
+        stop
+      endif
+    endif
+
+    !-----------------------------------------------------------------------
+    ! - read remapping data
+    ! - via the scrip package this sets variables:
+    !    grid1_size, grid2_size:     sizes of input and output grids
+    !    grid1_mask, grid2_mask:     masks
+    !    grid1_rank, grid2_rank:     ranks
+  
+    call read_remap(map_name, interp_file)
+  
+  end subroutine read_mappings
+
+  ! ==========================================================================
+
+  subroutine calculate_grid(grid1_array, grid2_array)
+
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+
+    real (kind=dbl_kind), intent(in), dimension(:) ::    &
+      grid1_array
+    real (kind=dbl_kind), intent(out), dimension(:) ::    &
+      grid2_array
+
+    !-----------------------------------------------------------------------
+    ! - local variables
+
+    integer (kind=int_kind), dimension(:), allocatable :: &
+        grid1_imask, grid2_imask, grid2_count
+
+    real (kind=dbl_kind), dimension(:), allocatable :: &
+        grid1_tmp,           &
+        grad1_lat,           &
+        grad1_lon,           &
+        grad1_latlon,        &
+        grad1_lat_zero,      &
+        grad1_lon_zero,      &
+        grid2_tmp1,           &
+        grid2_tmp2
+
+    real (kind=dbl_kind) ::  &
+        delew, delns            ! variables for computing bicub gradients
+
+    integer (kind=int_kind) ::                          &
+        i,j,n,imin,imax,idiff,                          &
+        ip1,im1,jp1,jm1,nx,ny,                          &  ! for computing bicub gradients
+        in,is,ie,iw,ine,inw,ise,isw
+
+    logical, parameter :: lat_gradient = .false.
+  
+    write(6,*) 'starting'
+
+    !-----------------------------------------------------------------------
+    ! - allocate arrays
+  
+    allocate (grid1_tmp      (grid1_size),   &
+              grad1_lat      (grid1_size),    &
+              grad1_lon      (grid1_size),    &
+              grad1_lat_zero (grid1_size),    &
+              grad1_lon_zero (grid1_size),    &
+              grid1_imask    (grid1_size),   &
+              grid2_tmp1     (grid2_size),   &
+              grid2_tmp2     (grid2_size),   &
+              grid2_imask    (grid2_size),   &
+              grid2_count    (grid2_size))
+  
+    write(6,*) 'allocated'
+    write(6,*) grid1_size,grid2_size
+
+    grid1_imask(:) = 1
+    grid2_imask(:) = 1
+    where (grid1_mask)
+      grid1_imask = 1
+    elsewhere
+      grid1_imask = 0
+    endwhere
+    where (grid2_mask)
+      grid2_imask = 1
+    elsewhere
+      grid2_imask = 0
+    endwhere
+
+    write(6,*) 'masked'
+
+    grad1_lat_zero = zero
+    grad1_lon_zero = zero
+    nx = input_dims(1)
+    ny = input_dims(2)
+    write(6,*) nx,ny
+  
+    !-----------------------------------------------------------------------
+    ! - if bicubic, we need 3 gradients in logical space
+  
+    if (map_type == map_type_bicubic) then
+  
+      write(6,*) 'bicubic'
+      write(6,*) grid1_size
+
+      allocate (grad1_latlon (grid1_size)) 
+  
+      do n=1,grid1_size
+  
+        grad1_lat(n) = zero
+        grad1_lon(n) = zero
+        grad1_latlon(n) = zero
+  
+!       if (n.ge.8000) write(6,*) 0,grid1_mask(n),nx
+        if (grid1_mask(n)) then
+  
+          delew = half
+          delns = half
+  
+          j = (n-1)/nx + 1
+          i = n - (j-1)*nx
+  
+          ip1 = i+1
+          im1 = i-1
+          jp1 = j+1
+          jm1 = j-1
+  
+          if (ip1 > nx) ip1 = ip1 - nx
+          if (im1 < 1 ) im1 = nx
+          if (jp1 > ny) then
+            jp1 = j
+            delns = one
+          endif
+          if (jm1 < 1 ) then
+            jm1 = j
+            delns = one
+          endif
+  
+          in  = (jp1-1)*nx + i
+          is  = (jm1-1)*nx + i
+          ie  = (j  -1)*nx + ip1
+          iw  = (j  -1)*nx + im1
+  
+          ine = (jp1-1)*nx + ip1
+          inw = (jp1-1)*nx + im1
+          ise = (jm1-1)*nx + ip1
+          isw = (jm1-1)*nx + im1
+  
+          ! -  compute i-gradient
+  
+          if (.not. grid1_mask(ie)) then
+            ie = n
+            delew = one
+          endif
+          if (.not. grid1_mask(iw)) then
+            iw = n
+            delew = one
+          endif
+   
+          grad1_lat(n) = delew*(grid1_array(ie) - grid1_array(iw))
+!         if (n.ge.8000) write(6,*) 1,grad1_lat(n)
+  
+          ! -  compute j-gradient
+  
+          if (.not. grid1_mask(in)) then
+            in = n
+            delns = one
+          endif
+          if (.not. grid1_mask(is)) then
+            is = n
+            delns = one
+          endif
+   
+          grad1_lon(n) = delns*(grid1_array(in) - grid1_array(is))
+!         if (n.ge.8000) write(6,*) 2,grad1_lon(n)
+  
+          ! -  compute ij-gradient
+  
+          delew = half
+          if (jp1 == j .or. jm1 == j) then
+            delns = one
+          else 
+            delns = half
+          endif
+  
+          if (.not. grid1_mask(ine)) then
+            if (in /= n) then
+              ine = in
+              delew = one
+            else if (ie /= n) then
+              ine = ie
+              inw = iw
+              if (inw == n) delew = one
+              delns = one
+            else
+              ine = n
+              inw = iw
+              delew = one
+              delns = one
+            endif
+          endif
+  
+          if (.not. grid1_mask(inw)) then
+            if (in /= n) then
+              inw = in
+              delew = one
+            else if (iw /= n) then
+              inw = iw
+              ine = ie
+              if (ie == n) delew = one
+              delns = one
+            else
+              inw = n
+              ine = ie
+              delew = one
+              delns = one
+            endif
+          endif
+  
+          grad1_lat_zero(n) = delew*(grid1_array(ine) - grid1_array(inw))
+!         if (n.ge.8000) write(6,*) 3,grad1_lat_zero(n)
+  
+          if (.not. grid1_mask(ise)) then
+            if (is /= n) then
+              ise = is
+              delew = one
+            else if (ie /= n) then
+              ise = ie
+              isw = iw
+              if (isw == n) delew = one
+              delns = one
+            else
+              ise = n
+              isw = iw
+              delew = one
+              delns = one
+            endif
+          endif
+  
+          if (.not. grid1_mask(isw)) then
+            if (is /= n) then
+              isw = is
+              delew = one
+            else if (iw /= n) then
+              isw = iw
+              ise = ie
+              if (ie == n) delew = one
+              delns = one
+            else
+              isw = n
+              ise = ie
+              delew = one
+              delns = one
+            endif
+          endif
+  
+          grad1_lon_zero(n) = delew*(grid1_array(ise) - grid1_array(isw))
+          grad1_latlon(n) = delns*(grad1_lat_zero(n) - grad1_lon_zero(n))
+!         if (n.ge.8000) write(6,*) 4,grad1_lon_zero(n),grad1_latlon(n)
+  
+        endif
+      enddo
+  
+      write(6,*) 'remapping'
+      call remap(grid2_array, wts_map1, grid2_add_map1, grid1_add_map1, &
+                 grid1_array, src_grad1=grad1_lat,                    &
+                 src_grad2=grad1_lon, src_grad3=grad1_latlon)
+  
+      print *,'Third order mapping from grid1 to grid2:'
+      print *,'----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_array  ),maxval(grid2_array  )
+    
+      ! -  Conservation Test
+    
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_array  *grid2_area*grid2_frac)
+    
+    !-----------------------------------------------------------------------
+    ! - a first-order map from grid1 to grid2
+  
+    else if (map_type /= map_type_conserv .AND.map_type /= map_type_bicubic) then
+
+      write(6,*) 'bilinear or conservative'
+  
+      call remap(grid2_array, wts_map1, grid2_add_map1, grid1_add_map1,grid1_array)
+  
+      print *,'First order mapping from grid1 to grid2:'
+      print *,'----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_array  ),maxval(grid2_array  )
+    
+      ! -  Conservation Test
+    
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_array  *grid2_area*grid2_frac)
+    
+    !-----------------------------------------------------------------------
+    ! - conservative mappings:
+    ! - a second-order map from grid1 to grid2 with only lat grads
+  
+    else if (map_type == map_type_conserv .AND. lat_gradient) then
+  
+      call remap(grid2_array, wts_map1, grid2_add_map1, grid1_add_map1,  &
+                 grid1_array, src_grad1=grad1_lat,src_grad2=grad1_lon_zero) 
+  
+      select case (norm_opt)
+      case (norm_opt_none)
+        grid2_tmp2 = grid2_frac*grid2_area
+        where (grid2_tmp2 /= zero)
+          grid2_array = grid2_array/grid2_tmp2
+        elsewhere
+          grid2_array = zero
+        end where
+      case (norm_opt_frcarea)
+      case (norm_opt_dstarea)
+        where (grid2_frac /= zero)
+          grid2_array = grid2_array/grid2_frac
+        elsewhere
+          grid2_array = zero
+        end where
+      end select
+  
+      print *,'Second order mapping from grid1 to grid2 (lat only):'
+      print *,'----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_array  ),maxval(grid2_array  )
+  
+      ! -  Conservation Test
+  
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_array*grid2_area*grid2_frac)
+  
+    !-----------------------------------------------------------------------
+    ! - conservative mappings:
+    ! - a second-order map from grid1 to grid2 both gradients
+  
+    else if (map_type == map_type_conserv .AND..NOT. lat_gradient) then
+  
+      call remap(grid2_array,wts_map1,grid2_add_map1,grid1_add_map1,  &
+                 grid1_array, src_grad1=grad1_lat,src_grad2=grad1_lon) 
+  
+      select case (norm_opt)
+      case (norm_opt_none)
+        grid2_tmp2 = grid2_frac*grid2_area
+        where (grid2_tmp2 /= zero)
+          grid2_array = grid2_array/grid2_tmp2
+        elsewhere
+          grid2_array = zero
+        end where
+      case (norm_opt_frcarea)
+      case (norm_opt_dstarea)
+        where (grid2_frac /= zero)
+          grid2_array = grid2_array/grid2_frac
+        elsewhere
+          grid2_array = zero
+        end where
+      end select
+  
+      print *,'Second order mapping from grid1 to grid2:'
+      print *,'-----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_array  ),maxval(grid2_array  )
+  
+      ! -  Conservation Test
+  
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_array*grid2_area*grid2_frac)
+  
+    endif
+  
+    !-----------------------------------------------------------------------
+    !     calculate some statistics
+  
+    grid2_count = zero
+    grid2_tmp1  = zero
+    grid2_tmp2  = zero
+  
+    print *,'number of sparse matrix entries ',num_links_map1
+    do n=1,num_links_map1
+      grid2_count(grid2_add_map1(n)) = grid2_count(grid2_add_map1(n)) + 1
+      if (wts_map1(1,n) > one .or. wts_map1(1,n) < zero) then
+        grid2_tmp1(grid2_add_map1(n)) = grid2_tmp1(grid2_add_map1(n)) + 1
+        grid2_tmp2(grid2_add_map1(n)) = max(abs(wts_map1(1,n)),grid2_tmp2(grid2_add_map1(n)) )
+      endif
+    end do
+  
+    do n=1,grid2_size
+      if (grid2_tmp1(n) > zero) print *,n,grid2_tmp2(n)
+    end do
+  
+    imin = minval(grid2_count, mask=(grid2_count > 0))
+    imax = maxval(grid2_count)
+    idiff =  (imax - imin)/10 + 1
+    print *,'total number of dest cells ',grid2_size
+    print *,'number of cells participating in remap ',count(grid2_count > zero)
+    print *,'min no of entries/row = ',imin
+    print *,'max no of entries/row = ',imax
+  
+    imax = imin + idiff
+    do n=1,10
+      print *,'num of rows with entries between ',imin,' - ',imax-1,   &
+               count(grid2_count >= imin .and. grid2_count < imax)
+      imin = imin + idiff
+      imax = imax + idiff
+    end do
+  
+    !-----------------------------------------------------------------------
+    ! - deallocate arrays
+  
+    deallocate (grid1_tmp, grad1_lat, grad1_lon,    &
+                grad1_lat_zero, grad1_lon_zero, grid1_imask,     &
+                grid2_tmp1, grid2_tmp2,   &
+                grid2_imask, grid2_count)
+  
+  end subroutine calculate_grid
+
+  ! ==========================================================================
+
+end module scripinterp_mod
+
Index: /utils/tools_ticket2413/WEIGHTS/nocsutil/scripshape.F90
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/nocsutil/scripshape.F90	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/nocsutil/scripshape.F90	(revision 12863)
@@ -0,0 +1,419 @@
+      PROGRAM scripshape
+!
+! program to take output from the SCRIP weights generator
+! and rearrange the data into a series of 2D fields suitable
+! for reading with iom_get in NEMO configurations using the
+! interpolation on the fly option
+!
+      USE netcdf
+      IMPLICIT none
+      INTEGER    :: ncId, VarId, status
+      INTEGER    :: start(4), count(4)
+      CHARACTER(LEN=1) :: y
+      INTEGER    :: nd, ns, nl, nw, sx, sy, dx, dy
+      INTEGER    :: i, j, k, m, n, smax
+!
+!  ifort -O2 -o scripshape scripshape.f90 \
+!        -I/nerc/packages/netcdfifort/v3.6.0-pl1/include \
+!        -L/nerc/packages/netcdfifort/v3.6.0-pl1/lib -lnetcdf
+!
+!
+      INTEGER(KIND=4), ALLOCATABLE :: src(:)
+      INTEGER(KIND=4), ALLOCATABLE :: dst(:)
+      REAL(KIND=8), ALLOCATABLE :: wgt(:,:)
+      REAL(KIND=8), ALLOCATABLE :: src1(:,:),dst1(:,:),wgt1(:,:)
+      LOGICAL  :: around, verbose
+#if defined ARGC
+      INTEGER(KIND=4) :: iargc
+      EXTERNAL :: iargc
+#endif
+
+      CHARACTER(LEN=256) :: interp_file, output_file, name_file
+      INTEGER            :: ew_wrap
+      NAMELIST /shape_inputs/ interp_file, output_file, ew_wrap
+
+! scripshape requires 1 arguments; the name of the file containing
+! the input namelist.
+! This namelist contains:
+!     the name of the input file containing the weights ! produced by SCRIP in its format;
+!     the name of the new output file which ! is to contain the reorganized fields ready for input to NEMO.
+!     the east-west wrapping of the input grid (-1, 0, 1 and 2 are accepted values)
+!
+! E.g.
+!     interp_file = 'data_nemo_bilin.nc'
+!     output_file = 'weights_bilin.nc'
+!     ew_wrap     = 2
+!
+#if defined ARGC
+      IF (iargc() == 1) THEN
+        CALL getarg(1, name_file)
+      ELSE
+        WRITE(*,*) 'Usage: scripshape namelist_file'
+        STOP
+      ENDIF
+#else
+      WRITE(6,*) 'enter name of namelist file'
+      READ(5,*) name_file
+#endif
+      interp_file = 'none'
+      output_file = 'none'
+      ew_wrap = 0
+      OPEN(12, FILE=name_file, STATUS='OLD', FORM='FORMATTED')
+      READ(12, NML=shape_inputs)
+      CLOSE(12)
+!
+      INQUIRE(FILE = TRIM(interp_file), EXIST=around)
+      IF (.not.around) THEN
+       WRITE(*,*) 'Input file: '//TRIM(interp_file)//' not found'
+       STOP
+      ENDIF
+! 
+      INQUIRE(FILE = TRIM(output_file), EXIST=around)
+      IF (around) THEN
+       WRITE(*,*) 'Output file: '//TRIM(output_file)//' exists'
+       WRITE(*,*) 'Ok to overwrite (y/n)?'
+       READ(5,'(a)') y
+       IF ( y .ne. 'y' .AND. y .ne. 'Y' ) STOP
+      ENDIF
+!
+      verbose = .true.
+!
+! Obtain grid size information from interp_file
+!
+      CALL ncgetsize
+!
+! Allocate array spaces
+!
+      ALLOCATE(src(nl), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('src')
+      ALLOCATE(dst(nl), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('dst')
+      ALLOCATE(wgt(nw,nl), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('wgt')
+      ALLOCATE(src1(dx,dy), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('src1')
+      ALLOCATE(dst1(dx,dy), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('dst1')
+      ALLOCATE(wgt1(dx,dy), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('wgt1')
+!
+! Read all required data from interp_file
+!
+      CALL ncgetfields
+!
+! Check that dst is monotonically increasing
+!
+      DO k = 1,nl-1
+       IF(dst(k+1).lt.dst(k)) THEN
+        WRITE(*,*) 'non-monotonic at ',k
+        WRITE(*,*) dst(k-4:k+16)
+        STOP
+       ENDIF
+      END DO
+!
+! Remove references to the top row of src
+!
+      IF(verbose) WRITE(*,*) &
+        'Removing references to the top row of the source grid'
+      smax = (sy-1)*sx
+      n = 0
+      DO k = 1,nl
+       IF(src(k).gt.smax-1) THEN
+        src(k) = src(k)-sx
+        n = n + 1
+       ENDIF
+      END DO
+      IF(verbose) WRITE(*,*) n,' values changed (',100.*n/nl,'%)'
+!
+! Loop through weights for each corner in turn and
+! rearrange weight fields into separate 2D fields for
+! reading with iom_get in NEMO
+!
+      DO k = 1,nw
+       DO n = 1,4
+
+        i = 0
+        j = 1
+        DO m = n,nl,4
+         i = i+1
+         IF(i.gt.dx) THEN
+          i = 1
+          j = j + 1
+         ENDIF
+         src1(i,j) = src(m)
+         dst1(i,j) = dst(m)
+         wgt1(i,j) = wgt(k,m)
+        END DO
+!
+! Write out this set which will be labelled with
+! a 2 digit number equal to n+4*(k-1)
+!
+        CALL wrwgts
+!   
+       END DO
+      END DO
+      STOP
+      CONTAINS
+!
+!----------------------------------------------------------------------*
+      SUBROUTINE ncgetsize
+!
+! Access grid size information in interp_file and set the
+! following integers:
+!
+!    nd = dst_grid_size
+!    ns = src_grid_size
+!    nl = num_links    
+!    nw = num_wgts     
+! sx,sy = src_grid_dims     
+! dx,dy = dst_grid_dims     
+!
+      INTEGER idims(2)
+!
+       status = nf90_open(interp_file, nf90_NoWrite, ncid)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_dimid(ncid, 'dst_grid_size', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_inquire_dimension(ncid, VarId, LEN = nd)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_dimid(ncid, 'src_grid_size', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_inquire_dimension(ncid, VarId, LEN = ns)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_dimid(ncid, 'num_links', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_inquire_dimension(ncid, VarId, LEN = nl)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_dimid(ncid, 'num_wgts', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_inquire_dimension(ncid, VarId, LEN = nw)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       start = 1
+       count = 2
+       status = nf90_inq_varid(ncid, 'src_grid_dims', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_get_var(ncid, VarId, idims, start, count)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       sx = idims(1) ; sy = idims(2)
+!
+       status = nf90_inq_varid(ncid, 'dst_grid_dims', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_get_var(ncid, VarId, idims, start, count)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       dx = idims(1) ; dy = idims(2)
+!
+       status = nf90_close(ncid)
+       IF (status /= nf90_noerr) CALL handle_err(status)
+!
+       IF(verbose) THEN
+         WRITE(*,*) 'Detected sizes: '
+         WRITE(*,*) 'dst_grid_size: ', nd
+         WRITE(*,*) 'src_grid_size: ', ns
+         WRITE(*,*) 'num_links    : ', nl
+         WRITE(*,*) 'num_wgts     : ', nw
+         WRITE(*,*) 'src_grid_dims: ', sx, ' x ', sy
+         WRITE(*,*) 'dst_grid_dims: ', dx, ' x ', dy
+       ENDIF
+!
+      END SUBROUTINE ncgetsize
+
+!----------------------------------------------------------------------*
+      SUBROUTINE ncgetfields
+!
+! Read all required data from interp_file. The data read are:
+!
+! netcdf variable    size   internal array
+!-----------------+-------+--------------
+! src_address        nl     src
+! dst_address        nl     dst
+! remap_matrix     (nw,nl)  wgt
+!
+       status = nf90_open(interp_file, nf90_NoWrite, ncid)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_varid(ncid, 'src_address', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Read the values for src
+       status = nf90_get_var(ncid, VarId, src, &
+                         start = (/ 1 /),      &
+                         count = (/ nl /))
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_varid(ncid, 'dst_address', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Read the values for dst
+       status = nf90_get_var(ncid, VarId, dst, &
+                         start = (/ 1 /),      &
+                         count = (/ nl /))
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_varid(ncid, 'remap_matrix', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Read the values for wgt
+       status = nf90_get_var(ncid, VarId, wgt, &
+                         start = (/ 1, 1 /),   &
+                         count = (/ nw, nl /))
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_close(ncid)
+       IF (status /= nf90_noerr) CALL handle_err(status)
+!
+      END SUBROUTINE ncgetfields
+
+!----------------------------------------------------------------------*
+      SUBROUTINE handle_err(status)
+!
+! Simple netcdf error checking routine
+!
+      INTEGER, intent ( in) :: status
+!
+      IF(status /= nf90_noerr) THEN
+       IF(trim(nf90_strerror(status)) .eq. 'Attribute not found') THEN
+! ignore
+       ELSE
+        WRITE(*,*) trim(nf90_strerror(status))
+        STOP "Stopped"
+       END IF
+      END IF
+      END SUBROUTINE handle_err
+
+!----------------------------------------------------------------------*
+      SUBROUTINE alloc_err(arname)
+!
+! Simple allocation error checking routine
+!
+      CHARACTER(LEN=*) :: arname
+!
+      WRITE(*,*) 'Allocation error attempting to ALLOCATE '//arname
+      STOP "Stopped"
+      END SUBROUTINE alloc_err
+
+!                                                                       
+!----------------------------------------------------------------------*
+      SUBROUTINE wrwgts
+!
+! Write out each set of 2D fields to output_file.
+! Each call will write out a set of srcXX, dstXX and wgtXX fields
+! where XX is a two digit number equal to n + 4*(k-1). The first
+! and last calls to this routine initialise and close the output
+! file respectively. The first call is detected when k*n=1 and the
+! last call is detected when k*n=4*nw. The outfile file remains
+! open between the first and last calls. 
+!
+      INTEGER :: status, ncid, ncin
+      INTEGER :: Lontdid, Lattdid
+      INTEGER :: tvid, tvid2, tvid3
+      INTEGER :: ioldfill
+      CHARACTER(LEN=2) :: cs
+      SAVE ncid, Lontdid, Lattdid
+!
+      IF(k*n.eq.1) THEN
+!
+! Create output_file and set the dimensions
+!
+         status = nf90_create(output_file, nf90_Clobber, ncid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+         status = nf90_set_fill(ncid, nf90_NoFill, ioldfill)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_def_dim(ncid, "lon", dx, Lontdid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+         status = nf90_def_dim(ncid, "lat", dy, Lattdid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_put_att(ncid, nf90_global, 'ew_wrap', ew_wrap)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+      ELSE
+!
+! Reenter define mode
+!
+         status = nf90_redef(ncid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+      ENDIF
+!
+      WRITE(cs,'(i2.2)') n + 4*(k-1)
+!
+! Define new variables
+!
+      status = nf90_def_var(ncid, "src"//cs, nf90_double, &
+                         (/ Lontdid, Lattdid /), tvid)
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      status = nf90_def_var(ncid, "dst"//cs, nf90_double, &
+                         (/ Lontdid, Lattdid /), tvid2)
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      status = nf90_def_var(ncid, "wgt"//cs, nf90_double, &
+                         (/ Lontdid, Lattdid /), tvid3)
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Leave define mode
+!
+      status = nf90_enddef(ncid)
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Write the data
+!
+      status = nf90_put_var(ncid, tvid, src1,    &
+                            start = (/ 1, 1 /),  &
+                            count = (/ dx, dy /) )
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      status = nf90_put_var(ncid, tvid2, dst1,   &
+                            start = (/ 1, 1 /),  &
+                            count = (/ dx, dy /) )
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      status = nf90_put_var(ncid, tvid3, wgt1,   &
+                            start = (/ 1, 1  /), &
+                            count = (/ dx, dy /) )
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      IF(k*n.eq.4*nw) THEN
+!
+! --     Reenter define mode
+!
+         status = nf90_redef(ncid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! --     Reopen interp_file and transfer some global attributes
+!
+         status = nf90_open(interp_file, nf90_NoWrite, ncin)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'title',        ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'normalization',ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'map_method',   ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'conventions',  ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'history',      ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! --     Close interp_file
+!
+         status = nf90_close(ncin)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! --     Close output_file
+!
+         status = nf90_close(ncid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+      ENDIF
+
+      END SUBROUTINE wrwgts
+      END PROGRAM scripshape
Index: /utils/tools_ticket2413/WEIGHTS/src/CHANGES_BY_NOCS
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/src/CHANGES_BY_NOCS	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/src/CHANGES_BY_NOCS	(revision 12863)
@@ -0,0 +1,12 @@
+
+      SCRIP code, version 1.4, from Los Alamos National Laboratory (http://climate.lanl.gov/Software/SCRIP)
+
+      Changes made at NOCS for inclusion of weights generation code in NEMO 3.3 and later:
+
+          - File extensions changed from '.f' to '.f90'
+          - File netcdf.f renamed as netcdf_mod.f90 to avoid clash with netcdf library module filename
+          - File netcdf.f modified to add error message to netcdf_error_handler
+          - Small bug in remap_conserv when using gfortran compiler: replace ". and." with " .and."
+          - continuation lines reformatted with '&' moved from the start of the continuation line to 
+            the end of the line before
+    
Index: /utils/tools_ticket2413/WEIGHTS/src/constants.f90
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/src/constants.f90	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/src/constants.f90	(revision 12863)
@@ -0,0 +1,65 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module defines common constants used in many routines.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: constants.f,v 1.2 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module constants
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod  ! defines common data types
+
+      implicit none
+
+      save
+
+!-----------------------------------------------------------------------
+
+      real (kind = dbl_kind), parameter ::  &
+                              zero   = 0.0_dbl_kind, &
+                              one    = 1.0_dbl_kind, &
+                              two    = 2.0_dbl_kind, &
+                              three  = 3.0_dbl_kind, &
+                              four   = 4.0_dbl_kind, &
+                              five   = 5.0_dbl_kind, &
+                              half   = 0.5_dbl_kind, &
+                              quart  = 0.25_dbl_kind, &
+                              bignum = 1.e+20_dbl_kind, &
+                              tiny   = 1.e-14_dbl_kind, &
+                              pi     = 3.14159265359_dbl_kind, &
+                              pi2    = two*pi, &
+                              pih    = half*pi
+
+!-----------------------------------------------------------------------
+
+      end module constants
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/src/copyright
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/src/copyright	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/src/copyright	(revision 12863)
@@ -0,0 +1,26 @@
+!-----------------------------------------------------------------------
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!-----------------------------------------------------------------------
Index: /utils/tools_ticket2413/WEIGHTS/src/grids.f90
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/src/grids.f90	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/src/grids.f90	(revision 12863)
@@ -0,0 +1,831 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module reads in and initializes two grids for remapping.
+!     NOTE: grid1 must be the master grid -- the grid that determines
+!           which cells participate (e.g. land mask) and the fractional
+!           area of grid2 cells that participate in the remapping.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: grids.f,v 1.6 2001/08/21 21:06:41 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module grids
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod    ! defines data types
+      use constants    ! common constants
+      use iounits      ! I/O unit manager
+      use netcdf_mod   ! netCDF stuff
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     variables that describe each grid
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), save :: &
+                   grid1_size, grid2_size,  & ! total points on each grid
+                   grid1_rank, grid2_rank,  & ! rank of each grid
+                   grid1_corners, grid2_corners ! number of corners
+                                                ! for each grid cell
+
+      integer (kind=int_kind), dimension(:), allocatable, save :: &
+                   grid1_dims, grid2_dims  ! size of each grid dimension
+
+      character(char_len), save ::  &
+                   grid1_name, grid2_name  ! name for each grid
+
+      character (char_len), save ::  &
+                   grid1_units,  & ! units for grid coords (degs/radians)
+                   grid2_units  ! units for grid coords
+
+      real (kind=dbl_kind), parameter :: &
+            deg2rad = pi/180.   ! conversion for deg to rads
+
+!-----------------------------------------------------------------------
+!
+!     grid coordinates and masks
+!
+!-----------------------------------------------------------------------
+
+      logical (kind=log_kind), dimension(:), allocatable, save :: &
+                   grid1_mask,         & ! flag which cells participate
+                   grid2_mask         ! flag which cells participate
+
+      real (kind=dbl_kind), dimension(:), allocatable, save :: &
+                   grid1_center_lat,   & ! lat/lon coordinates for
+                   grid1_center_lon,   & ! each grid center in radians
+                   grid2_center_lat,  &
+                   grid2_center_lon, &
+                   grid1_area,         & ! tot area of each grid1 cell
+                   grid2_area,         & ! tot area of each grid2 cell
+                   grid1_area_in,      & ! area of grid1 cell from file
+                   grid2_area_in,      & ! area of grid2 cell from file
+                   grid1_frac,         & ! fractional area of grid cells
+                   grid2_frac         ! participating in remapping
+
+      real (kind=dbl_kind), dimension(:,:), allocatable, save :: &
+                   grid1_corner_lat,   & ! lat/lon coordinates for
+                   grid1_corner_lon,   & ! each grid corner in radians
+                   grid2_corner_lat,  &
+                   grid2_corner_lon
+
+      logical (kind=log_kind), save :: &
+                   luse_grid_centers  & ! use centers for bounding boxes
+      ,            luse_grid1_area    & ! use area from grid file
+      ,            luse_grid2_area   ! use area from grid file
+
+      real (kind=dbl_kind), dimension(:,:), allocatable, save :: &
+                   grid1_bound_box,   & ! lat/lon bounding box for use
+                   grid2_bound_box   ! in restricting grid searches
+
+!-----------------------------------------------------------------------
+!
+!     bins for restricting searches
+!
+!-----------------------------------------------------------------------
+
+      character (char_len), save :: &
+              restrict_type  ! type of bins to use
+
+      integer (kind=int_kind), save :: &
+              num_srch_bins  ! num of bins for restricted srch
+
+      integer (kind=int_kind), dimension(:,:), allocatable, save :: &
+              bin_addr1,  & ! min,max adds for grid1 cells in this lat bin
+              bin_addr2  ! min,max adds for grid2 cells in this lat bin
+
+      real(kind=dbl_kind), dimension(:,:), allocatable, save :: &
+              bin_lats    & ! min,max latitude for each search bin
+      ,       bin_lons   ! min,max longitude for each search bin
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine grid_init(grid1_file, grid2_file)
+
+!-----------------------------------------------------------------------
+!
+!     this routine reads grid info from grid files and makes any
+!     necessary changes (e.g. for 0,2pi longitude range)
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) ::  &
+                   grid1_file, grid2_file  ! grid data files
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) ::  &
+        n       & ! loop counter
+      , nele    & ! element loop counter
+      , iunit   & ! unit number for opening files
+      , i,j     & ! logical 2d addresses
+      , ip1,jp1 &
+      , n_add, e_add, ne_add &
+      , nx, ny
+
+      integer (kind=int_kind) ::  &
+               ncstat,            & ! netCDF status variable
+               nc_grid1_id,        & ! netCDF grid file id
+               nc_grid2_id,        & ! netCDF grid file id
+               nc_grid1size_id,    & ! netCDF grid size dim id
+               nc_grid2size_id,    & ! netCDF grid size dim id
+               nc_grid1corn_id,    & ! netCDF grid corner dim id
+               nc_grid2corn_id,    & ! netCDF grid corner dim id
+               nc_grid1rank_id,    & ! netCDF grid rank dim id
+               nc_grid2rank_id,    & ! netCDF grid rank dim id
+               nc_grid1area_id,    & ! netCDF grid rank dim id
+               nc_grid2area_id,    & ! netCDF grid rank dim id
+               nc_grid1dims_id,    & ! netCDF grid dimension size id
+               nc_grid2dims_id,    & ! netCDF grid dimension size id
+               nc_grd1imask_id,    & ! netCDF grid imask var id
+               nc_grd2imask_id,    & ! netCDF grid imask var id
+               nc_grd1crnrlat_id,  & ! netCDF grid corner lat var id
+               nc_grd2crnrlat_id,  & ! netCDF grid corner lat var id
+               nc_grd1crnrlon_id,  & ! netCDF grid corner lon var id
+               nc_grd2crnrlon_id,  & ! netCDF grid corner lon var id
+               nc_grd1cntrlat_id,  & ! netCDF grid center lat var id
+               nc_grd2cntrlat_id,  & ! netCDF grid center lat var id
+               nc_grd1cntrlon_id,  & ! netCDF grid center lon var id
+               nc_grd2cntrlon_id  ! netCDF grid center lon var id
+
+      integer (kind=int_kind), dimension(:), allocatable ::  &
+                                  imask ! integer mask read from file
+
+      real (kind=dbl_kind) ::  &
+        dlat,dlon           ! lat/lon intervals for search bins
+
+      real (kind=dbl_kind), dimension(4) :: &
+        tmp_lats, tmp_lons  ! temps for computing bounding boxes
+
+!-----------------------------------------------------------------------
+!
+!     open grid files and read grid size/name data
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_open(grid1_file, NF_NOWRITE, nc_grid1_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_open(grid2_file, NF_NOWRITE, nc_grid2_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid1_id, 'grid_size', nc_grid1size_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid1_id, nc_grid1size_id, grid1_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid2_id, 'grid_size', nc_grid2size_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid2_id, nc_grid2size_id, grid2_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid1_id, 'grid_rank', nc_grid1rank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid1_id, nc_grid1rank_id, grid1_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid2_id, 'grid_rank', nc_grid2rank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid2_id, nc_grid2rank_id, grid2_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid1_id,'grid_corners',nc_grid1corn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid1_id,nc_grid1corn_id,grid1_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid2_id,'grid_corners',nc_grid2corn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid2_id,nc_grid2corn_id,grid2_corners)
+      call netcdf_error_handler(ncstat)
+
+      allocate( grid1_dims(grid1_rank), &
+                grid2_dims(grid2_rank))
+
+      ncstat = nf_get_att_text(nc_grid1_id, nf_global, 'title', &
+                               grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text(nc_grid2_id, nf_global, 'title', &
+                               grid2_name)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     allocate grid coordinates/masks and read data
+!
+!-----------------------------------------------------------------------
+
+      allocate( grid1_mask      (grid1_size), &
+                grid2_mask      (grid2_size), &
+                grid1_center_lat(grid1_size),  &
+                grid1_center_lon(grid1_size), &
+                grid2_center_lat(grid2_size),  &
+                grid2_center_lon(grid2_size), &
+                grid1_area      (grid1_size), &
+                grid2_area      (grid2_size), &
+                grid1_frac      (grid1_size), &
+                grid2_frac      (grid2_size), &
+                grid1_corner_lat(grid1_corners, grid1_size), &
+                grid1_corner_lon(grid1_corners, grid1_size), &
+                grid2_corner_lat(grid2_corners, grid2_size), &
+                grid2_corner_lon(grid2_corners, grid2_size), &
+                grid1_bound_box (4            , grid1_size), &
+                grid2_bound_box (4            , grid2_size))
+
+      allocate(imask(grid1_size))
+
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_dims', nc_grid1dims_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_imask', nc_grd1imask_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_center_lat',  &
+                                         nc_grd1cntrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_center_lon',  &
+                                         nc_grd1cntrlon_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_corner_lat',  &
+                                         nc_grd1crnrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_corner_lon',  &
+                                         nc_grd1crnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_grid1_id, nc_grid1dims_id, grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_grid1_id, nc_grd1imask_id, imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid1_id, nc_grd1cntrlat_id,  &
+                                             grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid1_id, nc_grd1cntrlon_id,  &
+                                             grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid1_id, nc_grd1crnrlat_id,  &
+                                             grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid1_id, nc_grd1crnrlon_id,  &
+                                             grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (luse_grid1_area) then
+        allocate (grid1_area_in(grid1_size))
+        ncstat = nf_inq_varid(nc_grid1_id, 'grid_area', nc_grid1area_id)
+        call netcdf_error_handler(ncstat)
+        ncstat = nf_get_var_double(nc_grid1_id, nc_grid1area_id,  &
+                                                grid1_area_in)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      grid1_area = zero
+      grid1_frac = zero
+
+!-----------------------------------------------------------------------
+!
+!     initialize logical mask and convert lat/lon units if required
+!
+!-----------------------------------------------------------------------
+
+      where (imask == 1)
+        grid1_mask = .true.
+      elsewhere
+        grid1_mask = .false.
+      endwhere
+      deallocate(imask)
+
+      grid1_units = ' '
+      ncstat = nf_get_att_text(nc_grid1_id, nc_grd1cntrlat_id, 'units', &
+                               grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+
+        grid1_center_lat = grid1_center_lat*deg2rad
+        grid1_center_lon = grid1_center_lon*deg2rad
+
+      case ('radians')
+
+        !*** no conversion necessary
+
+      case default
+
+        print *,'unknown units supplied for grid1 center lat/lon: '
+        print *,'proceeding assuming radians'
+
+      end select
+
+      grid1_units = ' '
+      ncstat = nf_get_att_text(nc_grid1_id, nc_grd1crnrlat_id, 'units', &
+                               grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+
+        grid1_corner_lat = grid1_corner_lat*deg2rad
+        grid1_corner_lon = grid1_corner_lon*deg2rad
+
+      case ('radians')
+
+        !*** no conversion necessary
+
+      case default
+
+        print *,'unknown units supplied for grid1 corner lat/lon: '
+        print *,'proceeding assuming radians'
+
+      end select
+
+      ncstat = nf_close(nc_grid1_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     read data for grid 2
+!
+!-----------------------------------------------------------------------
+
+      allocate(imask(grid2_size))
+
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_dims', nc_grid2dims_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_imask', nc_grd2imask_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_center_lat',  &
+                                         nc_grd2cntrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_center_lon',  &
+                                         nc_grd2cntrlon_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_corner_lat',  &
+                                         nc_grd2crnrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_corner_lon',  &
+                                         nc_grd2crnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_grid2_id, nc_grid2dims_id, grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_grid2_id, nc_grd2imask_id, imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid2_id, nc_grd2cntrlat_id,  &
+                                             grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid2_id, nc_grd2cntrlon_id,  &
+                                             grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid2_id, nc_grd2crnrlat_id,  &
+                                             grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid2_id, nc_grd2crnrlon_id,  &
+                                             grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (luse_grid2_area) then
+        allocate (grid2_area_in(grid2_size))
+        ncstat = nf_inq_varid(nc_grid2_id, 'grid_area', nc_grid2area_id)
+        call netcdf_error_handler(ncstat)
+        ncstat = nf_get_var_double(nc_grid2_id, nc_grid2area_id,  &
+                                                grid2_area_in)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      grid2_area = zero
+      grid2_frac = zero
+
+!-----------------------------------------------------------------------
+!
+!     initialize logical mask and convert lat/lon units if required
+!
+!-----------------------------------------------------------------------
+
+      where (imask == 1)
+        grid2_mask = .true.
+      elsewhere
+        grid2_mask = .false.
+      endwhere
+      deallocate(imask)
+
+      grid2_units = ' '
+      ncstat = nf_get_att_text(nc_grid2_id, nc_grd2cntrlat_id, 'units', &
+                               grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+
+        grid2_center_lat = grid2_center_lat*deg2rad
+        grid2_center_lon = grid2_center_lon*deg2rad
+
+      case ('radians')
+
+        !*** no conversion necessary
+
+      case default
+
+        print *,'unknown units supplied for grid2 center lat/lon: '
+        print *,'proceeding assuming radians'
+
+      end select
+
+      grid2_units = ' '
+      ncstat = nf_get_att_text(nc_grid2_id, nc_grd2crnrlat_id, 'units', &
+                               grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+
+        grid2_corner_lat = grid2_corner_lat*deg2rad
+        grid2_corner_lon = grid2_corner_lon*deg2rad
+
+      case ('radians')
+
+        !*** no conversion necessary
+
+      case default
+
+        print *,'no units supplied for grid2 corner lat/lon: '
+        print *,'proceeding assuming radians'
+
+      end select
+
+      ncstat = nf_close(nc_grid2_id)
+      call netcdf_error_handler(ncstat)
+
+
+!-----------------------------------------------------------------------
+!
+!     convert longitudes to 0,2pi interval
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_center_lon .gt. pi2)  grid1_center_lon = &
+                                         grid1_center_lon - pi2
+      where (grid1_center_lon .lt. zero) grid1_center_lon = &
+                                         grid1_center_lon + pi2
+      where (grid2_center_lon .gt. pi2)  grid2_center_lon = &
+                                         grid2_center_lon - pi2
+      where (grid2_center_lon .lt. zero) grid2_center_lon = &
+                                         grid2_center_lon + pi2
+      where (grid1_corner_lon .gt. pi2)  grid1_corner_lon = &
+                                         grid1_corner_lon - pi2
+      where (grid1_corner_lon .lt. zero) grid1_corner_lon = &
+                                         grid1_corner_lon + pi2
+      where (grid2_corner_lon .gt. pi2)  grid2_corner_lon = &
+                                         grid2_corner_lon - pi2
+      where (grid2_corner_lon .lt. zero) grid2_corner_lon = &
+                                         grid2_corner_lon + pi2
+
+!-----------------------------------------------------------------------
+!
+!     make sure input latitude range is within the machine values
+!     for +/- pi/2 
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_center_lat >  pih) grid1_center_lat =  pih
+      where (grid1_corner_lat >  pih) grid1_corner_lat =  pih
+      where (grid1_center_lat < -pih) grid1_center_lat = -pih
+      where (grid1_corner_lat < -pih) grid1_corner_lat = -pih
+
+      where (grid2_center_lat >  pih) grid2_center_lat =  pih
+      where (grid2_corner_lat >  pih) grid2_corner_lat =  pih
+      where (grid2_center_lat < -pih) grid2_center_lat = -pih
+      where (grid2_corner_lat < -pih) grid2_corner_lat = -pih
+
+!-----------------------------------------------------------------------
+!
+!     compute bounding boxes for restricting future grid searches
+!
+!-----------------------------------------------------------------------
+
+      if (.not. luse_grid_centers) then
+        grid1_bound_box(1,:) = minval(grid1_corner_lat, DIM=1)
+        grid1_bound_box(2,:) = maxval(grid1_corner_lat, DIM=1)
+        grid1_bound_box(3,:) = minval(grid1_corner_lon, DIM=1)
+        grid1_bound_box(4,:) = maxval(grid1_corner_lon, DIM=1)
+
+        grid2_bound_box(1,:) = minval(grid2_corner_lat, DIM=1)
+        grid2_bound_box(2,:) = maxval(grid2_corner_lat, DIM=1)
+        grid2_bound_box(3,:) = minval(grid2_corner_lon, DIM=1)
+        grid2_bound_box(4,:) = maxval(grid2_corner_lon, DIM=1)
+
+      else
+
+        nx = grid1_dims(1)
+        ny = grid1_dims(2)
+
+        do n=1,grid1_size
+
+          !*** find N,S and NE points to this grid point
+
+          j = (n - 1)/nx +1
+          i = n - (j-1)*nx
+
+          if (i < nx) then
+            ip1 = i + 1
+          else
+            !*** assume cyclic
+            ip1 = 1
+            !*** but if it is not, correct
+            e_add = (j - 1)*nx + ip1
+            if (abs(grid1_center_lat(e_add) -  &
+                    grid1_center_lat(n   )) > pih) then
+              ip1 = i
+            endif
+          endif
+
+          if (j < ny) then
+            jp1 = j+1
+          else
+            !*** assume cyclic
+            jp1 = 1
+            !*** but if it is not, correct
+            n_add = (jp1 - 1)*nx + i
+            if (abs(grid1_center_lat(n_add) -  &
+                    grid1_center_lat(n   )) > pih) then
+              jp1 = j
+            endif
+          endif
+
+          n_add = (jp1 - 1)*nx + i
+          e_add = (j - 1)*nx + ip1
+          ne_add = (jp1 - 1)*nx + ip1
+
+          !*** find N,S and NE lat/lon coords and check bounding box
+
+          tmp_lats(1) = grid1_center_lat(n)
+          tmp_lats(2) = grid1_center_lat(e_add)
+          tmp_lats(3) = grid1_center_lat(ne_add)
+          tmp_lats(4) = grid1_center_lat(n_add)
+
+          tmp_lons(1) = grid1_center_lon(n)
+          tmp_lons(2) = grid1_center_lon(e_add)
+          tmp_lons(3) = grid1_center_lon(ne_add)
+          tmp_lons(4) = grid1_center_lon(n_add)
+
+          grid1_bound_box(1,n) = minval(tmp_lats)
+          grid1_bound_box(2,n) = maxval(tmp_lats)
+          grid1_bound_box(3,n) = minval(tmp_lons)
+          grid1_bound_box(4,n) = maxval(tmp_lons)
+        end do
+
+        nx = grid2_dims(1)
+        ny = grid2_dims(2)
+
+        do n=1,grid2_size
+
+          !*** find N,S and NE points to this grid point
+
+          j = (n - 1)/nx +1
+          i = n - (j-1)*nx
+
+          if (i < nx) then
+            ip1 = i + 1
+          else
+            !*** assume cyclic
+            ip1 = 1
+            !*** but if it is not, correct
+            e_add = (j - 1)*nx + ip1
+            if (abs(grid2_center_lat(e_add) -  &
+                    grid2_center_lat(n   )) > pih) then
+              ip1 = i
+            endif
+          endif
+
+          if (j < ny) then
+            jp1 = j+1
+          else
+            !*** assume cyclic
+            jp1 = 1
+            !*** but if it is not, correct
+            n_add = (jp1 - 1)*nx + i
+            if (abs(grid2_center_lat(n_add) -  &
+                    grid2_center_lat(n   )) > pih) then
+              jp1 = j
+            endif
+          endif
+
+          n_add = (jp1 - 1)*nx + i
+          e_add = (j - 1)*nx + ip1
+          ne_add = (jp1 - 1)*nx + ip1
+
+          !*** find N,S and NE lat/lon coords and check bounding box
+
+          tmp_lats(1) = grid2_center_lat(n)
+          tmp_lats(2) = grid2_center_lat(e_add)
+          tmp_lats(3) = grid2_center_lat(ne_add)
+          tmp_lats(4) = grid2_center_lat(n_add)
+
+          tmp_lons(1) = grid2_center_lon(n)
+          tmp_lons(2) = grid2_center_lon(e_add)
+          tmp_lons(3) = grid2_center_lon(ne_add)
+          tmp_lons(4) = grid2_center_lon(n_add)
+
+          grid2_bound_box(1,n) = minval(tmp_lats)
+          grid2_bound_box(2,n) = maxval(tmp_lats)
+          grid2_bound_box(3,n) = minval(tmp_lons)
+          grid2_bound_box(4,n) = maxval(tmp_lons)
+        end do
+
+      endif
+
+      where (abs(grid1_bound_box(4,:) - grid1_bound_box(3,:)) > pi)
+        grid1_bound_box(3,:) = zero
+        grid1_bound_box(4,:) = pi2
+      end where
+
+      where (abs(grid2_bound_box(4,:) - grid2_bound_box(3,:)) > pi)
+        grid2_bound_box(3,:) = zero
+        grid2_bound_box(4,:) = pi2
+      end where
+
+      !***
+      !*** try to check for cells that overlap poles
+      !***
+
+      where (grid1_center_lat > grid1_bound_box(2,:)) &
+        grid1_bound_box(2,:) = pih
+
+      where (grid1_center_lat < grid1_bound_box(1,:)) &
+        grid1_bound_box(1,:) = -pih
+
+      where (grid2_center_lat > grid2_bound_box(2,:)) &
+        grid2_bound_box(2,:) = pih
+
+      where (grid2_center_lat < grid2_bound_box(1,:)) &
+        grid2_bound_box(1,:) = -pih
+
+!-----------------------------------------------------------------------
+!
+!     set up and assign address ranges to search bins in order to 
+!     further restrict later searches
+!
+!-----------------------------------------------------------------------
+
+      select case (restrict_type)
+
+      case ('latitude')
+        write(stdout,*) 'Using latitude bins to restrict search.'
+
+        allocate(bin_addr1(2,num_srch_bins))
+        allocate(bin_addr2(2,num_srch_bins))
+        allocate(bin_lats (2,num_srch_bins))
+        allocate(bin_lons (2,num_srch_bins))
+
+        dlat = pi/num_srch_bins
+
+        do n=1,num_srch_bins
+          bin_lats(1,n) = (n-1)*dlat - pih
+          bin_lats(2,n) =     n*dlat - pih
+          bin_lons(1,n) = zero
+          bin_lons(2,n) = pi2
+          bin_addr1(1,n) = grid1_size + 1
+          bin_addr1(2,n) = 0
+          bin_addr2(1,n) = grid2_size + 1
+          bin_addr2(2,n) = 0
+        end do
+
+        do nele=1,grid1_size
+          do n=1,num_srch_bins
+            if (grid1_bound_box(1,nele) <= bin_lats(2,n) .and. &
+                grid1_bound_box(2,nele) >= bin_lats(1,n)) then
+              bin_addr1(1,n) = min(nele,bin_addr1(1,n))
+              bin_addr1(2,n) = max(nele,bin_addr1(2,n))
+            endif
+          end do
+        end do
+
+        do nele=1,grid2_size
+          do n=1,num_srch_bins
+            if (grid2_bound_box(1,nele) <= bin_lats(2,n) .and. &
+                grid2_bound_box(2,nele) >= bin_lats(1,n)) then
+              bin_addr2(1,n) = min(nele,bin_addr2(1,n))
+              bin_addr2(2,n) = max(nele,bin_addr2(2,n))
+            endif
+          end do
+        end do
+
+      case ('latlon')
+        write(stdout,*) 'Using lat/lon boxes to restrict search.'
+
+        dlat = pi /num_srch_bins
+        dlon = pi2/num_srch_bins
+
+        allocate(bin_addr1(2,num_srch_bins*num_srch_bins))
+        allocate(bin_addr2(2,num_srch_bins*num_srch_bins))
+        allocate(bin_lats (2,num_srch_bins*num_srch_bins))
+        allocate(bin_lons (2,num_srch_bins*num_srch_bins))
+
+        n = 0
+        do j=1,num_srch_bins
+        do i=1,num_srch_bins
+          n = n + 1
+
+          bin_lats(1,n) = (j-1)*dlat - pih
+          bin_lats(2,n) =     j*dlat - pih
+          bin_lons(1,n) = (i-1)*dlon
+          bin_lons(2,n) =     i*dlon
+          bin_addr1(1,n) = grid1_size + 1
+          bin_addr1(2,n) = 0
+          bin_addr2(1,n) = grid2_size + 1
+          bin_addr2(2,n) = 0
+        end do
+        end do
+
+        num_srch_bins = num_srch_bins**2
+
+        do nele=1,grid1_size
+          do n=1,num_srch_bins
+            if (grid1_bound_box(1,nele) <= bin_lats(2,n) .and. &
+                grid1_bound_box(2,nele) >= bin_lats(1,n) .and. &
+                grid1_bound_box(3,nele) <= bin_lons(2,n) .and. &
+                grid1_bound_box(4,nele) >= bin_lons(1,n)) then
+              bin_addr1(1,n) = min(nele,bin_addr1(1,n))
+              bin_addr1(2,n) = max(nele,bin_addr1(2,n))
+            endif
+          end do
+        end do
+
+        do nele=1,grid2_size
+          do n=1,num_srch_bins
+            if (grid2_bound_box(1,nele) <= bin_lats(2,n) .and. &
+                grid2_bound_box(2,nele) >= bin_lats(1,n) .and. &
+                grid2_bound_box(3,nele) <= bin_lons(2,n) .and. &
+                grid2_bound_box(4,nele) >= bin_lons(1,n)) then
+              bin_addr2(1,n) = min(nele,bin_addr2(1,n))
+              bin_addr2(2,n) = max(nele,bin_addr2(2,n))
+            endif
+          end do
+        end do
+
+      case default
+        stop 'unknown search restriction method'
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine grid_init
+
+!***********************************************************************
+
+      end module grids
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
Index: /utils/tools_ticket2413/WEIGHTS/src/iounits.f90
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/src/iounits.f90	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/src/iounits.f90	(revision 12863)
@@ -0,0 +1,154 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module is a dynamic I/O unit manager.  It keeps track of
+!     which units are in use and reserves units for stdin, stdout, and
+!     stderr.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: iounits.f,v 1.2 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module iounits
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod   ! defines data types
+
+      implicit none
+
+!-----------------------------------------------------------------------
+
+      logical (kind=log_kind), dimension(99), save :: &
+          unit_free   ! flags to determine whether unit is free for use
+
+      integer (kind=int_kind), parameter :: &
+          stdin  = 5,  & ! reserves unit for standard input
+          stdout = 6,  & ! reserves unit for standard output
+          stderr = 6  ! reserves unit for standard error
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine get_unit(iunit)
+
+!-----------------------------------------------------------------------
+!
+!     This routine returns the next available I/O unit number.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(out) :: &
+           iunit   ! next free I/O unit
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n
+
+      logical (kind=log_kind), save :: first_call = .true.
+
+!-----------------------------------------------------------------------
+!
+!     if this is the first call, reserve stdout, stdin and stderr
+!
+!-----------------------------------------------------------------------
+
+      if (first_call) then
+        unit_free = .true.
+        unit_free(stdin)  = .false.
+        unit_free(stdout) = .false.
+        unit_free(stderr) = .false.
+        first_call = .false.
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     search for next available unit
+!
+!-----------------------------------------------------------------------
+
+      srch_unit: do n=1,99
+        if (unit_free(n)) then
+          iunit = n
+          unit_free(n) = .false.
+          exit srch_unit
+        endif
+      end do srch_unit
+
+!-----------------------------------------------------------------------
+
+      end subroutine get_unit
+
+!***********************************************************************
+
+      subroutine release_unit(iunit)
+
+!-----------------------------------------------------------------------
+!
+!     This routine releases the specified unit and closes the file.
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: &
+           iunit   ! I/O unit to release
+
+!-----------------------------------------------------------------------
+!
+!     closes I/O unit and declares it free
+!
+!-----------------------------------------------------------------------
+
+      unit_free(iunit) = .true.
+      close(iunit)
+
+!-----------------------------------------------------------------------
+
+      end subroutine release_unit
+
+!***********************************************************************
+
+      end module iounits
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/src/kinds_mod.f90
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/src/kinds_mod.f90	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/src/kinds_mod.f90	(revision 12863)
@@ -0,0 +1,53 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module defines the F90 kind parameter for common data types.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: kinds_mod.f,v 1.2 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module kinds_mod
+
+!-----------------------------------------------------------------------
+
+      implicit none
+      save
+
+!-----------------------------------------------------------------------
+
+      integer, parameter :: char_len  = 80, &
+                            int_kind  = kind(1), &
+                            log_kind  = kind(.true.), &
+                            real_kind = selected_real_kind(6), &
+                            dbl_kind  = selected_real_kind(13)
+
+!-----------------------------------------------------------------------
+
+      end module kinds_mod
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/src/netcdf_mod.f90
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/src/netcdf_mod.f90	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/src/netcdf_mod.f90	(revision 12863)
@@ -0,0 +1,84 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module contains the netCDF include file and a netcdf error
+!     handling routine.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: netcdf.f,v 1.2 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module netcdf_mod
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+      use constants
+
+      implicit none
+
+      include 'netcdf.inc'
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine netcdf_error_handler(istat, mess)
+
+!-----------------------------------------------------------------------
+!
+!     This routine provides a simple interface to netCDF error message
+!     routine.
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::  &
+          istat   ! integer status returned by netCDF function call
+      character (len=*), intent(in), optional :: mess
+
+!-----------------------------------------------------------------------
+
+      if (istat /= NF_NOERR) then
+       if (present(mess)) then
+         print *,'Error in netCDF: ',nf_strerror(istat), 'Message: ',mess
+       else
+         print *,'Error in netCDF: ',nf_strerror(istat)
+       endif
+        stop
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine netcdf_error_handler
+
+!***********************************************************************
+
+      end module netcdf_mod
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/src/remap.f90
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/src/remap.f90	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/src/remap.f90	(revision 12863)
@@ -0,0 +1,165 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this routine performs a remapping based on addresses and weights
+!     computed in a setup phase
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap.f,v 1.5 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_mod
+
+!-----------------------------------------------------------------------
+!
+!     this module contains the routines for performing the actual
+!     remappings
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod    ! defines common data types
+      use constants    ! defines common constants
+
+      implicit none
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap(dst_array, map_wts, dst_add, src_add,  &
+                       src_array, src_grad1, src_grad2, src_grad3)
+
+!-----------------------------------------------------------------------
+!
+!     performs the remapping based on weights computed elsewhere
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input arrays
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(:), intent(in) :: &
+           dst_add,      & ! destination address for each link
+           src_add      ! source      address for each link
+
+      real (kind=dbl_kind), dimension(:,:), intent(in) :: &
+           map_wts      ! remapping weights for each link
+
+      real (kind=dbl_kind), dimension(:), intent(in) :: &
+           src_array    ! array with source field to be remapped
+
+      real (kind=dbl_kind), dimension(:), intent(in), optional :: &
+           src_grad1     & ! gradient arrays on source grid necessary for
+      ,    src_grad2     & ! higher-order remappings
+      ,    src_grad3
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), dimension(:), intent(inout) :: &
+           dst_array    ! array for remapped field on destination grid
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, iorder
+
+!-----------------------------------------------------------------------
+!
+!     check the order of the interpolation
+!
+!-----------------------------------------------------------------------
+
+      if (present(src_grad1)) then
+        iorder = 2
+      else
+        iorder = 1
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     first order remapping
+!
+!-----------------------------------------------------------------------
+
+      dst_array = zero
+
+      select case (iorder)
+      case(1)
+
+        do n=1,size(dst_add)
+          dst_array(dst_add(n)) = dst_array(dst_add(n)) +  &
+                                  src_array(src_add(n))*map_wts(1,n)
+        end do
+
+!-----------------------------------------------------------------------
+!
+!     second order remapping
+!
+!-----------------------------------------------------------------------
+
+      case(2)
+
+        if (size(map_wts,DIM=1) == 3) then
+          do n=1,size(dst_add)
+            dst_array(dst_add(n)) = dst_array(dst_add(n)) + &
+                                    src_array(src_add(n))*map_wts(1,n) + &
+                                    src_grad1(src_add(n))*map_wts(2,n) + &
+                                    src_grad2(src_add(n))*map_wts(3,n)
+          end do
+        else if (size(map_wts,DIM=1) == 4) then
+          do n=1,size(dst_add)
+            dst_array(dst_add(n)) = dst_array(dst_add(n)) + &
+                                    src_array(src_add(n))*map_wts(1,n) + &
+                                    src_grad1(src_add(n))*map_wts(2,n) + &
+                                    src_grad2(src_add(n))*map_wts(3,n) + &
+                                    src_grad3(src_add(n))*map_wts(4,n)
+          end do
+        endif
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine remap
+
+!***********************************************************************
+
+      end module remap_mod
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/src/remap_bicubic.f90
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/src/remap_bicubic.f90	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/src/remap_bicubic.f90	(revision 12863)
@@ -0,0 +1,844 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for performing an 
+!     bicubic interpolation.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_bicubic.f,v 1.5 2001/08/22 18:20:41 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_bicubic
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common constants
+      use grids         ! module containing grid info
+      use remap_vars    ! module containing remap info
+
+      implicit none
+
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter :: &
+          max_iter = 100   ! max iteration count for i,j iteration
+
+      real (kind=dbl_kind), parameter :: &
+           converge = 1.e-10_dbl_kind  ! convergence criterion
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap_bicub
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the weights for a bicubic interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,icount, &
+           dst_add,         & ! destination address
+           iter,            & ! iteration counter
+           nmap            ! index of current map being computed
+
+      integer (kind=int_kind), dimension(4) ::  &
+           src_add         ! address for the four source points
+
+      real (kind=dbl_kind), dimension(4)  :: &
+           src_lats,        & ! latitudes  of four bilinear corners
+           src_lons        ! longitudes of four bilinear corners
+
+      real (kind=dbl_kind), dimension(4,4)  :: &
+           wgts            ! bicubic weights for four corners
+
+      real (kind=dbl_kind) :: &
+           plat, plon,        & ! lat/lon coords of destination point
+           iguess, jguess,    & ! current guess for bilinear coordinate
+           thguess, phguess,  & ! current guess for lat/lon coordinate
+           deli, delj,        & ! corrections to i,j
+           dth1, dth2, dth3,  & ! some latitude  differences
+           dph1, dph2, dph3,  & ! some longitude differences
+           dthp, dphp,        & ! difference between point and sw corner
+           mat1, mat2, mat3, mat4,  & ! matrix elements
+           determinant,       & ! matrix determinant
+           sum_wgts,          & ! sum of weights for normalization
+           w1,w2,w3,w4,w5,w6,w7,w8,  & ! 16 bicubic weight functions
+           w9,w10,w11,w12,w13,w14,w15,w16
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+
+      nmap = 1
+      if (grid1_rank /= 2) then
+        stop 'Can not do bicubic interpolation when grid_rank /= 2'
+      endif
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop1: do dst_add = 1, grid2_size
+
+        if (.not. grid2_mask(dst_add)) cycle grid_loop1
+
+        plat = grid2_center_lat(dst_add)
+        plon = grid2_center_lon(dst_add)
+
+!-----------------------------------------------------------------------
+!
+!       find nearest square of grid points on source grid
+!
+!-----------------------------------------------------------------------
+
+        call grid_search_bicub(src_add, src_lats, src_lons,  &
+                               plat, plon, grid1_dims, &
+                               grid1_center_lat, grid1_center_lon, &
+                               grid1_bound_box, bin_addr1, bin_addr2)
+
+        !***
+        !*** check to see if points are land points
+        !***
+
+        if (src_add(1) > 0) then
+          do n=1,4
+            if (.not. grid1_mask(src_add(n))) src_add(1) = 0
+          end do
+        endif
+
+!-----------------------------------------------------------------------
+!
+!       if point found, find local i,j coordinates for weights
+!
+!-----------------------------------------------------------------------
+
+        if (src_add(1) > 0) then
+
+          grid2_frac(dst_add) = one
+
+          !***
+          !*** iterate to find i,j for bicubic approximation
+          !***
+
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          if (dph1 >  three*pih) dph1 = dph1 - pi2
+          if (dph2 >  three*pih) dph2 = dph2 - pi2
+          if (dph3 >  three*pih) dph3 = dph3 - pi2
+          if (dph1 < -three*pih) dph1 = dph1 + pi2
+          if (dph2 < -three*pih) dph2 = dph2 + pi2
+          if (dph3 < -three*pih) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+
+          iguess = half
+          jguess = half
+
+          iter_loop1: do iter=1,max_iter
+
+            dthp = plat - src_lats(1) - dth1*iguess - &
+                          dth2*jguess - dth3*iguess*jguess
+            dphp = plon - src_lons(1)
+
+            if (dphp >  three*pih) dphp = dphp - pi2
+            if (dphp < -three*pih) dphp = dphp + pi2
+
+            dphp = dphp - dph1*iguess - dph2*jguess -  &
+                          dph3*iguess*jguess
+
+            mat1 = dth1 + dth3*jguess
+            mat2 = dth2 + dth3*iguess
+            mat3 = dph1 + dph3*jguess
+            mat4 = dph2 + dph3*iguess
+
+            determinant = mat1*mat4 - mat2*mat3
+
+            deli = (dthp*mat4 - mat2*dphp)/determinant
+            delj = (mat1*dphp - dthp*mat3)/determinant
+
+            if (abs(deli) < converge .and.  &
+                abs(delj) < converge) exit iter_loop1
+
+            iguess = iguess + deli
+            jguess = jguess + delj
+
+          end do iter_loop1
+
+          if (iter <= max_iter) then
+
+!-----------------------------------------------------------------------
+!
+!           successfully found i,j - compute weights
+!
+!-----------------------------------------------------------------------
+
+            wgts(1,1) = (one - jguess**2*(three-two*jguess))* &
+                        (one - iguess**2*(three-two*iguess))
+            wgts(1,2) = (one - jguess**2*(three-two*jguess))* &
+                               iguess**2*(three-two*iguess)
+            wgts(1,3) =        jguess**2*(three-two*jguess)* &
+                               iguess**2*(three-two*iguess)
+            wgts(1,4) =        jguess**2*(three-two*jguess)* &
+                        (one - iguess**2*(three-two*iguess))
+            wgts(2,1) = (one - jguess**2*(three-two*jguess))* &
+                               iguess*(iguess-one)**2
+            wgts(2,2) = (one - jguess**2*(three-two*jguess))* &
+                               iguess**2*(iguess-one)
+            wgts(2,3) =        jguess**2*(three-two*jguess)* &
+                               iguess**2*(iguess-one)
+            wgts(2,4) =        jguess**2*(three-two*jguess)* &
+                               iguess*(iguess-one)**2
+            wgts(3,1) =        jguess*(jguess-one)**2* &
+                        (one - iguess**2*(three-two*iguess))
+            wgts(3,2) =        jguess*(jguess-one)**2* &
+                               iguess**2*(three-two*iguess)
+            wgts(3,3) =        jguess**2*(jguess-one)* &
+                               iguess**2*(three-two*iguess)
+            wgts(3,4) =        jguess**2*(jguess-one)* &
+                        (one - iguess**2*(three-two*iguess))
+            wgts(4,1) =        iguess*(iguess-one)**2* &
+                               jguess*(jguess-one)**2
+            wgts(4,2) =        iguess**2*(iguess-one)* &
+                               jguess*(jguess-one)**2
+            wgts(4,3) =        iguess**2*(iguess-one)* &
+                               jguess**2*(jguess-one)
+            wgts(4,4) =        iguess*(iguess-one)**2* &
+                               jguess**2*(jguess-one)
+
+            call store_link_bicub(dst_add, src_add, wgts, nmap)
+
+          else
+            stop 'Iteration for i,j exceed max iteration count'
+          endif
+
+!-----------------------------------------------------------------------
+!
+!       search for bilinear failed - use a distance-weighted
+!       average instead (this is typically near the pole)
+!
+!-----------------------------------------------------------------------
+
+        else if (src_add(1) < 0) then
+
+          src_add = abs(src_add)
+
+          icount = 0
+          do n=1,4
+            if (grid1_mask(src_add(n))) then
+              icount = icount + 1
+            else
+              src_lats(n) = zero
+            endif
+          end do
+
+          if (icount > 0) then
+            !*** renormalize weights
+
+            sum_wgts = sum(src_lats)
+            wgts(1,1) = src_lats(1)/sum_wgts
+            wgts(1,2) = src_lats(2)/sum_wgts
+            wgts(1,3) = src_lats(3)/sum_wgts
+            wgts(1,4) = src_lats(4)/sum_wgts
+            wgts(2:4,:) = zero
+
+            grid2_frac(dst_add) = one
+            call store_link_bicub(dst_add, src_add, wgts, nmap)
+          endif
+
+        endif
+      end do grid_loop1
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid2 to grid1 if necessary
+!
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+
+      nmap = 2
+      if (grid2_rank /= 2) then
+        stop 'Can not do bicubic interpolation when grid_rank /= 2'
+      endif
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop2: do dst_add = 1, grid1_size
+
+        if (.not. grid1_mask(dst_add)) cycle grid_loop2
+
+        plat = grid1_center_lat(dst_add)
+        plon = grid1_center_lon(dst_add)
+
+        !***
+        !*** find nearest square of grid points on source grid
+        !***
+
+        call grid_search_bicub(src_add, src_lats, src_lons,  &
+                               plat, plon, grid2_dims, &
+                               grid2_center_lat, grid2_center_lon, &
+                               grid2_bound_box, bin_addr2, bin_addr1)
+
+        !***
+        !*** check to see if points are land points
+        !***
+
+        if (src_add(1) > 0) then
+          do n=1,4
+            if (.not. grid2_mask(src_add(n))) src_add(1) = 0
+          end do
+        endif
+
+        !***
+        !*** if point found, find i,j coordinates for weights
+        !***
+
+        if (src_add(1) > 0) then
+
+          grid1_frac(dst_add) = one
+
+          !***
+          !*** iterate to find i,j for bilinear approximation
+          !***
+
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          if (dph1 >  pi) dph1 = dph1 - pi2
+          if (dph2 >  pi) dph2 = dph2 - pi2
+          if (dph3 >  pi) dph3 = dph3 - pi2
+          if (dph1 < -pi) dph1 = dph1 + pi2
+          if (dph2 < -pi) dph2 = dph2 + pi2
+          if (dph3 < -pi) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+
+          iguess = zero
+          jguess = zero
+
+          iter_loop2: do iter=1,max_iter
+
+            dthp = plat - src_lats(1) - dth1*iguess - &
+                          dth2*jguess - dth3*iguess*jguess
+            dphp = plon - src_lons(1)
+
+            if (dphp >  pi) dphp = dphp - pi2
+            if (dphp < -pi) dphp = dphp + pi2
+
+            dphp = dphp - dph1*iguess - dph2*jguess -  &
+                          dph3*iguess*jguess
+
+            mat1 = dth1 + dth3*jguess
+            mat2 = dth2 + dth3*iguess
+            mat3 = dph1 + dph3*jguess
+            mat4 = dph2 + dph3*iguess
+
+            determinant = mat1*mat4 - mat2*mat3
+
+            deli = (dthp*mat4 - mat2*dphp)/determinant
+            delj = (mat1*dphp - dthp*mat3)/determinant
+
+            if (abs(deli) < converge .and.  &
+                abs(delj) < converge) exit iter_loop2
+
+            iguess = iguess + deli
+            jguess = jguess + delj
+
+          end do iter_loop2
+
+          if (iter <= max_iter) then
+
+            !***
+            !*** successfully found i,j - compute weights
+            !***
+
+            wgts(1,1) = (one - jguess**2*(three-two*jguess))* &
+                        (one - iguess**2*(three-two*iguess))
+            wgts(1,2) = (one - jguess**2*(three-two*jguess))* &
+                               iguess**2*(three-two*iguess)
+            wgts(1,3) =        jguess**2*(three-two*jguess)* &
+                               iguess**2*(three-two*iguess)
+            wgts(1,4) =        jguess**2*(three-two*jguess)* &
+                        (one - iguess**2*(three-two*iguess))
+            wgts(2,1) = (one - jguess**2*(three-two*jguess))* &
+                               iguess*(iguess-one)**2
+            wgts(2,2) = (one - jguess**2*(three-two*jguess))* &
+                               iguess**2*(iguess-one)
+            wgts(2,3) =        jguess**2*(three-two*jguess)* &
+                               iguess**2*(iguess-one)
+            wgts(2,4) =        jguess**2*(three-two*jguess)* &
+                               iguess*(iguess-one)**2
+            wgts(3,1) =        jguess*(jguess-one)**2* &
+                        (one - iguess**2*(three-two*iguess))
+            wgts(3,2) =        jguess*(jguess-one)**2* &
+                               iguess**2*(three-two*iguess)
+            wgts(3,3) =        jguess**2*(jguess-one)* &
+                               iguess**2*(three-two*iguess)
+            wgts(3,4) =        jguess**2*(jguess-one)* &
+                        (one - iguess**2*(three-two*iguess))
+            wgts(4,1) =        iguess*(iguess-one)**2* &
+                               jguess*(jguess-one)**2
+            wgts(4,2) =        iguess**2*(iguess-one)* &
+                               jguess*(jguess-one)**2
+            wgts(4,3) =        iguess**2*(iguess-one)* &
+                               jguess**2*(jguess-one)
+            wgts(4,4) =        iguess*(iguess-one)**2* &
+                               jguess**2*(jguess-one)
+
+            call store_link_bicub(dst_add, src_add, wgts, nmap)
+
+          else
+            stop 'Iteration for i,j exceed max iteration count'
+          endif
+
+        !***
+        !*** search for bilinear failed - us a distance-weighted
+        !*** average instead
+        !***
+
+        else if (src_add(1) < 0) then
+
+          src_add = abs(src_add)
+
+          icount = 0
+          do n=1,4
+            if (grid2_mask(src_add(n))) then
+              icount = icount + 1
+            else
+              src_lats(n) = zero
+            endif
+          end do
+
+          if (icount > 0) then
+            !*** renormalize weights
+
+            sum_wgts = sum(src_lats)
+            wgts(1,1) = src_lats(1)/sum_wgts
+            wgts(1,2) = src_lats(2)/sum_wgts
+            wgts(1,3) = src_lats(3)/sum_wgts
+            wgts(1,4) = src_lats(4)/sum_wgts
+            wgts(2:4,:) = zero
+
+            grid1_frac(dst_add) = one
+            call store_link_bicub(dst_add, src_add, wgts, nmap)
+          endif
+
+        endif
+      end do grid_loop2
+
+      endif ! nmap=2
+
+!-----------------------------------------------------------------------
+
+      end subroutine remap_bicub
+
+!***********************************************************************
+
+      subroutine grid_search_bicub(src_add, src_lats, src_lons,  &
+                                   plat, plon, src_grid_dims, &
+                                   src_center_lat, src_center_lon, &
+                                   src_bound_box, &
+                                   src_bin_add, dst_bin_add)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the location of the search point plat, plon
+!     in the source grid and returns the corners needed for a bicubic
+!     interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(4), intent(out) :: &
+              src_add  ! address of each corner point enclosing P
+
+      real (kind=dbl_kind), dimension(4), intent(out) :: &
+              src_lats,  & ! latitudes  of the four corner points
+              src_lons  ! longitudes of the four corner points
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), intent(in) :: &
+              plat,    & ! latitude  of the search point
+              plon    ! longitude of the search point
+
+      integer (kind=int_kind), dimension(2), intent(in) :: &
+              src_grid_dims  ! size of each src grid dimension
+
+      real (kind=dbl_kind), dimension(:), intent(in) :: &
+              src_center_lat,  & ! latitude  of each src grid center 
+              src_center_lon  ! longitude of each src grid center
+
+      real (kind=dbl_kind), dimension(:,:), intent(in) :: &
+              src_bound_box   ! bounding box for src grid search
+
+      integer (kind=int_kind), dimension(:,:), intent(in) :: &
+              src_bin_add,     & ! search bins for restricting
+              dst_bin_add     ! searches
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, srch_add,    & ! dummy indices
+          nx, ny,             & ! dimensions of src grid
+          min_add, max_add,   & ! addresses for restricting search
+          i, j, jp1, ip1, n_add, e_add, ne_add  ! addresses
+
+      real (kind=dbl_kind) ::   & ! vectors for cross-product check
+            vec1_lat, vec1_lon, &
+            vec2_lat, vec2_lon, cross_product, cross_product_last, &
+            coslat_dst, sinlat_dst, coslon_dst, sinlon_dst, &
+            dist_min, distance ! for computing dist-weighted avg
+
+!-----------------------------------------------------------------------
+!
+!     restrict search first using search bins. 
+!
+!-----------------------------------------------------------------------
+
+      src_add = 0
+
+      min_add = size(src_center_lat)
+      max_add = 1
+      do n=1,num_srch_bins
+        if (plat >= bin_lats(1,n) .and. plat <= bin_lats(2,n) .and. &
+            plon >= bin_lons(1,n) .and. plon <= bin_lons(2,n)) then
+          min_add = min(min_add, src_bin_add(1,n))
+          max_add = max(max_add, src_bin_add(2,n))
+        endif
+      end do
+ 
+!-----------------------------------------------------------------------
+!
+!     now perform a more detailed search 
+!
+!-----------------------------------------------------------------------
+
+      nx = src_grid_dims(1)
+      ny = src_grid_dims(2)
+
+      srch_loop: do srch_add = min_add,max_add
+
+        if (plat <= src_bound_box(2,srch_add) .and.  &
+            plat >= src_bound_box(1,srch_add) .and. &
+            plon <= src_bound_box(4,srch_add) .and.  &
+            plon >= src_bound_box(3,srch_add)) then
+
+          !***
+          !*** we are within bounding box so get really serious
+          !***
+
+          !*** find N,S and NE points to this grid point
+
+          j = (srch_add - 1)/nx +1
+          i = srch_add - (j-1)*nx
+
+          if (i < nx) then
+            ip1 = i + 1
+          else
+            ip1 = 1
+          endif
+
+          if (j < ny) then
+            jp1 = j+1
+          else
+            jp1 = 1
+          endif
+
+          n_add = (jp1 - 1)*nx + i
+          e_add = (j - 1)*nx + ip1
+          ne_add = (jp1 - 1)*nx + ip1
+
+          !***
+          !*** find N,S and NE lat/lon coords and check bounding box
+          !***
+
+          src_lats(1) = src_center_lat(srch_add)
+          src_lats(2) = src_center_lat(e_add)
+          src_lats(3) = src_center_lat(ne_add)
+          src_lats(4) = src_center_lat(n_add)
+
+          src_lons(1) = src_center_lon(srch_add)
+          src_lons(2) = src_center_lon(e_add)
+          src_lons(3) = src_center_lon(ne_add)
+          src_lons(4) = src_center_lon(n_add)
+
+          !***
+          !*** for consistency, we must make sure all lons are in
+          !*** same 2pi interval
+          !***
+
+          vec1_lon = src_lons(1) - plon
+          if (vec1_lon > pi) then
+            src_lons(1) = src_lons(1) - pi2
+          else if (vec1_lon < -pi) then
+            src_lons(1) = src_lons(1) + pi2
+          endif
+          do n=2,4
+            vec1_lon = src_lons(n) - src_lons(1)
+            if (vec1_lon > pi) then
+              src_lons(n) = src_lons(n) - pi2
+            else if (vec1_lon < -pi) then
+              src_lons(n) = src_lons(n) + pi2
+            endif
+          end do
+
+          corner_loop: do n=1,4
+            next_n = MOD(n,4) + 1
+
+            !***
+            !*** here we take the cross product of the vector making 
+            !*** up each box side with the vector formed by the vertex
+            !*** and search point.  if all the cross products are 
+            !*** same sign, the point is contained in the box.
+            !***
+
+            vec1_lat = src_lats(next_n) - src_lats(n)
+            vec1_lon = src_lons(next_n) - src_lons(n)
+            vec2_lat = plat - src_lats(n)
+            vec2_lon = plon - src_lons(n)
+
+            !***
+            !*** check for 0,2pi crossings
+            !***
+
+            if (vec1_lon >  three*pih) then
+              vec1_lon = vec1_lon - pi2
+            else if (vec1_lon < -three*pih) then
+              vec1_lon = vec1_lon + pi2
+            endif
+            if (vec2_lon >  three*pih) then
+              vec2_lon = vec2_lon - pi2
+            else if (vec2_lon < -three*pih) then
+              vec2_lon = vec2_lon + pi2
+            endif
+
+            cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+
+            !***
+            !*** if cross product is less than zero, this cell
+            !*** doesn't work
+            !***
+
+            if (n==1) cross_product_last = cross_product
+            if (cross_product*cross_product_last < zero) then
+              exit corner_loop
+            else
+              cross_product_last = cross_product
+            endif
+
+          end do corner_loop
+
+          !***
+          !*** if cross products all positive, we found the location
+          !***
+
+          if (n > 4) then
+            src_add(1) = srch_add
+            src_add(2) = e_add
+            src_add(3) = ne_add
+            src_add(4) = n_add
+
+            return
+          endif
+
+          !***
+          !*** otherwise move on to next cell
+          !***
+
+        endif !bounding box check
+      end do srch_loop
+
+      !***
+      !*** if no cell found, point is likely either in a box that
+      !*** straddles either pole or is outside the grid.  fall back
+      !*** to a distance-weighted average of the four closest
+      !*** points.  go ahead and compute weights here, but store
+      !*** in src_lats and return -add to prevent the parent
+      !*** routine from computing bilinear weights
+      !***
+
+      coslat_dst = cos(plat)
+      sinlat_dst = sin(plat)
+      coslon_dst = cos(plon)
+      sinlon_dst = sin(plon)
+
+      dist_min = bignum
+      src_lats = bignum
+      do srch_add = min_add,max_add
+        distance = acos(coslat_dst*cos(src_center_lat(srch_add))* &
+                       (coslon_dst*cos(src_center_lon(srch_add)) + &
+                        sinlon_dst*sin(src_center_lon(srch_add)))+ &
+                        sinlat_dst*sin(src_center_lat(srch_add)))
+
+        if (distance < dist_min) then
+          sort_loop: do n=1,4
+            if (distance < src_lats(n)) then
+              do i=4,n+1,-1
+                src_add (i) = src_add (i-1)
+                src_lats(i) = src_lats(i-1)
+              end do
+              src_add (n) = -srch_add
+              src_lats(n) = distance
+              dist_min = src_lats(4)
+              exit sort_loop
+            endif
+          end do sort_loop
+        endif
+      end do
+
+      src_lons = one/(src_lats + tiny)
+      distance = sum(src_lons)
+      src_lats = src_lons/distance
+
+!-----------------------------------------------------------------------
+
+      end subroutine grid_search_bicub 
+
+!***********************************************************************
+
+      subroutine store_link_bicub(dst_add, src_add, weights, nmap)
+
+!-----------------------------------------------------------------------
+!
+!     this routine stores the address and weight for four links 
+!     associated with one destination point in the appropriate address 
+!     and weight arrays and resizes those arrays if necessary.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: &
+              dst_add,   & ! address on destination grid
+              nmap      ! identifies which direction for mapping
+
+      integer (kind=int_kind), dimension(4), intent(in) :: &
+              src_add   ! addresses on source grid
+
+      real (kind=dbl_kind), dimension(4,4), intent(in) :: &
+              weights ! array of remapping weights for these links
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,  & ! dummy index
+             num_links_old          ! placeholder for old link number
+
+!-----------------------------------------------------------------------
+!
+!     increment number of links and check to see if remap arrays need
+!     to be increased to accomodate the new link.  then store the
+!     link.
+!
+!-----------------------------------------------------------------------
+
+      select case (nmap)
+      case(1)
+
+        num_links_old  = num_links_map1
+        num_links_map1 = num_links_old + 4
+
+        if (num_links_map1 > max_links_map1)  &
+           call resize_remap_vars(1,resize_increment)
+
+        do n=1,4
+          grid1_add_map1(num_links_old+n) = src_add(n)
+          grid2_add_map1(num_links_old+n) = dst_add
+          wts_map1    (:,num_links_old+n) = weights(:,n)
+        end do
+
+      case(2)
+
+        num_links_old  = num_links_map2
+        num_links_map2 = num_links_old + 4
+
+        if (num_links_map2 > max_links_map2)  &
+           call resize_remap_vars(2,resize_increment)
+
+        do n=1,4
+          grid1_add_map2(num_links_old+n) = dst_add
+          grid2_add_map2(num_links_old+n) = src_add(n)
+          wts_map2    (:,num_links_old+n) = weights(:,n)
+        end do
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine store_link_bicub
+
+!***********************************************************************
+
+      end module remap_bicubic
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/src/remap_bilinear.f90
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/src/remap_bilinear.f90	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/src/remap_bilinear.f90	(revision 12863)
@@ -0,0 +1,781 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for performing an 
+!     bilinear interpolation.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_bilinear.f,v 1.6 2001/08/22 18:20:40 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_bilinear
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common constants
+      use grids         ! module containing grid info
+      use remap_vars    ! module containing remap info
+
+      implicit none
+
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter :: &
+          max_iter = 100   ! max iteration count for i,j iteration
+
+      real (kind=dbl_kind), parameter :: &
+           converge = 1.e-10_dbl_kind  ! convergence criterion
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap_bilin
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the weights for a bilinear interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,icount, &
+           dst_add,         & ! destination address
+           iter,            & ! iteration counter
+           nmap            ! index of current map being computed
+
+      integer (kind=int_kind), dimension(4) ::  &
+           src_add         ! address for the four source points
+
+      real (kind=dbl_kind), dimension(4)  :: &
+           src_lats,        & ! latitudes  of four bilinear corners
+           src_lons,        & ! longitudes of four bilinear corners
+           wgts            ! bilinear weights for four corners
+
+      real (kind=dbl_kind) :: &
+           plat, plon,        & ! lat/lon coords of destination point
+           iguess, jguess,    & ! current guess for bilinear coordinate
+           thguess, phguess,  & ! current guess for lat/lon coordinate
+           deli, delj,        & ! corrections to i,j
+           dth1, dth2, dth3,  & ! some latitude  differences
+           dph1, dph2, dph3,  & ! some longitude differences
+           dthp, dphp,        & ! difference between point and sw corner
+           mat1, mat2, mat3, mat4,  & ! matrix elements
+           determinant,       & ! matrix determinant
+           sum_wgts          ! sum of weights for normalization
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+
+      nmap = 1
+      if (grid1_rank /= 2) then
+        stop 'Can not do bilinear interpolation when grid_rank /= 2'
+      endif
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop1: do dst_add = 1, grid2_size
+
+        if (.not. grid2_mask(dst_add)) cycle grid_loop1
+
+        plat = grid2_center_lat(dst_add)
+        plon = grid2_center_lon(dst_add)
+
+        !***
+        !*** find nearest square of grid points on source grid
+        !***
+
+        call grid_search_bilin(src_add, src_lats, src_lons,  &
+                               plat, plon, grid1_dims, &
+                               grid1_center_lat, grid1_center_lon, &
+                               grid1_bound_box, bin_addr1, bin_addr2)
+
+        !***
+        !*** check to see if points are land points
+        !***
+
+        if (src_add(1) > 0) then
+          do n=1,4
+            if (.not. grid1_mask(src_add(n))) src_add(1) = 0
+          end do
+        endif
+
+        !***
+        !*** if point found, find local i,j coordinates for weights
+        !***
+
+        if (src_add(1) > 0) then
+
+          grid2_frac(dst_add) = one
+
+          !***
+          !*** iterate to find i,j for bilinear approximation
+          !***
+
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          if (dph1 >  three*pih) dph1 = dph1 - pi2
+          if (dph2 >  three*pih) dph2 = dph2 - pi2
+          if (dph3 >  three*pih) dph3 = dph3 - pi2
+          if (dph1 < -three*pih) dph1 = dph1 + pi2
+          if (dph2 < -three*pih) dph2 = dph2 + pi2
+          if (dph3 < -three*pih) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+
+          iguess = half
+          jguess = half
+
+          iter_loop1: do iter=1,max_iter
+
+            dthp = plat - src_lats(1) - dth1*iguess - &
+                          dth2*jguess - dth3*iguess*jguess
+            dphp = plon - src_lons(1)
+
+            if (dphp >  three*pih) dphp = dphp - pi2
+            if (dphp < -three*pih) dphp = dphp + pi2
+
+            dphp = dphp - dph1*iguess - dph2*jguess -  &
+                          dph3*iguess*jguess
+
+            mat1 = dth1 + dth3*jguess
+            mat2 = dth2 + dth3*iguess
+            mat3 = dph1 + dph3*jguess
+            mat4 = dph2 + dph3*iguess
+
+            determinant = mat1*mat4 - mat2*mat3
+
+            deli = (dthp*mat4 - mat2*dphp)/determinant
+            delj = (mat1*dphp - dthp*mat3)/determinant
+
+            if (abs(deli) < converge .and.  &
+                abs(delj) < converge) exit iter_loop1
+
+            iguess = iguess + deli
+            jguess = jguess + delj
+
+          end do iter_loop1
+
+          if (iter <= max_iter) then
+
+            !***
+            !*** successfully found i,j - compute weights
+            !***
+
+            wgts(1) = (one-iguess)*(one-jguess)
+            wgts(2) = iguess*(one-jguess)
+            wgts(3) = iguess*jguess
+            wgts(4) = (one-iguess)*jguess
+
+            call store_link_bilin(dst_add, src_add, wgts, nmap)
+
+          else
+            print *,'Point coords: ',plat,plon
+            print *,'Dest grid lats: ',src_lats
+            print *,'Dest grid lons: ',src_lons
+            print *,'Dest grid addresses: ',src_add
+            print *,'Current i,j : ',iguess, jguess
+            stop 'Iteration for i,j exceed max iteration count'
+          endif
+
+        !***
+        !*** search for bilinear failed - use a distance-weighted
+        !*** average instead (this is typically near the pole)
+        !***
+
+        else if (src_add(1) < 0) then
+
+          src_add = abs(src_add)
+          icount = 0
+          do n=1,4
+            if (grid1_mask(src_add(n))) then
+              icount = icount + 1
+            else
+              src_lats(n) = zero
+            endif
+          end do
+
+          if (icount > 0) then
+            !*** renormalize weights
+
+            sum_wgts = sum(src_lats)
+            wgts(1) = src_lats(1)/sum_wgts
+            wgts(2) = src_lats(2)/sum_wgts
+            wgts(3) = src_lats(3)/sum_wgts
+            wgts(4) = src_lats(4)/sum_wgts
+
+            grid2_frac(dst_add) = one
+            call store_link_bilin(dst_add, src_add, wgts, nmap)
+          endif
+
+        endif
+      end do grid_loop1
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid2 to grid1 if necessary
+!
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+
+      nmap = 2
+      if (grid2_rank /= 2) then
+        stop 'Can not do bilinear interpolation when grid_rank /= 2'
+      endif
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop2: do dst_add = 1, grid1_size
+
+        if (.not. grid1_mask(dst_add)) cycle grid_loop2
+
+        plat = grid1_center_lat(dst_add)
+        plon = grid1_center_lon(dst_add)
+
+        !***
+        !*** find nearest square of grid points on source grid
+        !***
+
+        call grid_search_bilin(src_add, src_lats, src_lons,  &
+                               plat, plon, grid2_dims, &
+                               grid2_center_lat, grid2_center_lon, &
+                               grid2_bound_box, bin_addr2, bin_addr1)
+
+        !***
+        !*** check to see if points are land points
+        !***
+
+        if (src_add(1) > 0) then
+          do n=1,4
+            if (.not. grid2_mask(src_add(n))) src_add(1) = 0
+          end do
+        endif
+
+        !***
+        !*** if point found, find i,j coordinates for weights
+        !***
+
+        if (src_add(1) > 0) then
+
+          grid1_frac(dst_add) = one
+
+          !***
+          !*** iterate to find i,j for bilinear approximation
+          !***
+
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          if (dph1 >  pi) dph1 = dph1 - pi2
+          if (dph2 >  pi) dph2 = dph2 - pi2
+          if (dph3 >  pi) dph3 = dph3 - pi2
+          if (dph1 < -pi) dph1 = dph1 + pi2
+          if (dph2 < -pi) dph2 = dph2 + pi2
+          if (dph3 < -pi) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+
+          iguess = zero
+          jguess = zero
+
+          iter_loop2: do iter=1,max_iter
+
+            dthp = plat - src_lats(1) - dth1*iguess - &
+                          dth2*jguess - dth3*iguess*jguess
+            dphp = plon - src_lons(1)
+
+            if (dphp >  pi) dphp = dphp - pi2
+            if (dphp < -pi) dphp = dphp + pi2
+
+            dphp = dphp - dph1*iguess - dph2*jguess -  &
+                          dph3*iguess*jguess
+
+            mat1 = dth1 + dth3*jguess
+            mat2 = dth2 + dth3*iguess
+            mat3 = dph1 + dph3*jguess
+            mat4 = dph2 + dph3*iguess
+
+            determinant = mat1*mat4 - mat2*mat3
+
+            deli = (dthp*mat4 - mat2*dphp)/determinant
+            delj = (mat1*dphp - dthp*mat3)/determinant
+
+            if (abs(deli) < converge .and.  &
+                abs(delj) < converge) exit iter_loop2
+
+            iguess = iguess + deli
+            jguess = jguess + delj
+
+          end do iter_loop2
+
+          if (iter <= max_iter) then
+
+            !***
+            !*** successfully found i,j - compute weights
+            !***
+
+            wgts(1) = (one-iguess)*(one-jguess)
+            wgts(2) = iguess*(one-jguess)
+            wgts(3) = iguess*jguess
+            wgts(4) = (one-iguess)*jguess
+
+            call store_link_bilin(dst_add, src_add, wgts, nmap)
+
+          else
+            print *,'Point coords: ',plat,plon
+            print *,'Dest grid lats: ',src_lats
+            print *,'Dest grid lons: ',src_lons
+            print *,'Dest grid addresses: ',src_add
+            print *,'Current i,j : ',iguess, jguess
+            stop 'Iteration for i,j exceed max iteration count'
+          endif
+
+        !***
+        !*** search for bilinear failed - us a distance-weighted
+        !*** average instead
+        !***
+
+        else if (src_add(1) < 0) then
+
+          src_add = abs(src_add)
+          icount = 0
+          do n=1,4
+            if (grid2_mask(src_add(n))) then
+              icount = icount + 1
+            else
+              src_lats(n) = zero
+            endif
+          end do
+
+          if (icount > 0) then
+            !*** renormalize weights
+
+            sum_wgts = sum(src_lats)
+            wgts(1) = src_lats(1)/sum_wgts
+            wgts(2) = src_lats(2)/sum_wgts
+            wgts(3) = src_lats(3)/sum_wgts
+            wgts(4) = src_lats(4)/sum_wgts
+
+            grid1_frac(dst_add) = one
+            call store_link_bilin(dst_add, src_add, wgts, nmap)
+          endif
+
+        endif
+      end do grid_loop2
+
+      endif ! nmap=2
+
+!-----------------------------------------------------------------------
+
+      end subroutine remap_bilin
+
+!***********************************************************************
+
+      subroutine grid_search_bilin(src_add, src_lats, src_lons,  &
+                                   plat, plon, src_grid_dims, &
+                                   src_center_lat, src_center_lon, &
+                                   src_grid_bound_box, &
+                                   src_bin_add, dst_bin_add)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the location of the search point plat, plon
+!     in the source grid and returns the corners needed for a bilinear
+!     interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(4), intent(out) :: &
+              src_add  ! address of each corner point enclosing P
+
+      real (kind=dbl_kind), dimension(4), intent(out) :: &
+              src_lats,  & ! latitudes  of the four corner points
+              src_lons  ! longitudes of the four corner points
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), intent(in) :: &
+              plat,    & ! latitude  of the search point
+              plon    ! longitude of the search point
+
+      integer (kind=int_kind), dimension(2), intent(in) :: &
+              src_grid_dims  ! size of each src grid dimension
+
+      real (kind=dbl_kind), dimension(:), intent(in) :: &
+              src_center_lat,  & ! latitude  of each src grid center 
+              src_center_lon  ! longitude of each src grid center
+
+      real (kind=dbl_kind), dimension(:,:), intent(in) :: &
+              src_grid_bound_box ! bound box for source grid
+
+      integer (kind=int_kind), dimension(:,:), intent(in) :: &
+              src_bin_add,     & ! latitude bins for restricting
+              dst_bin_add     ! searches
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, srch_add,    & ! dummy indices
+          nx, ny,             & ! dimensions of src grid
+          min_add, max_add,   & ! addresses for restricting search
+          i, j, jp1, ip1, n_add, e_add, ne_add  ! addresses
+
+      real (kind=dbl_kind) ::   & ! vectors for cross-product check
+            vec1_lat, vec1_lon, &
+            vec2_lat, vec2_lon, cross_product, cross_product_last, &
+            coslat_dst, sinlat_dst, coslon_dst, sinlon_dst, &
+            dist_min, distance ! for computing dist-weighted avg
+
+!-----------------------------------------------------------------------
+!
+!     restrict search first using bins
+!
+!-----------------------------------------------------------------------
+
+      src_add = 0
+
+      min_add = size(src_center_lat)
+      max_add = 1
+      do n=1,num_srch_bins
+        if (plat >= bin_lats(1,n) .and. plat <= bin_lats(2,n) .and. &
+            plon >= bin_lons(1,n) .and. plon <= bin_lons(2,n)) then
+          min_add = min(min_add, src_bin_add(1,n))
+          max_add = max(max_add, src_bin_add(2,n))
+        endif
+      end do
+ 
+!-----------------------------------------------------------------------
+!
+!     now perform a more detailed search 
+!
+!-----------------------------------------------------------------------
+
+      nx = src_grid_dims(1)
+      ny = src_grid_dims(2)
+
+      srch_loop: do srch_add = min_add,max_add
+
+        !*** first check bounding box
+
+        if (plat <= src_grid_bound_box(2,srch_add) .and.  &
+            plat >= src_grid_bound_box(1,srch_add) .and. &
+            plon <= src_grid_bound_box(4,srch_add) .and.  &
+            plon >= src_grid_bound_box(3,srch_add)) then
+
+          !***
+          !*** we are within bounding box so get really serious
+          !***
+
+          !*** determine neighbor addresses
+
+          j = (srch_add - 1)/nx +1
+          i = srch_add - (j-1)*nx
+
+          if (i < nx) then
+            ip1 = i + 1
+          else
+            ip1 = 1
+          endif
+
+          if (j < ny) then
+            jp1 = j+1
+          else
+            jp1 = 1
+          endif
+
+          n_add = (jp1 - 1)*nx + i
+          e_add = (j - 1)*nx + ip1
+          ne_add = (jp1 - 1)*nx + ip1
+
+          src_lats(1) = src_center_lat(srch_add)
+          src_lats(2) = src_center_lat(e_add)
+          src_lats(3) = src_center_lat(ne_add)
+          src_lats(4) = src_center_lat(n_add)
+
+          src_lons(1) = src_center_lon(srch_add)
+          src_lons(2) = src_center_lon(e_add)
+          src_lons(3) = src_center_lon(ne_add)
+          src_lons(4) = src_center_lon(n_add)
+
+          !***
+          !*** for consistency, we must make sure all lons are in
+          !*** same 2pi interval
+          !***
+
+          vec1_lon = src_lons(1) - plon
+          if (vec1_lon >  pi) then
+            src_lons(1) = src_lons(1) - pi2
+          else if (vec1_lon < -pi) then
+            src_lons(1) = src_lons(1) + pi2
+          endif
+          do n=2,4
+            vec1_lon = src_lons(n) - src_lons(1)
+            if (vec1_lon >  pi) then
+              src_lons(n) = src_lons(n) - pi2
+            else if (vec1_lon < -pi) then
+              src_lons(n) = src_lons(n) + pi2
+            endif
+          end do
+
+          corner_loop: do n=1,4
+            next_n = MOD(n,4) + 1
+
+            !***
+            !*** here we take the cross product of the vector making 
+            !*** up each box side with the vector formed by the vertex
+            !*** and search point.  if all the cross products are 
+            !*** positive, the point is contained in the box.
+            !***
+
+            vec1_lat = src_lats(next_n) - src_lats(n)
+            vec1_lon = src_lons(next_n) - src_lons(n)
+            vec2_lat = plat - src_lats(n)
+            vec2_lon = plon - src_lons(n)
+
+            !***
+            !*** check for 0,2pi crossings
+            !***
+
+            if (vec1_lon >  three*pih) then
+              vec1_lon = vec1_lon - pi2
+            else if (vec1_lon < -three*pih) then
+              vec1_lon = vec1_lon + pi2
+            endif
+            if (vec2_lon >  three*pih) then
+              vec2_lon = vec2_lon - pi2
+            else if (vec2_lon < -three*pih) then
+              vec2_lon = vec2_lon + pi2
+            endif
+
+            cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+
+            !***
+            !*** if cross product is less than zero, this cell
+            !*** doesn't work
+            !***
+
+            if (n == 1) cross_product_last = cross_product
+            if (cross_product*cross_product_last < zero)  &
+                exit corner_loop
+            cross_product_last = cross_product
+
+          end do corner_loop
+
+          !***
+          !*** if cross products all same sign, we found the location
+          !***
+
+          if (n > 4) then
+            src_add(1) = srch_add
+            src_add(2) = e_add
+            src_add(3) = ne_add
+            src_add(4) = n_add
+
+            return
+          endif
+
+          !***
+          !*** otherwise move on to next cell
+          !***
+
+        endif !bounding box check
+      end do srch_loop
+
+      !***
+      !*** if no cell found, point is likely either in a box that
+      !*** straddles either pole or is outside the grid.  fall back
+      !*** to a distance-weighted average of the four closest
+      !*** points.  go ahead and compute weights here, but store
+      !*** in src_lats and return -add to prevent the parent
+      !*** routine from computing bilinear weights
+      !***
+
+      !print *,'Could not find location for ',plat,plon
+      !print *,'Using nearest-neighbor average for this point'
+
+      coslat_dst = cos(plat)
+      sinlat_dst = sin(plat)
+      coslon_dst = cos(plon)
+      sinlon_dst = sin(plon)
+
+      dist_min = bignum
+      src_lats = bignum
+      do srch_add = min_add,max_add
+        distance = acos(coslat_dst*cos(src_center_lat(srch_add))* &
+                       (coslon_dst*cos(src_center_lon(srch_add)) + &
+                        sinlon_dst*sin(src_center_lon(srch_add)))+ &
+                        sinlat_dst*sin(src_center_lat(srch_add)))
+
+        if (distance < dist_min) then
+          sort_loop: do n=1,4
+            if (distance < src_lats(n)) then
+              do i=4,n+1,-1
+                src_add (i) = src_add (i-1)
+                src_lats(i) = src_lats(i-1)
+              end do
+              src_add (n) = -srch_add
+              src_lats(n) = distance
+              dist_min = src_lats(4)
+              exit sort_loop
+            endif
+          end do sort_loop
+        endif
+      end do
+
+      src_lons = one/(src_lats + tiny)
+      distance = sum(src_lons)
+      src_lats = src_lons/distance
+
+!-----------------------------------------------------------------------
+
+      end subroutine grid_search_bilin 
+
+!***********************************************************************
+
+      subroutine store_link_bilin(dst_add, src_add, weights, nmap)
+
+!-----------------------------------------------------------------------
+!
+!     this routine stores the address and weight for four links 
+!     associated with one destination point in the appropriate address 
+!     and weight arrays and resizes those arrays if necessary.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: &
+              dst_add,   & ! address on destination grid
+              nmap      ! identifies which direction for mapping
+
+      integer (kind=int_kind), dimension(4), intent(in) :: &
+              src_add   ! addresses on source grid
+
+      real (kind=dbl_kind), dimension(4), intent(in) :: &
+              weights ! array of remapping weights for these links
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,  & ! dummy index
+             num_links_old          ! placeholder for old link number
+
+!-----------------------------------------------------------------------
+!
+!     increment number of links and check to see if remap arrays need
+!     to be increased to accomodate the new link.  then store the
+!     link.
+!
+!-----------------------------------------------------------------------
+
+      select case (nmap)
+      case(1)
+
+        num_links_old  = num_links_map1
+        num_links_map1 = num_links_old + 4
+
+        if (num_links_map1 > max_links_map1)  &
+           call resize_remap_vars(1,resize_increment)
+
+        do n=1,4
+          grid1_add_map1(num_links_old+n) = src_add(n)
+          grid2_add_map1(num_links_old+n) = dst_add
+          wts_map1    (1,num_links_old+n) = weights(n)
+        end do
+
+      case(2)
+
+        num_links_old  = num_links_map2
+        num_links_map2 = num_links_old + 4
+
+        if (num_links_map2 > max_links_map2)  &
+           call resize_remap_vars(2,resize_increment)
+
+        do n=1,4
+          grid1_add_map2(num_links_old+n) = dst_add
+          grid2_add_map2(num_links_old+n) = src_add(n)
+          wts_map2    (1,num_links_old+n) = weights(n)
+        end do
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine store_link_bilin
+
+!***********************************************************************
+
+      end module remap_bilinear
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/src/remap_conserv.f90
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/src/remap_conserv.f90	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/src/remap_conserv.f90	(revision 12863)
@@ -0,0 +1,2197 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for computing addresses
+!     and weights for a conservative interpolation  between any two 
+!     grids on a sphere.  the weights are computed by performing line 
+!     integrals around all overlap regions of the two grids.  see 
+!     Dukowicz and Kodis, SIAM J. Sci. Stat. Comput. 8, 305 (1987) and
+!     Jones, P.W. Monthly Weather Review (submitted).
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_conserv.f,v 1.10 2001/08/21 21:05:13 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_conservative
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod    ! defines common data types
+      use constants    ! defines common constants
+      use timers       ! module for timing
+      use grids        ! module containing grid information
+      use remap_vars   ! module containing remap information
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), save ::  &
+              num_srch_cells ! num cells in restricted search arrays
+
+      integer (kind=int_kind), dimension(:), allocatable, save ::  &
+              srch_add       ! global address of cells in srch arrays
+
+      real (kind=dbl_kind), parameter ::  &
+           north_thresh = 1.45_dbl_kind,  & ! threshold for coord transf.
+           south_thresh =-2.00_dbl_kind  ! threshold for coord transf.
+
+      real (kind=dbl_kind), dimension(:,:), allocatable, save :: &
+           srch_corner_lat,   & ! lat of each corner of srch cells
+           srch_corner_lon   ! lon of each corner of srch cells
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap_conserv
+
+!-----------------------------------------------------------------------
+!
+!     this routine traces the perimeters of every grid cell on each
+!     grid checking for intersections with the other grid and computing
+!     line integrals for each subsegment.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter ::  &
+              max_subseg = 10000 ! max number of subsegments per segment
+                                 ! to prevent infinite loop
+
+      integer (kind=int_kind) ::  &
+              grid1_add,   & ! current linear address for grid1 cell
+              grid2_add,   & ! current linear address for grid2 cell
+              min_add,     & ! addresses for restricting search of
+              max_add,     & !   destination grid
+              n, nwgt,     & ! generic counters
+              corner,      & ! corner of cell that segment starts from
+              next_corn,   & ! corner of cell that segment ends on
+              num_subseg  ! number of subsegments 
+
+      logical (kind=log_kind) ::  &
+              lcoinc,   & ! flag for coincident segments
+              lrevers,  & ! flag for reversing direction of segment
+              lbegin   ! flag for first integration of a segment
+
+      logical (kind=log_kind), dimension(:), allocatable :: &
+              srch_mask   ! mask for restricting searches
+
+      real (kind=dbl_kind) :: &
+           intrsct_lat, intrsct_lon,        & ! lat/lon of next intersect
+           beglat, endlat, beglon, endlon,  & ! endpoints of current seg.
+           norm_factor                     ! factor for normalizing wts
+
+      real (kind=dbl_kind), dimension(:), allocatable :: &
+             grid2_centroid_lat, grid2_centroid_lon,  & ! centroid coords
+             grid1_centroid_lat, grid1_centroid_lon  ! on each grid
+
+      real (kind=dbl_kind), dimension(2) :: begseg ! begin lat/lon for
+                                                   ! full segment
+
+      real (kind=dbl_kind), dimension(6) :: weights ! local wgt array
+
+!-----------------------------------------------------------------------
+!
+!     initialize centroid arrays
+!
+!-----------------------------------------------------------------------
+
+      allocate( grid1_centroid_lat(grid1_size), &
+                grid1_centroid_lon(grid1_size), &
+                grid2_centroid_lat(grid2_size), &
+                grid2_centroid_lon(grid2_size))
+
+      grid1_centroid_lat = zero
+      grid1_centroid_lon = zero
+      grid2_centroid_lat = zero
+      grid2_centroid_lon = zero
+
+!-----------------------------------------------------------------------
+!
+!     integrate around each cell on grid1
+!
+!-----------------------------------------------------------------------
+
+      allocate(srch_mask(grid2_size))
+
+      print *,'grid1 sweep '
+      do grid1_add = 1,grid1_size
+
+        !***
+        !*** restrict searches first using search bins
+        !***
+
+        call timer_start(1)
+        min_add = grid2_size
+        max_add = 1
+        do n=1,num_srch_bins
+          if (grid1_add >= bin_addr1(1,n) .and. &
+              grid1_add <= bin_addr1(2,n)) then
+            min_add = min(min_add, bin_addr2(1,n))
+            max_add = max(max_add, bin_addr2(2,n))
+          endif
+        end do
+
+        !***
+        !*** further restrict searches using bounding boxes
+        !***
+
+        num_srch_cells = 0
+        do grid2_add = min_add,max_add
+          srch_mask(grid2_add) = (grid2_bound_box(1,grid2_add) <=  &
+                                  grid1_bound_box(2,grid1_add)) .and. &
+                                 (grid2_bound_box(2,grid2_add) >=  &
+                                  grid1_bound_box(1,grid1_add)) .and. &
+                                 (grid2_bound_box(3,grid2_add) <=  &
+                                  grid1_bound_box(4,grid1_add)) .and. &
+                                 (grid2_bound_box(4,grid2_add) >=  &
+                                  grid1_bound_box(3,grid1_add))
+
+          if (srch_mask(grid2_add)) num_srch_cells = num_srch_cells+1
+        end do
+
+        !***
+        !*** create search arrays
+        !***
+
+        allocate(srch_add(num_srch_cells), &
+                 srch_corner_lat(grid2_corners,num_srch_cells), &
+                 srch_corner_lon(grid2_corners,num_srch_cells))
+
+        n = 0
+        gather1: do grid2_add = min_add,max_add
+          if (srch_mask(grid2_add)) then
+            n = n+1
+            srch_add(n) = grid2_add
+            srch_corner_lat(:,n) = grid2_corner_lat(:,grid2_add)
+            srch_corner_lon(:,n) = grid2_corner_lon(:,grid2_add)
+          endif
+        end do gather1
+        call timer_stop(1)
+
+        !***
+        !*** integrate around this cell
+        !***
+
+        do corner = 1,grid1_corners
+          next_corn = mod(corner,grid1_corners) + 1
+
+          !***
+          !*** define endpoints of the current segment
+          !***
+
+          beglat = grid1_corner_lat(corner,grid1_add)
+          beglon = grid1_corner_lon(corner,grid1_add)
+          endlat = grid1_corner_lat(next_corn,grid1_add)
+          endlon = grid1_corner_lon(next_corn,grid1_add)
+          lrevers = .false.
+
+          !***
+          !*** to ensure exact path taken during both
+          !*** sweeps, always integrate segments in the same 
+          !*** direction (SW to NE).
+          !***
+
+          if ((endlat < beglat) .or. &
+              (endlat == beglat .and. endlon < beglon)) then 
+            beglat = grid1_corner_lat(next_corn,grid1_add)
+            beglon = grid1_corner_lon(next_corn,grid1_add)
+            endlat = grid1_corner_lat(corner,grid1_add)
+            endlon = grid1_corner_lon(corner,grid1_add)
+            lrevers = .true.
+          endif
+
+          begseg(1) = beglat
+          begseg(2) = beglon
+          lbegin = .true.
+          num_subseg = 0
+
+          !***
+          !*** if this is a constant-longitude segment, skip the rest 
+          !*** since the line integral contribution will be zero.
+          !***
+
+          if (endlon /= beglon) then
+
+          !***
+          !*** integrate along this segment, detecting intersections 
+          !*** and computing the line integral for each sub-segment
+          !***
+
+          do while (beglat /= endlat .or. beglon /= endlon)
+
+            !***
+            !*** prevent infinite loops if integration gets stuck
+            !*** near cell or threshold boundary
+            !***
+
+            num_subseg = num_subseg + 1
+            if (num_subseg > max_subseg) then
+              stop 'integration stalled: num_subseg exceeded limit'
+            endif
+
+            !***
+            !*** find next intersection of this segment with a grid
+            !*** line on grid 2.
+            !***
+
+            call timer_start(2)
+            call intersection(grid2_add,intrsct_lat,intrsct_lon,lcoinc, &
+                              beglat, beglon, endlat, endlon, begseg,  &
+                              lbegin, lrevers)
+            call timer_stop(2)
+            lbegin = .false.
+
+            !***
+            !*** compute line integral for this subsegment.
+            !***
+
+            call timer_start(3)
+            if (grid2_add /= 0) then
+              call line_integral(weights, num_wts, &
+                               beglon, intrsct_lon, beglat, intrsct_lat, &
+                               grid1_center_lat(grid1_add),  &
+                               grid1_center_lon(grid1_add), &
+                               grid2_center_lat(grid2_add),  &
+                               grid2_center_lon(grid2_add))
+            else
+              call line_integral(weights, num_wts, &
+                               beglon, intrsct_lon, beglat, intrsct_lat, &
+                               grid1_center_lat(grid1_add),  &
+                               grid1_center_lon(grid1_add), &
+                               grid1_center_lat(grid1_add),  &
+                               grid1_center_lon(grid1_add))
+            endif
+            call timer_stop(3)
+
+            !***
+            !*** if integrating in reverse order, change
+            !*** sign of weights
+            !***
+
+            if (lrevers) then
+              weights = -weights
+            endif
+
+            !***
+            !*** store the appropriate addresses and weights. 
+            !*** also add contributions to cell areas and centroids.
+            !***
+
+            !if (grid1_add == 119247) then
+            !  print *,grid1_add,grid2_add,corner,weights(1)
+            !  print *,grid1_corner_lat(:,grid1_add)
+            !  print *,grid1_corner_lon(:,grid1_add)
+            !  print *,grid2_corner_lat(:,grid2_add)
+            !  print *,grid2_corner_lon(:,grid2_add)
+            !  print *,beglat,beglon,intrsct_lat,intrsct_lon
+            !endif
+
+            if (grid2_add /= 0) then
+              if (grid1_mask(grid1_add)) then
+                call timer_start(4)
+                call store_link_cnsrv(grid1_add, grid2_add, weights)
+                call timer_stop(4)
+                grid1_frac(grid1_add) = grid1_frac(grid1_add) +  &
+                                        weights(1)
+                grid2_frac(grid2_add) = grid2_frac(grid2_add) +  &
+                                        weights(num_wts+1)
+              endif
+
+            endif
+
+            grid1_area(grid1_add) = grid1_area(grid1_add) + weights(1)
+            grid1_centroid_lat(grid1_add) =  &
+            grid1_centroid_lat(grid1_add) + weights(2)
+            grid1_centroid_lon(grid1_add) =  &
+            grid1_centroid_lon(grid1_add) + weights(3)
+
+            !***
+            !*** reset beglat and beglon for next subsegment.
+            !***
+
+            beglat = intrsct_lat
+            beglon = intrsct_lon
+          end do
+
+          endif
+
+          !***
+          !*** end of segment
+          !***
+
+        end do
+
+        !***
+        !*** finished with this cell: deallocate search array and
+        !*** start on next cell
+
+        deallocate(srch_add, srch_corner_lat, srch_corner_lon)
+
+      end do
+
+      deallocate(srch_mask)
+
+!-----------------------------------------------------------------------
+!
+!     integrate around each cell on grid2
+!
+!-----------------------------------------------------------------------
+
+      allocate(srch_mask(grid1_size))
+
+      print *,'grid2 sweep '
+      do grid2_add = 1,grid2_size
+
+        !***
+        !*** restrict searches first using search bins
+        !***
+
+        call timer_start(5)
+        min_add = grid1_size
+        max_add = 1
+        do n=1,num_srch_bins
+          if (grid2_add >= bin_addr2(1,n) .and. &
+              grid2_add <= bin_addr2(2,n)) then
+            min_add = min(min_add, bin_addr1(1,n))
+            max_add = max(max_add, bin_addr1(2,n))
+          endif
+        end do
+
+        !***
+        !*** further restrict searches using bounding boxes
+        !***
+
+        num_srch_cells = 0
+        do grid1_add = min_add, max_add
+          srch_mask(grid1_add) = (grid1_bound_box(1,grid1_add) <=  &
+                                  grid2_bound_box(2,grid2_add)) .and. &
+                                 (grid1_bound_box(2,grid1_add) >=  &
+                                  grid2_bound_box(1,grid2_add)) .and. &
+                                 (grid1_bound_box(3,grid1_add) <=  &
+                                  grid2_bound_box(4,grid2_add)) .and. &
+                                 (grid1_bound_box(4,grid1_add) >=  &
+                                  grid2_bound_box(3,grid2_add))
+
+          if (srch_mask(grid1_add)) num_srch_cells = num_srch_cells+1
+        end do
+
+        allocate(srch_add(num_srch_cells), &
+                 srch_corner_lat(grid1_corners,num_srch_cells), &
+                 srch_corner_lon(grid1_corners,num_srch_cells))
+
+        n = 0
+        gather2: do grid1_add = min_add,max_add
+          if (srch_mask(grid1_add)) then
+            n = n+1
+            srch_add(n) = grid1_add
+            srch_corner_lat(:,n) = grid1_corner_lat(:,grid1_add)
+            srch_corner_lon(:,n) = grid1_corner_lon(:,grid1_add)
+          endif
+        end do gather2
+        call timer_stop(5)
+
+        !***
+        !*** integrate around this cell
+        !***
+
+        do corner = 1,grid2_corners
+          next_corn = mod(corner,grid2_corners) + 1
+
+          beglat = grid2_corner_lat(corner,grid2_add)
+          beglon = grid2_corner_lon(corner,grid2_add)
+          endlat = grid2_corner_lat(next_corn,grid2_add)
+          endlon = grid2_corner_lon(next_corn,grid2_add)
+          lrevers = .false.
+
+          !***
+          !*** to ensure exact path taken during both
+          !*** sweeps, always integrate in the same direction
+          !***
+
+          if ((endlat < beglat) .or. &
+              (endlat == beglat .and. endlon < beglon)) then 
+            beglat = grid2_corner_lat(next_corn,grid2_add)
+            beglon = grid2_corner_lon(next_corn,grid2_add)
+            endlat = grid2_corner_lat(corner,grid2_add)
+            endlon = grid2_corner_lon(corner,grid2_add)
+            lrevers = .true.
+          endif
+
+          begseg(1) = beglat
+          begseg(2) = beglon
+          lbegin = .true.
+
+          !***
+          !*** if this is a constant-longitude segment, skip the rest 
+          !*** since the line integral contribution will be zero.
+          !***
+
+          if (endlon /= beglon) then
+          num_subseg = 0
+
+          !***
+          !*** integrate along this segment, detecting intersections 
+          !*** and computing the line integral for each sub-segment
+          !***
+
+          do while (beglat /= endlat .or. beglon /= endlon)
+
+            !***
+            !*** prevent infinite loops if integration gets stuck
+            !*** near cell or threshold boundary
+            !***
+
+            num_subseg = num_subseg + 1
+            if (num_subseg > max_subseg) then
+              stop 'integration stalled: num_subseg exceeded limit'
+            endif
+
+            !***
+            !*** find next intersection of this segment with a line 
+            !*** on grid 2.
+            !***
+
+            call timer_start(6)
+            call intersection(grid1_add,intrsct_lat,intrsct_lon,lcoinc, &
+                              beglat, beglon, endlat, endlon, begseg, &
+                              lbegin, lrevers)
+            call timer_stop(6)
+            lbegin = .false.
+
+            !***
+            !*** compute line integral for this subsegment.
+            !***
+
+            call timer_start(7)
+            if (grid1_add /= 0) then
+              call line_integral(weights, num_wts, &
+                               beglon, intrsct_lon, beglat, intrsct_lat, &
+                               grid1_center_lat(grid1_add),  &
+                               grid1_center_lon(grid1_add), &
+                               grid2_center_lat(grid2_add),  &
+                               grid2_center_lon(grid2_add))
+            else
+              call line_integral(weights, num_wts, &
+                               beglon, intrsct_lon, beglat, intrsct_lat, &
+                               grid2_center_lat(grid2_add),  &
+                               grid2_center_lon(grid2_add), &
+                               grid2_center_lat(grid2_add),  &
+                               grid2_center_lon(grid2_add))
+            endif
+            call timer_stop(7)
+
+            if (lrevers) then
+              weights = -weights
+            endif
+
+            !***
+            !*** store the appropriate addresses and weights. 
+            !*** also add contributions to cell areas and centroids.
+            !*** if there is a coincidence, do not store weights
+            !*** because they have been captured in the previous loop.
+            !*** the grid1 mask is the master mask
+            !***
+
+            !if (grid1_add == 119247) then
+            !  print *,grid1_add,grid2_add,corner,weights(1)
+            !  print *,grid1_corner_lat(:,grid1_add)
+            !  print *,grid1_corner_lon(:,grid1_add)
+            !  print *,grid2_corner_lat(:,grid2_add)
+            !  print *,grid2_corner_lon(:,grid2_add)
+            !  print *,beglat,beglon,intrsct_lat,intrsct_lon
+            !endif
+
+            if (.not. lcoinc .and. grid1_add /= 0) then
+              if (grid1_mask(grid1_add)) then
+                call timer_start(8)
+                call store_link_cnsrv(grid1_add, grid2_add, weights)
+                call timer_stop(8)
+                grid1_frac(grid1_add) = grid1_frac(grid1_add) +  &
+                                        weights(1)
+                grid2_frac(grid2_add) = grid2_frac(grid2_add) +  &
+                                        weights(num_wts+1)
+              endif
+
+            endif
+
+            grid2_area(grid2_add) = grid2_area(grid2_add) +  &
+                                            weights(num_wts+1)
+            grid2_centroid_lat(grid2_add) =  &
+            grid2_centroid_lat(grid2_add) + weights(num_wts+2)
+            grid2_centroid_lon(grid2_add) =  &
+            grid2_centroid_lon(grid2_add) + weights(num_wts+3)
+
+            !***
+            !*** reset beglat and beglon for next subsegment.
+            !***
+
+            beglat = intrsct_lat
+            beglon = intrsct_lon
+          end do
+
+          endif
+
+          !***
+          !*** end of segment
+          !***
+
+        end do
+
+        !***
+        !*** finished with this cell: deallocate search array and
+        !*** start on next cell
+
+        deallocate(srch_add, srch_corner_lat, srch_corner_lon)
+
+      end do
+
+      deallocate(srch_mask)
+
+!-----------------------------------------------------------------------
+!
+!     correct for situations where N/S pole not explicitly included in
+!     grid (i.e. as a grid corner point). if pole is missing from only
+!     one grid, need to correct only the area and centroid of that 
+!     grid.  if missing from both, do complete weight calculation.
+!
+!-----------------------------------------------------------------------
+
+      !*** North Pole
+      weights(1) =  pi2
+      weights(2) =  pi*pi
+      weights(3) =  zero
+      weights(4) =  pi2
+      weights(5) =  pi*pi
+      weights(6) =  zero
+
+      grid1_add = 0
+      pole_loop1: do n=1,grid1_size
+        if (grid1_area(n) < -three*pih .and. &
+            grid1_center_lat(n) > zero) then
+          grid1_add = n
+          exit pole_loop1
+        endif
+      end do pole_loop1
+
+      grid2_add = 0
+      pole_loop2: do n=1,grid2_size
+        if (grid2_area(n) < -three*pih .and. &
+            grid2_center_lat(n) > zero) then
+          grid2_add = n
+          exit pole_loop2
+        endif
+      end do pole_loop2
+
+      if (grid1_add /=0) then
+        grid1_area(grid1_add) = grid1_area(grid1_add) + weights(1)
+        grid1_centroid_lat(grid1_add) =  &
+        grid1_centroid_lat(grid1_add) + weights(2)
+        grid1_centroid_lon(grid1_add) = &
+        grid1_centroid_lon(grid1_add) + weights(3)
+      endif
+
+      if (grid2_add /=0) then
+        grid2_area(grid2_add) = grid2_area(grid2_add) +  &
+                                        weights(num_wts+1)
+        grid2_centroid_lat(grid2_add) =  &
+        grid2_centroid_lat(grid2_add) + weights(num_wts+2)
+        grid2_centroid_lon(grid2_add) = &
+        grid2_centroid_lon(grid2_add) + weights(num_wts+3)
+      endif
+
+      if (grid1_add /= 0 .and. grid2_add /=0) then
+        call store_link_cnsrv(grid1_add, grid2_add, weights)
+
+        grid1_frac(grid1_add) = grid1_frac(grid1_add) +  &
+                                weights(1)
+        grid2_frac(grid2_add) = grid2_frac(grid2_add) +  &
+                                weights(num_wts+1)
+      endif
+
+      !*** South Pole
+      weights(1) =  pi2
+      weights(2) = -pi*pi
+      weights(3) =  zero
+      weights(4) =  pi2
+      weights(5) = -pi*pi
+      weights(6) =  zero
+
+      grid1_add = 0
+      pole_loop3: do n=1,grid1_size
+        if (grid1_area(n) < -three*pih .and. &
+            grid1_center_lat(n) < zero) then
+          grid1_add = n
+          exit pole_loop3
+        endif
+      end do pole_loop3
+
+      grid2_add = 0
+      pole_loop4: do n=1,grid2_size
+        if (grid2_area(n) < -three*pih .and. &
+            grid2_center_lat(n) < zero) then
+          grid2_add = n
+          exit pole_loop4
+        endif
+      end do pole_loop4
+
+      if (grid1_add /=0) then
+        grid1_area(grid1_add) = grid1_area(grid1_add) + weights(1)
+        grid1_centroid_lat(grid1_add) =  &
+        grid1_centroid_lat(grid1_add) + weights(2)
+        grid1_centroid_lon(grid1_add) = &
+        grid1_centroid_lon(grid1_add) + weights(3)
+      endif
+
+      if (grid2_add /=0) then
+        grid2_area(grid2_add) = grid2_area(grid2_add) +  &
+                                        weights(num_wts+1)
+        grid2_centroid_lat(grid2_add) =  &
+        grid2_centroid_lat(grid2_add) + weights(num_wts+2)
+        grid2_centroid_lon(grid2_add) = &
+        grid2_centroid_lon(grid2_add) + weights(num_wts+3)
+      endif
+
+      if (grid1_add /= 0 .and. grid2_add /=0) then
+        call store_link_cnsrv(grid1_add, grid2_add, weights)
+
+        grid1_frac(grid1_add) = grid1_frac(grid1_add) +  &
+                                weights(1)
+        grid2_frac(grid2_add) = grid2_frac(grid2_add) +  &
+                                weights(num_wts+1)
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     finish centroid computation
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_area /= zero)
+        grid1_centroid_lat = grid1_centroid_lat/grid1_area
+        grid1_centroid_lon = grid1_centroid_lon/grid1_area
+      end where
+
+      where (grid2_area /= zero)
+        grid2_centroid_lat = grid2_centroid_lat/grid2_area
+        grid2_centroid_lon = grid2_centroid_lon/grid2_area
+      end where
+
+!-----------------------------------------------------------------------
+!
+!     include centroids in weights and normalize using destination
+!     area if requested
+!
+!-----------------------------------------------------------------------
+
+      do n=1,num_links_map1
+        grid1_add = grid1_add_map1(n)
+        grid2_add = grid2_add_map1(n)
+        do nwgt=1,num_wts
+          weights(        nwgt) = wts_map1(nwgt,n)
+          if (num_maps > 1) then
+            weights(num_wts+nwgt) = wts_map2(nwgt,n)
+          endif
+        end do
+
+        select case(norm_opt)
+        case (norm_opt_dstarea)
+          if (grid2_area(grid2_add) /= zero) then
+            if (luse_grid2_area) then
+              norm_factor = one/grid2_area_in(grid2_add)
+            else
+              norm_factor = one/grid2_area(grid2_add)
+            endif
+          else
+            norm_factor = zero
+          endif
+        case (norm_opt_frcarea)
+          if (grid2_frac(grid2_add) /= zero) then
+            if (luse_grid2_area) then
+              norm_factor = grid2_area(grid2_add)/ &
+                           (grid2_frac(grid2_add)* &
+                            grid2_area_in(grid2_add))
+            else
+              norm_factor = one/grid2_frac(grid2_add)
+            endif
+          else
+            norm_factor = zero
+          endif
+        case (norm_opt_none)
+          norm_factor = one
+        end select
+
+        wts_map1(1,n) =  weights(1)*norm_factor
+        wts_map1(2,n) = (weights(2) - weights(1)* &
+                                    grid1_centroid_lat(grid1_add))* &
+                                    norm_factor
+        wts_map1(3,n) = (weights(3) - weights(1)* &
+                                    grid1_centroid_lon(grid1_add))* &
+                                    norm_factor
+
+        if (num_maps > 1) then
+          select case(norm_opt)
+          case (norm_opt_dstarea)
+            if (grid1_area(grid1_add) /= zero) then
+              if (luse_grid1_area) then
+                norm_factor = one/grid1_area_in(grid1_add)
+              else
+                norm_factor = one/grid1_area(grid1_add)
+              endif
+            else
+              norm_factor = zero
+            endif
+          case (norm_opt_frcarea)
+            if (grid1_frac(grid1_add) /= zero) then
+              if (luse_grid1_area) then
+                norm_factor = grid1_area(grid1_add)/ &
+                             (grid1_frac(grid1_add)* &
+                              grid1_area_in(grid1_add))
+              else
+                norm_factor = one/grid1_frac(grid1_add)
+              endif
+            else
+              norm_factor = zero
+            endif
+          case (norm_opt_none)
+            norm_factor = one
+          end select
+
+          wts_map2(1,n) =  weights(num_wts+1)*norm_factor
+          wts_map2(2,n) = (weights(num_wts+2) - weights(num_wts+1)* &
+                                      grid2_centroid_lat(grid2_add))* &
+                                      norm_factor
+          wts_map2(3,n) = (weights(num_wts+3) - weights(num_wts+1)* &
+                                      grid2_centroid_lon(grid2_add))* &
+                                      norm_factor
+        endif
+
+      end do
+
+      print *, 'Total number of links = ',num_links_map1
+
+      where (grid1_area /= zero) grid1_frac = grid1_frac/grid1_area
+      where (grid2_area /= zero) grid2_frac = grid2_frac/grid2_area
+
+!-----------------------------------------------------------------------
+!
+!     perform some error checking on final weights
+!
+!-----------------------------------------------------------------------
+
+      grid2_centroid_lat = zero
+      grid2_centroid_lon = zero
+
+      do n=1,grid1_size
+        if (grid1_area(n) < -.01) then
+          print *,'Grid 1 area error: ',n,grid1_area(n)
+        endif
+        if (grid1_centroid_lat(n) < -pih-.01 .or. &
+            grid1_centroid_lat(n) >  pih+.01) then
+          print *,'Grid 1 centroid lat error: ',n,grid1_centroid_lat(n)
+        endif
+        grid1_centroid_lat(n) = zero
+        grid1_centroid_lon(n) = zero
+      end do
+
+      do n=1,grid2_size
+        if (grid2_area(n) < -.01) then
+          print *,'Grid 2 area error: ',n,grid2_area(n)
+        endif
+        if (grid2_centroid_lat(n) < -pih-.01 .or. &
+            grid2_centroid_lat(n) >  pih+.01) then
+          print *,'Grid 2 centroid lat error: ',n,grid2_centroid_lat(n)
+        endif
+        grid2_centroid_lat(n) = zero
+        grid2_centroid_lon(n) = zero
+      end do
+
+      do n=1,num_links_map1
+        grid1_add = grid1_add_map1(n)
+        grid2_add = grid2_add_map1(n)
+        
+        if (wts_map1(1,n) < -.01) then
+          print *,'Map 1 weight < 0 ',grid1_add,grid2_add,wts_map1(1,n)
+        endif
+        if (norm_opt /= norm_opt_none .and. wts_map1(1,n) > 1.01) then
+          print *,'Map 1 weight > 1 ',grid1_add,grid2_add,wts_map1(1,n)
+        endif
+        grid2_centroid_lat(grid2_add) =  &
+        grid2_centroid_lat(grid2_add) + wts_map1(1,n)
+
+        if (num_maps > 1) then
+          if (wts_map2(1,n) < -.01) then
+            print *,'Map 2 weight < 0 ',grid1_add,grid2_add, &
+                                        wts_map2(1,n)
+          endif
+          if (norm_opt /= norm_opt_none .and. wts_map2(1,n) > 1.01) then
+            print *,'Map 2 weight < 0 ',grid1_add,grid2_add, &
+                                        wts_map2(1,n)
+          endif
+          grid1_centroid_lat(grid1_add) =  &
+          grid1_centroid_lat(grid1_add) + wts_map2(1,n)
+        endif
+      end do
+
+      do n=1,grid2_size
+        select case(norm_opt)
+        case (norm_opt_dstarea)
+          norm_factor = grid2_frac(grid2_add)
+        case (norm_opt_frcarea)
+          norm_factor = one
+        case (norm_opt_none)
+          if (luse_grid2_area) then
+            norm_factor = grid2_area_in(grid2_add)
+          else
+            norm_factor = grid2_area(grid2_add)
+          endif
+        end select
+        if (abs(grid2_centroid_lat(grid2_add)-norm_factor) > .01) then
+          print *,'Error: sum of wts for map1 ',grid2_add, &
+                  grid2_centroid_lat(grid2_add),norm_factor
+        endif
+      end do
+
+      if (num_maps > 1) then
+        do n=1,grid1_size
+          select case(norm_opt)
+          case (norm_opt_dstarea)
+            norm_factor = grid1_frac(grid1_add)
+          case (norm_opt_frcarea)
+            norm_factor = one
+          case (norm_opt_none)
+            if (luse_grid1_area) then
+              norm_factor = grid1_area_in(grid1_add)
+            else
+              norm_factor = grid1_area(grid1_add)
+            endif
+          end select
+          if (abs(grid1_centroid_lat(grid1_add)-norm_factor) > .01) then
+            print *,'Error: sum of wts for map2 ',grid1_add, &
+                    grid1_centroid_lat(grid1_add),norm_factor
+          endif
+        end do
+      endif
+!-----------------------------------------------------------------------
+
+      end subroutine remap_conserv
+
+!***********************************************************************
+
+      subroutine intersection(location,intrsct_lat,intrsct_lon,lcoinc, &
+                              beglat, beglon, endlat, endlon, begseg, &
+                              lbegin, lrevers)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the next intersection of a destination grid 
+!     line with the line segment given by beglon, endlon, etc.
+!     a coincidence flag is returned if the segment is entirely 
+!     coincident with an ocean grid line.  the cells in which to search
+!     for an intersection must have already been restricted in the
+!     calling routine.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     intent(in): 
+!
+!-----------------------------------------------------------------------
+
+      logical (kind=log_kind), intent(in) :: &
+           lbegin,  & ! flag for first integration along this segment
+           lrevers ! flag whether segment integrated in reverse
+
+      real (kind=dbl_kind), intent(in) ::  &
+           beglat, beglon,   & ! beginning lat/lon endpoints for segment
+           endlat, endlon   ! ending    lat/lon endpoints for segment
+
+      real (kind=dbl_kind), dimension(2), intent(inout) ::  &
+           begseg ! begin lat/lon of full segment
+
+!-----------------------------------------------------------------------
+!
+!     intent(out): 
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(out) :: &
+              location  ! address in destination array containing this
+                        ! segment
+
+      logical (kind=log_kind), intent(out) :: &
+              lcoinc    ! flag segments which are entirely coincident
+                        ! with a grid line
+
+      real (kind=dbl_kind), intent(out) :: &
+           intrsct_lat, intrsct_lon ! lat/lon coords of next intersect.
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, cell, srch_corners, pole_loc
+
+      integer (kind=int_kind), save ::  &
+           last_loc  ! save location when crossing threshold
+
+      logical (kind=log_kind) ::  &
+           loutside  ! flags points outside grid
+
+      logical (kind=log_kind), save ::  &
+           lthresh = .false.  ! flags segments crossing threshold bndy
+
+      real (kind=dbl_kind) :: &
+           lon1, lon2,        & ! local longitude variables for segment
+           lat1, lat2,        & ! local latitude  variables for segment
+           grdlon1, grdlon2,  & ! local longitude variables for grid cell
+           grdlat1, grdlat2,  & ! local latitude  variables for grid cell
+           vec1_lat, vec1_lon,  & ! vectors and cross products used
+           vec2_lat, vec2_lon,  & ! during grid search
+           cross_product,  &
+           eps, offset,         & ! small offset away from intersect
+           s1, s2, determ,      & ! variables used for linear solve to
+           mat1, mat2, mat3, mat4, rhs1, rhs2  ! find intersection
+
+      real (kind=dbl_kind), save :: &
+           intrsct_lat_off, intrsct_lon_off ! lat/lon coords offset 
+                                            ! for next search
+
+!-----------------------------------------------------------------------
+!
+!     initialize defaults, flags, etc.
+!
+!-----------------------------------------------------------------------
+
+      location = 0
+      lcoinc = .false.
+      intrsct_lat = endlat
+      intrsct_lon = endlon
+
+      if (num_srch_cells == 0) return
+
+      if (beglat > north_thresh .or. beglat < south_thresh) then
+
+        if (lthresh) location = last_loc
+        call pole_intersection(location, &
+                     intrsct_lat,intrsct_lon,lcoinc,lthresh, &
+                     beglat, beglon, endlat, endlon, begseg, lrevers)
+        if (lthresh) then
+          last_loc = location
+          intrsct_lat_off = intrsct_lat
+          intrsct_lon_off = intrsct_lon
+        endif
+        return
+
+      endif
+
+      loutside = .false.
+      if (lbegin) then
+        lat1 = beglat
+        lon1 = beglon
+      else
+        lat1 = intrsct_lat_off
+        lon1 = intrsct_lon_off
+      endif
+      lat2 = endlat
+      lon2 = endlon
+      if ((lon2-lon1) > three*pih) then
+        lon2 = lon2 - pi2
+      else if ((lon2-lon1) < -three*pih) then
+        lon2 = lon2 + pi2
+      endif
+      s1 = zero
+
+!-----------------------------------------------------------------------
+!
+!     search for location of this segment in ocean grid using cross
+!     product method to determine whether a point is enclosed by a cell
+!
+!-----------------------------------------------------------------------
+
+      call timer_start(12)
+      srch_corners = size(srch_corner_lat,DIM=1)
+      srch_loop: do
+
+        !***
+        !*** if last segment crossed threshold, use that location
+        !***
+
+        if (lthresh) then
+          do cell=1,num_srch_cells
+            if (srch_add(cell) == last_loc) then
+              location = last_loc
+              eps = tiny
+              exit srch_loop
+            endif
+          end do
+        endif
+
+        !***
+        !*** otherwise normal search algorithm
+        !***
+
+        cell_loop: do cell=1,num_srch_cells
+          corner_loop: do n=1,srch_corners
+            next_n = MOD(n,srch_corners) + 1
+
+            !***
+            !*** here we take the cross product of the vector making 
+            !*** up each cell side with the vector formed by the vertex
+            !*** and search point.  if all the cross products are 
+            !*** positive, the point is contained in the cell.
+            !***
+
+            vec1_lat = srch_corner_lat(next_n,cell) -  &
+                       srch_corner_lat(n     ,cell)
+            vec1_lon = srch_corner_lon(next_n,cell) -  &
+                       srch_corner_lon(n     ,cell)
+            vec2_lat = lat1 - srch_corner_lat(n,cell)
+            vec2_lon = lon1 - srch_corner_lon(n,cell)
+
+            !***
+            !*** if endpoint coincident with vertex, offset
+            !*** the endpoint
+            !***
+
+            if (vec2_lat == 0 .and. vec2_lon == 0) then
+              lat1 = lat1 + 1.d-10*(lat2-lat1)
+              lon1 = lon1 + 1.d-10*(lon2-lon1)
+              vec2_lat = lat1 - srch_corner_lat(n,cell)
+              vec2_lon = lon1 - srch_corner_lon(n,cell)
+            endif
+
+            !***
+            !*** check for 0,2pi crossings
+            !***
+
+            if (vec1_lon >  pi) then
+              vec1_lon = vec1_lon - pi2
+            else if (vec1_lon < -pi) then
+              vec1_lon = vec1_lon + pi2
+            endif
+            if (vec2_lon >  pi) then
+              vec2_lon = vec2_lon - pi2
+            else if (vec2_lon < -pi) then
+              vec2_lon = vec2_lon + pi2
+            endif
+
+            cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+
+            !***
+            !*** if the cross product for a side is zero, the point 
+            !***   lies exactly on the side or the side is degenerate
+            !***   (zero length).  if degenerate, set the cross 
+            !***   product to a positive number.  otherwise perform 
+            !***   another cross product between the side and the 
+            !***   segment itself. 
+            !*** if this cross product is also zero, the line is 
+            !***   coincident with the cell boundary - perform the 
+            !***   dot product and only choose the cell if the dot 
+            !***   product is positive (parallel vs anti-parallel).
+            !***
+
+            if (cross_product == zero) then
+              if (vec1_lat /= zero .or. vec1_lon /= zero) then
+                vec2_lat = lat2 - lat1
+                vec2_lon = lon2 - lon1
+
+                if (vec2_lon >  pi) then
+                  vec2_lon = vec2_lon - pi2
+                else if (vec2_lon < -pi) then
+                  vec2_lon = vec2_lon + pi2
+                endif
+
+                cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+              else
+                cross_product = one
+              endif
+
+              if (cross_product == zero) then
+                lcoinc = .true.
+                cross_product = vec1_lon*vec2_lon + vec1_lat*vec2_lat
+                if (lrevers) cross_product = -cross_product
+              endif
+            endif
+
+            !***
+            !*** if cross product is less than zero, this cell
+            !*** doesn't work
+            !***
+
+            if (cross_product < zero) exit corner_loop
+
+          end do corner_loop
+
+          !***
+          !*** if cross products all positive, we found the location
+          !***
+
+          if (n > srch_corners) then
+            location = srch_add(cell)
+
+            !***
+            !*** if the beginning of this segment was outside the
+            !*** grid, invert the segment so the intersection found
+            !*** will be the first intersection with the grid
+            !***
+
+            if (loutside) then
+              lat2 = beglat
+              lon2 = beglon
+              location = 0
+              eps  = -tiny
+            else
+              eps  = tiny
+            endif
+
+            exit srch_loop
+          endif
+
+          !***
+          !*** otherwise move on to next cell
+          !***
+
+        end do cell_loop
+
+        !***
+        !*** if still no cell found, the point lies outside the grid.
+        !***   take some baby steps along the segment to see if any
+        !***   part of the segment lies inside the grid.  
+        !***
+
+        loutside = .true.
+        s1 = s1 + 0.001_dbl_kind
+        lat1 = beglat + s1*(endlat - beglat)
+        lon1 = beglon + s1*(lon2   - beglon)
+
+        !***
+        !*** reached the end of the segment and still outside the grid
+        !*** return no intersection
+        !***
+
+        if (s1 >= one) return
+
+      end do srch_loop
+      call timer_stop(12)
+
+!-----------------------------------------------------------------------
+!
+!     now that a cell is found, search for the next intersection.
+!     loop over sides of the cell to find intersection with side
+!     must check all sides for coincidences or intersections
+!
+!-----------------------------------------------------------------------
+
+      call timer_start(13)
+      intrsct_loop: do n=1,srch_corners
+        next_n = mod(n,srch_corners) + 1
+
+        grdlon1 = srch_corner_lon(n     ,cell)
+        grdlon2 = srch_corner_lon(next_n,cell)
+        grdlat1 = srch_corner_lat(n     ,cell)
+        grdlat2 = srch_corner_lat(next_n,cell)
+
+        !***
+        !*** set up linear system to solve for intersection
+        !***
+
+        mat1 = lat2 - lat1
+        mat2 = grdlat1 - grdlat2
+        mat3 = lon2 - lon1
+        mat4 = grdlon1 - grdlon2
+        rhs1 = grdlat1 - lat1
+        rhs2 = grdlon1 - lon1
+
+        if (mat3 >  pi) then
+          mat3 = mat3 - pi2
+        else if (mat3 < -pi) then
+          mat3 = mat3 + pi2
+        endif
+        if (mat4 >  pi) then
+          mat4 = mat4 - pi2
+        else if (mat4 < -pi) then
+          mat4 = mat4 + pi2
+        endif
+        if (rhs2 >  pi) then
+          rhs2 = rhs2 - pi2
+        else if (rhs2 < -pi) then
+          rhs2 = rhs2 + pi2
+        endif
+
+        determ = mat1*mat4 - mat2*mat3
+
+        !***
+        !*** if the determinant is zero, the segments are either 
+        !***   parallel or coincident.  coincidences were detected 
+        !***   above so do nothing.
+        !*** if the determinant is non-zero, solve for the linear 
+        !***   parameters s for the intersection point on each line 
+        !***   segment.
+        !*** if 0<s1,s2<1 then the segment intersects with this side.
+        !***   return the point of intersection (adding a small
+        !***   number so the intersection is off the grid line).
+        !***
+
+        if (abs(determ) > 1.e-30) then
+
+          s1 = (rhs1*mat4 - mat2*rhs2)/determ
+          s2 = (mat1*rhs2 - rhs1*mat3)/determ
+
+          if (s2 >= zero .and. s2 <= one .and. &
+              s1 >  zero .and. s1 <= one) then
+
+            !***
+            !*** recompute intersection based on full segment
+            !*** so intersections are consistent for both sweeps
+            !***
+
+            if (.not. loutside) then
+              mat1 = lat2 - begseg(1)
+              mat3 = lon2 - begseg(2)
+              rhs1 = grdlat1 - begseg(1)
+              rhs2 = grdlon1 - begseg(2)
+            else
+              mat1 = begseg(1) - endlat
+              mat3 = begseg(2) - endlon
+              rhs1 = grdlat1 - endlat
+              rhs2 = grdlon1 - endlon
+            endif
+
+            if (mat3 >  pi) then
+              mat3 = mat3 - pi2
+            else if (mat3 < -pi) then
+              mat3 = mat3 + pi2
+            endif
+            if (rhs2 >  pi) then
+              rhs2 = rhs2 - pi2
+            else if (rhs2 < -pi) then
+              rhs2 = rhs2 + pi2
+            endif
+
+            determ = mat1*mat4 - mat2*mat3
+
+            !***
+            !*** sometimes due to roundoff, the previous 
+            !*** determinant is non-zero, but the lines
+            !*** are actually coincident.  if this is the
+            !*** case, skip the rest.
+            !***
+
+            if (determ /= zero) then
+              s1 = (rhs1*mat4 - mat2*rhs2)/determ
+              s2 = (mat1*rhs2 - rhs1*mat3)/determ
+
+              offset = s1 + eps/determ
+              if (offset > one) offset = one
+
+              if (.not. loutside) then
+                intrsct_lat = begseg(1) + mat1*s1
+                intrsct_lon = begseg(2) + mat3*s1
+                intrsct_lat_off = begseg(1) + mat1*offset
+                intrsct_lon_off = begseg(2) + mat3*offset
+              else
+                intrsct_lat = endlat + mat1*s1
+                intrsct_lon = endlon + mat3*s1
+                intrsct_lat_off = endlat + mat1*offset
+                intrsct_lon_off = endlon + mat3*offset
+              endif
+              exit intrsct_loop
+            endif
+
+          endif
+        endif
+
+        !***
+        !*** no intersection this side, move on to next side
+        !***
+
+      end do intrsct_loop
+      call timer_stop(13)
+
+!-----------------------------------------------------------------------
+!
+!     if the segment crosses a pole threshold, reset the intersection
+!     to be the threshold latitude.  only check if this was not a
+!     threshold segment since sometimes coordinate transform can end
+!     up on other side of threshold again.
+!
+!-----------------------------------------------------------------------
+
+      if (lthresh) then
+        if (intrsct_lat < north_thresh .or. intrsct_lat > south_thresh) &
+            lthresh = .false.
+      else if (lat1 > zero .and. intrsct_lat > north_thresh) then
+        intrsct_lat = north_thresh + tiny
+        intrsct_lat_off = north_thresh + eps*mat1
+        s1 = (intrsct_lat - begseg(1))/mat1
+        intrsct_lon     = begseg(2) + s1*mat3
+        intrsct_lon_off = begseg(2) + (s1+eps)*mat3
+        last_loc = location
+        lthresh = .true.
+      else if (lat1 < zero .and. intrsct_lat < south_thresh) then
+        intrsct_lat = south_thresh - tiny
+        intrsct_lat_off = south_thresh + eps*mat1
+        s1 = (intrsct_lat - begseg(1))/mat1
+        intrsct_lon     = begseg(2) + s1*mat3
+        intrsct_lon_off = begseg(2) + (s1+eps)*mat3
+        last_loc = location
+        lthresh = .true.
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine intersection
+
+!***********************************************************************
+
+      subroutine pole_intersection(location, &
+                       intrsct_lat,intrsct_lon,lcoinc,lthresh, &
+                       beglat, beglon, endlat, endlon, begseg, lrevers)
+
+!-----------------------------------------------------------------------
+!
+!     this routine is identical to the intersection routine except
+!     that a coordinate transformation (using a Lambert azimuthal
+!     equivalent projection) is performed to treat polar cells more
+!     accurately.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     intent(in): 
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), intent(in) ::  &
+           beglat, beglon,   & ! beginning lat/lon endpoints for segment
+           endlat, endlon   ! ending    lat/lon endpoints for segment
+
+      real (kind=dbl_kind), dimension(2), intent(inout) ::  &
+           begseg ! begin lat/lon of full segment
+
+      logical (kind=log_kind), intent(in) :: &
+              lrevers   ! flag true if segment integrated in reverse
+
+!-----------------------------------------------------------------------
+!
+!     intent(out): 
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(inout) :: &
+              location  ! address in destination array containing this
+                        ! segment -- also may contain last location on
+                        ! entry
+
+      logical (kind=log_kind), intent(out) :: &
+              lcoinc    ! flag segment coincident with grid line
+
+      logical (kind=log_kind), intent(inout) :: &
+              lthresh   ! flag segment crossing threshold boundary
+
+      real (kind=dbl_kind), intent(out) :: &
+           intrsct_lat, intrsct_lon ! lat/lon coords of next intersect.
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, cell, srch_corners, pole_loc
+
+      logical (kind=log_kind) :: loutside ! flags points outside grid
+
+      real (kind=dbl_kind) :: pi4, rns,  & ! north/south conversion
+           x1, x2,        & ! local x variables for segment
+           y1, y2,        & ! local y variables for segment
+           begx, begy,    & ! beginning x,y variables for segment
+           endx, endy,    & ! beginning x,y variables for segment
+           begsegx, begsegy,    & ! beginning x,y variables for segment
+           grdx1, grdx2,  & ! local x variables for grid cell
+           grdy1, grdy2,  & ! local y variables for grid cell
+           vec1_y, vec1_x,  & ! vectors and cross products used
+           vec2_y, vec2_x,  & ! during grid search
+           cross_product, eps,  & ! eps=small offset away from intersect
+           s1, s2, determ,      & ! variables used for linear solve to
+           mat1, mat2, mat3, mat4, rhs1, rhs2  ! find intersection
+
+      real (kind=dbl_kind), dimension(:,:), allocatable :: &
+           srch_corner_x,   & ! x of each corner of srch cells
+           srch_corner_y   ! y of each corner of srch cells
+
+      !***
+      !*** save last intersection to avoid roundoff during coord
+      !*** transformation
+      !***
+
+      logical (kind=log_kind), save :: luse_last = .false.
+
+      real (kind=dbl_kind), save ::  &
+           intrsct_x, intrsct_y  ! x,y for intersection
+
+      !***
+      !*** variables necessary if segment manages to hit pole
+      !***
+
+      integer (kind=int_kind), save ::  &
+           avoid_pole_count = 0  ! count attempts to avoid pole
+
+      real (kind=dbl_kind), save ::  &
+           avoid_pole_offset = tiny  ! endpoint offset to avoid pole
+
+!-----------------------------------------------------------------------
+!
+!     initialize defaults, flags, etc.
+!
+!-----------------------------------------------------------------------
+
+      if (.not. lthresh) location = 0
+      lcoinc = .false.
+      intrsct_lat = endlat
+      intrsct_lon = endlon
+
+      loutside = .false.
+      s1 = zero
+
+!-----------------------------------------------------------------------
+!
+!     convert coordinates
+!
+!-----------------------------------------------------------------------
+
+      allocate(srch_corner_x(size(srch_corner_lat,DIM=1), &
+                             size(srch_corner_lat,DIM=2)), &
+               srch_corner_y(size(srch_corner_lat,DIM=1), &
+                             size(srch_corner_lat,DIM=2)))
+
+      if (beglat > zero) then
+        pi4 = quart*pi
+        rns = one
+      else
+        pi4 = -quart*pi
+        rns = -one
+      endif
+
+      if (luse_last) then
+        x1 = intrsct_x
+        y1 = intrsct_y
+      else
+        x1 = rns*two*sin(pi4 - half*beglat)*cos(beglon)
+        y1 =     two*sin(pi4 - half*beglat)*sin(beglon)
+        luse_last = .true.
+      endif
+      x2 = rns*two*sin(pi4 - half*endlat)*cos(endlon)
+      y2 =     two*sin(pi4 - half*endlat)*sin(endlon)
+      srch_corner_x = rns*two*sin(pi4 - half*srch_corner_lat)* &
+                              cos(srch_corner_lon)
+      srch_corner_y =     two*sin(pi4 - half*srch_corner_lat)* &
+                              sin(srch_corner_lon)
+
+      begx = x1
+      begy = y1
+      endx = x2
+      endy = y2
+      begsegx = rns*two*sin(pi4 - half*begseg(1))*cos(begseg(2))
+      begsegy =     two*sin(pi4 - half*begseg(1))*sin(begseg(2))
+      intrsct_x = endx
+      intrsct_y = endy
+
+!-----------------------------------------------------------------------
+!
+!     search for location of this segment in ocean grid using cross
+!     product method to determine whether a point is enclosed by a cell
+!
+!-----------------------------------------------------------------------
+
+      call timer_start(12)
+      srch_corners = size(srch_corner_lat,DIM=1)
+      srch_loop: do
+
+        !***
+        !*** if last segment crossed threshold, use that location
+        !***
+
+        if (lthresh) then
+          do cell=1,num_srch_cells
+            if (srch_add(cell) == location) then
+              eps = tiny
+              exit srch_loop
+            endif
+          end do
+        endif
+
+        !***
+        !*** otherwise normal search algorithm
+        !***
+
+        cell_loop: do cell=1,num_srch_cells
+          corner_loop: do n=1,srch_corners
+            next_n = MOD(n,srch_corners) + 1
+
+            !***
+            !*** here we take the cross product of the vector making 
+            !*** up each cell side with the vector formed by the vertex
+            !*** and search point.  if all the cross products are 
+            !*** positive, the point is contained in the cell.
+            !***
+
+            vec1_x = srch_corner_x(next_n,cell) -  &
+                     srch_corner_x(n     ,cell)
+            vec1_y = srch_corner_y(next_n,cell) -  &
+                     srch_corner_y(n     ,cell)
+            vec2_x = x1 - srch_corner_x(n,cell)
+            vec2_y = y1 - srch_corner_y(n,cell)
+
+            !***
+            !*** if endpoint coincident with vertex, offset
+            !*** the endpoint
+            !***
+
+            if (vec2_x == 0 .and. vec2_y == 0) then
+              x1 = x1 + 1.d-10*(x2-x1)
+              y1 = y1 + 1.d-10*(y2-y1)
+              vec2_x = x1 - srch_corner_x(n,cell)
+              vec2_y = y1 - srch_corner_y(n,cell)
+            endif
+
+            cross_product = vec1_x*vec2_y - vec2_x*vec1_y
+
+            !***
+            !*** if the cross product for a side is zero, the point 
+            !***   lies exactly on the side or the length of a side
+            !***   is zero.  if the length is zero set det > 0.
+            !***   otherwise, perform another cross 
+            !***   product between the side and the segment itself. 
+            !*** if this cross product is also zero, the line is 
+            !***   coincident with the cell boundary - perform the 
+            !***   dot product and only choose the cell if the dot 
+            !***   product is positive (parallel vs anti-parallel).
+            !***
+
+            if (cross_product == zero) then
+              if (vec1_x /= zero .or. vec1_y /= 0) then
+                vec2_x = x2 - x1
+                vec2_y = y2 - y1
+                cross_product = vec1_x*vec2_y - vec2_x*vec1_y
+              else
+                cross_product = one
+              endif
+
+              if (cross_product == zero) then
+                lcoinc = .true.
+                cross_product = vec1_x*vec2_x + vec1_y*vec2_y
+                if (lrevers) cross_product = -cross_product
+              endif
+            endif
+
+            !***
+            !*** if cross product is less than zero, this cell
+            !*** doesn't work
+            !***
+
+            if (cross_product < zero) exit corner_loop
+
+          end do corner_loop
+
+          !***
+          !*** if cross products all positive, we found the location
+          !***
+
+          if (n > srch_corners) then
+            location = srch_add(cell)
+
+            !***
+            !*** if the beginning of this segment was outside the
+            !*** grid, invert the segment so the intersection found
+            !*** will be the first intersection with the grid
+            !***
+
+            if (loutside) then
+              x2 = begx
+              y2 = begy
+              location = 0
+              eps  = -tiny
+            else
+              eps  = tiny
+            endif
+
+            exit srch_loop
+          endif
+
+          !***
+          !*** otherwise move on to next cell
+          !***
+
+        end do cell_loop
+
+        !***
+        !*** if no cell found, the point lies outside the grid.
+        !***   take some baby steps along the segment to see if any
+        !***   part of the segment lies inside the grid.  
+        !***
+
+        loutside = .true.
+        s1 = s1 + 0.001_dbl_kind
+        x1 = begx + s1*(x2 - begx)
+        y1 = begy + s1*(y2 - begy)
+
+        !***
+        !*** reached the end of the segment and still outside the grid
+        !*** return no intersection
+        !***
+
+        if (s1 >= one) then
+          deallocate(srch_corner_x, srch_corner_y)
+          luse_last = .false.
+          return
+        endif
+
+      end do srch_loop
+      call timer_stop(12)
+
+!-----------------------------------------------------------------------
+!
+!     now that a cell is found, search for the next intersection.
+!     loop over sides of the cell to find intersection with side
+!     must check all sides for coincidences or intersections
+!
+!-----------------------------------------------------------------------
+
+      call timer_start(13)
+      intrsct_loop: do n=1,srch_corners
+        next_n = mod(n,srch_corners) + 1
+
+        grdy1 = srch_corner_y(n     ,cell)
+        grdy2 = srch_corner_y(next_n,cell)
+        grdx1 = srch_corner_x(n     ,cell)
+        grdx2 = srch_corner_x(next_n,cell)
+
+        !***
+        !*** set up linear system to solve for intersection
+        !***
+
+        mat1 = x2 - x1
+        mat2 = grdx1 - grdx2
+        mat3 = y2 - y1
+        mat4 = grdy1 - grdy2
+        rhs1 = grdx1 - x1
+        rhs2 = grdy1 - y1
+
+        determ = mat1*mat4 - mat2*mat3
+
+        !***
+        !*** if the determinant is zero, the segments are either 
+        !***   parallel or coincident or one segment has zero length.  
+        !***   coincidences were detected above so do nothing.
+        !*** if the determinant is non-zero, solve for the linear 
+        !***   parameters s for the intersection point on each line 
+        !***   segment.
+        !*** if 0<s1,s2<1 then the segment intersects with this side.
+        !***   return the point of intersection (adding a small
+        !***   number so the intersection is off the grid line).
+        !***
+
+        if (abs(determ) > 1.e-30) then
+
+          s1 = (rhs1*mat4 - mat2*rhs2)/determ
+          s2 = (mat1*rhs2 - rhs1*mat3)/determ
+
+          if (s2 >= zero .and. s2 <= one .and. &
+              s1 >  zero .and. s1 <= one) then
+
+            !***
+            !*** recompute intersection using entire segment
+            !*** for consistency between sweeps
+            !***
+
+            if (.not. loutside) then
+              mat1 = x2 - begsegx
+              mat3 = y2 - begsegy
+              rhs1 = grdx1 - begsegx
+              rhs2 = grdy1 - begsegy
+            else 
+              mat1 = x2 - endx
+              mat3 = y2 - endy
+              rhs1 = grdx1 - endx
+              rhs2 = grdy1 - endy
+            endif
+
+            determ = mat1*mat4 - mat2*mat3
+
+            !***
+            !*** sometimes due to roundoff, the previous 
+            !*** determinant is non-zero, but the lines
+            !*** are actually coincident.  if this is the
+            !*** case, skip the rest.
+            !***
+
+            if (determ /= zero) then
+              s1 = (rhs1*mat4 - mat2*rhs2)/determ
+              s2 = (mat1*rhs2 - rhs1*mat3)/determ
+
+              if (.not. loutside) then
+                intrsct_x = begsegx + s1*mat1
+                intrsct_y = begsegy + s1*mat3
+              else 
+                intrsct_x = endx + s1*mat1
+                intrsct_y = endy + s1*mat3
+              endif
+
+              !***
+              !*** convert back to lat/lon coordinates
+              !***
+
+              intrsct_lon = rns*atan2(intrsct_y,intrsct_x)
+              if (intrsct_lon < zero)  &
+                intrsct_lon = intrsct_lon + pi2
+
+              if (abs(intrsct_x) > 1.d-10) then
+                intrsct_lat = (pi4 -  &
+                  asin(rns*half*intrsct_x/cos(intrsct_lon)))*two
+              else if (abs(intrsct_y) > 1.d-10) then
+                intrsct_lat = (pi4 -  &
+                  asin(half*intrsct_y/sin(intrsct_lon)))*two
+              else
+                intrsct_lat = two*pi4
+              endif
+
+              !***
+              !*** add offset in transformed space for next pass.
+              !***
+
+              if (s1 - eps/determ < one) then
+                intrsct_x = intrsct_x - mat1*(eps/determ)
+                intrsct_y = intrsct_y - mat3*(eps/determ)
+              else
+                if (.not. loutside) then
+                  intrsct_x = endx
+                  intrsct_y = endy
+                  intrsct_lat = endlat
+                  intrsct_lon = endlon
+                else 
+                  intrsct_x = begsegx
+                  intrsct_y = begsegy
+                  intrsct_lat = begseg(1)
+                  intrsct_lon = begseg(2)
+                endif
+              endif
+
+              exit intrsct_loop
+            endif
+          endif
+        endif
+
+        !***
+        !*** no intersection this side, move on to next side
+        !***
+
+      end do intrsct_loop
+      call timer_stop(13)
+
+      deallocate(srch_corner_x, srch_corner_y)
+
+!-----------------------------------------------------------------------
+!
+!     if segment manages to cross over pole, shift the beginning 
+!     endpoint in order to avoid hitting pole directly
+!     (it is ok for endpoint to be pole point)
+!
+!-----------------------------------------------------------------------
+
+      if (abs(intrsct_x) < 1.e-10 .and. abs(intrsct_y) < 1.e-10 .and. &
+          (endx /= zero .and. endy /=0)) then
+        if (avoid_pole_count > 2) then
+           avoid_pole_count = 0
+           avoid_pole_offset = 10.*avoid_pole_offset
+        endif
+
+        cross_product = begsegx*(endy-begsegy) - begsegy*(endx-begsegx)
+        intrsct_lat = begseg(1)
+        if (cross_product*intrsct_lat > zero) then
+          intrsct_lon = beglon    + avoid_pole_offset
+          begseg(2)   = begseg(2) + avoid_pole_offset
+        else
+          intrsct_lon = beglon    - avoid_pole_offset
+          begseg(2)   = begseg(2) - avoid_pole_offset
+        endif
+
+        avoid_pole_count = avoid_pole_count + 1
+        luse_last = .false.
+      else
+        avoid_pole_count = 0
+        avoid_pole_offset = tiny
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     if the segment crosses a pole threshold, reset the intersection
+!     to be the threshold latitude and do not reuse x,y intersect
+!     on next entry.  only check if did not cross threshold last
+!     time - sometimes the coordinate transformation can place a
+!     segment on the other side of the threshold again
+!
+!-----------------------------------------------------------------------
+
+      if (lthresh) then
+        if (intrsct_lat > north_thresh .or. intrsct_lat < south_thresh) &
+          lthresh = .false.
+      else if (beglat > zero .and. intrsct_lat < north_thresh) then
+        mat4 = endlat - begseg(1)
+        mat3 = endlon - begseg(2)
+        if (mat3 >  pi) mat3 = mat3 - pi2
+        if (mat3 < -pi) mat3 = mat3 + pi2
+        intrsct_lat = north_thresh - tiny
+        s1 = (north_thresh - begseg(1))/mat4
+        intrsct_lon = begseg(2) + s1*mat3
+        luse_last = .false.
+        lthresh = .true.
+      else if (beglat < zero .and. intrsct_lat > south_thresh) then
+        mat4 = endlat - begseg(1)
+        mat3 = endlon - begseg(2)
+        if (mat3 >  pi) mat3 = mat3 - pi2
+        if (mat3 < -pi) mat3 = mat3 + pi2
+        intrsct_lat = south_thresh + tiny
+        s1 = (south_thresh - begseg(1))/mat4
+        intrsct_lon = begseg(2) + s1*mat3
+        luse_last = .false.
+        lthresh = .true.
+      endif
+
+      !***
+      !*** if reached end of segment, do not use x,y intersect 
+      !*** on next entry
+      !***
+
+      if (intrsct_lat == endlat .and. intrsct_lon == endlon) then
+        luse_last = .false.
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine pole_intersection
+
+!***********************************************************************
+
+      subroutine line_integral(weights, num_wts,  &
+                             in_phi1, in_phi2, theta1, theta2, &
+                             grid1_lat, grid1_lon, grid2_lat, grid2_lon)
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the line integral of the flux function 
+!     that results in the interpolation weights.  the line is defined
+!     by the input lat/lon of the endpoints.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     intent(in):
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: &
+              num_wts  ! number of weights to compute
+
+      real (kind=dbl_kind), intent(in) ::  &
+           in_phi1, in_phi2,      & ! longitude endpoints for the segment
+           theta1, theta2,        & ! latitude  endpoints for the segment
+           grid1_lat, grid1_lon,  & ! reference coordinates for each
+           grid2_lat, grid2_lon  ! grid (to ensure correct 0,2pi interv.
+
+!-----------------------------------------------------------------------
+!
+!     intent(out):
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), dimension(2*num_wts), intent(out) :: &
+           weights   ! line integral contribution to weights
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind) :: dphi, sinth1, sinth2, costh1, costh2, fac, &
+                              phi1, phi2, phidiff1, phidiff2, sinint
+      real (kind=dbl_kind) :: f1, f2, fint
+
+!-----------------------------------------------------------------------
+!
+!     weights for the general case based on a trapezoidal approx to
+!     the integrals.
+!
+!-----------------------------------------------------------------------
+
+      sinth1 = SIN(theta1)
+      sinth2 = SIN(theta2)
+      costh1 = COS(theta1)
+      costh2 = COS(theta2)
+
+      dphi = in_phi1 - in_phi2
+      if (dphi >  pi) then
+        dphi = dphi - pi2
+      else if (dphi < -pi) then
+        dphi = dphi + pi2
+      endif
+      dphi = half*dphi
+
+!-----------------------------------------------------------------------
+!
+!     the first weight is the area overlap integral. the second and
+!     fourth are second-order latitude gradient weights.
+!
+!-----------------------------------------------------------------------
+
+      weights(        1) = dphi*(sinth1 + sinth2)
+      weights(num_wts+1) = dphi*(sinth1 + sinth2)
+      weights(        2) = dphi*(costh1 + costh2 + (theta1*sinth1 + &
+                                                    theta2*sinth2))
+      weights(num_wts+2) = dphi*(costh1 + costh2 + (theta1*sinth1 + &
+                                                    theta2*sinth2))
+
+!-----------------------------------------------------------------------
+!
+!     the third and fifth weights are for the second-order phi gradient
+!     component.  must be careful of longitude range.
+!
+!-----------------------------------------------------------------------
+
+      f1 = half*(costh1*sinth1 + theta1)
+      f2 = half*(costh2*sinth2 + theta2)
+
+      phi1 = in_phi1 - grid1_lon
+      if (phi1 >  pi) then
+        phi1 = phi1 - pi2
+      else if (phi1 < -pi) then
+        phi1 = phi1 + pi2
+      endif
+
+      phi2 = in_phi2 - grid1_lon
+      if (phi2 >  pi) then
+        phi2 = phi2 - pi2
+      else if (phi2 < -pi) then
+        phi2 = phi2 + pi2
+      endif
+
+      if ((phi2-phi1) <  pi .and. (phi2-phi1) > -pi) then
+        weights(3) = dphi*(phi1*f1 + phi2*f2)
+      else
+        if (phi1 > zero) then
+          fac = pi
+        else
+          fac = -pi
+        endif
+        fint = f1 + (f2-f1)*(fac-phi1)/abs(dphi)
+        weights(3) = half*phi1*(phi1-fac)*f1 - &
+                     half*phi2*(phi2+fac)*f2 + &
+                     half*fac*(phi1+phi2)*fint
+      endif
+
+      phi1 = in_phi1 - grid2_lon
+      if (phi1 >  pi) then
+        phi1 = phi1 - pi2
+      else if (phi1 < -pi) then
+        phi1 = phi1 + pi2
+      endif
+
+      phi2 = in_phi2 - grid2_lon
+      if (phi2 >  pi) then
+        phi2 = phi2 - pi2
+      else if (phi2 < -pi) then
+        phi2 = phi2 + pi2
+      endif
+
+      if ((phi2-phi1) <  pi .and. (phi2-phi1) > -pi) then
+        weights(num_wts+3) = dphi*(phi1*f1 + phi2*f2)
+      else
+        if (phi1 > zero) then
+          fac = pi
+        else
+          fac = -pi
+        endif
+        fint = f1 + (f2-f1)*(fac-phi1)/abs(dphi)
+        weights(num_wts+3) = half*phi1*(phi1-fac)*f1 - &
+                             half*phi2*(phi2+fac)*f2 + &
+                             half*fac*(phi1+phi2)*fint
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine line_integral
+
+!***********************************************************************
+
+      subroutine store_link_cnsrv(add1, add2, weights)
+
+!-----------------------------------------------------------------------
+!
+!     this routine stores the address and weight for this link in
+!     the appropriate address and weight arrays and resizes those
+!     arrays if necessary.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: &
+              add1,   & ! address on grid1
+              add2   ! address on grid2
+
+      real (kind=dbl_kind), dimension(:), intent(in) :: &
+              weights ! array of remapping weights for this link
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: nlink, min_link, max_link ! link index
+
+      integer (kind=int_kind), dimension(:,:), allocatable, save :: &
+              link_add1,   & ! min,max link add to restrict search
+              link_add2   ! min,max link add to restrict search
+
+      logical (kind=log_kind), save :: first_call = .true.
+
+!-----------------------------------------------------------------------
+!
+!     if all weights are zero, do not bother storing the link
+!
+!-----------------------------------------------------------------------
+
+      if (all(weights == zero)) return
+
+!-----------------------------------------------------------------------
+!
+!     restrict the range of links to search for existing links
+!
+!-----------------------------------------------------------------------
+
+      if (first_call) then
+        allocate(link_add1(2,grid1_size), link_add2(2,grid2_size))
+        link_add1 = 0
+        link_add2 = 0
+        first_call = .false.
+        min_link = 1
+        max_link = 0
+      else
+        min_link = min(link_add1(1,add1),link_add2(1,add2))
+        max_link = max(link_add1(2,add1),link_add2(2,add2))
+        if (min_link == 0) then
+          min_link = 1
+          max_link = 0
+        endif
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     if the link already exists, add the weight to the current weight
+!     arrays
+!
+!-----------------------------------------------------------------------
+
+      do nlink=min_link,max_link
+        if (add1 == grid1_add_map1(nlink)) then
+        if (add2 == grid2_add_map1(nlink)) then
+
+          wts_map1(:,nlink) = wts_map1(:,nlink) + weights(1:num_wts)
+          if (num_maps == 2) then
+            wts_map2(:,nlink) = wts_map2(:,nlink) +  &
+                                        weights(num_wts+1:2*num_wts)
+          endif
+          return
+
+        endif
+        endif
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     if the link does not yet exist, increment number of links and 
+!     check to see if remap arrays need to be increased to accomodate 
+!     the new link.  then store the link.
+!
+!-----------------------------------------------------------------------
+
+      num_links_map1  = num_links_map1 + 1
+      if (num_links_map1 > max_links_map1)  &
+         call resize_remap_vars(1,resize_increment)
+
+      grid1_add_map1(num_links_map1) = add1
+      grid2_add_map1(num_links_map1) = add2
+      wts_map1    (:,num_links_map1) = weights(1:num_wts)
+
+      if (num_maps > 1) then
+        num_links_map2  = num_links_map2 + 1
+        if (num_links_map2 > max_links_map2)  &
+           call resize_remap_vars(2,resize_increment)
+
+        grid1_add_map2(num_links_map2) = add1
+        grid2_add_map2(num_links_map2) = add2
+        wts_map2    (:,num_links_map2) = weights(num_wts+1:2*num_wts)
+      endif
+
+      if (link_add1(1,add1) == 0) link_add1(1,add1) = num_links_map1
+      if (link_add2(1,add2) == 0) link_add2(1,add2) = num_links_map1
+      link_add1(2,add1) = num_links_map1
+      link_add2(2,add2) = num_links_map1
+
+!-----------------------------------------------------------------------
+
+      end subroutine store_link_cnsrv
+
+!***********************************************************************
+
+      end module remap_conservative
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/src/remap_distwgt.f90
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/src/remap_distwgt.f90	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/src/remap_distwgt.f90	(revision 12863)
@@ -0,0 +1,498 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for performing an 
+!     interpolation using a distance-weighted average of n nearest
+!     neighbors.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_distwgt.f,v 1.3 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_distance_weight
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common constants
+      use grids         ! module containing grid info
+      use remap_vars    ! module containing remap info
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter ::  &
+           num_neighbors=4  ! num nearest neighbors to interpolate from
+
+      real (kind=dbl_kind), dimension(:), allocatable, save :: &
+           coslat, sinlat,  & ! cosine, sine of grid lats (for distance)
+           coslon, sinlon,  & ! cosine, sine of grid lons (for distance)
+           wgtstmp         ! an array to hold the link weight
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap_distwgt
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the inverse-distance weights for a
+!     nearest-neighbor interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      logical (kind=log_kind), dimension(num_neighbors) :: &
+           nbr_mask        ! mask at nearest neighbors
+
+      integer (kind=int_kind) :: n, &
+           dst_add,         & ! destination address
+           nmap            ! index of current map being computed
+
+      integer (kind=int_kind), dimension(num_neighbors) :: &
+           nbr_add         ! source address at nearest neighbors
+
+      real (kind=dbl_kind), dimension(num_neighbors) :: &
+           nbr_dist        ! angular distance four nearest neighbors
+
+      real (kind=dbl_kind) :: &
+           coslat_dst,      & ! cos(lat) of destination grid point
+           coslon_dst,      & ! cos(lon) of destination grid point
+           sinlat_dst,      & ! sin(lat) of destination grid point
+           sinlon_dst,      & ! sin(lon) of destination grid point
+           dist_tot        ! sum of neighbor distances (for normalizing)
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+
+      nmap = 1
+
+      !***
+      !*** allocate wgtstmp to be consistent with store_link interface
+      !***
+
+      allocate (wgtstmp(num_wts))
+
+      !***
+      !*** compute cos, sin of lat/lon on source grid for distance
+      !*** calculations
+      !***
+
+      allocate (coslat(grid1_size), coslon(grid1_size), &
+                sinlat(grid1_size), sinlon(grid1_size))
+
+      coslat = cos(grid1_center_lat)
+      coslon = cos(grid1_center_lon)
+      sinlat = sin(grid1_center_lat)
+      sinlon = sin(grid1_center_lon)
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop1: do dst_add = 1, grid2_size
+
+        if (.not. grid2_mask(dst_add)) cycle grid_loop1
+
+        coslat_dst = cos(grid2_center_lat(dst_add))
+        coslon_dst = cos(grid2_center_lon(dst_add))
+        sinlat_dst = sin(grid2_center_lat(dst_add))
+        sinlon_dst = sin(grid2_center_lon(dst_add))
+
+        !***
+        !*** find nearest grid points on source grid and
+        !*** distances to each point
+        !***
+
+        call grid_search_nbr(nbr_add, nbr_dist,  &
+                             grid2_center_lat(dst_add), &
+                             grid2_center_lon(dst_add), &
+                             coslat_dst, coslon_dst,  &
+                             sinlat_dst, sinlon_dst, &
+                             bin_addr1, bin_addr2)
+
+        !***
+        !*** compute weights based on inverse distance
+        !*** if mask is false, eliminate those points
+        !***
+
+        dist_tot = zero
+        do n=1,num_neighbors
+          if (grid1_mask(nbr_add(n))) then
+            nbr_dist(n) = one/nbr_dist(n)
+            dist_tot = dist_tot + nbr_dist(n)
+            nbr_mask(n) = .true.
+          else
+            nbr_mask(n) = .false.
+          endif
+        end do
+
+        !***
+        !*** normalize weights and store the link
+        !***
+
+        do n=1,num_neighbors
+          if (nbr_mask(n)) then
+            wgtstmp(1) = nbr_dist(n)/dist_tot
+            call store_link_nbr(nbr_add(n), dst_add, wgtstmp, nmap)
+            grid2_frac(dst_add) = one
+          endif
+        end do
+
+      end do grid_loop1
+
+      deallocate (coslat, coslon, sinlat, sinlon)
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid2 to grid1 if necessary
+!
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+
+      nmap = 2
+
+      !***
+      !*** compute cos, sin of lat/lon on source grid for distance
+      !*** calculations
+      !***
+
+      allocate (coslat(grid2_size), coslon(grid2_size), &
+                sinlat(grid2_size), sinlon(grid2_size))
+
+      coslat = cos(grid2_center_lat)
+      coslon = cos(grid2_center_lon)
+      sinlat = sin(grid2_center_lat)
+      sinlon = sin(grid2_center_lon)
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop2: do dst_add = 1, grid1_size
+
+        if (.not. grid1_mask(dst_add)) cycle grid_loop2
+
+        coslat_dst = cos(grid1_center_lat(dst_add))
+        coslon_dst = cos(grid1_center_lon(dst_add))
+        sinlat_dst = sin(grid1_center_lat(dst_add))
+        sinlon_dst = sin(grid1_center_lon(dst_add))
+
+        !***
+        !*** find four nearest grid points on source grid and
+        !*** distances to each point
+        !***
+
+        call grid_search_nbr(nbr_add, nbr_dist, &
+                             grid1_center_lat(dst_add), &
+                             grid1_center_lon(dst_add), &
+                             coslat_dst, coslon_dst,  &
+                             sinlat_dst, sinlon_dst, &
+                             bin_addr2, bin_addr1)
+
+        !***
+        !*** compute weights based on inverse distance
+        !*** if mask is false, eliminate those points
+        !***
+
+        dist_tot = zero
+        do n=1,num_neighbors
+          if (grid2_mask(nbr_add(n))) then
+            nbr_dist(n) = one/nbr_dist(n)
+            dist_tot = dist_tot + nbr_dist(n)
+            nbr_mask(n) = .true.
+          else
+            nbr_mask(n) = .false.
+          endif
+        end do
+
+        !***
+        !*** normalize weights and store the link
+        !***
+
+        do n=1,num_neighbors
+          if (nbr_mask(n)) then
+            wgtstmp(1) = nbr_dist(n)/dist_tot
+            call store_link_nbr(dst_add, nbr_add(n), wgtstmp, nmap)
+            grid1_frac(dst_add) = one
+          endif
+        end do
+
+      end do grid_loop2
+
+      deallocate (coslat, coslon, sinlat, sinlon)
+
+      endif
+
+      deallocate(wgtstmp)
+
+!-----------------------------------------------------------------------
+
+      end subroutine remap_distwgt
+
+!***********************************************************************
+
+      subroutine grid_search_nbr(nbr_add, nbr_dist, plat, plon,  &
+                     coslat_dst, coslon_dst, sinlat_dst, sinlon_dst, &
+                     src_bin_add, dst_bin_add)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the closest num_neighbor points to a search 
+!     point and computes a distance to each of the neighbors.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(num_neighbors), intent(out) :: &
+              nbr_add  ! address of each of the closest points
+
+      real (kind=dbl_kind), dimension(num_neighbors), intent(out) :: &
+              nbr_dist ! distance to each of the closest points
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(:,:), intent(in) :: &
+              src_bin_add,  & ! search bins for restricting search
+              dst_bin_add   
+
+      real (kind=dbl_kind), intent(in) :: &
+              plat,          & ! latitude  of the search point
+              plon,          & ! longitude of the search point
+              coslat_dst,    & ! cos(lat)  of the search point
+              coslon_dst,    & ! cos(lon)  of the search point
+              sinlat_dst,    & ! sin(lat)  of the search point
+              sinlon_dst    ! sin(lon)  of the search point
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, nmax, nadd, nchk,  & ! dummy indices
+              min_add, max_add, nm1, np1, i, j, ip1, im1, jp1, jm1
+
+      real (kind=dbl_kind) :: &
+              distance      ! angular distance
+
+!-----------------------------------------------------------------------
+!
+!     loop over source grid and find nearest neighbors
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** restrict the search using search bins
+      !*** expand the bins to catch neighbors
+      !***
+
+      select case (restrict_type)
+      case('latitude')
+
+        do n=1,num_srch_bins
+          if (plat >= bin_lats(1,n) .and. plat <= bin_lats(2,n)) then
+            min_add = src_bin_add(1,n)
+            max_add = src_bin_add(2,n)
+
+            nm1 = max(n-1,1)
+            np1 = min(n+1,num_srch_bins)
+
+            min_add = min(min_add,src_bin_add(1,nm1))
+            max_add = max(max_add,src_bin_add(2,nm1))
+            min_add = min(min_add,src_bin_add(1,np1))
+            max_add = max(max_add,src_bin_add(2,np1))
+          endif
+        end do
+
+      case('latlon')
+
+        n = 0
+        nmax = nint(sqrt(real(num_srch_bins)))
+        do j=1,nmax
+        jp1 = min(j+1,nmax)
+        jm1 = max(j-1,1)
+        do i=1,nmax
+          ip1 = min(i+1,nmax)
+          im1 = max(i-1,1)
+
+          n = n+1
+          if (plat >= bin_lats(1,n) .and. plat <= bin_lats(2,n) .and. &
+              plon >= bin_lons(1,n) .and. plon <= bin_lons(3,n)) then
+            min_add = src_bin_add(1,n)
+            max_add = src_bin_add(2,n)
+
+            nm1 = (jm1-1)*nmax + im1
+            np1 = (jp1-1)*nmax + ip1
+            nm1 = max(nm1,1)
+            np1 = min(np1,num_srch_bins)
+
+            min_add = min(min_add,src_bin_add(1,nm1))
+            max_add = max(max_add,src_bin_add(2,nm1))
+            min_add = min(min_add,src_bin_add(1,np1))
+            max_add = max(max_add,src_bin_add(2,np1))
+          endif
+        end do
+        end do
+
+      end select
+
+      !***
+      !*** initialize distance and address arrays
+      !***
+
+      nbr_add = 0
+      nbr_dist = bignum
+
+      do nadd=min_add,max_add
+
+        !***
+        !*** find distance to this point
+        !***
+
+        distance = acos(sinlat_dst*sinlat(nadd) + &
+                        coslat_dst*coslat(nadd)* &
+                       (coslon_dst*coslon(nadd) + &
+                        sinlon_dst*sinlon(nadd)) )
+
+        !***
+        !*** store the address and distance if this is one of the
+        !*** smallest four so far
+        !***
+
+        check_loop: do nchk=1,num_neighbors
+          if (distance .lt. nbr_dist(nchk)) then
+            do n=num_neighbors,nchk+1,-1
+              nbr_add(n) = nbr_add(n-1)
+              nbr_dist(n) = nbr_dist(n-1)
+            end do
+            nbr_add(nchk) = nadd
+            nbr_dist(nchk) = distance
+            exit check_loop
+          endif
+        end do check_loop
+
+      end do
+
+!-----------------------------------------------------------------------
+
+      end subroutine grid_search_nbr 
+
+!***********************************************************************
+
+      subroutine store_link_nbr(add1, add2, weights, nmap)
+
+!-----------------------------------------------------------------------
+!
+!     this routine stores the address and weight for this link in
+!     the appropriate address and weight arrays and resizes those
+!     arrays if necessary.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: &
+              add1,   & ! address on grid1
+              add2,   & ! address on grid2
+              nmap   ! identifies which direction for mapping
+
+      real (kind=dbl_kind), dimension(:), intent(in) :: &
+              weights ! array of remapping weights for this link
+
+!-----------------------------------------------------------------------
+!
+!     increment number of links and check to see if remap arrays need
+!     to be increased to accomodate the new link.  then store the
+!     link.
+!
+!-----------------------------------------------------------------------
+
+      select case (nmap)
+      case(1)
+
+        num_links_map1  = num_links_map1 + 1
+
+        if (num_links_map1 > max_links_map1)  &
+           call resize_remap_vars(1,resize_increment)
+
+        grid1_add_map1(num_links_map1) = add1
+        grid2_add_map1(num_links_map1) = add2
+        wts_map1    (:,num_links_map1) = weights
+
+      case(2)
+
+        num_links_map2  = num_links_map2 + 1
+
+        if (num_links_map2 > max_links_map2)  &
+           call resize_remap_vars(2,resize_increment)
+
+        grid1_add_map2(num_links_map2) = add1
+        grid2_add_map2(num_links_map2) = add2
+        wts_map2    (:,num_links_map2) = weights
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine store_link_nbr
+
+!***********************************************************************
+
+      end module remap_distance_weight
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/src/remap_read.f90
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/src/remap_read.f90	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/src/remap_read.f90	(revision 12863)
@@ -0,0 +1,1027 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This routine reads remapping information from files written
+!     by remap_setup.  If remapping in both directions are required,
+!     two input files must be specified.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_read.f,v 1.6 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_read
+
+!-----------------------------------------------------------------------
+!
+!     contains routines for reading a remap file
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines useful constants
+      use grids         ! includes all grid information
+      use netcdf_mod    ! module with netcdf vars and utilities
+      use remap_vars    ! module for all required remapping variables
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!     various netCDF ids for files variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), private ::  & ! netCDF ids
+               ncstat, nc_file_id, &
+               nc_srcgrdsize_id, nc_dstgrdsize_id, &
+               nc_srcgrdcorn_id, nc_dstgrdcorn_id, &
+               nc_srcgrdrank_id, nc_dstgrdrank_id, &
+               nc_srcgrddims_id, nc_dstgrddims_id, &
+               nc_numlinks_id, nc_numwgts_id,  &
+               nc_srcgrdimask_id, nc_dstgrdimask_id, &
+               nc_srcgrdcntrlat_id, nc_srcgrdcntrlon_id, &
+               nc_srcgrdcrnrlat_id, nc_srcgrdcrnrlon_id, &
+               nc_srcgrdarea_id, nc_srcgrdfrac_id, &
+               nc_dstgrdcntrlat_id, nc_dstgrdcntrlon_id, &
+               nc_dstgrdcrnrlat_id, nc_dstgrdcrnrlon_id, &
+               nc_dstgrdarea_id, nc_dstgrdfrac_id, &
+               nc_srcgrdadd_id, nc_dstgrdadd_id, nc_rmpmatrix_id
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine read_remap(map_name, interp_file)
+
+!-----------------------------------------------------------------------
+!
+!     this driver routine reads some global attributes and then
+!     calls a specific read routine based on file conventions
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) :: &
+        interp_file        ! filename for remap data
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(out) :: &
+        map_name            ! name for mapping
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len) ::  &
+         map_method        & ! character string for map_type
+      ,  normalize_opt     & ! character string for normalization option
+      ,  convention       ! character string for output convention
+
+!-----------------------------------------------------------------------
+!
+!     open file and read some global information
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_open(interp_file, NF_NOWRITE, nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map name
+      !***
+      map_name = ' '
+      ncstat = nf_get_att_text(nc_file_id, NF_GLOBAL, 'title', &
+                               map_name)
+      call netcdf_error_handler(ncstat)
+
+      print *,'Reading remapping:',trim(map_name)
+      print *,'From file:',trim(interp_file)
+
+      !***
+      !*** normalization option
+      !***
+      normalize_opt = ' '
+      ncstat = nf_get_att_text(nc_file_id, NF_GLOBAL, 'normalization', &
+                               normalize_opt)
+      call netcdf_error_handler(ncstat)
+
+      select case(normalize_opt)
+      case ('none')
+        norm_opt = norm_opt_none
+      case ('fracarea')
+        norm_opt = norm_opt_frcarea
+      case ('destarea')
+        norm_opt = norm_opt_dstarea
+      case default
+        print *,'normalize_opt = ',normalize_opt
+        stop 'Invalid normalization option'
+      end select
+
+      !***
+      !*** map method
+      !***
+      map_method = ' '
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'map_method', &
+                                map_method)
+      call netcdf_error_handler(ncstat)
+
+      select case(map_method)
+      case('Conservative remapping')
+        map_type = map_type_conserv
+      case('Bilinear remapping')
+        map_type = map_type_bilinear
+      case('Distance weighted avg of nearest neighbors')
+        map_type = map_type_distwgt
+      case('Bicubic remapping')
+        map_type = map_type_bicubic
+      case default
+        print *,'map_type = ',map_method
+        stop 'Invalid Map Type'
+      end select
+
+      !***
+      !*** file convention
+      !***
+      convention = ' '
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'conventions', &
+                                convention)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate read routine based on output convention
+!
+!-----------------------------------------------------------------------
+
+      select case(convention)
+      case ('SCRIP')
+        call read_remap_scrip
+      case ('NCAR-CSM')
+        call read_remap_csm
+      case default
+        print *,'convention = ',convention
+        stop 'unknown output file convention'
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine read_remap
+
+!***********************************************************************
+
+      subroutine read_remap_scrip
+
+!-----------------------------------------------------------------------
+!
+!     the routine reads a netCDF file to extract remapping info
+!     in SCRIP format
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) :: &
+        grid1_name            & ! grid name for source grid
+      , grid2_name           ! grid name for dest   grid
+
+      integer (kind=int_kind) ::   &
+        n                    ! dummy index
+
+      integer (kind=int_kind), dimension(:), allocatable :: &
+        grid1_mask_int,       & ! integer masks to determine
+        grid2_mask_int       ! cells that participate in map
+
+!-----------------------------------------------------------------------
+!
+!     read some additional global attributes
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** source and destination grid names
+      !***
+
+      grid1_name = ' '
+      grid2_name = ' '
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'source_grid', &
+                                grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'dest_grid', &
+                                grid2_name)
+      call netcdf_error_handler(ncstat)
+
+      print *,' '
+      print *,'Remapping between:',trim(grid1_name)
+      print *,'and ',trim(grid2_name)
+      print *,' '
+
+!-----------------------------------------------------------------------
+!
+!     read dimension information
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_inq_dimid(nc_file_id, 'src_grid_size',  &
+                            nc_srcgrdsize_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdsize_id, grid1_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_size',  &
+                            nc_dstgrdsize_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdsize_id, grid2_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'src_grid_corners',  &
+                            nc_srcgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdcorn_id,  &
+                             grid1_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_corners',  &
+                            nc_dstgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdcorn_id,  &
+                             grid2_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'src_grid_rank',  &
+                            nc_srcgrdrank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdrank_id,  &
+                             grid1_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_rank',  &
+                            nc_dstgrdrank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdrank_id,  &
+                             grid2_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'num_links',  &
+                            nc_numlinks_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_numlinks_id,  &
+                             num_links_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'num_wgts',  &
+                            nc_numwgts_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_numwgts_id, num_wts)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     allocate arrays
+!
+!-----------------------------------------------------------------------
+
+      allocate( grid1_dims      (grid1_rank), &
+                grid1_center_lat(grid1_size),  &
+                grid1_center_lon(grid1_size), &
+                grid1_area      (grid1_size), &
+                grid1_frac      (grid1_size), &
+                grid1_mask      (grid1_size), &
+                grid1_mask_int  (grid1_size), &
+                grid1_corner_lat(grid1_corners, grid1_size), &
+                grid1_corner_lon(grid1_corners, grid1_size) )
+
+      allocate( grid2_dims      (grid2_rank), &
+                grid2_center_lat(grid2_size),  &
+                grid2_center_lon(grid2_size), &
+                grid2_area      (grid2_size), &
+                grid2_frac      (grid2_size), &
+                grid2_mask      (grid2_size), &
+                grid2_mask_int  (grid2_size), &
+                grid2_corner_lat(grid2_corners, grid2_size), &
+                grid2_corner_lon(grid2_corners, grid2_size) )
+
+      allocate( grid1_add_map1(num_links_map1), &
+                grid2_add_map1(num_links_map1), &
+                wts_map1(num_wts,num_links_map1) )
+
+!-----------------------------------------------------------------------
+!
+!     get variable ids
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_dims',  &
+                            nc_srcgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_imask',  &
+                            nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_center_lat',  &
+                                         nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_center_lon',  &
+                                         nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_corner_lat',  &
+                                         nc_srcgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_corner_lon',  &
+                                         nc_srcgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_area',  &
+                                         nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_frac',  &
+                                         nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_dims',  &
+                            nc_dstgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_imask',  &
+                            nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_center_lat',  &
+                                         nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_center_lon',  &
+                                         nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_corner_lat',  &
+                                         nc_dstgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_corner_lon',  &
+                                         nc_dstgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_area',  &
+                                         nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_frac',  &
+                                         nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_address',  &
+                                         nc_srcgrdadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_address',  &
+                                         nc_dstgrdadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'remap_matrix',  &
+                                         nc_rmpmatrix_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     read all variables
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrddims_id,  &
+                              grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrdimask_id,  &
+                              grid1_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlat_id,  &
+                                             grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlon_id,  &
+                                             grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      grid1_units = ' '
+      ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcntrlat_id, 'units', &
+                               grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+        grid1_center_lat = grid1_center_lat*deg2rad
+        grid1_center_lon = grid1_center_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid1 center lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlat_id,  &
+                                             grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlon_id,  &
+                                             grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      grid1_units = ' '
+      ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcrnrlat_id, 'units', &
+                               grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+        grid1_corner_lat = grid1_corner_lat*deg2rad
+        grid1_corner_lon = grid1_corner_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid1 corner lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdarea_id,  &
+                                             grid1_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdfrac_id,  &
+                                             grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrddims_id,  &
+                              grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrdimask_id,  &
+                              grid2_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlat_id,  &
+                                             grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlon_id,  &
+                                             grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      grid2_units = ' '
+      ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcntrlat_id, 'units', &
+                               grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+        grid2_center_lat = grid2_center_lat*deg2rad
+        grid2_center_lon = grid2_center_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid2 center lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlat_id,  &
+                                             grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlon_id,  &
+                                             grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      grid2_units = ' '
+      ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcrnrlat_id, 'units', &
+                               grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+        grid2_corner_lat = grid2_corner_lat*deg2rad
+        grid2_corner_lon = grid2_corner_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid2 corner lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdarea_id,  &
+                                             grid2_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdfrac_id,  &
+                                             grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrdadd_id,  &
+                              grid1_add_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrdadd_id,  &
+                              grid2_add_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_rmpmatrix_id,  &
+                                             wts_map1)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     initialize logical mask 
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_mask_int == 1)
+        grid1_mask = .true.
+      elsewhere
+        grid1_mask = .false.
+      endwhere
+      where (grid2_mask_int == 1)
+        grid2_mask = .true.
+      elsewhere
+        grid2_mask = .false.
+      endwhere
+      deallocate(grid1_mask_int, grid2_mask_int)
+
+!-----------------------------------------------------------------------
+!
+!     close input file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_close(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end subroutine read_remap_scrip
+
+!***********************************************************************
+
+      subroutine read_remap_csm
+
+!-----------------------------------------------------------------------
+!
+!     the routine reads a netCDF file to extract remapping info
+!     in NCAR-CSM format
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) :: &
+        grid1_name            & ! grid name for source grid
+      , grid2_name           ! grid name for dest   grid
+
+      integer (kind=int_kind) :: &
+        nc_numwgts1_id     & ! extra netCDF id for num_wgts > 1 
+      , nc_rmpmatrix2_id  ! extra netCDF id for high-order remap matrix
+
+      real (kind=dbl_kind), dimension(:),allocatable :: &
+        wts1              ! CSM wants single array for 1st-order wts
+
+      real (kind=dbl_kind), dimension(:,:),allocatable :: &
+        wts2              ! write remaining weights in different array
+
+      integer (kind=int_kind) ::   &
+        n                    ! dummy index
+
+      integer (kind=int_kind), dimension(:), allocatable :: &
+        grid1_mask_int,       & ! integer masks to determine
+        grid2_mask_int       ! cells that participate in map
+
+!-----------------------------------------------------------------------
+!
+!     read some additional global attributes
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** source and destination grid names
+      !***
+
+      grid1_name = ' '
+      grid2_name = ' '
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'domain_a', &
+                                grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'domain_b', &
+                                grid2_name)
+      call netcdf_error_handler(ncstat)
+
+      print *,' '
+      print *,'Remapping between:',trim(grid1_name)
+      print *,'and ',trim(grid2_name)
+      print *,' '
+
+!-----------------------------------------------------------------------
+!
+!     read dimension information
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_inq_dimid(nc_file_id, 'n_a', nc_srcgrdsize_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdsize_id, grid1_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'n_b', nc_dstgrdsize_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdsize_id, grid2_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'nv_a', nc_srcgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdcorn_id,  &
+                             grid1_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'nv_b', nc_dstgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdcorn_id,  &
+                             grid2_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'src_grid_rank',  &
+                            nc_srcgrdrank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdrank_id,  &
+                             grid1_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_rank',  &
+                            nc_dstgrdrank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdrank_id,  &
+                             grid2_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'n_s',  &
+                            nc_numlinks_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_numlinks_id,  &
+                             num_links_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'num_wgts',  &
+                            nc_numwgts_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_numwgts_id, num_wts)
+      call netcdf_error_handler(ncstat)
+
+      if (num_wts > 1) then
+        ncstat = nf_inq_dimid(nc_file_id, 'num_wgts1',  &
+                              nc_numwgts1_id)
+        call netcdf_error_handler(ncstat)
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     allocate arrays
+!
+!-----------------------------------------------------------------------
+
+      allocate( grid1_dims      (grid1_rank), &
+                grid1_center_lat(grid1_size),  &
+                grid1_center_lon(grid1_size), &
+                grid1_area      (grid1_size), &
+                grid1_frac      (grid1_size), &
+                grid1_mask      (grid1_size), &
+                grid1_mask_int  (grid1_size), &
+                grid1_corner_lat(grid1_corners, grid1_size), &
+                grid1_corner_lon(grid1_corners, grid1_size) )
+
+      allocate( grid2_dims      (grid2_rank), &
+                grid2_center_lat(grid2_size),  &
+                grid2_center_lon(grid2_size), &
+                grid2_area      (grid2_size), &
+                grid2_frac      (grid2_size), &
+                grid2_mask      (grid2_size), &
+                grid2_mask_int  (grid2_size), &
+                grid2_corner_lat(grid2_corners, grid2_size), &
+                grid2_corner_lon(grid2_corners, grid2_size) )
+
+      allocate( grid1_add_map1(num_links_map1), &
+                grid2_add_map1(num_links_map1), &
+                wts_map1(num_wts,num_links_map1), &
+                wts1(num_links_map1), &
+                wts2(num_wts-1,num_links_map1) )
+
+!-----------------------------------------------------------------------
+!
+!     get variable ids
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_dims',  &
+                            nc_srcgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'mask_a',  &
+                            nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'yc_a', nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'xc_a', nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'yv_a', nc_srcgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'xv_a', nc_srcgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'area_a', nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'frac_a', nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_dims',  &
+                            nc_dstgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'mask_b',  &
+                            nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'yc_b', nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'xc_b', nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'yv_b', nc_dstgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'xv_b', nc_dstgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'area_b', nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'frac_b', nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'col', nc_srcgrdadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'row', nc_dstgrdadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'S', nc_rmpmatrix_id)
+      call netcdf_error_handler(ncstat)
+
+      if (num_wts > 1) then
+        ncstat = nf_inq_varid(nc_file_id, 'S2', nc_rmpmatrix2_id)
+        call netcdf_error_handler(ncstat)
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     read all variables
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrddims_id,  &
+                              grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrdimask_id,  &
+                              grid1_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlat_id,  &
+                                             grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlon_id,  &
+                                             grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcntrlat_id, 'units', &
+                               grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+        grid1_center_lat = grid1_center_lat*deg2rad
+        grid1_center_lon = grid1_center_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid1 center lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlat_id,  &
+                                             grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlon_id,  &
+                                             grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcrnrlat_id, 'units', &
+                               grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+        grid1_corner_lat = grid1_corner_lat*deg2rad
+        grid1_corner_lon = grid1_corner_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid1 corner lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdarea_id,  &
+                                             grid1_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdfrac_id,  &
+                                             grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrddims_id,  &
+                              grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrdimask_id,  &
+                              grid2_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlat_id,  &
+                                             grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlon_id,  &
+                                             grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcntrlat_id, 'units', &
+                               grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+        grid2_center_lat = grid2_center_lat*deg2rad
+        grid2_center_lon = grid2_center_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid2 center lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlat_id,  &
+                                             grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlon_id,  &
+                                             grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+
+      ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcrnrlat_id, 'units', &
+                               grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+        grid2_corner_lat = grid2_corner_lat*deg2rad
+        grid2_corner_lon = grid2_corner_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid2 corner lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdarea_id,  &
+                                             grid2_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdfrac_id,  &
+                                             grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrdadd_id,  &
+                              grid1_add_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrdadd_id,  &
+                              grid2_add_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_rmpmatrix_id,  &
+                                             wts1)
+      wts_map1(1,:) = wts1
+      deallocate(wts1)
+
+      if (num_wts > 1) then
+        ncstat = nf_get_var_double(nc_file_id, nc_rmpmatrix2_id,  &
+                                               wts2)
+        wts_map1(2:,:) = wts2
+        deallocate(wts2)
+      endif
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     initialize logical mask 
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_mask_int == 1)
+        grid1_mask = .true.
+      elsewhere
+        grid1_mask = .false.
+      endwhere
+      where (grid2_mask_int == 1)
+        grid2_mask = .true.
+      elsewhere
+        grid2_mask = .false.
+      endwhere
+      deallocate(grid1_mask_int, grid2_mask_int)
+
+!-----------------------------------------------------------------------
+!
+!     close input file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_close(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end subroutine read_remap_csm
+
+!***********************************************************************
+
+      end module remap_read
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/src/remap_vars.f90
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/src/remap_vars.f90	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/src/remap_vars.f90	(revision 12863)
@@ -0,0 +1,302 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary variables for remapping between
+!     two grids.  also routines for resizing and initializing these
+!     variables.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_vars.f,v 1.5 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_vars
+
+      use kinds_mod
+      use constants
+      use grids
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter :: &
+            norm_opt_none    = 1 &
+      ,     norm_opt_dstarea = 2 &
+      ,     norm_opt_frcarea = 3
+
+      integer (kind=int_kind), parameter :: &
+            map_type_conserv  = 1 &
+      ,     map_type_bilinear = 2 &
+      ,     map_type_bicubic  = 3 &
+      ,     map_type_distwgt  = 4
+
+      integer (kind=int_kind), save ::  &
+            max_links_map1   & ! current size of link arrays
+      ,     num_links_map1   & ! actual number of links for remapping
+      ,     max_links_map2   & ! current size of link arrays
+      ,     num_links_map2   & ! actual number of links for remapping
+      ,     num_maps         & ! num of remappings for this grid pair
+      ,     num_wts          & ! num of weights used in remapping
+      ,     map_type         & ! identifier for remapping method
+      ,     norm_opt         & ! option for normalization (conserv only)
+      ,     resize_increment ! default amount to increase array size
+
+      integer (kind=int_kind), dimension(:), allocatable, save :: &
+            grid1_add_map1,  & ! grid1 address for each link in mapping 1
+            grid2_add_map1,  & ! grid2 address for each link in mapping 1
+            grid1_add_map2,  & ! grid1 address for each link in mapping 2
+            grid2_add_map2  ! grid2 address for each link in mapping 2
+
+      real (kind=dbl_kind), dimension(:,:), allocatable, save :: &
+            wts_map1,  & ! map weights for each link (num_wts,max_links)
+            wts_map2  ! map weights for each link (num_wts,max_links)
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine init_remap_vars
+
+!-----------------------------------------------------------------------
+!
+!     this routine initializes some variables and provides an initial
+!     allocation of arrays (fairly large so frequent resizing 
+!     unnecessary).
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     determine the number of weights
+!
+!-----------------------------------------------------------------------
+
+      select case (map_type)
+      case(map_type_conserv)
+        num_wts = 3
+      case(map_type_bilinear)
+        num_wts = 1
+      case(map_type_bicubic)
+        num_wts = 4
+      case(map_type_distwgt)
+        num_wts = 1
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     initialize num_links and set max_links to four times the largest 
+!     of the destination grid sizes initially (can be changed later).
+!     set a default resize increment to increase the size of link
+!     arrays if the number of links exceeds the initial size
+!   
+!-----------------------------------------------------------------------
+
+      num_links_map1 = 0
+      max_links_map1 = 4*grid2_size
+      if (num_maps > 1) then
+        num_links_map2 = 0
+        max_links_map1 = max(4*grid1_size,4*grid2_size)
+        max_links_map2 = max_links_map1
+      endif
+
+      resize_increment = 0.1*max(grid1_size,grid2_size)
+
+!-----------------------------------------------------------------------
+!
+!     allocate address and weight arrays for mapping 1
+!   
+!-----------------------------------------------------------------------
+
+      allocate (grid1_add_map1(max_links_map1), &
+                grid2_add_map1(max_links_map1), &
+                wts_map1(num_wts, max_links_map1))
+
+!-----------------------------------------------------------------------
+!
+!     allocate address and weight arrays for mapping 2 if necessary 
+!   
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+        allocate (grid1_add_map2(max_links_map2), &
+                  grid2_add_map2(max_links_map2), &
+                  wts_map2(num_wts, max_links_map2))
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine init_remap_vars
+
+!***********************************************************************
+
+      subroutine resize_remap_vars(nmap, increment)
+
+!-----------------------------------------------------------------------
+!
+!     this routine resizes remapping arrays by increasing(decreasing)
+!     the max_links by increment
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: &
+           nmap,       & ! identifies which mapping array to resize
+           increment  ! the number of links to add(subtract) to arrays
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: &
+         ierr,      & ! error flag
+         mxlinks   ! size of link arrays
+
+      integer (kind=int_kind), dimension(:), allocatable :: &
+         add1_tmp,  & ! temp array for resizing address arrays
+         add2_tmp  ! temp array for resizing address arrays
+
+      real (kind=dbl_kind), dimension(:,:), allocatable :: &
+         wts_tmp   ! temp array for resizing weight arrays
+
+!-----------------------------------------------------------------------
+!
+!     resize map 1 arrays if required.
+!
+!-----------------------------------------------------------------------
+
+      select case (nmap)
+      case(1)
+
+        !***
+        !*** allocate temporaries to hold original values
+        !***
+
+        mxlinks = size(grid1_add_map1)
+        allocate (add1_tmp(mxlinks), add2_tmp(mxlinks),  &
+                  wts_tmp(num_wts,mxlinks))
+
+        add1_tmp = grid1_add_map1
+        add2_tmp = grid2_add_map1
+        wts_tmp  = wts_map1
+        
+        !***
+        !*** deallocate originals and increment max_links then
+        !*** reallocate arrays at new size
+        !***
+
+        deallocate (grid1_add_map1, grid2_add_map1, wts_map1)
+        max_links_map1 = mxlinks + increment
+        allocate (grid1_add_map1(max_links_map1), &
+                  grid2_add_map1(max_links_map1), &
+                  wts_map1(num_wts,max_links_map1))
+
+        !***
+        !*** restore original values from temp arrays and
+        !*** deallocate temps
+        !***
+
+        mxlinks = min(mxlinks, max_links_map1)
+        grid1_add_map1(1:mxlinks) = add1_tmp (1:mxlinks)
+        grid2_add_map1(1:mxlinks) = add2_tmp (1:mxlinks)
+        wts_map1    (:,1:mxlinks) = wts_tmp(:,1:mxlinks)
+        deallocate(add1_tmp, add2_tmp, wts_tmp)
+
+!-----------------------------------------------------------------------
+!
+!     resize map 2 arrays if required.
+!
+!-----------------------------------------------------------------------
+
+      case(2)
+
+        !***
+        !*** allocate temporaries to hold original values
+        !***
+
+        mxlinks = size(grid1_add_map2)
+        allocate (add1_tmp(mxlinks), add2_tmp(mxlinks),  &
+                  wts_tmp(num_wts,mxlinks),stat=ierr)
+        if (ierr .ne. 0) then
+          print *,'error allocating temps in resize: ',ierr
+          stop
+        endif
+
+        add1_tmp = grid1_add_map2
+        add2_tmp = grid2_add_map2
+        wts_tmp  = wts_map2
+        
+        !***
+        !*** deallocate originals and increment max_links then
+        !*** reallocate arrays at new size
+        !***
+
+        deallocate (grid1_add_map2, grid2_add_map2, wts_map2)
+        max_links_map2 = mxlinks + increment
+        allocate (grid1_add_map2(max_links_map2), &
+                  grid2_add_map2(max_links_map2), &
+                  wts_map2(num_wts,max_links_map2),stat=ierr)
+        if (ierr .ne. 0) then
+          print *,'error allocating new arrays in resize: ',ierr
+          stop
+        endif
+
+
+        !***
+        !*** restore original values from temp arrays and
+        !*** deallocate temps
+        !***
+
+        mxlinks = min(mxlinks, max_links_map2)
+        grid1_add_map2(1:mxlinks) = add1_tmp (1:mxlinks)
+        grid2_add_map2(1:mxlinks) = add2_tmp (1:mxlinks)
+        wts_map2    (:,1:mxlinks) = wts_tmp(:,1:mxlinks)
+        deallocate(add1_tmp, add2_tmp, wts_tmp)
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine resize_remap_vars
+
+!***********************************************************************
+
+      end module remap_vars
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/src/remap_write.f90
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/src/remap_write.f90	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/src/remap_write.f90	(revision 12863)
@@ -0,0 +1,1763 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module contains routines for writing the remapping data to 
+!     a file.  Before writing the data for each mapping, the links are 
+!     sorted by destination grid address.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_write.f,v 1.7 2001/08/21 21:06:42 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_write
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common scalar constants
+      use grids         ! module containing grid information
+      use remap_vars    ! module containing remap information
+      use netcdf_mod    ! module with netCDF stuff
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), private ::  &
+         map_method        & ! character string for map_type
+      ,  normalize_opt     & ! character string for normalization option
+      ,  history           & ! character string for history information
+      ,  convention       ! character string for output convention
+
+      character(8), private ::  &
+         cdate            ! character date string
+
+      integer (kind=int_kind), dimension(:), allocatable, private :: &
+         src_mask_int      & ! integer masks to determine
+      ,  dst_mask_int     ! cells that participate in map
+
+!-----------------------------------------------------------------------
+!
+!     various netCDF identifiers used by output routines
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), private :: &
+         ncstat                & ! error flag for netCDF calls 
+      ,  nc_file_id            & ! id for netCDF file
+      ,  nc_srcgrdsize_id      & ! id for source grid size
+      ,  nc_dstgrdsize_id      & ! id for destination grid size
+      ,  nc_srcgrdcorn_id      & ! id for number of source grid corners
+      ,  nc_dstgrdcorn_id      & ! id for number of dest grid corners
+      ,  nc_srcgrdrank_id      & ! id for source grid rank
+      ,  nc_dstgrdrank_id      & ! id for dest grid rank
+      ,  nc_numlinks_id        & ! id for number of links in mapping
+      ,  nc_numwgts_id         & ! id for number of weights for mapping
+      ,  nc_srcgrddims_id      & ! id for source grid dimensions
+      ,  nc_dstgrddims_id      & ! id for dest grid dimensions
+      ,  nc_srcgrdcntrlat_id   & ! id for source grid center latitude
+      ,  nc_dstgrdcntrlat_id   & ! id for dest grid center latitude
+      ,  nc_srcgrdcntrlon_id   & ! id for source grid center longitude
+      ,  nc_dstgrdcntrlon_id   & ! id for dest grid center longitude
+      ,  nc_srcgrdimask_id     & ! id for source grid mask
+      ,  nc_dstgrdimask_id     & ! id for dest grid mask
+      ,  nc_srcgrdcrnrlat_id   & ! id for latitude of source grid corners
+      ,  nc_srcgrdcrnrlon_id   & ! id for longitude of source grid corners
+      ,  nc_dstgrdcrnrlat_id   & ! id for latitude of dest grid corners
+      ,  nc_dstgrdcrnrlon_id   & ! id for longitude of dest grid corners
+      ,  nc_srcgrdarea_id      & ! id for area of source grid cells
+      ,  nc_dstgrdarea_id      & ! id for area of dest grid cells
+      ,  nc_srcgrdfrac_id      & ! id for area fraction on source grid
+      ,  nc_dstgrdfrac_id      & ! id for area fraction on dest grid
+      ,  nc_srcadd_id          & ! id for map source address
+      ,  nc_dstadd_id          & ! id for map destination address
+      ,  nc_rmpmatrix_id      ! id for remapping matrix
+
+      integer (kind=int_kind), dimension(2), private :: &
+         nc_dims2_id  ! netCDF ids for 2d array dims
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine write_remap(map1_name, map2_name,  &
+                             interp_file1, interp_file2, output_opt)
+
+!-----------------------------------------------------------------------
+!
+!     calls correct output routine based on output format choice
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) :: &
+                  map1_name,     & ! name for mapping grid1 to grid2
+                  map2_name,     & ! name for mapping grid2 to grid1
+                  interp_file1,  & ! filename for map1 remap data
+                  interp_file2,  & ! filename for map2 remap data
+                  output_opt    ! option for output conventions
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     define some common variables to be used in all routines
+!
+!-----------------------------------------------------------------------
+
+      select case(norm_opt)
+      case (norm_opt_none)
+        normalize_opt = 'none'
+      case (norm_opt_frcarea)
+        normalize_opt = 'fracarea'
+      case (norm_opt_dstarea)
+        normalize_opt = 'destarea'
+      end select
+
+      select case(map_type)
+      case(map_type_conserv)
+        map_method = 'Conservative remapping'
+      case(map_type_bilinear)
+        map_method = 'Bilinear remapping'
+      case(map_type_distwgt)
+        map_method = 'Distance weighted avg of nearest neighbors'
+      case(map_type_bicubic)
+        map_method = 'Bicubic remapping'
+      case default
+        stop 'Invalid Map Type'
+      end select
+
+      call date_and_time(date=cdate)
+      write (history,1000) cdate(5:6),cdate(7:8),cdate(1:4)
+ 1000 format('Created: ',a2,'-',a2,'-',a4)
+
+!-----------------------------------------------------------------------
+!
+!     sort address and weight arrays
+!
+!-----------------------------------------------------------------------
+
+      call sort_add(grid2_add_map1, grid1_add_map1, wts_map1)
+      if (num_maps > 1) then
+        call sort_add(grid1_add_map2, grid2_add_map2, wts_map2)
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate output routine
+!
+!-----------------------------------------------------------------------
+
+      select case(output_opt)
+      case ('scrip')
+        call write_remap_scrip(map1_name, interp_file1, 1)
+      case ('ncar-csm')
+        call write_remap_csm  (map1_name, interp_file1, 1)
+      case default
+        stop 'unknown output file convention'
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate output routine for second mapping if required
+!
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+        select case(output_opt)
+        case ('scrip')
+          call write_remap_scrip(map2_name, interp_file2, 2)
+        case ('ncar-csm')
+          call write_remap_csm  (map2_name, interp_file2, 2)
+        case default
+          stop 'unknown output file convention'
+        end select
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine write_remap
+
+!***********************************************************************
+
+      subroutine write_remap_scrip(map_name, interp_file, direction)
+
+!-----------------------------------------------------------------------
+!
+!     writes remap data to a netCDF file using SCRIP conventions
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) :: &
+                  map_name      & ! name for mapping 
+      ,           interp_file  ! filename for remap data
+
+      integer (kind=int_kind), intent(in) :: &
+        direction              ! direction of map (1=grid1 to grid2
+                               !                   2=grid2 to grid1)
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len) :: &
+        grid1_ctmp         & ! character temp for grid1 names
+      , grid2_ctmp        ! character temp for grid2 names
+
+      integer (kind=int_kind) :: &
+        itmp1              & ! integer temp
+      , itmp2              & ! integer temp
+      , itmp3              & ! integer temp
+      , itmp4             ! integer temp
+
+!-----------------------------------------------------------------------
+!
+!     create netCDF file for mapping and define some global attributes
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_create (interp_file, NF_CLOBBER, nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map name
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'title', &
+                                len_trim(map_name), map_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** normalization option
+      !***
+      ncstat = nf_put_att_text(nc_file_id, NF_GLOBAL, 'normalization', &
+                               len_trim(normalize_opt), normalize_opt)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map method
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'map_method', &
+                                len_trim(map_method), map_method)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** history
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'history', &
+                                len_trim(history), history)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** file convention
+      !***
+      convention = 'SCRIP'
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'conventions', &
+                                len_trim(convention), convention)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** source and destination grid names
+      !***
+
+      if (direction == 1) then
+        grid1_ctmp = 'source_grid'
+        grid2_ctmp = 'dest_grid'
+      else
+        grid1_ctmp = 'dest_grid'
+        grid2_ctmp = 'source_grid'
+      endif
+
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid1_ctmp), &
+                                len_trim(grid1_name), grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid2_ctmp), &
+                                len_trim(grid2_name), grid2_name)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     prepare netCDF dimension info
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** define grid size dimensions
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_size
+        itmp2 = grid2_size
+      else
+        itmp1 = grid2_size
+        itmp2 = grid1_size
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'src_grid_size', itmp1,  &
+                           nc_srcgrdsize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'dst_grid_size', itmp2,  &
+                           nc_dstgrdsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner dimension
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_corners
+        itmp2 = grid2_corners
+      else
+        itmp1 = grid2_corners
+        itmp2 = grid1_corners
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'src_grid_corners',  &
+                           itmp1, nc_srcgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'dst_grid_corners',  &
+                           itmp2, nc_dstgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid rank dimension
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_rank
+        itmp2 = grid2_rank
+      else
+        itmp1 = grid2_rank
+        itmp2 = grid1_rank
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'src_grid_rank',  &
+                           itmp1, nc_srcgrdrank_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'dst_grid_rank',  &
+                           itmp2, nc_dstgrdrank_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define map size dimensions
+      !***
+
+      if (direction == 1) then
+        itmp1 = num_links_map1
+      else
+        itmp1 = num_links_map2
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'num_links',  &
+                           itmp1, nc_numlinks_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'num_wgts',  &
+                           num_wts, nc_numwgts_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid dimensions
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_dims', NF_INT, &
+                           1, nc_srcgrdrank_id, nc_srcgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_dims', NF_INT, &
+                           1, nc_dstgrdrank_id, nc_dstgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     define all arrays for netCDF descriptors
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_center_lat',  &
+                           NF_DOUBLE, 1, nc_srcgrdsize_id,  &
+                           nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_center_lat',  &
+                           NF_DOUBLE, 1, nc_dstgrdsize_id,  &
+                           nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_center_lon',  &
+                           NF_DOUBLE, 1, nc_srcgrdsize_id,  &
+                           nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_center_lon',  &
+                           NF_DOUBLE, 1, nc_dstgrdsize_id,  &
+                           nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner lat/lon arrays
+      !***
+
+      nc_dims2_id(1) = nc_srcgrdcorn_id
+      nc_dims2_id(2) = nc_srcgrdsize_id
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_corner_lat',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_srcgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_corner_lon',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_srcgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      nc_dims2_id(1) = nc_dstgrdcorn_id
+      nc_dims2_id(2) = nc_dstgrdsize_id
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_corner_lat',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_dstgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_corner_lon',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_dstgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define units for all coordinate arrays
+      !***
+
+      if (direction == 1) then
+        grid1_ctmp = grid1_units
+        grid2_ctmp = grid2_units
+      else
+        grid1_ctmp = grid2_units
+        grid2_ctmp = grid1_units
+      endif
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlat_id,  &
+                                'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlat_id,  &
+                                'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlon_id,  &
+                                'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlon_id,  &
+                                'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlat_id,  &
+                                'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlon_id,  &
+                                'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlat_id,  &
+                                'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlon_id,  &
+                                'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_imask', NF_INT, &
+                           1, nc_srcgrdsize_id, nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdimask_id,  &
+                                'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_imask', NF_INT, &
+                           1, nc_dstgrdsize_id, nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdimask_id,  &
+                                'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_area',  &
+                           NF_DOUBLE, 1, nc_srcgrdsize_id,  &
+                           nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdarea_id,  &
+                                'units', 14, 'square radians')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_area',  &
+                           NF_DOUBLE, 1, nc_dstgrdsize_id,  &
+                           nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdarea_id,  &
+                                'units', 14, 'square radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid fraction arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_frac',  &
+                           NF_DOUBLE, 1, nc_srcgrdsize_id,  &
+                           nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdfrac_id,  &
+                                'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_frac',  &
+                           NF_DOUBLE, 1, nc_dstgrdsize_id,  &
+                           nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdfrac_id,  &
+                                'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define mapping arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_address',  &
+                           NF_INT, 1, nc_numlinks_id,  &
+                           nc_srcadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_address',  &
+                           NF_INT, 1, nc_numlinks_id,  &
+                           nc_dstadd_id)
+      call netcdf_error_handler(ncstat)
+
+      nc_dims2_id(1) = nc_numwgts_id
+      nc_dims2_id(2) = nc_numlinks_id
+
+      ncstat = nf_def_var (nc_file_id, 'remap_matrix',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_rmpmatrix_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     compute integer masks
+!
+!-----------------------------------------------------------------------
+
+      if (direction == 1) then
+        allocate (src_mask_int(grid1_size), &
+                  dst_mask_int(grid2_size))
+
+        where (grid2_mask)
+          dst_mask_int = 1
+        elsewhere
+          dst_mask_int = 0
+        endwhere
+
+        where (grid1_mask)
+          src_mask_int = 1
+        elsewhere
+          src_mask_int = 0
+        endwhere
+      else
+        allocate (src_mask_int(grid2_size), &
+                  dst_mask_int(grid1_size))
+
+        where (grid1_mask)
+          dst_mask_int = 1
+        elsewhere
+          dst_mask_int = 0
+        endwhere
+
+        where (grid2_mask)
+          src_mask_int = 1
+        elsewhere
+          src_mask_int = 0
+        endwhere
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     change units of lat/lon coordinates if input units different
+!     from radians
+!
+!-----------------------------------------------------------------------
+
+      if (grid1_units(1:7) == 'degrees' .and. direction == 1) then
+        grid1_center_lat = grid1_center_lat/deg2rad
+        grid1_center_lon = grid1_center_lon/deg2rad
+        grid1_corner_lat = grid1_corner_lat/deg2rad
+        grid1_corner_lon = grid1_corner_lon/deg2rad
+      endif
+
+      if (grid2_units(1:7) == 'degrees' .and. direction == 1) then
+        grid2_center_lat = grid2_center_lat/deg2rad
+        grid2_center_lon = grid2_center_lon/deg2rad
+        grid2_corner_lat = grid2_corner_lat/deg2rad
+        grid2_corner_lon = grid2_corner_lon/deg2rad
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     write mapping data
+!
+!-----------------------------------------------------------------------
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrddims_id
+        itmp2 = nc_dstgrddims_id
+      else
+        itmp2 = nc_srcgrddims_id
+        itmp1 = nc_dstgrddims_id
+      endif
+
+      ncstat = nf_put_var_int(nc_file_id, itmp1, grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, itmp2, grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, nc_srcgrdimask_id,  &
+                              src_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, nc_dstgrdimask_id, &
+                              dst_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      deallocate(src_mask_int, dst_mask_int)
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrdcntrlat_id
+        itmp2 = nc_srcgrdcntrlon_id
+        itmp3 = nc_srcgrdcrnrlat_id
+        itmp4 = nc_srcgrdcrnrlon_id
+      else
+        itmp1 = nc_dstgrdcntrlat_id
+        itmp2 = nc_dstgrdcntrlon_id
+        itmp3 = nc_dstgrdcrnrlat_id
+        itmp4 = nc_dstgrdcrnrlon_id
+      endif
+
+      ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp3, grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        itmp1 = nc_dstgrdcntrlat_id
+        itmp2 = nc_dstgrdcntrlon_id
+        itmp3 = nc_dstgrdcrnrlat_id
+        itmp4 = nc_dstgrdcrnrlon_id
+      else
+        itmp1 = nc_srcgrdcntrlat_id
+        itmp2 = nc_srcgrdcntrlon_id
+        itmp3 = nc_srcgrdcrnrlat_id
+        itmp4 = nc_srcgrdcrnrlon_id
+      endif
+
+      ncstat = nf_put_var_double(nc_file_id, itmp1, grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrdarea_id
+        itmp2 = nc_srcgrdfrac_id
+        itmp3 = nc_dstgrdarea_id
+        itmp4 = nc_dstgrdfrac_id
+      else
+        itmp1 = nc_dstgrdarea_id
+        itmp2 = nc_dstgrdfrac_id
+        itmp3 = nc_srcgrdarea_id
+        itmp4 = nc_srcgrdfrac_id
+      endif
+
+      if (luse_grid1_area) then
+        ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area_in)
+      else
+        ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area)
+      endif
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      if (luse_grid2_area) then
+        ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area_in)
+      else
+        ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area)
+      endif
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id,  &
+                                grid1_add_map1)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id,  &
+                                grid2_add_map1)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id,  &
+                                   wts_map1)
+        call netcdf_error_handler(ncstat)
+      else
+        ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id,  &
+                                grid2_add_map2)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id,  &
+                                grid1_add_map2)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id,  &
+                                   wts_map2)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      ncstat = nf_close(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end subroutine write_remap_scrip
+
+!***********************************************************************
+
+      subroutine write_remap_csm(map_name, interp_file, direction)
+
+!-----------------------------------------------------------------------
+!
+!     writes remap data to a netCDF file using NCAR-CSM conventions
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) :: &
+                  map_name      & ! name for mapping 
+      ,           interp_file  ! filename for remap data
+
+      integer (kind=int_kind), intent(in) :: &
+        direction              ! direction of map (1=grid1 to grid2
+                               !                   2=grid2 to grid1)
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len) :: &
+        grid1_ctmp         & ! character temp for grid1 names
+      , grid2_ctmp        ! character temp for grid2 names
+
+      integer (kind=int_kind) :: &
+        itmp1              & ! integer temp
+      , itmp2              & ! integer temp
+      , itmp3              & ! integer temp
+      , itmp4              & ! integer temp
+      , nc_numwgts1_id     & ! extra netCDF id for additional weights
+      , nc_src_isize_id    & ! extra netCDF id for ni_a
+      , nc_src_jsize_id    & ! extra netCDF id for nj_a
+      , nc_dst_isize_id    & ! extra netCDF id for ni_b
+      , nc_dst_jsize_id    & ! extra netCDF id for nj_b
+      , nc_rmpmatrix2_id  ! extra netCDF id for high-order remap matrix
+
+      real (kind=dbl_kind), dimension(:),allocatable :: &
+        wts1              ! CSM wants single array for 1st-order wts
+
+      real (kind=dbl_kind), dimension(:,:),allocatable :: &
+        wts2              ! write remaining weights in different array
+
+!-----------------------------------------------------------------------
+!
+!     create netCDF file for mapping and define some global attributes
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_create (interp_file, NF_CLOBBER, nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map name
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'title', &
+                                len_trim(map_name), map_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** normalization option
+      !***
+      ncstat = nf_put_att_text(nc_file_id, NF_GLOBAL, 'normalization', &
+                               len_trim(normalize_opt), normalize_opt)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map method
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'map_method', &
+                                len_trim(map_method), map_method)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** history
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'history', &
+                                len_trim(history), history)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** file convention
+      !***
+      convention = 'NCAR-CSM'
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'conventions', &
+                                len_trim(convention), convention)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** source and destination grid names
+      !***
+
+      if (direction == 1) then
+        grid1_ctmp = 'domain_a'
+        grid2_ctmp = 'domain_b'
+      else
+        grid1_ctmp = 'domain_b'
+        grid2_ctmp = 'domain_a'
+      endif
+
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid1_ctmp), &
+                                len_trim(grid1_name), grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid2_ctmp), &
+                                len_trim(grid2_name), grid2_name)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     prepare netCDF dimension info
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** define grid size dimensions
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_size
+        itmp2 = grid2_size
+      else
+        itmp1 = grid2_size
+        itmp2 = grid1_size
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'n_a', itmp1, nc_srcgrdsize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'n_b', itmp2, nc_dstgrdsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner dimension
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_corners
+        itmp2 = grid2_corners
+      else
+        itmp1 = grid2_corners
+        itmp2 = grid1_corners
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'nv_a', itmp1, nc_srcgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'nv_b', itmp2, nc_dstgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid rank dimension
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_rank
+        itmp2 = grid2_rank
+      else
+        itmp1 = grid2_rank
+        itmp2 = grid1_rank
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'src_grid_rank',  &
+                           itmp1, nc_srcgrdrank_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'dst_grid_rank',  &
+                           itmp2, nc_dstgrdrank_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define first two dims as if 2-d cartesian domain
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_dims(1)
+        if (grid1_rank > 1) then
+          itmp2 = grid1_dims(2)
+        else
+          itmp2 = 0
+        endif
+        itmp3 = grid2_dims(1)
+        if (grid2_rank > 1) then
+          itmp4 = grid2_dims(2)
+        else
+          itmp4 = 0
+        endif
+      else
+        itmp1 = grid2_dims(1)
+        if (grid2_rank > 1) then
+          itmp2 = grid2_dims(2)
+        else
+          itmp2 = 0
+        endif
+        itmp3 = grid1_dims(1)
+        if (grid1_rank > 1) then
+          itmp4 = grid1_dims(2)
+        else
+          itmp4 = 0
+        endif
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'ni_a', itmp1, nc_src_isize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'nj_a', itmp2, nc_src_jsize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'ni_b', itmp3, nc_dst_isize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'nj_b', itmp4, nc_dst_jsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define map size dimensions
+      !***
+
+      if (direction == 1) then
+        itmp1 = num_links_map1
+      else
+        itmp1 = num_links_map2
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'n_s', itmp1, nc_numlinks_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'num_wgts',  &
+                           num_wts, nc_numwgts_id)
+      call netcdf_error_handler(ncstat)
+
+      if (num_wts > 1) then
+        ncstat = nf_def_dim (nc_file_id, 'num_wgts1',  &
+                             num_wts-1, nc_numwgts1_id)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      !***
+      !*** define grid dimensions
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_dims', NF_INT, &
+                           1, nc_srcgrdrank_id, nc_srcgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_dims', NF_INT, &
+                           1, nc_dstgrdrank_id, nc_dstgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     define all arrays for netCDF descriptors
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'yc_a', &
+                           NF_DOUBLE, 1, nc_srcgrdsize_id,  &
+                           nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'yc_b',  &
+                           NF_DOUBLE, 1, nc_dstgrdsize_id,  &
+                           nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'xc_a',  &
+                           NF_DOUBLE, 1, nc_srcgrdsize_id,  &
+                           nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'xc_b',  &
+                           NF_DOUBLE, 1, nc_dstgrdsize_id,  &
+                           nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner lat/lon arrays
+      !***
+
+      nc_dims2_id(1) = nc_srcgrdcorn_id
+      nc_dims2_id(2) = nc_srcgrdsize_id
+
+      ncstat = nf_def_var (nc_file_id, 'yv_a',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_srcgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'xv_a',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_srcgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      nc_dims2_id(1) = nc_dstgrdcorn_id
+      nc_dims2_id(2) = nc_dstgrdsize_id
+
+      ncstat = nf_def_var (nc_file_id, 'yv_b',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_dstgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'xv_b',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_dstgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** CSM wants all in degrees
+      !***
+
+      grid1_units = 'degrees'
+      grid2_units = 'degrees'
+
+      if (direction == 1) then
+        grid1_ctmp = grid1_units
+        grid2_ctmp = grid2_units
+      else
+        grid1_ctmp = grid2_units
+        grid2_ctmp = grid1_units
+      endif
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlat_id,  &
+                                'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlat_id,  &
+                                'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlon_id,  &
+                                'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlon_id,  &
+                                'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlat_id,  &
+                                'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlon_id,  &
+                                'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlat_id,  &
+                                'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlon_id,  &
+                                'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'mask_a', NF_INT, &
+                           1, nc_srcgrdsize_id, nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdimask_id,  &
+                                'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'mask_b', NF_INT, &
+                           1, nc_dstgrdsize_id, nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdimask_id,  &
+                                'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'area_a',  &
+                           NF_DOUBLE, 1, nc_srcgrdsize_id,  &
+                           nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdarea_id,  &
+                                'units', 14, 'square radians')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'area_b',  &
+                           NF_DOUBLE, 1, nc_dstgrdsize_id,  &
+                           nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdarea_id,  &
+                                'units', 14, 'square radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid fraction arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'frac_a',  &
+                           NF_DOUBLE, 1, nc_srcgrdsize_id,  &
+                           nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdfrac_id,  &
+                                'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'frac_b',  &
+                           NF_DOUBLE, 1, nc_dstgrdsize_id,  &
+                           nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdfrac_id,  &
+                                'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define mapping arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'col',  &
+                           NF_INT, 1, nc_numlinks_id,  &
+                           nc_srcadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'row',  &
+                           NF_INT, 1, nc_numlinks_id,  &
+                           nc_dstadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'S',  &
+                           NF_DOUBLE, 1, nc_numlinks_id,  &
+                           nc_rmpmatrix_id)
+      call netcdf_error_handler(ncstat)
+
+      if (num_wts > 1) then
+        nc_dims2_id(1) = nc_numwgts1_id
+        nc_dims2_id(2) = nc_numlinks_id
+
+        ncstat = nf_def_var (nc_file_id, 'S2',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_rmpmatrix2_id)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     compute integer masks
+!
+!-----------------------------------------------------------------------
+
+      if (direction == 1) then
+        allocate (src_mask_int(grid1_size), &
+                  dst_mask_int(grid2_size))
+
+        where (grid2_mask)
+          dst_mask_int = 1
+        elsewhere
+          dst_mask_int = 0
+        endwhere
+
+        where (grid1_mask)
+          src_mask_int = 1
+        elsewhere
+          src_mask_int = 0
+        endwhere
+      else
+        allocate (src_mask_int(grid2_size), &
+                  dst_mask_int(grid1_size))
+
+        where (grid1_mask)
+          dst_mask_int = 1
+        elsewhere
+          dst_mask_int = 0
+        endwhere
+
+        where (grid2_mask)
+          src_mask_int = 1
+        elsewhere
+          src_mask_int = 0
+        endwhere
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     change units of lat/lon coordinates if input units different
+!     from radians. if this is the second mapping, the conversion has
+!     alread been done.
+!
+!-----------------------------------------------------------------------
+
+      if (grid1_units(1:7) == 'degrees' .and. direction == 1) then
+        grid1_center_lat = grid1_center_lat/deg2rad
+        grid1_center_lon = grid1_center_lon/deg2rad
+        grid1_corner_lat = grid1_corner_lat/deg2rad
+        grid1_corner_lon = grid1_corner_lon/deg2rad
+      endif
+
+      if (grid2_units(1:7) == 'degrees' .and. direction == 1) then
+        grid2_center_lat = grid2_center_lat/deg2rad
+        grid2_center_lon = grid2_center_lon/deg2rad
+        grid2_corner_lat = grid2_corner_lat/deg2rad
+        grid2_corner_lon = grid2_corner_lon/deg2rad
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     write mapping data
+!
+!-----------------------------------------------------------------------
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrddims_id
+        itmp2 = nc_dstgrddims_id
+      else
+        itmp2 = nc_srcgrddims_id
+        itmp1 = nc_dstgrddims_id
+      endif
+
+      ncstat = nf_put_var_int(nc_file_id, itmp1, grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, itmp2, grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, nc_srcgrdimask_id,  &
+                              src_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, nc_dstgrdimask_id, &
+                              dst_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      deallocate(src_mask_int, dst_mask_int)
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrdcntrlat_id
+        itmp2 = nc_srcgrdcntrlon_id
+        itmp3 = nc_srcgrdcrnrlat_id
+        itmp4 = nc_srcgrdcrnrlon_id
+      else
+        itmp1 = nc_dstgrdcntrlat_id
+        itmp2 = nc_dstgrdcntrlon_id
+        itmp3 = nc_dstgrdcrnrlat_id
+        itmp4 = nc_dstgrdcrnrlon_id
+      endif
+
+      ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp3, grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        itmp1 = nc_dstgrdcntrlat_id
+        itmp2 = nc_dstgrdcntrlon_id
+        itmp3 = nc_dstgrdcrnrlat_id
+        itmp4 = nc_dstgrdcrnrlon_id
+      else
+        itmp1 = nc_srcgrdcntrlat_id
+        itmp2 = nc_srcgrdcntrlon_id
+        itmp3 = nc_srcgrdcrnrlat_id
+        itmp4 = nc_srcgrdcrnrlon_id
+      endif
+
+      ncstat = nf_put_var_double(nc_file_id, itmp1, grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrdarea_id
+        itmp2 = nc_srcgrdfrac_id
+        itmp3 = nc_dstgrdarea_id
+        itmp4 = nc_dstgrdfrac_id
+      else
+        itmp1 = nc_dstgrdarea_id
+        itmp2 = nc_dstgrdfrac_id
+        itmp3 = nc_srcgrdarea_id
+        itmp4 = nc_srcgrdfrac_id
+      endif
+
+      if (luse_grid1_area) then
+        ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area_in)
+      else
+        ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area)
+      endif
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      if (luse_grid2_area) then
+        ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area)
+      else
+        ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area)
+      endif
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id,  &
+                                grid1_add_map1)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id,  &
+                                grid2_add_map1)
+        call netcdf_error_handler(ncstat)
+
+        if (num_wts == 1) then
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id,  &
+                                     wts_map1)
+          call netcdf_error_handler(ncstat)
+        else
+          allocate(wts1(num_links_map1),wts2(num_wts-1,num_links_map1))
+
+          wts1 = wts_map1(1,:)
+          wts2 = wts_map1(2:,:)
+
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id,  &
+                                     wts1)
+          call netcdf_error_handler(ncstat)
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix2_id,  &
+                                     wts2)
+          call netcdf_error_handler(ncstat)
+          deallocate(wts1,wts2)
+        endif
+      else
+        ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id,  &
+                                grid2_add_map2)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id,  &
+                                grid1_add_map2)
+        call netcdf_error_handler(ncstat)
+
+        if (num_wts == 1) then
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id,  &
+                                     wts_map2)
+          call netcdf_error_handler(ncstat)
+        else
+          allocate(wts1(num_links_map2),wts2(num_wts-1,num_links_map2))
+
+          wts1 = wts_map2(1,:)
+          wts2 = wts_map2(2:,:)
+
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id,  &
+                                     wts1)
+          call netcdf_error_handler(ncstat)
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix2_id,  &
+                                     wts2)
+          call netcdf_error_handler(ncstat)
+          deallocate(wts1,wts2)
+        endif
+      endif
+
+      ncstat = nf_close(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end subroutine write_remap_csm
+
+!***********************************************************************
+
+      subroutine sort_add(add1, add2, weights)
+
+!-----------------------------------------------------------------------
+!
+!     this routine sorts address and weight arrays based on the
+!     destination address with the source address as a secondary
+!     sorting criterion.  the method is a standard heap sort.
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common scalar constants
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     Input and Output arrays
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(inout), dimension(:) :: &
+              add1,        & ! destination address array (num_links)
+              add2        ! source      address array
+
+      real (kind=dbl_kind), intent(inout), dimension(:,:) :: &
+              weights     ! remapping weights (num_wts, num_links)
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: &
+                num_links,           & ! num of links for this mapping
+                num_wts,             & ! num of weights for this mapping
+                add1_tmp, add2_tmp,  & ! temp for addresses during swap
+                nwgt, &
+                lvl, final_lvl,      & ! level indexes for heap sort levels
+                chk_lvl1, chk_lvl2, max_lvl
+
+      real (kind=dbl_kind), dimension(SIZE(weights,DIM=1)) :: &
+                wgttmp              ! temp for holding wts during swap
+
+!-----------------------------------------------------------------------
+!
+!     determine total number of links to sort and number of weights
+!
+!-----------------------------------------------------------------------
+
+      num_links = SIZE(add1)
+      num_wts   = SIZE(weights, DIM=1)
+
+!-----------------------------------------------------------------------
+!
+!     start at the lowest level (N/2) of the tree and sift lower 
+!     values to the bottom of the tree, promoting the larger numbers
+!
+!-----------------------------------------------------------------------
+
+      do lvl=num_links/2,1,-1
+
+        final_lvl = lvl
+        add1_tmp = add1(lvl)
+        add2_tmp = add2(lvl)
+        wgttmp(:) = weights(:,lvl)
+
+        !***
+        !*** loop until proper level is found for this link, or reach
+        !*** bottom
+        !***
+
+        sift_loop1: do
+
+          !***
+          !*** find the largest of the two daughters
+          !***
+
+          chk_lvl1 = 2*final_lvl
+          chk_lvl2 = 2*final_lvl+1
+          if (chk_lvl1 .EQ. num_links) chk_lvl2 = chk_lvl1
+
+          if ((add1(chk_lvl1) >  add1(chk_lvl2)) .OR. &
+             ((add1(chk_lvl1) == add1(chk_lvl2)) .AND. &
+              (add2(chk_lvl1) >  add2(chk_lvl2)))) then
+            max_lvl = chk_lvl1
+          else 
+            max_lvl = chk_lvl2
+          endif
+
+          !***
+          !*** if the parent is greater than both daughters,
+          !*** the correct level has been found
+          !***
+
+          if ((add1_tmp .GT. add1(max_lvl)) .OR. &
+             ((add1_tmp .EQ. add1(max_lvl)) .AND. &
+              (add2_tmp .GT. add2(max_lvl)))) then
+            add1(final_lvl) = add1_tmp
+            add2(final_lvl) = add2_tmp
+            weights(:,final_lvl) = wgttmp(:)
+            exit sift_loop1
+
+          !***
+          !*** otherwise, promote the largest daughter and push
+          !*** down one level in the tree.  if haven't reached
+          !*** the end of the tree, repeat the process.  otherwise
+          !*** store last values and exit the loop
+          !***
+
+          else 
+            add1(final_lvl) = add1(max_lvl)
+            add2(final_lvl) = add2(max_lvl)
+            weights(:,final_lvl) = weights(:,max_lvl)
+
+            final_lvl = max_lvl
+            if (2*final_lvl > num_links) then
+              add1(final_lvl) = add1_tmp
+              add2(final_lvl) = add2_tmp
+              weights(:,final_lvl) = wgttmp(:)
+              exit sift_loop1
+            endif
+          endif
+        end do sift_loop1
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     now that the heap has been sorted, strip off the top (largest)
+!     value and promote the values below
+!
+!-----------------------------------------------------------------------
+
+      do lvl=num_links,3,-1
+
+        !***
+        !*** move the top value and insert it into the correct place
+        !***
+
+        add1_tmp = add1(lvl)
+        add1(lvl) = add1(1)
+
+        add2_tmp = add2(lvl)
+        add2(lvl) = add2(1)
+
+        wgttmp(:) = weights(:,lvl)
+        weights(:,lvl) = weights(:,1)
+
+        !***
+        !*** as above this loop sifts the tmp values down until proper 
+        !*** level is reached
+        !***
+
+        final_lvl = 1
+
+        sift_loop2: do
+
+          !***
+          !*** find the largest of the two daughters
+          !***
+
+          chk_lvl1 = 2*final_lvl
+          chk_lvl2 = 2*final_lvl+1
+          if (chk_lvl2 >= lvl) chk_lvl2 = chk_lvl1
+
+          if ((add1(chk_lvl1) >  add1(chk_lvl2)) .OR. &
+             ((add1(chk_lvl1) == add1(chk_lvl2)) .AND. &
+              (add2(chk_lvl1) >  add2(chk_lvl2)))) then
+            max_lvl = chk_lvl1
+          else 
+            max_lvl = chk_lvl2
+          endif
+
+          !***
+          !*** if the parent is greater than both daughters,
+          !*** the correct level has been found
+          !***
+
+          if ((add1_tmp >  add1(max_lvl)) .OR. &
+             ((add1_tmp == add1(max_lvl)) .AND. &
+              (add2_tmp >  add2(max_lvl)))) then
+            add1(final_lvl) = add1_tmp
+            add2(final_lvl) = add2_tmp
+            weights(:,final_lvl) = wgttmp(:)
+            exit sift_loop2
+
+          !***
+          !*** otherwise, promote the largest daughter and push
+          !*** down one level in the tree.  if haven't reached
+          !*** the end of the tree, repeat the process.  otherwise
+          !*** store last values and exit the loop
+          !***
+
+          else 
+            add1(final_lvl) = add1(max_lvl)
+            add2(final_lvl) = add2(max_lvl)
+            weights(:,final_lvl) = weights(:,max_lvl)
+
+            final_lvl = max_lvl
+            if (2*final_lvl >= lvl) then
+              add1(final_lvl) = add1_tmp
+              add2(final_lvl) = add2_tmp
+              weights(:,final_lvl) = wgttmp(:)
+              exit sift_loop2
+            endif
+          endif
+        end do sift_loop2
+      end do
+
+      !***
+      !*** swap the last two entries
+      !***
+
+
+      add1_tmp = add1(2)
+      add1(2)  = add1(1)
+      add1(1)  = add1_tmp
+
+      add2_tmp = add2(2)
+      add2(2)  = add2(1)
+      add2(1)  = add2_tmp
+
+      wgttmp (:)   = weights(:,2)
+      weights(:,2) = weights(:,1)
+      weights(:,1) = wgttmp (:)
+
+!-----------------------------------------------------------------------
+
+      end subroutine sort_add
+
+!***********************************************************************
+
+      end module remap_write
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/src/scrip.F90
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/src/scrip.F90	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/src/scrip.F90	(revision 12863)
@@ -0,0 +1,232 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This routine is the driver for computing the addresses and weights 
+!     for interpolating between two grids on a sphere.
+!
+!     Modified slightly to get name of namelist file from command line - sga 2/12/05
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: scrip.f,v 1.6 2001/08/21 21:06:44 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      program scrip
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod                  ! module defining data types
+      use constants                  ! module for common constants
+      use iounits                    ! I/O unit manager
+      use timers                     ! CPU timers
+      use grids                      ! module with grid information
+      use remap_vars                 ! common remapping variables
+      use remap_conservative         ! routines for conservative remap
+      use remap_distance_weight      ! routines for dist-weight remap
+      use remap_bilinear             ! routines for bilinear interp
+      use remap_bicubic              ! routines for bicubic  interp
+      use remap_write                ! routines for remap output
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     input namelist variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) :: &
+         grid1_file,       &  ! filename of grid file containing grid1
+         grid2_file,       &  ! filename of grid file containing grid2
+         interp_file1,     &  ! filename for output remap data (map1)
+         interp_file2,     &  ! filename for output remap data (map2)
+         map1_name,        &  ! name for mapping from grid1 to grid2
+         map2_name,        &  ! name for mapping from grid2 to grid1
+         map_method,       &  ! choice for mapping method
+         normalize_opt,    &  ! option for normalizing weights
+         output_opt           ! option for output conventions
+
+      integer (kind=int_kind) :: &
+         nmap                 ! number of mappings to compute (1 or 2)
+
+      namelist /remap_inputs/ grid1_file, grid2_file,  &
+         interp_file1, interp_file2,                   &
+         map1_name, map2_name, num_maps,               &
+         luse_grid1_area, luse_grid2_area,             &
+         map_method, normalize_opt, output_opt,        &
+         restrict_type, num_srch_bins
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,   &  ! dummy counter
+                                 iunit   ! unit number for namelist file
+
+      character (char_len) :: nm_in
+#if defined ARGC
+      integer :: iargc
+      external iargc
+
+      if (iargc() == 1) then
+        call getarg(1, nm_in)
+      else
+        write(6,*) 'need name of namelist file'
+        stop
+      endif
+#else
+      write(6,*) 'enter name for namelist file'
+      read(5,*) nm_in
+#endif
+
+!-----------------------------------------------------------------------
+!
+!     initialize timers
+!
+!-----------------------------------------------------------------------
+
+      call timers_init
+      do n=1,max_timers
+        call timer_clear(n)
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     read input namelist
+!
+!-----------------------------------------------------------------------
+
+      grid1_file    = 'unknown'
+      grid2_file    = 'unknown'
+      interp_file1  = 'unknown'
+      interp_file2  = 'unknown'
+      map1_name     = 'unknown'
+      map2_name     = 'unknown'
+      luse_grid1_area = .false.
+      luse_grid2_area = .false.
+      num_maps      = 2
+      map_type      = 1
+      normalize_opt = 'fracarea'
+      output_opt    = 'scrip'
+      restrict_type = 'latitude'
+      num_srch_bins = 900
+
+      call get_unit(iunit)
+      open(iunit, file=nm_in, status='old', form='formatted')
+      read(iunit, nml=remap_inputs)
+      call release_unit(iunit)
+
+      select case(map_method)
+      case ('conservative')
+        map_type = map_type_conserv
+        luse_grid_centers = .false.
+      case ('bilinear')
+        map_type = map_type_bilinear
+        luse_grid_centers = .true.
+      case ('bicubic')
+        map_type = map_type_bicubic
+        luse_grid_centers = .true.
+      case ('distwgt')
+        map_type = map_type_distwgt
+        luse_grid_centers = .true.
+      case default
+        stop 'unknown mapping method'
+      end select
+
+      select case(normalize_opt(1:4))
+      case ('none')
+        norm_opt = norm_opt_none
+      case ('frac')
+        norm_opt = norm_opt_frcarea
+      case ('dest')
+        norm_opt = norm_opt_dstarea
+      case default
+        stop 'unknown normalization option'
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     initialize grid information for both grids
+!
+!-----------------------------------------------------------------------
+
+      call grid_init(grid1_file, grid2_file)
+
+      write(stdout, *) ' Computing remappings between: ',grid1_name
+      write(stdout, *) '                          and  ',grid2_name
+
+!-----------------------------------------------------------------------
+!
+!     initialize some remapping variables.
+!
+!-----------------------------------------------------------------------
+
+      call init_remap_vars
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate interpolation setup routine based on type of
+!     remapping requested.
+!
+!-----------------------------------------------------------------------
+
+      select case(map_type)
+      case(map_type_conserv)
+        call remap_conserv
+      case(map_type_bilinear)
+        call remap_bilin
+      case(map_type_distwgt)
+        call remap_distwgt
+      case(map_type_bicubic)
+        call remap_bicub
+      case default
+        stop 'Invalid Map Type'
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     reduce size of remapping arrays and then write remapping info
+!     to a file.
+!
+!-----------------------------------------------------------------------
+
+      if (num_links_map1 /= max_links_map1) then
+        call resize_remap_vars(1, num_links_map1-max_links_map1)
+      endif
+      if ((num_maps > 1) .and. (num_links_map2 /= max_links_map2)) then
+        call resize_remap_vars(2, num_links_map2-max_links_map2)
+      endif
+
+      call write_remap(map1_name, map2_name, &
+                       interp_file1, interp_file2, output_opt)
+
+!-----------------------------------------------------------------------
+
+      end program scrip
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/WEIGHTS/src/scripgrid.F90
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/src/scripgrid.F90	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/src/scripgrid.F90	(revision 12863)
@@ -0,0 +1,26 @@
+! ==============================================================================
+
+PROGRAM scripgrid
+
+  USE scripgrid_mod
+
+  CHARACTER(char_len) :: infile
+
+#if defined ARGC
+  INTEGER :: IARGC
+  EXTERNAL IARGC
+
+  if (IARGC() == 1) then
+    CALL GETARG(1, infile)
+    CALL convert( infile )
+  ELSE
+    write(6,*) 'need to supply a namelist file'
+  ENDIF
+#else
+  write(6,*) 'enter name of namelist file'
+  read(5,*) infile
+
+  CALL convert( infile )
+#endif
+
+END PROGRAM scripgrid
Index: /utils/tools_ticket2413/WEIGHTS/src/scripgrid_mod.F90
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/src/scripgrid_mod.F90	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/src/scripgrid_mod.F90	(revision 12863)
@@ -0,0 +1,759 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module creates grid description files for input to the SCRIP code
+!
+!-----------------------------------------------------------------------
+
+MODULE scripgrid_mod
+
+  USE kinds_mod
+  USE constants
+  USE iounits
+  USE netcdf
+  USE netcdf_mod
+  
+  IMPLICIT NONE
+
+  !-----------------------------------------------------------------------
+  !     module variables that describe the grid
+
+  INTEGER (kind=int_kind), parameter :: &
+       grid_rank = 2,         &
+       grid_corners = 4
+  INTEGER (kind=int_kind) :: nx, ny, grid_size
+  INTEGER (kind=int_kind), dimension(2) :: &
+       grid_dims,    &  ! size of x, y dimensions
+       grid_dim_ids     ! ids of the x, y dimensions
+  INTEGER (kind=int_kind), ALLOCATABLE, DIMENSION(:) :: &
+       grid_imask          ! land-sea mask
+  REAL (kind=int_kind), ALLOCATABLE, DIMENSION(:) :: &
+       grid_center_lat, &  ! lat/lon coordinates for
+       grid_center_lon     ! each grid center in degrees
+  REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:) :: &
+       grid_corner_lat, &  ! lat/lon coordinates for
+       grid_corner_lon     ! each grid corner in degrees
+  REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:,:) :: &
+       corner_lon, &
+       corner_lat
+  REAL (kind=dbl_kind), PARAMETER :: circle = 360.0
+
+  !-----------------------------------------------------------------------
+  !     module variables that describe the netcdf file
+
+  INTEGER (kind=int_kind) :: &
+       ncstat,           &   ! general netCDF status variable
+       ncid_in
+
+CONTAINS
+
+  ! ==============================================================================
+  
+  SUBROUTINE convert(nm_in)
+  
+    ! -----------------------------------------------------------------------------
+    ! - input variables
+  
+    CHARACTER(char_len), INTENT(in) ::  &
+      nm_in
+  
+    ! -----------------------------------------------------------------------------
+    ! - local variables
+  
+    CHARACTER(char_len) ::  &
+      nemo_file, input_file, method, input_lon, input_lat, datagrid_file, &
+      nemogrid_file, nemo_lon, nemo_lat, corn_lon, corn_lat, nemo_mask, input_mask
+    INTEGER (kind=int_kind), dimension(2) :: &
+      offset
+    INTEGER (kind=int_kind) :: &
+      iunit, nemo_mask_value, input_mask_value
+  
+    namelist /grid_inputs/ nemo_file, input_file, datagrid_file, nemogrid_file,  &
+                           method, input_lon, input_lat, nemo_lon, nemo_lat,     &
+                           nemo_mask, nemo_mask_value, input_mask, input_mask_value
+  
+    !-----------------------------------------------------------------------
+    ! - namelist describing the processing
+    !   note that mask_value is the minimum good value,
+    !   so that where the mask is less than the value is masked
+
+    nemo_file = "coordinates.nc"
+    nemo_lon = "glamt"
+    nemo_lat = "gphit"
+    input_lon = "lon"
+    input_lat = "lat"
+    input_mask = "none"
+    input_mask_value = 0
+    datagrid_file = 'remap_data_grid.nc'
+    nemogrid_file = 'remap_nemo_grid.nc'
+
+    call get_unit(iunit)
+    open(iunit, file=nm_in, status='old', form='formatted')
+    read(iunit, nml=grid_inputs) 
+    call release_unit(iunit)
+
+    if (nemo_lon(1:4) .ne. 'glam' .or. nemo_lat(1:4) .ne. 'gphi') then
+      write(6,*) 'lon name does not start with "glam" or lat name does not start with "gphi"'
+      stop
+    endif
+
+    ! set up the names of the corner variables for a given input
+    ! the offset represents what needs to be added to (i,j) to get to the correct 
+    ! element in the corner arrays to correspond to the point northeast of the center
+    if (nemo_lon(5:5) == "t") then
+      corn_lon = "glamf"
+      corn_lat = "gphif"
+      offset = (/ 0,0 /)
+    else if (nemo_lon(5:5) == "u") then
+      corn_lon = "glamv"
+      corn_lat = "gphiv"
+      offset = (/ 1,0 /)
+    else if (nemo_lon(5:5) == "v") then
+      corn_lon = "glamu"
+      corn_lat = "gphiu"
+      offset = (/ 0,1 /)
+    else
+      write(6,*) 'unknown nemo_lon name'
+      stop
+    endif
+
+    write(6,*) "processing " // trim(nemo_file)
+    call convertNEMO(nemo_file, nemo_lon, nemo_lat, corn_lon, corn_lat, &
+                     offset, nemogrid_file)
+
+    write(6,*) "processing regular grid"
+    call convertFLUX(input_file, input_lon, input_lat, &
+                     input_mask, input_mask_value, datagrid_file)
+
+  END SUBROUTINE convert
+  
+  ! ==============================================================================
+  
+  SUBROUTINE convertNEMO(grid_file_in, cent_lon, cent_lat, corn_lon, corn_lat, &
+                         off, grid_file_out)
+  
+    !-----------------------------------------------------------------------
+    !
+    !     This routine converts a NEMO coordinates.nc file to a remapping grid file.
+    !
+    
+    CHARACTER(char_len), INTENT(in) :: cent_lon, cent_lat, corn_lon, corn_lat
+    INTEGER (kind=int_kind), INTENT(in), DIMENSION(2) :: off
+    CHARACTER(char_len), INTENT(in) :: grid_file_out
+    CHARACTER(char_len), INTENT(in) :: grid_file_in
+
+    !-----------------------------------------------------------------------
+    !     module variables that describe the grid
+  
+    CHARACTER(char_len), parameter ::  &
+         grid_name = 'Remapped NEMO grid for SCRIP'
+  
+    !-----------------------------------------------------------------------
+    !     grid coordinates and masks
+  
+    REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:) :: &
+         clon, clat, &             ! expanded corner arrays
+         glam, &                   ! center longitude
+         gphi, &                   ! center latitude
+         glamc, &                  ! corner longitude
+         gphic                     ! corner latitude
+  
+    !-----------------------------------------------------------------------
+    !     other local variables
+  
+    INTEGER (kind=int_kind) :: i, j, n, iunit, im1, jm1, imid, isame, ic, jc
+    INTEGER (kind=int_kind) :: varid_lam, varid_phi, varid_lamc, varid_phic
+    INTEGER (kind=int_kind) :: jdim
+    INTEGER (kind=int_kind), dimension(4) :: grid_dimids  ! input fields have 4 dims
+    REAL (kind=dbl_kind) :: tmplon, dxt, dyt
+  
+    !-----------------------------------------------------------------------
+    !     read in grid info
+    !
+    !     For NEMO input grids, assume that variable names are glam, glamc etc.
+    !     Assume that 1st 2 dimensions of these variables are x and y directions.
+    !     These assumptions are made by NEMO, so should be valid for coordinates.nc.
+    !
+    ! write in nf90 calls (without error handling) and then think about 
+    ! making more readable by taking chunks into ncutil
+    !
+  
+    ncstat = nf90_open( grid_file_in, NF90_NOWRITE, ncid_in )
+    call netcdf_error_handler(ncstat)
+  
+    ! find dimids for 'glam'
+    ! use dimids to get dimlengths
+    ! allocate glam array
+    ! get glam from file 
+  
+    ncstat = nf90_inq_varid( ncid_in, cent_lon, varid_lam )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_inq_varid( ncid_in, corn_lon, varid_lamc )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_inq_varid( ncid_in, cent_lat, varid_phi )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_inq_varid( ncid_in, corn_lat, varid_phic )
+    call netcdf_error_handler(ncstat)
+  
+    ncstat = nf90_inquire_variable( ncid_in, varid_lam, dimids=grid_dimids(:) )
+    call netcdf_error_handler(ncstat)
+    DO jdim = 1, SIZE(grid_dims)
+       ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(jdim),  &
+                                        len=grid_dims(jdim) )
+       call netcdf_error_handler(ncstat)
+    END DO
+    nx = grid_dims(1)
+    ny = grid_dims(2)
+    grid_size = nx * ny
+    WRITE(*,FMT='("Input grid dimensions are:",2i6)') nx, ny
+    
+    ! assume that dimensions are all the same as glam
+    ALLOCATE( glam(nx,ny), glamc(nx,ny), gphi(nx,ny), gphic(nx,ny) )
+    ncstat = nf90_get_var( ncid_in, varid_lam, glam(:,:) )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_get_var( ncid_in, varid_lamc, glamc(:,:) )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_get_var( ncid_in, varid_phi, gphi(:,:) )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_get_var( ncid_in, varid_phic, gphic(:,:) )
+    call netcdf_error_handler(ncstat)
+    
+    !-----------------------------------------------------------------------
+    ! - Mask is all ocean for now
+  
+    ALLOCATE( grid_imask(grid_size) )
+    grid_imask(:) = 1
+  
+    !-----------------------------------------------------------------------
+    ! corners are arranged as follows:    4 3
+    !                                     1 2
+    !
+    ! Assume that cyclic grids have 2 wrap columns in coordinates.nc
+    !  (this is the case for ORCA grids)
+    !
+  
+    ! -----------------------------------------------------------------------------
+    ! create a single pair of arrays for the corners where clon(1,1) corresponds
+    ! to the south west corner of a box containing glam(1,1)
+    ! various special cases then apply
+    !   bottom row:  assume clon(:,j) = clon(:,j+1)
+  
+    ALLOCATE ( clon(nx+1,ny+1), clat(nx+1,ny+1) )
+
+    ! first the easy internal points
+    DO j = 2,ny
+      DO i = 2,nx
+        ic = i + off(1) - 1
+        jc = j + off(2) - 1
+        clon(i,j) = glamc(ic,jc)
+        clat(i,j) = gphic(ic,jc)
+      ENDDO
+    ENDDO
+
+    ! then the tricky boundary points
+    imid = (nx-1)/2 + 1
+    DO j = 1,ny+1,ny
+      DO i = 1,nx+1,nx
+        ic = i + off(1) - 1
+        jc = j + off(2) - 1
+        if (ic == 0 .and. jc == 0) then
+          clon(i,j) = glamc(nx,1)
+          clat(i,j) = gphic(nx,1) - (gphic(nx,2)-gphic(nx,1))
+        else if (ic == nx+1 .and. jc == 0) then
+          clon(i,j) = glamc(1,1)
+          clat(i,j) = gphic(1,1) - (gphic(1,2)-gphic(1,1))
+        else if (ic == 0 .and. jc == ny+1) then
+          isame = 2*imid - nx + 1
+          clon(i,j) = glamc(isame,jc-1)
+          clat(i,j) = gphic(isame,jc-1)
+        else if (ic == nx+1 .and. jc == ny+1) then
+          isame = 2*imid
+          clon(i,j) = glamc(isame,jc-1)
+          clat(i,j) = gphic(isame,jc-1)
+        else if (ic == 0) then
+          clon(i,j) = glamc(nx,jc)
+          clat(i,j) = gphic(nx,jc)
+        else if (jc == 0) then
+          clon(i,j) = glamc(ic,1)
+          clat(i,j) = gphic(ic,1) - (gphic(ic,2)-gphic(ic,1))
+        else if (ic == nx+1) then
+          clon(i,j) = glamc(1,jc)
+          clat(i,j) = gphic(1,jc)
+        else if (jc == ny+1) then
+          isame = 2*imid - ic + 1
+          clon(i,j) = glamc(isame,jc-1)
+          clat(i,j) = gphic(isame,jc-1)
+        endif
+      ENDDO
+    ENDDO
+
+    ALLOCATE ( corner_lon(4,nx,ny), corner_lat(4,nx,ny) )
+  
+    ! top-right corner
+    corner_lon(3,:,:) = clon(2:nx+1,2:ny+1)
+    corner_lat(3,:,:) = clat(2:nx+1,2:ny+1)
+  
+    ! top-left corner
+    corner_lon(4,:,:) = clon(1:nx,2:ny+1)
+    corner_lat(4,:,:) = clat(1:nx,2:ny+1)
+  
+    ! bottom-right corner 
+    corner_lon(2,:,:) = clon(2:nx+1,1:ny)
+    corner_lat(2,:,:) = clat(2:nx+1,1:ny)
+  
+    ! bottom-left corner
+    corner_lon(1,:,:) = clon(1:nx,1:ny)
+    corner_lat(1,:,:) = clat(1:nx,1:ny)
+  
+  ! For [N, E, W]-ward extrapolation near the poles, should we use stereographic (or
+  ! similar) projection?  This issue will come for V,F interpolation, and for all
+  ! grids with non-cyclic grids.
+  
+    ! -----------------------------------------------------------------------------
+    !     correct for 0,2pi longitude crossings
+    !      (In practice this means putting all corners into 0,2pi range
+    !       and ensuring that no box corners are miles from each other.
+    !       3pi/2 is used as threshold - I think this is quite arbitrary.)
+  
+    corner_lon(:,:,:) = MODULO( corner_lon(:,:,:), circle )
+    DO n = 2, grid_corners
+       WHERE    ( corner_lon(n,:,:) - corner_lon(n-1,:,:) < -three*circle*0.25 )
+          corner_lon(n,:,:) = corner_lon(n,:,:) + circle
+       ELSEWHERE( corner_lon(n,:,:) - corner_lon(n-1,:,:) >  three*circle*0.25 )
+          corner_lon(n,:,:) = corner_lon(n,:,:) - circle
+       END WHERE
+    END DO
+  
+    ! -----------------------------------------------------------------------------
+    ! - put longitudes on smooth grid 
+  
+ !  call mouldlon(glam,nx,ny)
+ !  call mouldlon(corner_lon(1,:,:),nx,ny)
+ !  call mouldlon(corner_lon(2,:,:),nx,ny)
+ !  call mouldlon(corner_lon(3,:,:),nx,ny)
+ !  call mouldlon(corner_lon(4,:,:),nx,ny)
+
+    ! -----------------------------------------------------------------------------
+    ! - reshape for SCRIP input format
+  
+    ALLOCATE( grid_center_lon(grid_size), grid_center_lat(grid_size) )
+    
+    grid_center_lon(:) = RESHAPE( glam(:,:), (/ grid_size /) )
+    grid_center_lat(:) = RESHAPE( gphi(:,:), (/ grid_size /) )
+  
+    DEALLOCATE( glam, gphi, glamc, gphic )
+  
+    ALLOCATE( grid_corner_lon(4, grid_size), grid_corner_lat(4, grid_size) )
+  
+    grid_corner_lon(:,:) = RESHAPE( corner_lon(:,:,:), (/ 4, grid_size /) )
+    grid_corner_lat(:,:) = RESHAPE( corner_lat(:,:,:), (/ 4, grid_size /) )
+  
+    DEALLOCATE( corner_lon, corner_lat )
+  
+    CALL createSCRIPgrid(grid_file_out, grid_name)
+  
+  END SUBROUTINE convertNEMO
+  
+  ! ==============================================================================
+  
+  SUBROUTINE convertFLUX(grid_file_in, name_lon, name_lat, &
+                         name_mask, value_mask, grid_file_out)
+  
+    !-----------------------------------------------------------------------
+    !
+    !     This routine creates a remapping grid file from an input grid.
+    !
+    !-----------------------------------------------------------------------
+    
+    CHARACTER(char_len), INTENT(in) ::  &
+         grid_file_in, name_lon, name_lat, name_mask, grid_file_out
+    INTEGER (kind=int_kind) :: value_mask
+  
+    !-----------------------------------------------------------------------
+    !     variables that describe the grid
+  
+    CHARACTER(char_len), parameter ::  &
+         grid_name = 'Remapped regular grid for SCRIP'
+  
+    !-----------------------------------------------------------------------
+    !     grid coordinates (note that a flux file just has lon and lat)
+  
+    REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:) :: &
+         lam, phi
+    REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:) :: &
+         glam, &                   ! longitude
+         gphi, &                   ! latitude
+         glamc, &
+         gphic
+    REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:) :: mask
+  
+    !-----------------------------------------------------------------------
+    !     other local variables
+  
+    INTEGER (kind=int_kind) :: i, j, n, iunit, im1, jm1
+    INTEGER (kind=int_kind) :: varid_lam, varid_phi, varid_mask
+    INTEGER (kind=int_kind) :: jdim, nspace
+    INTEGER (kind=int_kind), dimension(4) :: grid_dimids  ! input fields have 4 dims
+    REAL (kind=dbl_kind) :: tmplon, dxt, dyt
+  
+    !-----------------------------------------------------------------------
+    !     read in grid info
+    !
+    !     For NEMO input grids, assume that variable names are glam, glamc etc.
+    !     Assume that 1st 2 dimensions of these variables are x and y directions.
+    !     These assumptions are made by NEMO, so should be valid for coordinates.nc.
+    !
+    ! write in nf90 calls (without error handling) and then think about 
+    ! making more readable by taking chunks into ncutil
+  
+    ncstat = nf90_open( grid_file_in, NF90_NOWRITE, ncid_in )
+    call netcdf_error_handler(ncstat)
+  
+    ! find dimids for 'glamt'
+    ! use dimids to get dimlengths
+    ! allocate glam array
+    ! get glam from file 
+  
+    ncstat = nf90_inq_varid( ncid_in, name_lat, varid_phi )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_inq_varid( ncid_in, name_lon, varid_lam )
+    call netcdf_error_handler(ncstat)
+  
+    ncstat = nf90_inquire_variable( ncid_in, varid_lam, ndims=nspace )
+    call netcdf_error_handler(ncstat)
+
+    if (nspace == 1) then
+      ncstat = nf90_inquire_variable( ncid_in, varid_lam, dimids=grid_dimids(:1) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_variable( ncid_in, varid_phi, dimids=grid_dimids(2:) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(1), len=grid_dims(1) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(2), len=grid_dims(2) )
+      call netcdf_error_handler(ncstat)
+      nx = grid_dims(1)
+      ny = grid_dims(2)
+      grid_size = nx * ny
+      WRITE(*,FMT='("Input grid dimensions are:",2i6)') nx, ny
+    
+      ALLOCATE( lam(nx), phi(ny) )
+      write(6,*) 'double'
+      ncstat = nf90_get_var( ncid_in, varid_lam, lam )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_get_var( ncid_in, varid_phi, phi )
+      call netcdf_error_handler(ncstat)
+    
+      ALLOCATE( glam(nx,ny), gphi(nx,ny))
+      write(6,*) shape(lam),shape(phi)
+      glam(:,:) = SPREAD(lam,2,ny)
+      gphi(:,:) = SPREAD(phi,1,nx)
+    else
+
+      ncstat = nf90_inquire_variable( ncid_in, varid_lam, dimids=grid_dimids(:2) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(1), len=grid_dims(1) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(2), len=grid_dims(2) )
+      call netcdf_error_handler(ncstat)
+      nx = grid_dims(1)
+      ny = grid_dims(2)
+      grid_size = nx * ny
+      WRITE(*,FMT='("Input grid dimensions are:",2i6)') nx, ny
+    
+      ALLOCATE( glam(nx,ny), gphi(nx,ny))
+      ncstat = nf90_get_var( ncid_in, varid_lam, glam )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_get_var( ncid_in, varid_phi, gphi )
+      call netcdf_error_handler(ncstat)
+
+    endif
+    write(6,*) grid_size,nx,ny
+  
+    ALLOCATE(glamc(0:nx,0:ny), gphic(0:nx,0:ny) )
+
+    ! - for now a simple average to get top right box corners
+    ! - glamc(i,j), gphic(i,j) are top right coordinates of box containing 
+    ! - glam(i,j),gphi(i,j)
+    write(6,*) 'averaging'
+    write(6,*) size(gphic),size(gphi)
+    gphic(1:nx,1:ny-1) = 0.5*(gphi(:,1:ny-1)+gphi(:,2:ny))
+    write(6,*) size(glamc),size(glam)
+    glamc(1:nx-1,1:ny) = 0.5*(glam(1:nx-1,:)+glam(2:nx,:))
+  
+    ! - left and right column of longitudes 
+    write(6,*) 'columns'
+    glamc(nx,1:ny) = 1.5*glam(nx,:)-0.5*glam(nx-1,:)
+    glamc( 0,1:ny) = 1.5*glam(1,:)-0.5*glam(2,:)
+    glamc(nx, 0) = glamc(nx,1)
+    glamc( 0, 0) = glamc( 0,1)
+
+    ! - top and bottom row of latitudes by extrapolation
+    write(6,*) 'rows'
+    gphic(1:nx,ny) = 1.5*gphi(:,ny)-0.5*gphi(:,ny-1)
+    gphic(1:nx, 0) = 1.5*gphi(:,1)-0.5*gphi(:,2)
+    gphic( 0,ny) = gphic(1,ny)
+    gphic( 0, 0) = gphic(1, 0)
+
+    !-----------------------------------------------------------------------
+  
+    write(6,*) 'allocating'
+    ALLOCATE( grid_imask(grid_size) )
+    grid_imask(:) = 1
+    write(6,*) name_mask
+    if (trim(name_mask) /= "none") then
+      write(6,*) 'masking'
+      ncstat = nf90_inq_varid( ncid_in, name_mask, varid_mask )
+      call netcdf_error_handler(ncstat)
+      ALLOCATE( mask(nx,ny) )
+      write(6,*) 'reading mask'
+      ncstat = nf90_get_var( ncid_in, varid_mask, mask )
+      call netcdf_error_handler(ncstat)
+      write(6,*) 'setting mask'
+      WHERE ( RESHAPE(mask(:,:),(/ grid_size /)) < value_mask)
+        grid_imask = 0
+      END WHERE
+      write(6,*) 'masked'
+    END IF
+  
+    !-----------------------------------------------------------------------
+    ! corners are arranged as follows:    4 3
+    !                                     1 2
+  
+    ALLOCATE ( corner_lon(4,nx,ny), corner_lat(4,nx,ny) )
+  
+    ! - bottom-left corner
+    corner_lon(1,:,:) = glamc(0:nx-1, 0:ny-1 )
+    corner_lat(1,:,:) = gphic(0:nx-1, 0:ny-1 )
+  
+    ! - bottom-right corner 
+    corner_lon(2,:,:) = glamc(1:nx, 0:ny-1 )
+    corner_lat(2,:,:) = gphic(1:nx, 0:ny-1 )
+  
+    ! - top-right corner
+    corner_lon(3,:,:) = glamc(1:nx,1:ny)
+    corner_lat(3,:,:) = gphic(1:nx,1:ny)
+    write(6,*) corner_lat(3,nx-2:nx,ny)
+  
+    ! - top-left corner
+    corner_lon(4,:,:) = glamc(0:nx-1, 1:ny )
+    corner_lat(4,:,:) = gphic(0:nx-1, 1:ny )
+  
+  ! For [N, E, W]-ward extrapolation near the poles, should we use stereographic (or
+  ! similar) projection?  This issue will come for V,F interpolation, and for all
+  ! grids with non-cyclic grids.
+  
+    ! -----------------------------------------------------------------------------
+    !     correct for 0,2pi longitude crossings
+    !      (In practice this means putting all corners into 0,2pi range
+    !       and ensuring that no box corners are miles from each other.
+    !       3pi/2 is used as threshold - I think this is quite arbitrary.)
+  
+  ! corner_lon(:,:,:) = MODULO( corner_lon(:,:,:), circle )
+  ! DO n = 2, grid_corners
+  !    WHERE    ( corner_lon(n,:,:) - corner_lon(n-1,:,:) < -three*circle*0.25 )
+  !       corner_lon(n,:,:) = corner_lon(n,:,:) + circle
+  !    ELSEWHERE( corner_lon(n,:,:) - corner_lon(n-1,:,:) >  three*circle*0.25 )
+  !       corner_lon(n,:,:) = corner_lon(n,:,:) - circle
+  !    END WHERE
+  ! END DO
+  
+    ! -----------------------------------------------------------------------------
+    ! - reshape for SCRIP input format
+  
+    ALLOCATE( grid_center_lon(grid_size), grid_center_lat(grid_size) )
+    
+    grid_center_lon(:) = RESHAPE( glam(:,:), (/ grid_size /) )
+    grid_center_lat(:) = RESHAPE( gphi(:,:), (/ grid_size /) )
+  
+    DEALLOCATE( glam, gphi, glamc, gphic )
+  
+    ALLOCATE( grid_corner_lon(4, grid_size), grid_corner_lat(4, grid_size) )
+  
+    grid_corner_lon(:,:) = RESHAPE( corner_lon(:,:,:), (/ 4, grid_size /) )
+    grid_corner_lat(:,:) = RESHAPE( corner_lat(:,:,:), (/ 4, grid_size /) )
+  
+    DEALLOCATE( corner_lon, corner_lat )
+  
+    CALL createSCRIPgrid(grid_file_out, grid_name)
+  
+  END SUBROUTINE convertFLUX
+  
+  ! ==============================================================================
+  
+  SUBROUTINE mouldlon(lon_grid, nx, ny)
+
+    ! -----------------------------------------------------------------------------
+    ! - input variables
+
+    INTEGER, INTENT(in) :: nx, ny
+    REAL (kind=dbl_kind), INTENT(inout), DIMENSION(nx,ny) ::  &
+      lon_grid
+  
+    ! -----------------------------------------------------------------------------
+    ! - local variables
+
+    INTEGER :: ix, iy
+    REAL (kind=dbl_kind), DIMENSION(:,:), ALLOCATABLE ::  &
+      dlon
+    REAL :: step
+
+    ! -----------------------------------------------------------------------------
+    ! - try to eliminate any 360 degree steps in a grid of longitudes
+
+    ALLOCATE(dlon(nx,ny))
+
+    step = 0.75*circle
+    dlon(:,:) = 0
+    dlon(2:,:) = lon_grid(2:,:) - lon_grid(:nx-1,:)
+    WHERE (dlon > -step .AND. dlon < step)
+      dlon = 0.0
+    ELSEWHERE
+      dlon = -SIGN(circle,dlon)
+    END WHERE
+
+    ! - close your eyes this is nasty
+    DO ix = 2,nx
+      dlon(ix,:) = dlon(ix,:) + dlon(ix-1,:)
+    END DO
+    lon_grid = lon_grid + dlon
+
+  END SUBROUTINE mouldlon
+  
+  ! ==============================================================================
+  
+  SUBROUTINE createSCRIPgrid(grid_file_out, grid_name)
+  
+    ! -----------------------------------------------------------------------------
+    ! - input variables
+  
+    CHARACTER(char_len), INTENT(in) ::  &
+         grid_name, grid_file_out
+  
+    ! -----------------------------------------------------------------------------
+    ! - local variables that describe the netcdf file
+  
+    INTEGER (kind=int_kind) :: &
+         nc_grid_id,       &   ! netCDF grid dataset id
+         nc_gridsize_id,   &   ! netCDF grid size dim id
+         nc_gridcorn_id,   &   ! netCDF grid corner dim id
+         nc_gridrank_id,   &   ! netCDF grid rank dim id
+         nc_griddims_id,   &   ! netCDF grid dimensions id
+         nc_grdcntrlat_id, &   ! netCDF grid center lat id
+         nc_grdcntrlon_id, &   ! netCDF grid center lon id
+         nc_grdimask_id,   &   ! netCDF grid mask id
+         nc_gridarea_id,   &   ! netCDF grid area id
+         nc_grdcrnrlat_id, &   ! netCDF grid corner lat id
+         nc_grdcrnrlon_id      ! netCDF grid corner lon id
+  
+    ! -----------------------------------------------------------------------------
+    ! - create netCDF dataset for this grid
+    ! - rewrite in nf90 
+    ! - (bring out functional blocks into ncclear for readability)
+  
+    ncstat = nf90_create (grid_file_out, NF90_CLOBBER, nc_grid_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att (nc_grid_id, NF90_GLOBAL, 'title', grid_name)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid size dimension
+  
+    ncstat = nf90_def_dim (nc_grid_id, 'grid_size', grid_size, nc_gridsize_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid rank dimension
+  
+    ncstat = nf90_def_dim (nc_grid_id, 'grid_rank', grid_rank, nc_gridrank_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid corner dimension
+  
+    ncstat = nf90_def_dim (nc_grid_id, 'grid_corners', grid_corners, nc_gridcorn_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid dim size array
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_dims', NF90_INT, nc_gridrank_id, nc_griddims_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid mask
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_imask', NF90_INT, &
+                          nc_gridsize_id, nc_grdimask_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdimask_id, 'units', 'unitless')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid center latitude array
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_center_lat', NF90_DOUBLE, &
+                          nc_gridsize_id, nc_grdcntrlat_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdcntrlat_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid center longitude array
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_center_lon', NF90_DOUBLE, &
+                          nc_gridsize_id, nc_grdcntrlon_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdcntrlon_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid corner latitude array
+  
+    grid_dim_ids = (/ nc_gridcorn_id, nc_gridsize_id /)
+    ncstat = nf90_def_var(nc_grid_id, 'grid_corner_lat', NF90_DOUBLE, &
+                          grid_dim_ids, nc_grdcrnrlat_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdcrnrlat_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid corner longitude array
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_corner_lon', NF90_DOUBLE, &
+                          grid_dim_ids, nc_grdcrnrlon_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdcrnrlon_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! end definition stage
+  
+    ncstat = nf90_enddef(nc_grid_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! write grid data
+  
+    ncstat = nf90_put_var(nc_grid_id, nc_griddims_id, grid_dims)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdimask_id, grid_imask)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdcntrlat_id, grid_center_lat)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdcntrlon_id, grid_center_lon)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdcrnrlat_id, grid_corner_lat)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdcrnrlon_id, grid_corner_lon)
+    call netcdf_error_handler(ncstat)
+  
+    ncstat = nf90_close(nc_grid_id)
+    call netcdf_error_handler(ncstat)
+  
+    DEALLOCATE( grid_imask, grid_center_lon, grid_center_lat, &
+                grid_corner_lon, grid_corner_lat )
+  
+  
+  END SUBROUTINE createSCRIPgrid
+  
+END MODULE scripgrid_mod
+
Index: /utils/tools_ticket2413/WEIGHTS/src/scripinterp.F90
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/src/scripinterp.F90	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/src/scripinterp.F90	(revision 12863)
@@ -0,0 +1,24 @@
+! ==========================================================================
+
+program scripinterp
+
+  use scripinterp_mod
+
+  character (char_len) ::  nm_in
+#if defined ARGC
+  integer :: iargc
+  external iargc
+
+  if (iargc() == 1) then
+    call getarg(1, nm_in)
+    call process_grid(nm_in)
+  else
+    write(6,*) 'need the name of an input namelist'
+  endif
+#else
+  write(6,*) 'enter the name of an input namelist'
+  read(5,*) nm_in
+  call process_grid(nm_in)
+#endif
+
+end program scripinterp
Index: /utils/tools_ticket2413/WEIGHTS/src/scripinterp_mod.F90
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/src/scripinterp_mod.F90	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/src/scripinterp_mod.F90	(revision 12863)
@@ -0,0 +1,1031 @@
+! **************************************************************************
+
+  module scripinterp_mod
+
+! ==========================================================================
+
+  use kinds_mod    ! defines common data types
+  use constants    ! defines common constants
+  use iounits      ! I/O unit manager
+  use netcdf
+  use netcdf_mod   ! netcdf I/O stuff
+  use grids        ! module containing grid info
+  use remap_vars   ! module containing remapping info
+  use remap_mod    ! module containing remapping routines
+  use remap_read   ! routines for reading remap files
+
+  implicit none
+
+  real(kind=dbl_kind), dimension(:), allocatable ::   &
+    grid_out
+
+  integer(kind=int_kind) ::                           &  ! netCDF ids for files and arrays
+          ncstat, nc_outfile_id, nc_infile_id
+  integer (kind=int_kind), dimension(4) ::    &
+      input_dims, input_dimids, input_count
+  real (kind=dbl_kind), dimension(:), allocatable ::   &
+      scale
+  integer (kind=int_kind), dimension(:), allocatable ::        &
+      nc_xysize_id, nc_gridsize_id, nc_gridsize,           &
+      nc_variable_id
+  integer :: nc_lon_id, nc_lat_id, nc_array_id
+
+  character (char_len) ::  &
+          map_name      ! name for mapping from grid1 to grid2
+  character (1), parameter ::  &
+          separator = '|'
+  
+  ! - input namelist variables
+  
+  character (char_len) ::  &
+    input_file,            &  ! filename containing input fields
+    interp_file,           &  ! filename containing remap data (map1)
+    input_name                ! name of variable to grid
+  integer (kind=int_kind), dimension(4) :: &
+    input_stride,  &          ! how much of input array to process
+    input_start,   &          ! where to start
+    input_stop                ! and where to stop
+  character (char_len), dimension(4) ::  &
+    input_vars                ! input variables to be copied
+  
+  ! - output namelist variables
+  
+  character (char_len) ::  &
+    output_file,           &  ! filename for test results
+    output_mode,           &  ! 'create' or 'append'
+    output_name,           &  ! name of new grid variable
+    output_lat,            &  ! as it says
+    output_lon,            &  ! as it says
+    output_ydir               ! choose to invert output arrays in y direction
+  character (char_len), dimension(4) ::  &
+    output_dims,           &    ! name of new grid variable
+    output_vars                 ! variables to copy
+  character (char_len), dimension(10) ::  &
+    output_attributes,     &  ! attributes of stuff in output file
+    output_scaling             ! scaling factor to apply to input data to get
+                               ! correct units in output file
+contains
+
+! ==========================================================================
+
+  subroutine process_grid(nm_in)
+  
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+
+    character (char_len) ::  &
+      nm_in                    ! name of input namelist file
+  
+    !-----------------------------------------------------------------------
+    ! - local variables
+
+    integer (kind=int_kind), dimension(4) ::    &
+        astart, acount, plus_one
+    integer (kind=int_kind), dimension(3) ::    &
+        write_dims
+    integer (kind=int_kind) ::                  &
+      i1, i2, jdim, n, nx, ny, nloop,           &
+      nc_input_id, nc_input_rank,               &
+      vstart, vstride, numv
+
+    real (kind=dbl_kind), dimension(:), allocatable  ::    &
+      grid1_array
+    real (kind=dbl_kind), dimension(:,:), allocatable  ::    &
+      var_out
+
+    plus_one(:) = 1
+
+    !-----------------------------------------------------------------------
+
+    call read_mappings(nm_in)
+
+    !-----------------------------------------------------------------------
+    ! - read input grid
+    ! - WARNING - lots of assumptions here at the moment
+  
+    ncstat = nf90_open( input_file, NF90_NOWRITE, nc_infile_id )
+    call netcdf_error_handler(ncstat,"open")
+  
+    ncstat = nf90_inq_varid( nc_infile_id, input_name, nc_input_id )
+    call netcdf_error_handler(ncstat,"inq_varid")
+  
+    input_dims(:) = 0
+    ncstat = nf90_inquire_variable( nc_infile_id, nc_input_id,   &
+                  ndims=nc_input_rank, dimids=input_dimids(:) )
+    call netcdf_error_handler(ncstat,"inquire_variable")
+
+    do jdim = 1,nc_input_rank
+      ncstat = nf90_inquire_dimension(nc_infile_id,              &
+                    input_dimids(jdim), len=input_dims(jdim) )
+      call netcdf_error_handler(ncstat,"inquire_dimension")
+    enddo
+  
+    ! - dimids seem to be returned in storage order so the outer dimension of 
+    ! - the array as described by the netcdf file becomes the first dimension
+    ! - as far as f90 is concerned (confused? you will be!)
+
+    do jdim = 1,nc_input_rank
+      if (input_stop(jdim) == 0) then
+        input_stop(jdim) = input_dims(jdim)
+      endif
+      input_count(jdim) = input_stop(jdim) - input_start(jdim) + 1
+    enddo
+
+    ! - rashly we assume x followed by y
+    nx = input_dims(1)
+    ny = input_dims(2)
+    write(*,fmt='("Input grid dimensions are:",2i6)') nx, ny
+    if (nx*ny /= grid1_size) then
+      write(6,*) "mismatch between input grid and remap data"
+      stop
+    endif
+
+    ! - calculate number of horizontal slices to process
+    ! - at the moment this is not very general and will only work with 3 dimensions
+
+    acount(1:nc_input_rank) = &
+             (input_stop(1:nc_input_rank)-input_start(1:nc_input_rank)+1) / &
+             input_stride(1:nc_input_rank)
+    nloop = 1
+    do jdim = 1,nc_input_rank
+      nloop = nloop*acount(jdim)
+    enddo
+    nloop = nloop/grid1_size
+    write(6,*) "total slices requested: ",nloop
+
+    vstart = input_start(nc_input_rank)            ! ie extra var has outer dimension
+    vstride = input_stride(nc_input_rank)
+
+    ! - in general we cant read in the whole array so do it slice by slice
+    ! - slow but sure
+
+    write(6,*) "allocating input and output grids"
+    allocate( grid1_array(grid1_size))
+    allocate( grid_out(grid2_size) )
+
+    numv = 0
+    do n = 1,4
+      if (trim(input_vars(n)) /= '-' .and. &
+          trim(output_vars(n)) /= '-') numv = numv + 1
+    enddo
+
+    write_dims(1) = grid2_dims(1)
+    write_dims(2) = grid2_dims(2)
+    write_dims(3) = nloop
+    call define_grid(write_dims(1:3) , 2+numv)
+
+    astart(:) = input_start(:)
+    astart(3) = astart(3) - input_stride(3)
+    acount(:) = 1
+    acount(1) = nx
+    acount(2) = ny
+
+    do n = 1,nloop
+
+      write(6,*) "processing slice: ",n
+      astart(3) = astart(3) + input_stride(3)
+      ncstat = nf90_get_var(nc_infile_id, nc_input_id, grid1_array,  &
+                            start=astart(1:nc_input_rank),              &
+                            count=acount(1:nc_input_rank))
+      call netcdf_error_handler(ncstat,"get_var")
+
+      call calculate_grid(grid1_array, grid_out)
+
+      call write_grid(grid_out, n, write_dims(1:2) , 2)
+
+    enddo
+
+    ! ---------------------------------------------------------------------
+    ! - now for any extra variables to copy
+
+    if (numv > 0) then
+
+      write(6,*) "reading ",numv," extra variables"
+      allocate( var_out(nloop,numv) )
+  
+      do n = 1,numv
+        write(6,*) "looking for variable: ",trim(input_vars(n))
+        ncstat = nf90_inq_varid( nc_infile_id, trim(input_vars(n)), nc_input_id )
+        call netcdf_error_handler(ncstat,"inq_varid")
+      
+        input_dims(:) = 0
+        ncstat = nf90_inquire_variable( nc_infile_id, nc_input_id,   &
+                      ndims=nc_input_rank, dimids=input_dimids(:) )
+        call netcdf_error_handler(ncstat,"inquire_variable")
+  
+        if (nc_input_rank /= 1) then
+          write(6,*) 'sorry, only rank 1 variables can be copied'
+          cycle
+        endif
+        ncstat = nf90_inquire_dimension(nc_infile_id,              &
+                      input_dimids(1), len=input_dims(1) )
+        call netcdf_error_handler(ncstat,"inquire_dimension")
+  
+        ncstat = nf90_get_var(nc_infile_id, nc_input_id, var_out(1:nloop,n),  &
+                              start=(/ vstart /), stride=(/ vstride /))
+        call netcdf_error_handler(ncstat,"get_var")
+      enddo
+  
+      call write_extra(var_out, numv+2)
+      deallocate(var_out)
+
+    endif
+
+    ncstat = nf90_close(nc_outfile_id)
+    call netcdf_error_handler(ncstat,"out close")
+    ncstat = nf90_close(nc_infile_id)
+    call netcdf_error_handler(ncstat,"in close")
+
+    ! ---------------------------------------------------------------------
+
+    deallocate( grid1_array, grid_out)
+
+    ! ---------------------------------------------------------------------
+
+  end subroutine process_grid
+
+  ! ==========================================================================
+
+  subroutine define_grid(thedims, therank)
+
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+    
+    integer (kind=int_kind) :: &
+      therank
+    integer (kind=int_kind), dimension(therank) :: &
+      thedims
+
+    !-----------------------------------------------------------------------
+    ! - local variables
+
+    integer ::               &
+      k, n, ilon, ilat, icolon, i1, i2, natt, nvar, id, jd, kd, nd
+    character (char_len) ::  &
+      aname, vname, att
+    real (kind=dbl_kind) ::   s
+
+    ! - netcdf variables
+
+    integer :: xtype
+
+    !-----------------------------------------------------------------------
+    ! -  define grid size dimensions
+  
+    allocate(nc_xysize_id(grid2_rank))
+    allocate(nc_gridsize_id(therank))
+    allocate(nc_gridsize(therank))
+    allocate(nc_variable_id(therank-2))
+    
+    !-----------------------------------------------------------------------
+    ! - setup a NetCDF file for output
+  
+    xtype = NF90_FLOAT
+
+    write(6,*) 'creating output file'
+    ncstat = nf90_create (output_file, NF90_CLOBBER, nc_outfile_id)
+    call netcdf_error_handler(ncstat,"create")
+  
+    write(6,*) 'setting global attributes'
+    ncstat = nf90_put_att(nc_outfile_id, NF90_GLOBAL, 'title', map_name)
+    call netcdf_error_handler(ncstat,"put_att")
+  
+    write(6,*) 'setting dimensions'
+    do n=1,therank
+      if (n .eq. therank .and. therank .gt. 2) then
+        write(6,*) '    unlimited dim ',trim(output_dims(n)),' size: ',thedims(n)
+        ncstat = nf90_def_dim (nc_outfile_id, output_dims(n), NF90_UNLIMITED, &
+                               nc_gridsize_id(n))
+      else
+        write(6,*) '    dim ',trim(output_dims(n)),' size: ',thedims(n)
+        ncstat = nf90_def_dim (nc_outfile_id, output_dims(n), thedims(n), &
+                               nc_gridsize_id(n))
+      endif
+      call netcdf_error_handler(ncstat,"def_dim")
+    end do
+    nc_gridsize(:) = thedims(1:therank)
+
+    ! - at the moment there is an assumption here that the ordering is (lon,lat)
+
+    ilon = 1
+    ilat = 2
+    nc_xysize_id(1) = nc_gridsize_id(ilon)
+    nc_xysize_id(2) = nc_gridsize_id(ilat)
+
+    ! ----------------------------------------------------------------
+    ! -  define grid center longitude array
+  
+    write(6,*) 'defining longitude variable'
+    ncstat = nf90_def_var (nc_outfile_id, output_lon,   &
+                         xtype, nc_xysize_id,   &
+                         nc_lon_id)
+    call netcdf_error_handler(ncstat,"def_var")
+  
+    ncstat = nf90_put_att (nc_outfile_id, nc_lon_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat,"put_att")
+  
+    ! ----------------------------------------------------------------
+    ! -  define grid center latitude array
+  
+    write(6,*) 'defining latitude variable'
+    ncstat = nf90_def_var (nc_outfile_id, output_lat,     &
+                         xtype, nc_xysize_id,   &
+                         nc_lat_id)
+    call netcdf_error_handler(ncstat,"def_var")
+  
+    ncstat = nf90_put_att (nc_outfile_id, nc_lat_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat,"put_att")
+  
+    ! ----------------------------------------------------------------
+    ! -  define copy variables array
+  
+    write(6,*) 'defining copy variables'
+    do n = 3,therank
+      ncstat = nf90_def_var (nc_outfile_id, output_vars(n-2),   &
+                           xtype, nc_gridsize_id(n),    &
+                           nc_variable_id(n-2))
+      call netcdf_error_handler(ncstat,"def_var")
+    enddo
+  
+    ! ----------------------------------------------------------------
+    ! -  define output array
+  
+    write(6,*) 'defining grid variable'
+    ncstat = nf90_def_var (nc_outfile_id, output_name,               &
+                         xtype, nc_gridsize_id,    &
+                         nc_array_id)
+    call netcdf_error_handler(ncstat,"def_var")
+  
+    ! ----------------------------------------------------------------
+    ! - output attributes has to come after all other definitions
+    ! - this code currently a bit murky, needs a rewrite
+  
+    ncstat = nf90_inquire (nc_outfile_id, nVariables=nvar)
+    call netcdf_error_handler(ncstat,"inquire")
+    do n = 1,10
+      att = trim(output_attributes(n))
+      natt = len(att)
+      if (att /= '-') then
+        i1 = index(att,separator)
+        aname = att(1:i1-1)
+        do k = 1,nvar
+          ncstat = nf90_inquire_variable(nc_outfile_id, k, vname)
+          call netcdf_error_handler(ncstat,"inquire_variable")
+          if (vname == aname) then
+            i2 = index(att,separator,.true.)
+            ncstat = nf90_put_att (nc_outfile_id, k, &
+                                   att(i1+1:i2-1), att(i2+1:natt))
+            call netcdf_error_handler(ncstat,"put_att")
+            exit      ! from innermost do
+          endif
+        enddo
+      endif
+    enddo
+  
+    ! output scaling
+
+    allocate (scale(nvar))
+    scale(:) = 1.0
+
+    do n = 1,10
+      att = trim(output_scaling(n))
+      natt = len(att)
+      if (att /= '-') then
+        i1 = index(att,separator)
+        aname = att(1:i1-1)
+        do k = 1,nvar
+          ncstat = nf90_inquire_variable(nc_outfile_id, k, vname)
+          call netcdf_error_handler(ncstat,"inquire_variable")
+          if (vname == aname) then
+            i2 = index(att,separator,.true.)
+            read(att(i2+1:natt),*) scale(k)
+            call netcdf_error_handler(ncstat,"put_att")
+            exit      ! from innermost do
+          endif
+        enddo
+      endif
+    enddo
+  
+    ! ----------------------------------------------------------------
+    ! -  end definition stage
+  
+    ncstat = nf90_enddef(nc_outfile_id)
+    call netcdf_error_handler(ncstat,"enddef")
+ 
+  end subroutine define_grid
+
+  ! ==========================================================================
+
+  subroutine write_grid(thegrid, thelevel, thedims, therank)
+
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+    
+    integer (kind=int_kind), intent(in) :: &
+      therank, thelevel
+    real (kind=dbl_kind), dimension(:), intent(in) ::   &
+      thegrid
+    integer (kind=int_kind), dimension(therank) :: &
+      thedims
+
+    !-----------------------------------------------------------------------
+    ! - local variables
+
+    integer ::               &
+      k, n, ilon, ilat, icolon, j1, j2, dj, natt, nvar, id, jd, kd, nd
+    character (char_len) ::  &
+      aname, vname, att
+    real (kind=dbl_kind), dimension(:,:,:), allocatable ::   &
+      data
+    real (kind=dbl_kind) ::   s
+    real (kind=dbl_kind), parameter :: todeg = 57.295779513082323
+    integer (kind=int_kind), dimension(3) ::   &
+      start
+
+    ! - netcdf variables
+
+    integer :: xtype
+
+    !-----------------------------------------------------------------------
+    ! - write results to NetCDF file
+  
+    allocate (data(thedims(1),thedims(2),1))
+    if (output_ydir .eq. 'invert') then
+      j1 = thedims(2)
+      j2 = 1
+      dj = -1
+    else
+      j1 = 1
+      j2 = thedims(2)
+      dj = 1
+    endif
+
+    if (thelevel .eq. 1) then
+
+      ! -  grid center latitude array
+  
+      write(6,*) 'writing latitude variable'
+      s = scale(nc_lat_id)
+      nd = 0
+      do jd = j1,j2,dj
+        do id =1,thedims(1)
+          nd = nd + 1
+          data(id,jd,1) = s*todeg*grid2_center_lat(nd)
+        enddo
+      enddo
+      ncstat = nf90_put_var(nc_outfile_id, nc_lat_id, data(:,:,1))
+      call netcdf_error_handler(ncstat,"put_var")
+  
+      ! -  grid center longitude array
+  
+      write(6,*) 'writing longitude variable'
+      s = scale(nc_lon_id)
+      nd = 0
+      do jd = j1,j2,dj
+        do id =1,thedims(1)
+          nd = nd + 1
+          data(id,jd,1) = s*todeg*grid2_center_lon(nd)
+        enddo
+      enddo
+      ncstat = nf90_put_var(nc_outfile_id, nc_lon_id, data(:,:,1))
+      call netcdf_error_handler(ncstat,"put_var")
+
+    endif
+
+    !-----------------------------------------------------------------------
+    ! -  new grid
+
+    write(6,*) 'writing grid variable'
+    n = therank
+    s = scale(nc_array_id)
+    nd = 0
+    do jd = j1,j2,dj
+      do id =1,thedims(1)
+        nd = nd + 1
+        data(id,jd,1) = thegrid(nd)
+      enddo
+    enddo
+    write(6,*) 'scaling data '
+    data(:,:,1) = s*data(:,:,1)
+    start(:) = (/ 1, 1, thelevel /)
+    ncstat = nf90_put_var(nc_outfile_id, nc_array_id, data, start)
+    call netcdf_error_handler(ncstat,"put_var")
+    deallocate(data)
+
+  end subroutine write_grid
+
+  ! ==========================================================================
+
+  subroutine write_extra(thevars, therank)
+
+    real (kind=dbl_kind), dimension(:,:), intent(in) ::   &
+      thevars
+    real (kind=dbl_kind), dimension(:), allocatable ::   &
+      thedata
+    integer (kind=int_kind), intent(in) :: &
+      therank
+    real (kind=dbl_kind) ::   s
+    integer :: n
+
+    allocate( thedata(size(thevars,1)) )
+
+    ! -  copy variable arrays
+
+    write(6,*) 'writing copy variables'
+    do n = 3,therank
+      s = scale(nc_variable_id(n-2))
+      thedata(:) = s*thevars(:,n-2)
+      ncstat = nf90_put_var(nc_outfile_id, nc_variable_id(n-2), thedata)
+      call netcdf_error_handler(ncstat,"put_var")
+    enddo
+
+    deallocate( thedata )
+
+  end subroutine write_extra
+
+  ! ==========================================================================
+
+  subroutine close_grid()
+
+  !     close netCDF file
+  
+    write(6,*) 'closing file'
+    ncstat = nf90_close(nc_outfile_id)
+    call netcdf_error_handler(ncstat,"close")
+  
+  end subroutine close_grid
+
+  ! ==========================================================================
+
+  subroutine read_mappings(nm_in)
+
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+
+    character (char_len) ::  &
+      nm_in                    ! name of input namelist file
+  
+    !-----------------------------------------------------------------------
+    ! - local variables
+  
+    character (char_len) ::   &
+              dim_name    ! netCDF dimension name
+  
+    integer (kind=int_kind) ::     &
+        iunit                                                ! unit number for namelist file
+  
+    !-----------------------------------------------------------------------
+    ! - namelist block
+
+    namelist /interp_inputs/ input_file, interp_file, input_name, &
+                             input_stride, input_start, input_stop, &
+                             input_vars
+    namelist /interp_outputs/ output_dims, output_file, output_mode, output_name, &
+                              output_lat, output_lon, output_ydir,  &
+                              output_scaling, output_vars, output_attributes
+  
+    !-----------------------------------------------------------------------
+    ! - read namelist for file and mapping info
+  
+    input_stride(:) = 1
+    input_start(:) = 1
+    input_stop(:) = 0
+    output_scaling(:) = '-'
+    input_vars(:) = '-'
+    output_lon = '-'
+    output_lat = '-'
+    output_vars(:) = '-'
+    output_ydir = 'none'
+    output_attributes(:) = '-'
+
+    call get_unit(iunit)
+    open(iunit, file=nm_in, status='old', form='formatted')
+    read(iunit, nml=interp_inputs)
+    read(iunit, nml=interp_outputs)
+    call release_unit(iunit)
+    write(*,nml=interp_inputs)
+    write(*,nml=interp_outputs)
+    if (trim(output_mode) == "create") then
+      if (trim(output_lon) == '-' .or. trim(output_lat) == '-') then
+        write(6,*) 'if creating, need to supply lon and lat names'
+        stop
+      endif
+    endif
+
+    !-----------------------------------------------------------------------
+    ! - read remapping data
+    ! - via the scrip package this sets variables:
+    !    grid1_size, grid2_size:     sizes of input and output grids
+    !    grid1_mask, grid2_mask:     masks
+    !    grid1_rank, grid2_rank:     ranks
+  
+    call read_remap(map_name, interp_file)
+  
+  end subroutine read_mappings
+
+  ! ==========================================================================
+
+  subroutine calculate_grid(grid1_array, grid2_array)
+
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+
+    real (kind=dbl_kind), intent(in), dimension(:) ::    &
+      grid1_array
+    real (kind=dbl_kind), intent(out), dimension(:) ::    &
+      grid2_array
+
+    !-----------------------------------------------------------------------
+    ! - local variables
+
+    integer (kind=int_kind), dimension(:), allocatable :: &
+        grid1_imask, grid2_imask, grid2_count
+
+    real (kind=dbl_kind), dimension(:), allocatable :: &
+        grid1_tmp,           &
+        grad1_lat,           &
+        grad1_lon,           &
+        grad1_latlon,        &
+        grad1_lat_zero,      &
+        grad1_lon_zero,      &
+        grid2_tmp1,           &
+        grid2_tmp2
+
+    real (kind=dbl_kind) ::  &
+        delew, delns            ! variables for computing bicub gradients
+
+    integer (kind=int_kind) ::                          &
+        i,j,n,imin,imax,idiff,                          &
+        ip1,im1,jp1,jm1,nx,ny,                          &  ! for computing bicub gradients
+        in,is,ie,iw,ine,inw,ise,isw
+
+    logical, parameter :: lat_gradient = .false.
+  
+    write(6,*) 'starting'
+
+    !-----------------------------------------------------------------------
+    ! - allocate arrays
+  
+    allocate (grid1_tmp      (grid1_size),   &
+              grad1_lat      (grid1_size),    &
+              grad1_lon      (grid1_size),    &
+              grad1_lat_zero (grid1_size),    &
+              grad1_lon_zero (grid1_size),    &
+              grid1_imask    (grid1_size),   &
+              grid2_tmp1     (grid2_size),   &
+              grid2_tmp2     (grid2_size),   &
+              grid2_imask    (grid2_size),   &
+              grid2_count    (grid2_size))
+  
+    write(6,*) 'allocated'
+    write(6,*) grid1_size,grid2_size
+
+    grid1_imask(:) = 1
+    grid2_imask(:) = 1
+    where (grid1_mask)
+      grid1_imask = 1
+    elsewhere
+      grid1_imask = 0
+    endwhere
+    where (grid2_mask)
+      grid2_imask = 1
+    elsewhere
+      grid2_imask = 0
+    endwhere
+
+    write(6,*) 'masked'
+
+    grad1_lat_zero = zero
+    grad1_lon_zero = zero
+    nx = input_dims(1)
+    ny = input_dims(2)
+    write(6,*) nx,ny
+  
+    !-----------------------------------------------------------------------
+    ! - if bicubic, we need 3 gradients in logical space
+  
+    if (map_type == map_type_bicubic) then
+  
+      write(6,*) 'bicubic'
+      write(6,*) grid1_size
+
+      allocate (grad1_latlon (grid1_size)) 
+  
+      do n=1,grid1_size
+  
+        grad1_lat(n) = zero
+        grad1_lon(n) = zero
+        grad1_latlon(n) = zero
+  
+!       if (n.ge.8000) write(6,*) 0,grid1_mask(n),nx
+        if (grid1_mask(n)) then
+  
+          delew = half
+          delns = half
+  
+          j = (n-1)/nx + 1
+          i = n - (j-1)*nx
+  
+          ip1 = i+1
+          im1 = i-1
+          jp1 = j+1
+          jm1 = j-1
+  
+          if (ip1 > nx) ip1 = ip1 - nx
+          if (im1 < 1 ) im1 = nx
+          if (jp1 > ny) then
+            jp1 = j
+            delns = one
+          endif
+          if (jm1 < 1 ) then
+            jm1 = j
+            delns = one
+          endif
+  
+          in  = (jp1-1)*nx + i
+          is  = (jm1-1)*nx + i
+          ie  = (j  -1)*nx + ip1
+          iw  = (j  -1)*nx + im1
+  
+          ine = (jp1-1)*nx + ip1
+          inw = (jp1-1)*nx + im1
+          ise = (jm1-1)*nx + ip1
+          isw = (jm1-1)*nx + im1
+  
+          ! -  compute i-gradient
+  
+          if (.not. grid1_mask(ie)) then
+            ie = n
+            delew = one
+          endif
+          if (.not. grid1_mask(iw)) then
+            iw = n
+            delew = one
+          endif
+   
+          grad1_lat(n) = delew*(grid1_array(ie) - grid1_array(iw))
+!         if (n.ge.8000) write(6,*) 1,grad1_lat(n)
+  
+          ! -  compute j-gradient
+  
+          if (.not. grid1_mask(in)) then
+            in = n
+            delns = one
+          endif
+          if (.not. grid1_mask(is)) then
+            is = n
+            delns = one
+          endif
+   
+          grad1_lon(n) = delns*(grid1_array(in) - grid1_array(is))
+!         if (n.ge.8000) write(6,*) 2,grad1_lon(n)
+  
+          ! -  compute ij-gradient
+  
+          delew = half
+          if (jp1 == j .or. jm1 == j) then
+            delns = one
+          else 
+            delns = half
+          endif
+  
+          if (.not. grid1_mask(ine)) then
+            if (in /= n) then
+              ine = in
+              delew = one
+            else if (ie /= n) then
+              ine = ie
+              inw = iw
+              if (inw == n) delew = one
+              delns = one
+            else
+              ine = n
+              inw = iw
+              delew = one
+              delns = one
+            endif
+          endif
+  
+          if (.not. grid1_mask(inw)) then
+            if (in /= n) then
+              inw = in
+              delew = one
+            else if (iw /= n) then
+              inw = iw
+              ine = ie
+              if (ie == n) delew = one
+              delns = one
+            else
+              inw = n
+              ine = ie
+              delew = one
+              delns = one
+            endif
+          endif
+  
+          grad1_lat_zero(n) = delew*(grid1_array(ine) - grid1_array(inw))
+!         if (n.ge.8000) write(6,*) 3,grad1_lat_zero(n)
+  
+          if (.not. grid1_mask(ise)) then
+            if (is /= n) then
+              ise = is
+              delew = one
+            else if (ie /= n) then
+              ise = ie
+              isw = iw
+              if (isw == n) delew = one
+              delns = one
+            else
+              ise = n
+              isw = iw
+              delew = one
+              delns = one
+            endif
+          endif
+  
+          if (.not. grid1_mask(isw)) then
+            if (is /= n) then
+              isw = is
+              delew = one
+            else if (iw /= n) then
+              isw = iw
+              ise = ie
+              if (ie == n) delew = one
+              delns = one
+            else
+              isw = n
+              ise = ie
+              delew = one
+              delns = one
+            endif
+          endif
+  
+          grad1_lon_zero(n) = delew*(grid1_array(ise) - grid1_array(isw))
+          grad1_latlon(n) = delns*(grad1_lat_zero(n) - grad1_lon_zero(n))
+!         if (n.ge.8000) write(6,*) 4,grad1_lon_zero(n),grad1_latlon(n)
+  
+        endif
+      enddo
+  
+      write(6,*) 'remapping'
+      call remap(grid2_array, wts_map1, grid2_add_map1, grid1_add_map1, &
+                 grid1_array, src_grad1=grad1_lat,                    &
+                 src_grad2=grad1_lon, src_grad3=grad1_latlon)
+  
+      print *,'Third order mapping from grid1 to grid2:'
+      print *,'----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_array  ),maxval(grid2_array  )
+    
+      ! -  Conservation Test
+    
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_array  *grid2_area*grid2_frac)
+    
+    !-----------------------------------------------------------------------
+    ! - a first-order map from grid1 to grid2
+  
+    else if (map_type /= map_type_conserv .AND.map_type /= map_type_bicubic) then
+
+      write(6,*) 'bilinear or conservative'
+  
+      call remap(grid2_array, wts_map1, grid2_add_map1, grid1_add_map1,grid1_array)
+  
+      print *,'First order mapping from grid1 to grid2:'
+      print *,'----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_array  ),maxval(grid2_array  )
+    
+      ! -  Conservation Test
+    
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_array  *grid2_area*grid2_frac)
+    
+    !-----------------------------------------------------------------------
+    ! - conservative mappings:
+    ! - a second-order map from grid1 to grid2 with only lat grads
+  
+    else if (map_type == map_type_conserv .AND. lat_gradient) then
+  
+      call remap(grid2_array, wts_map1, grid2_add_map1, grid1_add_map1,  &
+                 grid1_array, src_grad1=grad1_lat,src_grad2=grad1_lon_zero) 
+  
+      select case (norm_opt)
+      case (norm_opt_none)
+        grid2_tmp2 = grid2_frac*grid2_area
+        where (grid2_tmp2 /= zero)
+          grid2_array = grid2_array/grid2_tmp2
+        elsewhere
+          grid2_array = zero
+        end where
+      case (norm_opt_frcarea)
+      case (norm_opt_dstarea)
+        where (grid2_frac /= zero)
+          grid2_array = grid2_array/grid2_frac
+        elsewhere
+          grid2_array = zero
+        end where
+      end select
+  
+      print *,'Second order mapping from grid1 to grid2 (lat only):'
+      print *,'----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_array  ),maxval(grid2_array  )
+  
+      ! -  Conservation Test
+  
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_array*grid2_area*grid2_frac)
+  
+    !-----------------------------------------------------------------------
+    ! - conservative mappings:
+    ! - a second-order map from grid1 to grid2 both gradients
+  
+    else if (map_type == map_type_conserv .AND..NOT. lat_gradient) then
+  
+      call remap(grid2_array,wts_map1,grid2_add_map1,grid1_add_map1,  &
+                 grid1_array, src_grad1=grad1_lat,src_grad2=grad1_lon) 
+  
+      select case (norm_opt)
+      case (norm_opt_none)
+        grid2_tmp2 = grid2_frac*grid2_area
+        where (grid2_tmp2 /= zero)
+          grid2_array = grid2_array/grid2_tmp2
+        elsewhere
+          grid2_array = zero
+        end where
+      case (norm_opt_frcarea)
+      case (norm_opt_dstarea)
+        where (grid2_frac /= zero)
+          grid2_array = grid2_array/grid2_frac
+        elsewhere
+          grid2_array = zero
+        end where
+      end select
+  
+      print *,'Second order mapping from grid1 to grid2:'
+      print *,'-----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_array  ),maxval(grid2_array  )
+  
+      ! -  Conservation Test
+  
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_array*grid2_area*grid2_frac)
+  
+    endif
+  
+    !-----------------------------------------------------------------------
+    !     calculate some statistics
+  
+    grid2_count = zero
+    grid2_tmp1  = zero
+    grid2_tmp2  = zero
+  
+    print *,'number of sparse matrix entries ',num_links_map1
+    do n=1,num_links_map1
+      grid2_count(grid2_add_map1(n)) = grid2_count(grid2_add_map1(n)) + 1
+      if (wts_map1(1,n) > one .or. wts_map1(1,n) < zero) then
+        grid2_tmp1(grid2_add_map1(n)) = grid2_tmp1(grid2_add_map1(n)) + 1
+        grid2_tmp2(grid2_add_map1(n)) = max(abs(wts_map1(1,n)),grid2_tmp2(grid2_add_map1(n)) )
+      endif
+    end do
+  
+    do n=1,grid2_size
+      if (grid2_tmp1(n) > zero) print *,n,grid2_tmp2(n)
+    end do
+  
+    imin = minval(grid2_count, mask=(grid2_count > 0))
+    imax = maxval(grid2_count)
+    idiff =  (imax - imin)/10 + 1
+    print *,'total number of dest cells ',grid2_size
+    print *,'number of cells participating in remap ',count(grid2_count > zero)
+    print *,'min no of entries/row = ',imin
+    print *,'max no of entries/row = ',imax
+  
+    imax = imin + idiff
+    do n=1,10
+      print *,'num of rows with entries between ',imin,' - ',imax-1,   &
+               count(grid2_count >= imin .and. grid2_count < imax)
+      imin = imin + idiff
+      imax = imax + idiff
+    end do
+  
+    !-----------------------------------------------------------------------
+    ! - deallocate arrays
+  
+    deallocate (grid1_tmp, grad1_lat, grad1_lon,    &
+                grad1_lat_zero, grad1_lon_zero, grid1_imask,     &
+                grid2_tmp1, grid2_tmp2,   &
+                grid2_imask, grid2_count)
+  
+  end subroutine calculate_grid
+
+  ! ==========================================================================
+
+end module scripinterp_mod
+
Index: /utils/tools_ticket2413/WEIGHTS/src/scripshape.F90
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/src/scripshape.F90	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/src/scripshape.F90	(revision 12863)
@@ -0,0 +1,419 @@
+      PROGRAM scripshape
+!
+! program to take output from the SCRIP weights generator
+! and rearrange the data into a series of 2D fields suitable
+! for reading with iom_get in NEMO configurations using the
+! interpolation on the fly option
+!
+      USE netcdf
+      IMPLICIT none
+      INTEGER    :: ncId, VarId, status
+      INTEGER    :: start(4), count(4)
+      CHARACTER(LEN=1) :: y
+      INTEGER    :: nd, ns, nl, nw, sx, sy, dx, dy
+      INTEGER    :: i, j, k, m, n, smax
+!
+!  ifort -O2 -o scripshape scripshape.f90 \
+!        -I/nerc/packages/netcdfifort/v3.6.0-pl1/include \
+!        -L/nerc/packages/netcdfifort/v3.6.0-pl1/lib -lnetcdf
+!
+!
+      INTEGER(KIND=4), ALLOCATABLE :: src(:)
+      INTEGER(KIND=4), ALLOCATABLE :: dst(:)
+      REAL(KIND=8), ALLOCATABLE :: wgt(:,:)
+      REAL(KIND=8), ALLOCATABLE :: src1(:,:),dst1(:,:),wgt1(:,:)
+      LOGICAL  :: around, verbose
+#if defined ARGC
+      INTEGER(KIND=4) :: iargc
+      EXTERNAL :: iargc
+#endif
+
+      CHARACTER(LEN=256) :: interp_file, output_file, name_file
+      INTEGER            :: ew_wrap
+      NAMELIST /shape_inputs/ interp_file, output_file, ew_wrap
+
+! scripshape requires 1 arguments; the name of the file containing
+! the input namelist.
+! This namelist contains:
+!     the name of the input file containing the weights ! produced by SCRIP in its format;
+!     the name of the new output file which ! is to contain the reorganized fields ready for input to NEMO.
+!     the east-west wrapping of the input grid (-1, 0, 1 and 2 are accepted values)
+!
+! E.g.
+!     interp_file = 'data_nemo_bilin.nc'
+!     output_file = 'weights_bilin.nc'
+!     ew_wrap     = 2
+!
+#if defined ARGC
+      IF (iargc() == 1) THEN
+        CALL getarg(1, name_file)
+      ELSE
+        WRITE(*,*) 'Usage: scripshape namelist_file'
+        STOP
+      ENDIF
+#else
+      WRITE(6,*) 'enter name of namelist file'
+      READ(5,*) name_file
+#endif
+      interp_file = 'none'
+      output_file = 'none'
+      ew_wrap = 0
+      OPEN(12, FILE=name_file, STATUS='OLD', FORM='FORMATTED')
+      READ(12, NML=shape_inputs)
+      CLOSE(12)
+!
+      INQUIRE(FILE = TRIM(interp_file), EXIST=around)
+      IF (.not.around) THEN
+       WRITE(*,*) 'Input file: '//TRIM(interp_file)//' not found'
+       STOP
+      ENDIF
+! 
+      INQUIRE(FILE = TRIM(output_file), EXIST=around)
+      IF (around) THEN
+       WRITE(*,*) 'Output file: '//TRIM(output_file)//' exists'
+       WRITE(*,*) 'Ok to overwrite (y/n)?'
+       READ(5,'(a)') y
+       IF ( y .ne. 'y' .AND. y .ne. 'Y' ) STOP
+      ENDIF
+!
+      verbose = .true.
+!
+! Obtain grid size information from interp_file
+!
+      CALL ncgetsize
+!
+! Allocate array spaces
+!
+      ALLOCATE(src(nl), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('src')
+      ALLOCATE(dst(nl), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('dst')
+      ALLOCATE(wgt(nw,nl), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('wgt')
+      ALLOCATE(src1(dx,dy), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('src1')
+      ALLOCATE(dst1(dx,dy), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('dst1')
+      ALLOCATE(wgt1(dx,dy), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('wgt1')
+!
+! Read all required data from interp_file
+!
+      CALL ncgetfields
+!
+! Check that dst is monotonically increasing
+!
+      DO k = 1,nl-1
+       IF(dst(k+1).lt.dst(k)) THEN
+        WRITE(*,*) 'non-monotonic at ',k
+        WRITE(*,*) dst(k-4:k+16)
+        STOP
+       ENDIF
+      END DO
+!
+! Remove references to the top row of src
+!
+      IF(verbose) WRITE(*,*) &
+        'Removing references to the top row of the source grid'
+      smax = (sy-1)*sx
+      n = 0
+      DO k = 1,nl
+       IF(src(k).gt.smax-1) THEN
+        src(k) = src(k)-sx
+        n = n + 1
+       ENDIF
+      END DO
+      IF(verbose) WRITE(*,*) n,' values changed (',100.*n/nl,'%)'
+!
+! Loop through weights for each corner in turn and
+! rearrange weight fields into separate 2D fields for
+! reading with iom_get in NEMO
+!
+      DO k = 1,nw
+       DO n = 1,4
+
+        i = 0
+        j = 1
+        DO m = n,nl,4
+         i = i+1
+         IF(i.gt.dx) THEN
+          i = 1
+          j = j + 1
+         ENDIF
+         src1(i,j) = src(m)
+         dst1(i,j) = dst(m)
+         wgt1(i,j) = wgt(k,m)
+        END DO
+!
+! Write out this set which will be labelled with
+! a 2 digit number equal to n+4*(k-1)
+!
+        CALL wrwgts
+!   
+       END DO
+      END DO
+      STOP
+      CONTAINS
+!
+!----------------------------------------------------------------------*
+      SUBROUTINE ncgetsize
+!
+! Access grid size information in interp_file and set the
+! following integers:
+!
+!    nd = dst_grid_size
+!    ns = src_grid_size
+!    nl = num_links    
+!    nw = num_wgts     
+! sx,sy = src_grid_dims     
+! dx,dy = dst_grid_dims     
+!
+      INTEGER idims(2)
+!
+       status = nf90_open(interp_file, nf90_NoWrite, ncid)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_dimid(ncid, 'dst_grid_size', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_inquire_dimension(ncid, VarId, LEN = nd)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_dimid(ncid, 'src_grid_size', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_inquire_dimension(ncid, VarId, LEN = ns)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_dimid(ncid, 'num_links', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_inquire_dimension(ncid, VarId, LEN = nl)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_dimid(ncid, 'num_wgts', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_inquire_dimension(ncid, VarId, LEN = nw)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       start = 1
+       count = 2
+       status = nf90_inq_varid(ncid, 'src_grid_dims', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_get_var(ncid, VarId, idims, start, count)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       sx = idims(1) ; sy = idims(2)
+!
+       status = nf90_inq_varid(ncid, 'dst_grid_dims', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_get_var(ncid, VarId, idims, start, count)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       dx = idims(1) ; dy = idims(2)
+!
+       status = nf90_close(ncid)
+       IF (status /= nf90_noerr) CALL handle_err(status)
+!
+       IF(verbose) THEN
+         WRITE(*,*) 'Detected sizes: '
+         WRITE(*,*) 'dst_grid_size: ', nd
+         WRITE(*,*) 'src_grid_size: ', ns
+         WRITE(*,*) 'num_links    : ', nl
+         WRITE(*,*) 'num_wgts     : ', nw
+         WRITE(*,*) 'src_grid_dims: ', sx, ' x ', sy
+         WRITE(*,*) 'dst_grid_dims: ', dx, ' x ', dy
+       ENDIF
+!
+      END SUBROUTINE ncgetsize
+
+!----------------------------------------------------------------------*
+      SUBROUTINE ncgetfields
+!
+! Read all required data from interp_file. The data read are:
+!
+! netcdf variable    size   internal array
+!-----------------+-------+--------------
+! src_address        nl     src
+! dst_address        nl     dst
+! remap_matrix     (nw,nl)  wgt
+!
+       status = nf90_open(interp_file, nf90_NoWrite, ncid)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_varid(ncid, 'src_address', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Read the values for src
+       status = nf90_get_var(ncid, VarId, src, &
+                         start = (/ 1 /),      &
+                         count = (/ nl /))
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_varid(ncid, 'dst_address', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Read the values for dst
+       status = nf90_get_var(ncid, VarId, dst, &
+                         start = (/ 1 /),      &
+                         count = (/ nl /))
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_varid(ncid, 'remap_matrix', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Read the values for wgt
+       status = nf90_get_var(ncid, VarId, wgt, &
+                         start = (/ 1, 1 /),   &
+                         count = (/ nw, nl /))
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_close(ncid)
+       IF (status /= nf90_noerr) CALL handle_err(status)
+!
+      END SUBROUTINE ncgetfields
+
+!----------------------------------------------------------------------*
+      SUBROUTINE handle_err(status)
+!
+! Simple netcdf error checking routine
+!
+      INTEGER, intent ( in) :: status
+!
+      IF(status /= nf90_noerr) THEN
+       IF(trim(nf90_strerror(status)) .eq. 'Attribute not found') THEN
+! ignore
+       ELSE
+        WRITE(*,*) trim(nf90_strerror(status))
+        STOP "Stopped"
+       END IF
+      END IF
+      END SUBROUTINE handle_err
+
+!----------------------------------------------------------------------*
+      SUBROUTINE alloc_err(arname)
+!
+! Simple allocation error checking routine
+!
+      CHARACTER(LEN=*) :: arname
+!
+      WRITE(*,*) 'Allocation error attempting to ALLOCATE '//arname
+      STOP "Stopped"
+      END SUBROUTINE alloc_err
+
+!                                                                       
+!----------------------------------------------------------------------*
+      SUBROUTINE wrwgts
+!
+! Write out each set of 2D fields to output_file.
+! Each call will write out a set of srcXX, dstXX and wgtXX fields
+! where XX is a two digit number equal to n + 4*(k-1). The first
+! and last calls to this routine initialise and close the output
+! file respectively. The first call is detected when k*n=1 and the
+! last call is detected when k*n=4*nw. The outfile file remains
+! open between the first and last calls. 
+!
+      INTEGER :: status, ncid, ncin
+      INTEGER :: Lontdid, Lattdid
+      INTEGER :: tvid, tvid2, tvid3
+      INTEGER :: ioldfill
+      CHARACTER(LEN=2) :: cs
+      SAVE ncid, Lontdid, Lattdid
+!
+      IF(k*n.eq.1) THEN
+!
+! Create output_file and set the dimensions
+!
+         status = nf90_create(output_file, nf90_Clobber, ncid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+         status = nf90_set_fill(ncid, nf90_NoFill, ioldfill)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_def_dim(ncid, "lon", dx, Lontdid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+         status = nf90_def_dim(ncid, "lat", dy, Lattdid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_put_att(ncid, nf90_global, 'ew_wrap', ew_wrap)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+      ELSE
+!
+! Reenter define mode
+!
+         status = nf90_redef(ncid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+      ENDIF
+!
+      WRITE(cs,'(i2.2)') n + 4*(k-1)
+!
+! Define new variables
+!
+      status = nf90_def_var(ncid, "src"//cs, nf90_double, &
+                         (/ Lontdid, Lattdid /), tvid)
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      status = nf90_def_var(ncid, "dst"//cs, nf90_double, &
+                         (/ Lontdid, Lattdid /), tvid2)
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      status = nf90_def_var(ncid, "wgt"//cs, nf90_double, &
+                         (/ Lontdid, Lattdid /), tvid3)
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Leave define mode
+!
+      status = nf90_enddef(ncid)
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Write the data
+!
+      status = nf90_put_var(ncid, tvid, src1,    &
+                            start = (/ 1, 1 /),  &
+                            count = (/ dx, dy /) )
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      status = nf90_put_var(ncid, tvid2, dst1,   &
+                            start = (/ 1, 1 /),  &
+                            count = (/ dx, dy /) )
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      status = nf90_put_var(ncid, tvid3, wgt1,   &
+                            start = (/ 1, 1  /), &
+                            count = (/ dx, dy /) )
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      IF(k*n.eq.4*nw) THEN
+!
+! --     Reenter define mode
+!
+         status = nf90_redef(ncid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! --     Reopen interp_file and transfer some global attributes
+!
+         status = nf90_open(interp_file, nf90_NoWrite, ncin)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'title',        ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'normalization',ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'map_method',   ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'conventions',  ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'history',      ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! --     Close interp_file
+!
+         status = nf90_close(ncin)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! --     Close output_file
+!
+         status = nf90_close(ncid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+      ENDIF
+
+      END SUBROUTINE wrwgts
+      END PROGRAM scripshape
Index: /utils/tools_ticket2413/WEIGHTS/src/timers.f90
===================================================================
--- /utils/tools_ticket2413/WEIGHTS/src/timers.f90	(revision 12863)
+++ /utils/tools_ticket2413/WEIGHTS/src/timers.f90	(revision 12863)
@@ -0,0 +1,343 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module uses F90 cpu time routines to allowing setting of
+!     multiple CPU timers.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: timers.f,v 1.2 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module timers
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+
+      implicit none
+
+      integer (kind=int_kind), parameter ::   &
+           max_timers = 99  ! max number of timers allowed
+
+      integer (kind=int_kind), save ::  &
+           cycles_max       ! max value of clock allowed by system
+
+      integer (kind=int_kind), dimension(max_timers), save ::  &
+           cycles1,          & ! cycle number at start for each timer
+           cycles2          ! cycle number at stop  for each timer
+
+      real (kind=real_kind), save ::   &
+           clock_rate       ! clock_rate in seconds for each cycle
+
+      real (kind=real_kind), dimension(max_timers), save ::   &
+           cputime          ! accumulated cpu time in each timer
+
+      character (len=8), dimension(max_timers), save ::   &
+           status           ! timer status string
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine timer_check(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine checks a given timer.  This is primarily used to
+!     periodically accumulate time in the timer to prevent timer cycles
+!     from wrapping around max_cycles.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::   &
+          timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      if (status(timer) .eq. 'running') then
+        call timer_stop (timer)
+        call timer_start(timer)
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_check
+
+!***********************************************************************
+
+      subroutine timer_clear(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine resets a given timer.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::   &
+          timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      cputime(timer) = 0.0_real_kind  ! clear the timer
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_clear
+
+!***********************************************************************
+
+      function timer_get(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine returns the result of a given timer.  This can be
+!     called instead of timer_print so that the calling routine can 
+!     print it in desired format.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::   &
+          timer            ! timer number
+
+!-----------------------------------------------------------------------
+!
+!     Output Variables:
+!
+!-----------------------------------------------------------------------
+
+      real (kind=real_kind) ::   &
+           timer_get   ! accumulated cputime in given timer
+
+!-----------------------------------------------------------------------
+
+      if (status(timer) .eq. 'stopped') then
+        timer_get = cputime(timer)
+      else
+        call timer_stop(timer)
+        timer_get = cputime(timer)
+        call timer_start(timer)
+      endif
+
+!-----------------------------------------------------------------------
+
+      end function timer_get
+
+!***********************************************************************
+
+      subroutine timer_print(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine prints the accumulated cpu time in given timer.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::   &
+          timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      !--- 
+      !--- print the cputime accumulated for timer 
+      !--- make sure timer is stopped
+      !---
+
+      if (status(timer) .eq. 'stopped') then
+        write(*,"(' CPU time for timer',i3,':',1p,e16.8)")   &
+             timer,cputime(timer)
+      else
+        call timer_stop(timer)
+        write(*,"(' CPU time for timer',i3,':',1p,e16.8)")   &
+             timer,cputime(timer)
+        call timer_start(timer)
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_print
+
+!***********************************************************************
+
+      subroutine timer_start(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine starts a given timer.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::   &
+          timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      !---
+      !--- Start the timer and change timer status.
+      !---
+
+      if (status(timer) .eq. 'stopped') then
+        call system_clock(count=cycles1(timer))
+        status(timer) = 'running'
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_start
+
+!***********************************************************************
+
+      subroutine timer_stop(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine stops a given timer.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::   &
+          timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      if (status(timer) .eq. 'running') then
+
+        !---
+        !--- Stop the desired timer.
+        !---
+
+        call system_clock(count=cycles2(timer))
+
+        !---
+        !--- check and correct for cycle wrapping
+        !---
+
+        if (cycles2(timer) .ge. cycles1(timer)) then
+          cputime(timer) = cputime(timer) + clock_rate*   &
+                           (cycles2(timer) - cycles1(timer))
+        else
+          cputime(timer) = cputime(timer) + clock_rate*   &
+                      (cycles2(timer) - cycles1(timer) + cycles_max)
+        endif
+
+        !---
+        !--- Change timer status.
+        !---
+
+        status(timer)='stopped'
+
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_stop
+
+!***********************************************************************
+
+      subroutine timers_init
+
+!-----------------------------------------------------------------------
+!
+!     This routine initializes some machine parameters necessary for
+!     computing cpu time from F90 intrinsics.
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: cycles ! count rate return by sys_clock
+
+!-----------------------------------------------------------------------
+
+      !---
+      !--- Initialize timer arrays and clock_rate.
+      !---
+
+      clock_rate = 0.0_real_kind
+      cycles1    = 0
+      cycles2    = 0
+      cputime    = 0.0_real_kind
+      status     = 'stopped'
+
+      !---
+      !--- Call F90 intrinsic system_clock to determine clock rate
+      !--- and maximum cycles.  If no clock available, print message.
+      !---
+
+      call system_clock(count_rate=cycles, count_max=cycles_max)
+
+      if (cycles /= 0) then
+        clock_rate = 1.0_real_kind/real(cycles)
+      else
+        clock_rate = 0.0_real_kind
+        print *, '--- No system clock available ---'
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timers_init
+
+!***********************************************************************
+
+      end module timers
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: /utils/tools_ticket2413/maketools
===================================================================
--- /utils/tools_ticket2413/maketools	(revision 12863)
+++ /utils/tools_ticket2413/maketools	(revision 12863)
@@ -0,0 +1,187 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u 
+#set -e
+#+
+#
+# ===============
+# maketools
+# ===============
+#
+# --------------------------
+# Compile NEMO
+# --------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ maketools
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# This script aims :
+#
+# - to choose a tool to compile
+# - to choose compiler options  
+# - to compile this tool
+#
+#  Variables used :
+#
+#  From user input
+#
+# - NEW_CONF    : configuration to be created
+# - CMP_NAM     : compiler name 
+# - NBR_PRC     : number of processes used to compile  
+#
+#  Locally defined :
+#
+# - MAIN_DIR : self explaining
+# - MODELES_DIR :   "    "    " 
+# - TOOLS_DIR   :   "    "    " 
+# - NEMO_DIR    :   "    "    "
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./maketools -t ifort_osx - j3 -n NESTING
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id: maketools 12415 2020-02-19 20:29:26Z smueller $
+#
+#
+#
+#   * creation
+#
+#-
+
+#- Local variables ---
+b_n=$(basename ${0})
+export MAIN_DIR=${PWD%/tools*}
+export TOOLS_DIR=${MAIN_DIR}/tools
+export COMPIL_DIR=${MAIN_DIR}/mk
+export NEMO_DIR=${MAIN_DIR}/NEMO
+#-
+#- FCM and functions location ---
+export PATH=${MAIN_DIR}/ext/FCM/bin:$PATH
+
+#-
+#- Choice of the options ---
+x_h="";
+x_n="";
+x_m="";
+x_t="";
+x_c="";
+x_j=1;
+while getopts :hm:n:r:j:t: V
+  do
+	 case $V in
+		(h)  x_h=${OPTARG};
+                          echo "Usage	 : "${b_n} \
+					 " [-h] [-n name] [-m arch] [-j No] [-t tmpdir]";
+			  echo " -h	 : help";
+                          echo " -h institute : specific help for consortium members";
+			  echo " -n name : tool name, [-n help] to list existing tools";
+			  echo " -m arch : choose compiler, [-m help] to list exiting compilers";
+			  echo " -j No	 : number of processes used to compile (0=nocompilation)";
+			  echo " -t dir  : remporary directory for compilation"
+			  echo "";
+			  echo "Example to compile Agrif Nesting tools";
+			  echo "maketools -n NESTING" ;
+			  echo "";
+                          printf "%s\n" "Available tools :" `ls ${TOOLS_DIR}|grep -v COMPILE | grep -v maketools`;
+			  echo "";
+                          . ${COMPIL_DIR}/Flist_archfile.sh  ${x_h};
+			  echo "";
+			  echo "Default : previous tool and compiler";
+			  exit 0;;
+		(n)  x_n=${OPTARG};;
+		(m)  x_m=${OPTARG};;
+		(j)  x_j=${OPTARG};;
+		(t)  x_t=${OPTARG};;
+		(:)  echo ${b_n}" : -"${OPTARG}" option : missing value" 1>&2;
+			  exit 2;;
+		(\?) echo ${b_n}" : -"${OPTARG}" option : not supported" 1>&2;
+			  exit 2;;
+	 esac
+  done
+shift $(($OPTIND-1));
+
+#-
+#- Get the clean option
+[[ "${#@}" -ne 0 && "${@}" != clean ]] && echo "Invalid option "$@" " && exit
+[ "${#@}" -ne 0 ] && x_c="--$@"
+
+#-
+#- Go to NEMOGCM/tools directory ---
+cd ${TOOLS_DIR}
+
+#-
+#- Initialisation from input ---
+export NEW_CONF=${x_n}
+NBR_PRC=${x_j}
+CMP_NAM=${x_m}
+NEMO_TDIR=${x_t:-$NEMO_TDIR}
+export NEMO_TDIR=${NEMO_TDIR:-$TOOLS_DIR}
+
+#- Check if the tool or the compiler exist or list it
+[ "${NEW_CONF}" == help ] && printf "%s\n"  "Available tools :" `ls ${TOOLS_DIR}|grep -v COMPILE | grep -v maketools` && exit
+[ "${CMP_NAM}" ==  help ] && . ${COMPIL_DIR}/Flist_archfile.sh all && exit
+
+#- Choose a default tool if needed ---
+#- REBUILD or last one used ---
+. ${COMPIL_DIR}/Fcheck_config.sh tools.txt ${NEW_CONF} || exit
+
+#- Save new configuration ---
+echo "${NEW_CONF} "  > ${COMPIL_DIR}/tools.txt
+
+#- Make the building directory
+. ${COMPIL_DIR}/Fmake_tools_bld.sh ${TOOLS_DIR} ${NEW_CONF} ${NEMO_TDIR} || exit
+
+#- At this stage cpp keys have been updated. we can check the arch file
+#- When used for the first time, choose a compiler ---
+. ${COMPIL_DIR}/Fcheck_archfile.sh arch_tools.fcm cpp_tools.fcm ${CMP_NAM} || exit
+
+#-
+#_ END OF CONFIGURATION PHASE
+#_
+
+#-
+#- Compile ---
+
+if [ "${NBR_PRC}" -gt 0 ]; then
+cd ${NEMO_TDIR}/${NEW_CONF} || cd -
+
+fcm build ${x_c} --ignore-lock -v 1 -j ${NBR_PRC} ${COMPIL_DIR}/bld_tools.cfg || cd -
+if [ -n "$(ls ${NEMO_TDIR}/${NEW_CONF}/BLD/bin/*.exe)" ]; then
+for i in `ls ${NEMO_TDIR}/${NEW_CONF}/BLD/bin/*.exe`
+   do
+      ln -sf ${i}  ${TOOLS_DIR}/${NEW_CONF}/.
+   done
+fi
+fi
+#-
+#- Come back to original directory ---
+cd -
+
+#-
+#- Unset variables
+${COMPIL_DIR}/Fclean_var.sh
+
+exit 0;
