Index: utils/tools/DOMAINcfg/src/agrif_connect.F90
===================================================================
--- utils/tools/DOMAINcfg/src/agrif_connect.F90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/agrif_connect.F90	(revision 14623)
@@ -74,5 +74,5 @@
          ELSEWHERE
            ssmask(i1:i2,j1:j2) = 1.
-         END WHERE           
+         END WHERE  
       ENDIF
       !
@@ -146,5 +146,5 @@
                   IF( e3t_interp(ji,jj,jk) == -10 ) THEN ! the connection has not yet been done
                      e3t_interp(ji,jj,jk) = MAX( ptab(ji,jj,jk),MIN(e3zps_min, e3t_1d(jk)*e3zps_rat) )
-                     e3t_interp(ji,jj,jk) = MIN( e3t_interp(ji,jj,jk),e3t_1d(jk) )
+                  !   e3t_interp(ji,jj,jk) = MIN( e3t_interp(ji,jj,jk),e3t_1d(jk) )
                      e3t_0(ji,jj,jk) = ( 1. - ztabramp(ji,jj) )*e3t_0(ji,jj,jk) + ztabramp(ji,jj)*e3t_interp(ji,jj,jk)
                   ENDIF
@@ -180,44 +180,76 @@
       ! --- West --- !
       IF( ((nbondi == -1) .OR. (nbondi == 2) ).AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6)) THEN
-         ind1 = 1+nbghostcells + istart
+         ind1 = nn_hls + 1 + nbghostcells + istart
          ind2 = ind1 + ispongearea 
-         DO jj = 1, jpj
-            DO ji = ind1, ind2                
-               ztabramp(ji,jj) = REAL( ind2 - ji ) * z1_spongearea * umask(ind1,jj,1)
-            END DO
-         ENDDO
+         DO ji = mi0(ind1), mi1(ind2)   
+            DO jj = 1, jpj               
+               ztabramp(ji,jj) = REAL(ind2 - mig(ji), wp) * z1_spongearea * umask(ind1,jj,1)
+            END DO
+         ENDDO
+            ! ghost cells:
+            ind1 = 1
+            ind2 = nn_hls + 1 + nbghostcells + istart  ! halo + land + nbghostcells
+            DO ji = mi0(ind1), mi1(ind2)   
+               DO jj = 1, jpj               
+                  ztabramp(ji,jj) = 1._wp
+               END DO
+            END DO
       ENDIF
 
       ! --- East --- !
       IF( ((nbondi == 1) .OR. (nbondi == 2) ).AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6)) THEN
-         ind2 = nlci - nbghostcells - istart
+         ind2 = jpiglo -  (nn_hls + nbghostcells ) - istart
          ind1 = ind2 -ispongearea       
-         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) )
+         DO ji = mi0(ind1), mi1(ind2)
+            DO jj = 1, jpj
+               ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mig(ji) - ind1 ) * z1_spongearea * umask(ind2-1,jj,1) )
             ENDDO
          ENDDO
+            ! ghost cells:
+            ind1 = jpiglo -  (nn_hls + nbghostcells ) - istart   ! halo + land + nbghostcells - 1
+            ind2 = jpiglo - 1
+            DO ji = mi0(ind1), mi1(ind2)
+               DO jj = 1, jpj
+                  ztabramp(ji,jj) = 1._wp
+               END DO
+            END DO
       ENDIF
 
       ! --- South --- !
       IF(( (nbondj == -1) .OR. (nbondj == 2) ).AND.(lk_south)) THEN
-         ind1 = 1+nbghostcells + istart
+         ind1 = nn_hls + 1 + nbghostcells + istart
          ind2 = ind1 + ispongearea 
-         DO jj = ind1, ind2 
+         DO jj = mj0(ind1), mj1(ind2) 
             DO ji = 1, jpi
-               ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - jj ) * z1_spongearea * vmask(ji,ind1,1) )
-            END DO
-         ENDDO
+               ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - mjg(jj) ) * z1_spongearea * vmask(ji,ind1,1) )
+            END DO
+         ENDDO
+            ! ghost cells:
+            ind1 = 1
+            ind2 = nn_hls + 1 + nbghostcells + istart                 ! halo + land + nbghostcells
+            DO jj = mj0(ind1), mj1(ind2) 
+               DO ji = 1, jpi
+                  ztabramp(ji,jj) = 1._wp
+               END DO
+            END DO
       ENDIF
 
       ! --- North --- !
       IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN
-         ind2 = nlcj - nbghostcells - istart
-         ind1 = ind2 -ispongearea         
-         DO jj = ind1, ind2
+         ind2 = jpjglo - (nn_hls + nbghostcells) - istart
+         ind1 = ind2 -ispongearea
+         DO jj = mj0(ind1), mj1(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
+               ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mjg(jj) - ind1 ) * z1_spongearea * vmask(ji,ind2-1,1) )
+            END DO
+         ENDDO
+            ! ghost cells:
+            ind1 = jpjglo - (nn_hls + nbghostcells) - istart      ! halo + land + nbghostcells - 1
+            ind2 = jpjglo
+            DO jj = mj0(ind1), mj1(ind2)
+               DO ji = 1, jpi
+                  ztabramp(ji,jj) = 1._wp
+               END DO
+            END DO
       ENDIF
       !
Index: utils/tools/DOMAINcfg/src/agrif_dom_update.F90
===================================================================
--- utils/tools/DOMAINcfg/src/agrif_dom_update.F90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/agrif_dom_update.F90	(revision 14623)
@@ -76,5 +76,5 @@
             DO jj=j1,j2
                DO ji=i1,i2
-                   IF( mbkt(ji,jj) .GE. jk ) THEN
+                   IF ((ssmask(ji,jj) /=0.).AND.( mbkt(ji,jj) .GE. jk )) THEN
                       tabres(ji,jj,jk) = e3t_0(ji,jj,jk)
                    ELSE
@@ -90,4 +90,5 @@
                    IF( mbkt(ji,jj) .GE. jk ) THEN
                       e3t_0(ji,jj,jk) = MAX(tabres(ji,jj,jk),MIN(e3zps_min,e3t_1d(jk)*e3zps_rat))
+                  !    e3t_0(ji,jj,jk) = tabres(ji,jj,jk)
                    ELSE
                       e3t_0(ji,jj,jk) = e3t_1d(jk)
@@ -97,5 +98,5 @@
          END DO
 
-         CALL lbc_lnk('update_e3t',e3t_0,'T',1.)
+         CALL lbc_lnk('update_e3t',e3t_0,'T',1.,kfillmode = jpfillcopy)
          !
       ENDIF
Index: utils/tools/DOMAINcfg/src/agrif_user.F90
===================================================================
--- utils/tools/DOMAINcfg/src/agrif_user.F90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/agrif_user.F90	(revision 14623)
@@ -45,5 +45,4 @@
       IMPLICIT NONE
       !
-      INTEGER :: nx, ny
       INTEGER :: irafx, irafy
       LOGICAL :: ln_perio
@@ -52,5 +51,4 @@
       irafy = agrif_irhoy()
 
-      nx = nlci ; ny = nlcj
 
    !       IF(jperio /=1 .AND. jperio/=4 .AND. jperio/=6 ) THEN
@@ -71,5 +69,5 @@
 
       WRITE(*,*) ' '
-      WRITE(*,*)'Size of the High resolution grid: ',nx,' x ',ny
+      WRITE(*,*)'Size of the High resolution grid: ',jpi,' x ',jpj
       WRITE(*,*) ' '
 
@@ -202,5 +200,4 @@
 
       INTEGER :: ind1, ind2, ind3
-      INTEGER :: nx, ny
       INTEGER ::nbghostcellsfine_tot_x, nbghostcellsfine_tot_y
       INTEGER :: irafx
@@ -211,8 +208,7 @@
       !---------------------------------------------------------------------
 
-      nx=nlci ; ny=nlcj
-
-      ind2 = 2 + nbghostcells_x
-      ind3 = 2 + nbghostcells_y_s
+      ind2 = nn_hls + 2 + nbghostcells_x
+      ind3 = nn_hls + 2 + nbghostcells_y_s
+
       nbghostcellsfine_tot_x=nbghostcells_x+1
       nbghostcellsfine_tot_y=max(nbghostcells_y_s,nbghostcells_y_n)+1
@@ -230,41 +226,41 @@
       endif
 
-      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)
+      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),glamt_id)
+      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),glamu_id)
+      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),glamv_id)
+      CALL agrif_declare_variable((/1,1/),(/ind2-1,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),glamf_id)
+
+      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gphit_id)
+      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gphiu_id)
+      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gphiv_id)
+      CALL agrif_declare_variable((/1,1/),(/ind2-1,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),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)
+      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1t_id)
+      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id)
+      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1v_id)
+      CALL agrif_declare_variable((/1,1/),(/ind2-1,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1f_id)
+
+      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2t_id)
+      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2u_id)
+      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id)
+      CALL agrif_declare_variable((/1,1/),(/ind2-1,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2f_id)
 
       ! Bathymetry
 
-      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),bathy_id)
+      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),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)
+      CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),e3t_id)
+      CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),e3t_copy_id)
+      CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk+1/),e3t_connect_id)
+
+      CALL agrif_declare_variable((/1,2,0/),(/ind2-1,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),e3u_id)
+      CALL agrif_declare_variable((/2,1,0/),(/ind2,ind3-1,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),e3v_id)
 
       ! Bottom level
 
-      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nx,ny/),bottom_level_id)
+      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),bottom_level_id)
 
       CALL Agrif_Set_bcinterp(glamt_id,interp=AGRIF_linear)
@@ -348,6 +344,6 @@
       CALL Agrif_Set_bc( e3t_copy_id, (/-npt_copy*irafx,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_bcinterp(e3t_connect_id,interp=AGRIF_linear)
+      CALL Agrif_Set_interp(e3t_connect_id,interp=AGRIF_linear)
       CALL Agrif_Set_bc( e3t_connect_id, (/-(npt_copy+npt_connect)*irafx-1,-npt_copy*irafx/))
 
@@ -589,13 +585,6 @@
       EXTERNAL :: init_glamt, init_glamu, init_glamv, init_glamf
       EXTERNAL :: init_gphit, init_gphiu, init_gphiv, init_gphif
-      REAL, EXTERNAL :: longitude_linear_interp
-
-      INTEGER :: ji,jj,i1,i2,j1,j2
-      REAL, DIMENSION(jpi,jpj) :: tab2dtemp
-      INTEGER :: ind2,ind3
-      INTEGER :: irhox, irhoy
-
-      irhox = agrif_irhox()
-      irhoy = agrif_irhoy()
+      EXTERNAL :: longitude_linear_interp
+
       CALL Agrif_Set_external_linear_interp(longitude_linear_interp)
 
@@ -637,10 +626,8 @@
       USE lbclnk
       LOGICAL :: ln_perio
-      INTEGER nx,ny
+      INTEGER jpi,jpj
 
       EXTERNAL :: init_e1t, init_e1u, init_e1v, init_e1f
       EXTERNAL :: init_e2t, init_e2u, init_e2v, init_e2f
-
-      nx = nlci ; ny = nlcj
 
       ln_perio=.FALSE.
@@ -1078,11 +1065,11 @@
       &  npt_copy
 
-      REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : nesting parameters
+  !    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
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist')
+
+  !    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 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist')
       IF(lwm) WRITE ( numond, namagrif )
 
@@ -1102,13 +1089,16 @@
       nbghostcells_y_n = nbghostcells
 
+      IF ((jperio == 1).OR.(jperio == 4)) THEN
+        nbghostcells_x = 0
+      ENDIF
+      IF (jperio == 4) THEN
+        nbghostcells_y_s = 0
+      ENDIF
+
+      IF (.not.agrif_root()) THEN
       lk_west  = .NOT. ( Agrif_Ix() == 1 )
       lk_east  = .NOT. ( Agrif_Ix() + nbcellsx/AGRIF_Irhox() == Agrif_Parent(jpiglo) -1 )
       lk_south = .NOT. ( Agrif_Iy() == 1 )
       lk_north = .NOT. ( Agrif_Iy() + nbcellsy/AGRIF_Irhoy() == Agrif_Parent(jpjglo) -1 )
-
-      IF (.not.agrif_root()) THEN
-        IF (jperio == 1) THEN
-          nbghostcells_x = 0
-        ENDIF
         IF (.NOT.lk_south) THEN
           nbghostcells_y_s = 0
@@ -1146,6 +1136,6 @@
       !
       SELECT CASE( i )
-      CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
-      CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1
+      CASE(1)   ;   indglob = mig(indloc)
+      CASE(2)   ;   indglob = mjg(indloc)
       CASE DEFAULT
          indglob = indloc
Index: utils/tools/DOMAINcfg/src/calendar.f90
===================================================================
--- utils/tools/DOMAINcfg/src/calendar.f90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/calendar.f90	(revision 14623)
@@ -1,3 +1,4 @@
 MODULE calendar
+!$AGRIF_DO_NOT_TREAT
 !-
 !$Id: calendar.f90 2459 2010-12-07 11:17:48Z smasson $
@@ -1042,3 +1043,4 @@
 !===
 !-
+!$AGRIF_END_DO_NOT_TREAT
 END MODULE calendar
Index: utils/tools/DOMAINcfg/src/do_loop_substitute.h90
===================================================================
--- utils/tools/DOMAINcfg/src/do_loop_substitute.h90	(revision 14623)
+++ utils/tools/DOMAINcfg/src/do_loop_substitute.h90	(revision 14623)
@@ -0,0 +1,68 @@
+#if defined show_comments
+! These comments are not intended to be retained during preprocessing; i.e. do not define "show_comments"
+!!----------------------------------------------------------------------
+!! NEMO/OCE 4.0 , NEMO Consortium (2018)
+!! Software governed by the CeCILL license (see ./LICENSE)
+!!----------------------------------------------------------------------
+! This header file contains preprocessor definitions and macros used in the do-loop substitutions introduced
+! between version 4.0 and 4.2. The primary aim of these macros is to assist in future applications of tiling
+! to improve performance. This is expected to be achieved by alternative versions of these macros in selected
+! locations. The initial introduction of these macros simply replaced all identifiable nested 2D- and 3D-loops
+! with single line statements (and adjusts indenting accordingly). Do loops were identifiable if they comformed
+! to either:
+!                                       DO jk = ....
+!   DO jj = ....                           DO jj = ...
+!      DO ji = ....                           DO ji = ...
+!         .                   OR                 .  
+!         .                                      .
+!     END DO                                  END DO
+!   END DO                                 END DO
+!                                       END DO
+! and white-space variants thereof.
+!
+! Additionally, only loops with recognised jj and ji loops limits were treated; these were:
+! Lower limits of 1, 2 or fs_2
+! Upper limits of jpi, jpim1 or fs_jpim1 (for ji) or jpj, jpjm1 or fs_jpjm1 (for jj)
+!
+! The macro naming convention takes the form: DO_2D( B, T, L, R) where: 
+!   B is the Bottom offset from the PE's inner domain;
+!   T is the Top    offset from the PE's inner domain;
+!   L is the Left   offset from the PE's inner domain;
+!   R is the Right  offset from the PE's inner domain
+!
+! So, given an inner domain of 2,jpim1 and 2,jpjm1, a typical example would replace:
+! 
+!   DO jj = 2, jpj
+!      DO ji = 1, jpim1
+!         .
+!         .
+!      END DO
+!   END DO
+!
+! with:
+!
+!   DO_2D( 0, 1, 1, 0 )
+!      .
+!      .
+!   END_2D
+! 
+! similar conventions apply to the 3D loops macros. jk loop limits are retained through macro arguments 
+! and are not restricted. This includes the possibility of strides for which an extra set of DO_3DS 
+! macros are defined.
+!
+! In the following definitions the inner PE domain is defined by start indices of (Nis0, Njs0) and end 
+! indices of (Nie0, Nje0) where:
+!
+! Nis0 =   1 + nn_hls     Njs0 =   1 + nn_hls
+! Nie0 = jpi - nn_hls     Nje0 = jpj - nn_hls
+! 
+#endif
+
+#define DO_2D(B, T, L, R) DO jj = Njs0-(B), Nje0+(T)   ;   DO ji = Nis0-(L), Nie0+(R)
+
+#define DO_3D(B, T, L, R, ks, ke) DO jk = ks, ke   ;   DO_2D(B, T, L, R)
+
+#define DO_3DS(B, T, L, R, ks, ke, ki) DO jk = ks, ke, ki   ;   DO_2D(B, T, L, R)
+
+#define END_2D   END DO   ;   END DO
+#define END_3D   END DO   ;   END DO   ;   END DO
Index: utils/tools/DOMAINcfg/src/dom_oce.F90
===================================================================
--- utils/tools/DOMAINcfg/src/dom_oce.F90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/dom_oce.F90	(revision 14623)
@@ -151,23 +151,36 @@
    INTEGER             , PUBLIC ::   nbondi, nbondj   !: mark of i- and j-direction local boundaries
 
+   !                             !: domain MPP decomposition parameters
+   INTEGER             , PUBLIC ::   nimpp, njmpp     !: i- & j-indexes for mpp-subdomain left bottom
+   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
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mig        !: local ==> global domain, including halos (jpiglo), i-index
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mjg        !: local ==> global domain, including halos (jpjglo), j-index
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mig0       !: local ==> global domain, excluding halos (Ni0glo), i-index
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mjg0       !: local ==> global domain, excluding halos (Nj0glo), j-index
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mig0_oldcmp !: local ==> global domain, excluding halos (Ni0glo), i-index
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mjg0_oldcmp !: local ==> global domain, excluding halos (Nj0glo), j-index
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mi0, mi1   !: global, including halos (jpiglo) ==> local domain i-index
+   !                                                                !:    (mi0=1 and mi1=0 if global index not in local domain)
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mj0, mj1   !: global, including halos (jpjglo) ==> local domain j-index
+   !                                                                !:    (mj0=1 and mj1=0 if global index not in 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(:) ::   jpiall,  jpjall   !: dimensions of all subdomain
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nis0all, njs0all  !: first, last indoor index for all i-subdomain
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nie0all, nje0all  !: first, last indoor index for all j-subdomain
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nfimpp, nfproc, nfjpi
+
 
    !!----------------------------------------------------------------------
@@ -312,5 +325,6 @@
       ierr(:) = 0
       !
-      ALLOCATE( mig(jpi), mjg(jpj), STAT=ierr(1) )
+      ALLOCATE( mig(jpi), mjg(jpj), mig0(jpi), mjg0(jpj), mig0_oldcmp(jpi), mjg0_oldcmp(jpj),&
+                STAT=ierr(1) )
          !
       ALLOCATE( mi0(jpiglo)   , mi1 (jpiglo),  mj0(jpjglo)   , mj1 (jpjglo) ,     &
Index: utils/tools/DOMAINcfg/src/domain.F90
===================================================================
--- utils/tools/DOMAINcfg/src/domain.F90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/domain.F90	(revision 14623)
@@ -76,10 +76,12 @@
       !                       !==  Reference coordinate system  ==!
       !
+      CALL dom_glo                     ! global domain versus local domain
       CALL dom_nam               ! read namelist ( namrun, namdom )
+                  !   CALL dom_clo               ! Closed seas and lake
          
       CALL dom_hgr               ! Horizontal mesh
       CALL dom_zgr( ik_top, ik_bot )  ! Vertical mesh and bathymetry
       CALL dom_msk( ik_top, ik_bot )  ! Masks
-      IF ( ln_domclo ) CALL dom_clo               ! Closed seas and lake
+      !
       !
       CALL dom_ctl                  ! print extrema of masked scale factors
@@ -91,4 +93,58 @@
    END SUBROUTINE dom_init
 
+   SUBROUTINE dom_glo
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_glo  ***
+      !!
+      !! ** Purpose :   initialization of global domain <--> local domain indices
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  : - mig , mjg : local  domain indices ==> global domain, including halos, indices
+      !!              - mig0, mjg0: local  domain indices ==> global domain, excluding halos, indices
+      !!              - mi0 , mi1 : global domain indices ==> local  domain indices
+      !!              - mj0 , mj1   (if 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, including halos, indices
+        mig(ji) = ji + nimpp - 1
+      END DO
+      DO jj = 1, jpj
+        mjg(jj) = jj + njmpp - 1
+      END DO
+      !                              ! local domain indices ==> global domain, excluding halos, indices
+      !
+      mig0(:) = mig(:) - nn_hls
+      mjg0(:) = mjg(:) - nn_hls  
+      ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data, 
+      ! we must define mig0 and mjg0 as bellow.
+      ! Once we decide to forget trunk compatibility, we must simply define mig0 and mjg0 as:
+      mig0_oldcmp(:) = mig0(:) + COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) )
+      mjg0_oldcmp(:) = mjg0(:) + COUNT( (/ jperio == 2 .OR. jperio == 7 /) )
+      !
+      !                              ! global domain, including halos, 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,*)
+      ENDIF
+      !
+   END SUBROUTINE dom_glo
+
    SUBROUTINE dom_nam
       !!----------------------------------------------------------------------
@@ -108,5 +164,5 @@
 
       NAMELIST/namdom/ ln_read_cfg, nn_bathy, cn_domcfg, cn_topo, cn_bath, cn_lon, cn_lat, rn_scale, nn_interp, &
-         &             cn_topolvl, cn_fisfd, cn_visfd, cn_bathlvl, cn_fcoord,                       & 
+         &             cn_topolvl, cn_fisfd, cn_visfd, cn_bathlvl, cn_fcoord,                        & 
          &             rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin,                       &
          &             rn_atfp , rn_rdt   ,  ln_crs      , jphgr_msh ,                               &
@@ -116,13 +172,14 @@
 
       INTEGER  ::   ios                 ! Local integer output status for namelist read
-      !!----------------------------------------------------------------------
-
-      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
+      CHARACTER(256) :: c_iomsg
+      !!----------------------------------------------------------------------
+
+   
       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 )
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist')
+
+      READ  ( numnam_cfg, namrun, IOSTAT = ios, IOMSG = c_iomsg, ERR = 902 )
+
+902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist')
       IF(lwm) WRITE ( numond, namrun )
       !
@@ -152,12 +209,12 @@
       rn_scale = 1.
 
-      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
+      !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 )
+903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist' )
   
       !
-      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
+      !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 )
+904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist' )
       IF(lwm) WRITE ( numond, namdom )
       !
Index: utils/tools/DOMAINcfg/src/dombat.F90
===================================================================
--- utils/tools/DOMAINcfg/src/dombat.F90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/dombat.F90	(revision 14623)
@@ -49,5 +49,5 @@
       latname=TRIM(cn_lat)
    
-      CALL iom_open( bathyfile, inum, lagrif=.FALSE. )
+      CALL iom_open( bathyfile, inum, ldiof=.TRUE. )
       
       ! check if lon/lat are 2D arrays
@@ -404,34 +404,34 @@
         !            
       ENDIF
-      CALL lbc_lnk( 'dom_bat', bathy, 'T', 1. )
+      CALL lbc_lnk( 'dom_bat', bathy, 'T', 1.,kfillmode = jpfillcopy)
 
        ! Correct South and North
-#if defined key_agrif
-      IF( lk_south ) THEN  
-         IF( (nbondj == -1).OR.(nbondj == 2) ) THEN
-           bathy(:,1)=bathy(:,2)
-         ENDIF
-      ELSE
-            bathy(:,1) = 0.
-      ENDIF
-#else
-      IF ((nbondj == -1).OR.(nbondj == 2)) THEN
-            bathy(:,1)=bathy(:,2)
-      ENDIF
-#endif
-
-      IF ((nbondj == 1).OR.(nbondj == 2)) THEN
-         bathy(:,jpj)=bathy(:,jpj-1)
-      ENDIF
-
-      ! Correct West and East
-      IF (jperio /=1) THEN
-         IF ((nbondi == -1).OR.(nbondi == 2)) THEN
-            bathy(1,:)=bathy(2,:)
-         ENDIF
-         IF ((nbondi == 1).OR.(nbondi == 2)) THEN
-         bathy(jpi,:)=bathy(jpi-1,:)
-         ENDIF
-      ENDIF
+! #if defined key_agrif
+!       IF( lk_south ) THEN  
+!          IF( (nbondj == -1).OR.(nbondj == 2) ) THEN
+!            bathy(:,1)=bathy(:,2)
+!          ENDIF
+!       ELSE
+!             bathy(:,1) = 0.
+!       ENDIF
+! #else
+!       IF ((nbondj == -1).OR.(nbondj == 2)) THEN
+!             bathy(:,1)=bathy(:,2)
+!       ENDIF
+! #endif
+
+!       IF ((nbondj == 1).OR.(nbondj == 2)) THEN
+!          bathy(:,jpj)=bathy(:,jpj-1)
+!       ENDIF
+
+!       ! Correct West and East
+!       IF (jperio /=1) THEN
+!          IF ((nbondi == -1).OR.(nbondi == 2)) THEN
+!             bathy(1,:)=bathy(2,:)
+!          ENDIF
+!          IF ((nbondi == 1).OR.(nbondi == 2)) THEN
+!          bathy(jpi,:)=bathy(jpi-1,:)
+!          ENDIF
+!       ENDIF
 
 
Index: utils/tools/DOMAINcfg/src/domcfg.f90
===================================================================
--- utils/tools/DOMAINcfg/src/domcfg.f90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/domcfg.f90	(revision 14623)
@@ -55,71 +55,6 @@
       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'
-
-!            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
- 25   FORMAT( 100(10x,19i4,/) )
-      !
-   END SUBROUTINE dom_glo
    !!======================================================================
 END MODULE domcfg
Index: utils/tools/DOMAINcfg/src/domclo.F90
===================================================================
--- utils/tools/DOMAINcfg/src/domclo.F90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/domclo.F90	(revision 14623)
@@ -93,10 +93,10 @@
       !!---------------------------------------------------------------------
       
-      REWIND( numnam_ref )              ! Namelist namlbc in reference namelist : Lateral momentum boundary condition
+   !   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
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namclo in reference namelist')
+   !   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 )
+902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namclo in configuration namelist')
       IF(lwm) WRITE ( numond, namclo )
 
Index: utils/tools/DOMAINcfg/src/domhgr.F90
===================================================================
--- utils/tools/DOMAINcfg/src/domhgr.F90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/domhgr.F90	(revision 14623)
@@ -392,10 +392,10 @@
          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)
+            WRITE(numout,*) '          Beta-plane: Beta parameter = constant = ', ff_f(Nis0,Njs0)
+            WRITE(numout,*) '          Coriolis parameter varies from ', ff_f(Nis0,Njs0),' to ', ff_f(Nis0,Nje0)
          ENDIF
          IF( lk_mpp ) THEN 
-            zminff=ff_f(nldi,nldj)
-            zmaxff=ff_f(nldi,nlej)
+            zminff=ff_f(Nis0,Njs0)
+            zmaxff=ff_f(Nis0,Nje0)
             CALL mpp_min( 'toto',zminff )   ! min over the global domain
             CALL mpp_max( 'toto',zmaxff )   ! max over the global domain
@@ -415,10 +415,10 @@
             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)
+            WRITE(numout,*) '          Coriolis parameter varies in this processor from ', ff_f(Nis0,Njs0),' to ', ff_f(Nis0,Nje0)
          ENDIF
          !
          IF( lk_mpp ) THEN 
-            zminff=ff_f(nldi,nldj)
-            zmaxff=ff_f(nldi,nlej)
+            zminff=ff_f(Nis0,Njs0)
+            zmaxff=ff_f(Nis0,Nje0)
             CALL mpp_min('toto', zminff )   ! min over the global domain
             CALL mpp_max( 'toto',zmaxff )   ! max over the global domain
@@ -462,4 +462,5 @@
       ENDIF
       !
+
       IF (ln_read_cfg) THEN
          coordinate_filename=TRIM(cn_domcfg)
@@ -469,28 +470,28 @@
       CALL iom_open( coordinate_filename, 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 )
+      CALL iom_get( inum, jpdom_global, 'glamt', glamt, cd_type = 'T', psgn = 1._wp )
+      CALL iom_get( inum, jpdom_global, 'glamu', glamu, cd_type = 'U', psgn = 1._wp )
+      CALL iom_get( inum, jpdom_global, 'glamv', glamv, cd_type = 'V', psgn = 1._wp )
+      CALL iom_get( inum, jpdom_global, 'glamf', glamf, cd_type = 'F', psgn = 1._wp )
+      !
+      CALL iom_get( inum, jpdom_global, 'gphit', gphit, cd_type = 'T', psgn = 1._wp )
+      CALL iom_get( inum, jpdom_global, 'gphiu', gphiu, cd_type = 'U', psgn = 1._wp )
+      CALL iom_get( inum, jpdom_global, 'gphiv', gphiv, cd_type = 'V', psgn = 1._wp )
+      CALL iom_get( inum, jpdom_global, 'gphif', gphif, cd_type = 'F', psgn = 1._wp )
+      !
+      CALL iom_get( inum, jpdom_global, 'e1t'  , e1t , cd_type = 'T', psgn = 1._wp, kfill = jpfillcopy )
+      CALL iom_get( inum, jpdom_global, 'e1u'  , e1u , cd_type = 'U', psgn = 1._wp, kfill = jpfillcopy )
+      CALL iom_get( inum, jpdom_global, 'e1v'  , e1v , cd_type = 'V', psgn = 1._wp, kfill = jpfillcopy )
+      CALL iom_get( inum, jpdom_global, 'e1f'  , e1f , cd_type = 'F', psgn = 1._wp, kfill = jpfillcopy )
+      !
+      CALL iom_get( inum, jpdom_global, 'e2t'  , e2t , cd_type = 'T', psgn = 1._wp, kfill = jpfillcopy )
+      CALL iom_get( inum, jpdom_global, 'e2u'  , e2u , cd_type = 'U', psgn = 1._wp, kfill = jpfillcopy )
+      CALL iom_get( inum, jpdom_global, 'e2v'  , e2v , cd_type = 'V', psgn = 1._wp, kfill = jpfillcopy )
+      CALL iom_get( inum, jpdom_global, 'e2f'  , e2f , cd_type = 'F', psgn = 1._wp, kfill = jpfillcopy )
       !
       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 )
+         CALL iom_get( inum, jpdom_global, 'e1e2u', e1e2u, cd_type = 'U', psgn = 1._wp, kfill = jpfillcopy )
+         CALL iom_get( inum, jpdom_global, 'e1e2v', e1e2v, cd_type = 'V', psgn = 1._wp, kfill = jpfillcopy )
          ke1e2u_v = 1
       ELSE
Index: utils/tools/DOMAINcfg/src/domisf.F90
===================================================================
--- utils/tools/DOMAINcfg/src/domisf.F90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/domisf.F90	(revision 14623)
@@ -59,11 +59,11 @@
       !
       ! 0.0 read namelist
-      REWIND( numnam_ref )              ! Namelist namzgr_isf in reference namelist : ice shelf geometry definition
+ !     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
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr_isf in reference namelist')
+
+ !     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 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr_isf in configuration namelist')
       IF(lwm) WRITE ( numond, namzgr_isf )
       !
@@ -295,5 +295,5 @@
          zrisfdep = risfdep
          WHERE ( mbathy(:,:) == 0 )
-            imask(:,:) = jpk
+            imask(:,:) = 0
             imbathy(:,:) = jpk
          END WHERE
@@ -302,5 +302,5 @@
                IF(  (misfdep(ji,jj) > 1) .AND. (mbathy(ji,jj) > 0) ) THEN
                   !
-                  ! what it should be (1 = should be connected; >= jpk = should not be connected)
+                  ! 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
@@ -308,5 +308,5 @@
                   imskjm1 = imask(ji,jj) * imask(ji  ,jj-1)  ! 1 = should be connected
                   !
-                  ! what it is ? ( 1 = no effective connection; jpk = effective connection )
+                  ! 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
@@ -316,11 +316,10 @@
                   !
                   ! defining level needed for connectivity
-                  ! imskip1 * imskip1_r == 1   means    connection need to be enforce
-                  ! imskip1 * imskip1_r >= jpk means no connection need to be enforce
+                  ! 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 ) ! add jpk in the MIN to avoid out of boundary later on
+                     &   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
Index: utils/tools/DOMAINcfg/src/dommsk.F90
===================================================================
--- utils/tools/DOMAINcfg/src/dommsk.F90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/dommsk.F90	(revision 14623)
@@ -98,10 +98,10 @@
       !!---------------------------------------------------------------------
       !
-      REWIND( numnam_ref )              ! Namelist namlbc in reference namelist : Lateral momentum boundary condition
+    !  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
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namlbc in reference namelist')
+    !  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 )
+902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namlbc in configuration namelist')
       IF(lwm) WRITE ( numond, namlbc )
       
@@ -156,5 +156,5 @@
             END DO  
          END DO  
-      ELSE
+         ELSE
          DO jk = 1, jpk
             DO jj = 1, jpj
@@ -209,6 +209,6 @@
       ! --------------------
       !
-      iif = nn_hls   ;   iil = nlci - nn_hls + 1
-      ijf = nn_hls   ;   ijl = nlcj - nn_hls + 1
+      iif = nn_hls   ;   iil = jpi - nn_hls + 1
+      ijf = nn_hls   ;   ijl = jpj - nn_hls + 1
       !
       !                          ! halo mask : 0 on the halo and 1 elsewhere
@@ -225,7 +225,7 @@
          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
+         IF( mjg(Nje0) == 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))
+               tmask_h(ji,Nje0-1) = tmask_h(ji,Nje0-1) * tpol(mig(ji))
             END DO
          ENDIF
@@ -275,7 +275,7 @@
 #if defined key_agrif 
             IF( .NOT. AGRIF_Root() ) THEN 
-               IF(lk_east)  fmask(nlci-1 , :     ,jk) = 0.e0      ! east 
+               IF(lk_east)  fmask(jpi-1 , :     ,jk) = 0.e0      ! east 
                IF(lk_west)  fmask(1      , :     ,jk) = 0.e0      ! west 
-               IF(lk_north) fmask(:      ,nlcj-1 ,jk) = 0.e0      ! north 
+               IF(lk_north) fmask(:      ,jpj-1 ,jk) = 0.e0      ! north 
                IF(lk_south) fmask(:      ,1      ,jk) = 0.e0      ! south 
             ENDIF 
@@ -294,7 +294,5 @@
       ! -------------------------------- 
       !
-      ! write mesh mask
-      IF ( nn_msh > 0 ) CALL dom_wri
-      !
+
       CALL usr_def_fmask( cp_cfg, jp_cfg, fmask )
       !
Index: utils/tools/DOMAINcfg/src/domngb.F90
===================================================================
--- utils/tools/DOMAINcfg/src/domngb.F90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/domngb.F90	(revision 14623)
@@ -46,4 +46,5 @@
       INTEGER :: ik         ! working level
       INTEGER , DIMENSION(2) ::   iloc
+      REAL(wp)               ::   zlon, zmini
       REAL(wp), DIMENSION(jpi,jpj) ::   zglam, zgphi, zmask, zdist
       !!--------------------------------------------------------------------
@@ -53,11 +54,15 @@
       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)
+      CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(Nis0:Nie0,Njs0:Nje0) = umask(Nis0:Nie0,Njs0:Nje0,ik)
+      CASE( 'V' )  ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(Nis0:Nie0,Njs0:Nje0) = vmask(Nis0:Nie0,Njs0:Nje0,ik)
+      CASE( 'F' )  ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(Nis0:Nie0,Njs0:Nje0) = fmask(Nis0:Nie0,Njs0:Nje0,ik)
+      CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(Nis0:Nie0,Njs0:Nje0) = tmask(Nis0:Nie0,Njs0:Nje0,ik)
       END SELECT
 
-      zdist = dist(plon, plat, zglam, zgphi)
+      zlon       = MOD( plon       + 720., 360. )                                     ! plon between    0 and 360
+      zglam(:,:) = MOD( zglam(:,:) + 720., 360. )                                     ! glam between    0 and 360
+      IF( zlon > 270. )   zlon = zlon - 360.                                          ! zlon between  -90 and 270
+      IF( zlon <  90. )   WHERE( zglam(:,:) > 180. ) zglam(:,:) = zglam(:,:) - 360.   ! glam between -180 and 180
+      zglam(:,:) = zglam(:,:) - zlon
 
       IF( lk_mpp ) THEN  
Index: utils/tools/DOMAINcfg/src/domwri.F90
===================================================================
--- utils/tools/DOMAINcfg/src/domwri.F90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/domwri.F90	(revision 14623)
@@ -215,5 +215,7 @@
       lldbl(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have been changed 
       !
-      puniq(:,:) = REAL( COUNT( lldbl(:,:,:), dim = 3 ) , wp )
+      puniq(:,:) = 1.                             ! default definition
+      ! fill only the inner part of the cpu with llbl converted into real 
+      puniq(Nis0:Nie0,Njs0:Nje0) = REAL( COUNT( lldbl(Nis0:Nie0,Njs0:Nje0,:), dim = 3 ) , wp )
       !
    END SUBROUTINE dom_uniq
Index: utils/tools/DOMAINcfg/src/domzgr.F90
===================================================================
--- utils/tools/DOMAINcfg/src/domzgr.F90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/domzgr.F90	(revision 14623)
@@ -75,20 +75,10 @@
    REAL(wp) ::   rn_zb_b           !  offset for calculating Zb
 
-  !! * Substitutions
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!                   ***  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)
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: dommsk.F90 13305 2020-07-14 17:12:25Z acc $
+   !! Software governed by the CeCILL license (see ./LICENSE)
    !!----------------------------------------------------------------------
 CONTAINS       
@@ -124,11 +114,11 @@
       !
       !
-      REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate
+     ! 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
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist')
+
+     ! 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 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist')
       IF(lwm) WRITE ( numond, namzgr )
 
@@ -279,11 +269,11 @@
       CALL iom_get( inum, jpdom_unknown, 'e3w_1d'  , pe3w_1d  )
       !
-      CALL iom_get( inum, jpdom_data, 'e3t_0'  , pe3t  , lrowattr=ln_use_jattr )    ! 3D coordinate
-      CALL iom_get( inum, jpdom_data, 'e3u_0'  , pe3u  , lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e3v_0'  , pe3v  , lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e3f_0'  , pe3f  , lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e3w_0'  , pe3w  , lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e3uw_0' , pe3uw , lrowattr=ln_use_jattr )
-      CALL iom_get( inum, jpdom_data, 'e3vw_0' , pe3vw , lrowattr=ln_use_jattr )
+      CALL iom_get( inum, jpdom_global, 'e3t_0'  , pe3t , cd_type = 'T', psgn = 1._wp, kfill = jpfillcopy )    ! 3D coordinate
+      CALL iom_get( inum, jpdom_global, 'e3u_0'  , pe3u , cd_type = 'U', psgn = 1._wp, kfill = jpfillcopy )
+      CALL iom_get( inum, jpdom_global, 'e3v_0'  , pe3v , cd_type = 'V', psgn = 1._wp, kfill = jpfillcopy )
+      CALL iom_get( inum, jpdom_global, 'e3f_0'  , pe3f , cd_type = 'F', psgn = 1._wp, kfill = jpfillcopy )
+      CALL iom_get( inum, jpdom_global, 'e3w_0'  , pe3w , cd_type = 'W', psgn = 1._wp, kfill = jpfillcopy )
+      CALL iom_get( inum, jpdom_global, 'e3uw_0' , pe3uw, cd_type = 'U', psgn = 1._wp, kfill = jpfillcopy )
+      CALL iom_get( inum, jpdom_global, 'e3vw_0' , pe3vw, cd_type = 'V', psgn = 1._wp, kfill = jpfillcopy )
       !
       !                          !* depths
@@ -297,6 +287,6 @@
          CALL iom_get( inum, jpdom_unknown, 'gdept_1d', pdept_1d )   
          CALL iom_get( inum, jpdom_unknown, 'gdepw_1d', pdepw_1d )
-         CALL iom_get( inum, jpdom_data   , 'gdept_0' , pdept , lrowattr=ln_use_jattr )
-         CALL iom_get( inum, jpdom_data   , 'gdepw_0' , pdepw , lrowattr=ln_use_jattr )
+         CALL iom_get( inum, jpdom_global , 'gdept_0' , pdept, kfill = jpfillcopy )
+         CALL iom_get( inum, jpdom_global , 'gdepw_0' , pdepw, kfill = jpfillcopy )
          !
       ELSE                                !- depths computed from e3. scale factors
@@ -312,7 +302,7 @@
       !
       !                          !* ocean top and bottom level
-      CALL iom_get( inum, jpdom_data, 'top_level'    , z2d  , lrowattr=ln_use_jattr )   ! 1st wet T-points (ISF)
+      CALL iom_get( inum, jpdom_global, 'top_level'    , z2d )   ! 1st wet T-points (ISF)
       k_top(:,:) = NINT( z2d(:,:) )
-      CALL iom_get( inum, jpdom_data, 'bottom_level' , z2d  , lrowattr=ln_use_jattr )   ! last wet T-points
+      CALL iom_get( inum, jpdom_global, 'bottom_level' , z2d )   ! last wet T-points
       k_bot(:,:) = NINT( z2d(:,:) )
       !
@@ -660,10 +650,8 @@
          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
+         DO_2D( 0, 0, 0, 0 )
                mbathy(ji,jj) = idta( mig(ji), mjg(jj) )
                bathy (ji,jj) = zdta( mig(ji), mjg(jj) )
-            END DO
-         END DO
+         END_2D
          risfdep(:,:)=0.e0
          misfdep(:,:)=1
@@ -677,5 +665,5 @@
          IF( ln_zco )   THEN                          ! zco : read level bathymetry 
             CALL iom_open ( cn_topolvl, inum )  
-            CALL iom_get  ( inum, jpdom_data, cn_bathlvl, bathy )
+            CALL iom_get  ( inum, jpdom_auto, cn_bathlvl, bathy )
             CALL iom_close( inum )
             mbathy(:,:) = INT( bathy(:,:) )
@@ -715,5 +703,5 @@
             IF( ntopo == 1) THEN
                CALL iom_open ( cn_topo, inum ) 
-               CALL iom_get  ( inum, jpdom_data, cn_bath, bathy, lrowattr=ln_use_jattr  )
+               CALL iom_get  ( inum, jpdom_auto, cn_bath, bathy )
                CALL iom_close( inum )
             ELSE
@@ -735,5 +723,5 @@
             IF ( ln_isfcav ) THEN
                CALL iom_open ( cn_fisfd, inum ) 
-               CALL iom_get  ( inum, jpdom_data, cn_visfd, risfdep )
+               CALL iom_get  ( inum, jpdom_auto, cn_visfd, risfdep )
                CALL iom_close( inum )
             END IF
@@ -857,21 +845,13 @@
       ENDIF
       !                                          ! 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
+         IF( ln_zco .OR. ln_zps ) THEN
+           mbathy(  mi0(     1+nn_hls):mi1(     1+nn_hls),:) = 0
+           mbathy(  mi0(jpiglo-nn_hls):mi1(jpiglo-nn_hls),:) = 0
          ELSE
-            IF( ln_zco .OR. ln_zps ) THEN
-               mbathy( 1 ,:) = 0
-               mbathy(jpi,:) = 0
-            ELSE
-               mbathy( 1 ,:) = jpkm1
-               mbathy(jpi,:) = jpkm1
-            ENDIF
+           mbathy(  mi0(     1+nn_hls):mi1(     1+nn_hls),:) = jpkm1
+           mbathy(  mi0(jpiglo-nn_hls):mi1(jpiglo-nn_hls),:) = jpkm1
          ENDIF
       ELSEIF( l_Iperio ) THEN
@@ -898,5 +878,6 @@
       ! Number of ocean level inferior or equal to jpkm1
       zbathy(:,:) = FLOAT( mbathy(:,:) )
-      ikmax = glob_max( 'domzgr', zbathy(:,:) )
+      ikmax = MAXVAL(zbathy(:,:))
+      CALL mpp_max( 'domzgr',ikmax)
 
       IF( ikmax > jpkm1 ) THEN
@@ -1308,11 +1289,11 @@
       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
+      !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
+901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr_sco in reference namelist')
+
+      !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 )
+902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr_sco in configuration namelist')
       IF(lwm) WRITE ( numond, namzgr_sco )
 
@@ -1386,5 +1367,5 @@
 
       ! apply lateral boundary condition   CAUTION: keep the value when the lbc field is zero
-      CALL lbc_lnk( 'domzgr',zenv, 'T', 1._wp, 'no0' )
+      CALL lbc_lnk( 'domzgr',zenv, 'T', 1._wp, kfillmode=jpfillnothing )
       ! 
       ! smooth the bathymetry (if required)
@@ -1417,15 +1398,12 @@
          ! we could exit DO WHILE prematurely before checking r-value
          ! of current zenv
-         DO jj = 1, nlcj
-            DO ji = 1, nlci
+          DO_2D( 0, 0, 0, 0 )
                zrmax = MAX( zrmax, ABS(zri(ji,jj)), ABS(zrj(ji,jj)) )
-            END DO
-         END DO
+         END_2D
          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)
+          DO_2D( 0, 0, 0, 0 )
+               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._wp) .AND. (zenv(iip1,jj) > 0._wp)) THEN
                   zri(ji,jj) = ( zenv(iip1,jj  ) - zenv(ji,jj) ) / ( zenv(iip1,jj  ) + zenv(ji,jj) )
@@ -1438,17 +1416,14 @@
                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
+         END_2D
   !       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
+         DO_2D( 0, 0, 0, 0 )
                zenv(ji,jj) = MAX(zenv(ji,jj), ztmpi1(ji,jj), ztmpi2(ji,jj), ztmpj1(ji,jj), ztmpj2(ji,jj) )
-            END DO
-         END DO
+         END_2D
          ! apply lateral boundary condition   CAUTION: keep the value when the lbc field is zero
-         CALL lbc_lnk( 'toto',zenv, 'T', 1._wp, 'no0' )
+         CALL lbc_lnk( 'toto',zenv, 'T', 1._wp, kfillmode=jpfillnothing)
          !                                                  ! ================ !
       END DO                                                !     End loop     !
Index: utils/tools/DOMAINcfg/src/errioipsl.f90
===================================================================
--- utils/tools/DOMAINcfg/src/errioipsl.f90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/errioipsl.f90	(revision 14623)
@@ -1,3 +1,4 @@
 MODULE errioipsl
+!$AGRIF_DO_NOT_TREAT
 !-
 !$Id: errioipsl.f90 2281 2010-10-15 14:21:13Z smasson $
@@ -213,3 +214,4 @@
 !===
 !-------------------
+!$AGRIF_END_DO_NOT_TREAT
 END MODULE errioipsl
Index: utils/tools/DOMAINcfg/src/flincom.f90
===================================================================
--- utils/tools/DOMAINcfg/src/flincom.f90	(revision 14623)
+++ utils/tools/DOMAINcfg/src/flincom.f90	(revision 14623)
@@ -0,0 +1,1941 @@
+MODULE flincom
+!$AGRIF_DO_NOT_TREAT
+!-
+!$Id: flincom.f90 2281 2010-10-15 14:21:13Z smasson $
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+  USE netcdf
+!-
+  USE calendar,  ONLY : ju2ymds, ymds2ju, ioconf_calendar
+  USE errioipsl, ONLY : histerr
+  USE stringop,  ONLY : strlowercase
+!-
+  IMPLICIT NONE
+!-
+  PRIVATE
+  PUBLIC :: flinput, flincre, flinget, flinclo, &
+            flinopen, flininfo, flininspect, flinquery_var
+!-
+  INTERFACE flinopen
+!---------------------------------------------------------------------
+!- The "flinopen" routines will open an input file
+!-
+!- INPUT
+!-
+!- filename  : Name of the netCDF file to be opened
+!-
+!- iideb     : index i for zoom     !
+!- iilen     : length  of  zoom     !   for
+!- jjdeb     : index j for zoom     !   zoom
+!- jjlen     : length  of  zoom     !
+!-
+!- do_test   : A flag that enables the testing of the content
+!-             of the file against the input from the model
+!-
+!- INPUT if do_test=TRUE      OUTPUT else
+!-
+!- iim       : size in the x direction in the file (longitude)
+!- jjm       : size in the y direction
+!- llm       : number of levels
+!-             (llm = 0 means no axis to be expected)
+!- lon       : array of (iilen,jjlen) (zoom), or (iim,jjm) (no zoom),
+!-             that contains the longitude of each point
+!- lat       : same for latitude
+!- lev       : An array of llm for the latitude
+!-
+!- WARNING :
+!- In the case of do_test=FALSE it is for the user to check
+!- that the dimensions of lon lat and lev are correct when passed to
+!- flinopen. This can be done after the call when iim and jjm have
+!- been retrieved from the netCDF file. In F90 this problem will
+!- be solved with an internal assign
+!- IF iim, jjm, llm or ttm are parameters in the calling program and
+!- you use the option do_test=FALSE it will create a segmentation fault
+!-
+!-  OUTPUT
+!-
+!-  ttm       : size of time axis
+!-  itaus     : Time steps within this file
+!-  date0     : Julian date at which itau = 0
+!-  dt        : length of the time steps of the data
+!-  fid       : returned file ID which is later used to read the data
+!---------------------------------------------------------------------
+    MODULE PROCEDURE flinopen_zoom2d, flinopen_nozoom
+  END INTERFACE
+!-
+  INTERFACE flinput
+!---------------------------------------------------------------------
+!- The "flinput" routines will put a variable
+!- on the netCDF file created by flincre.
+!- If the sizes of the axis do not match the one of the IDs
+!- then a new axis is created.
+!- That is we loose the possibility of writting hyperslabs of data.
+!-
+!- Again here if iim = jjm = llm = ttm = 0
+!- then a global attribute is added to the file.
+!-
+!- INPUT
+!-
+!- fid      : Identification of the file in which we will write
+!- varname  : Name of variable to be written
+!- iim      : size in x of variable
+!- nlonid   : ID of x axis which could fit for this axis
+!- jjm      : size in y of variable
+!- nlatid   : ID of y axis which could fit for this axis
+!- llm      : size in z of variable
+!- zdimid   : ID of z axis which could fit for this axis
+!- ttm      : size in t of variable
+!- tdimid   : ID of t axis which could fit for this axis
+!-
+!- OUTPUT
+!-
+!- NONE
+!---------------------------------------------------------------------
+    MODULE PROCEDURE flinput_r4d, flinput_r3d, flinput_r2d, &
+                     flinput_r1d, flinput_scal
+  END INTERFACE
+!-
+  INTERFACE flinget
+    MODULE PROCEDURE flinget_r4d, flinget_r3d, flinget_r2d, &
+                     flinget_r1d, flinget_scal, &
+                     flinget_r4d_zoom2d, flinget_r3d_zoom2d, &
+                     flinget_r2d_zoom2d
+  END INTERFACE
+!-
+! This is the data we keep on each file we open
+!-
+  INTEGER, PARAMETER :: nbfile_max = 200
+  INTEGER, SAVE :: nbfiles = 0
+  INTEGER, SAVE :: ncids(nbfile_max), ncnbd(nbfile_max), &
+                   ncfunli(nbfile_max), ncnba(nbfile_max)
+  INTEGER, SAVE :: ncnbva(nbfile_max), ncdims(nbfile_max,4)
+  LOGICAL, SAVE :: ncfileopen(nbfile_max)=.FALSE.
+!-
+  INTEGER, SAVE :: cind_vid, cind_fid, cind_len
+  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: cindex
+!-
+  INTEGER,DIMENSION(4) :: w_sta, w_len, w_dim
+!-
+CONTAINS
+!-
+!===
+!-
+SUBROUTINE flincre &
+  (filename, iim1, jjm1, lon1, lat1, llm1, lev1, ttm1, itaus, &
+   time0, dt, fid_out, nlonid1, nlatid1, zdimid1, tdimid1)
+!---------------------------------------------------------------------
+!- This is a "low level" subroutine for opening netCDF files wich
+!- contain the major coordinate system of the model.
+!- Other coordinates needed for other variables
+!- will be added as they are needed.
+!-
+!- INPUT
+!-
+!- filename    : Name of the file to be created
+!- iim1, jjm1  : Horizontal size of the grid
+!-               which will be stored in the file
+!- lon1, lat1  : Horizontal grids
+!- llm1        : Size of the vertical grid
+!- lev1        : Vertical grid
+!- ttm1        : Size of time axis
+!- itaus       : time steps on the time axis
+!- time0       : Time in julian days at which itau = 0
+!- dt          : time step in seconds between itaus
+!-               (one step of itau)
+!-
+!- OUTPUT
+!-
+!- fid         : File identification
+!- nlonid1     : Identification of longitudinal axis
+!- nlatid1     : Identification of latitudinal axis
+!- zdimid1     : ID of vertical axis
+!- tdimid1     : ID of time axis
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  CHARACTER(LEN=*) :: filename
+  INTEGER :: iim1, jjm1, llm1, ttm1
+  REAL :: lon1(iim1,jjm1)
+  REAL :: lat1(iim1,jjm1)
+  REAL :: lev1(llm1)
+  INTEGER :: itaus(ttm1)
+  REAL :: time0
+  REAL :: dt
+  INTEGER :: fid_out, zdimid1, nlonid1, nlatid1, tdimid1
+!-
+! LOCAL
+!-
+  INTEGER :: iret, lll, fid
+  INTEGER :: lonid, latid, levid, timeid
+  INTEGER :: year, month, day
+  REAL :: sec
+  CHARACTER(LEN=250):: name
+!-
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  lll = LEN_TRIM(filename)
+  IF (filename(lll-2:lll) /= '.nc') THEN
+    name=filename(1:lll)//'.nc'
+  ELSE
+    name=filename(1:lll)
+  ENDIF
+!-
+  iret = NF90_CREATE (name, NF90_CLOBBER, fid)
+!-
+  iret = NF90_DEF_DIM (fid, 'x',     iim1, nlonid1)
+  iret = NF90_DEF_DIM (fid, 'y',     jjm1, nlatid1)
+  iret = NF90_DEF_DIM (fid, 'lev',   llm1, zdimid1)
+  iret = NF90_DEF_DIM (fid, 'tstep', ttm1, tdimid1)
+!-
+! Vertical axis
+!-
+  IF (check) WRITE(*,*) 'flincre Vertical axis'
+!-
+  iret = NF90_DEF_VAR (fid, 'lev', NF90_FLOAT, zdimid1, levid)
+  iret = NF90_PUT_ATT (fid, levid, 'units',     '-')
+  iret = NF90_PUT_ATT (fid, levid, 'title',     'levels')
+  iret = NF90_PUT_ATT (fid, levid, 'long_name', 'Sigma Levels')
+!-
+! Time axis
+!-
+  IF (check) WRITE(*,*) 'flincre time axis'
+!-
+  iret = NF90_DEF_VAR (fid, 'tstep', NF90_FLOAT, tdimid1, timeid)
+  iret = NF90_PUT_ATT (fid, timeid, 'units',     '-')
+  iret = NF90_PUT_ATT (fid, timeid, 'title',     'time')
+  iret = NF90_PUT_ATT (fid, timeid, 'long_name', 'time steps')
+!-
+! The longitude
+!-
+  IF (check) WRITE(*,*) 'flincre Longitude axis'
+!-
+  iret = NF90_DEF_VAR (fid, "nav_lon", NF90_FLOAT, &
+                       (/ nlonid1, nlatid1 /), lonid)
+  iret = NF90_PUT_ATT (fid, lonid, 'units', "degrees_east")
+  iret = NF90_PUT_ATT (fid, lonid, 'title', "Longitude")
+  iret = NF90_PUT_ATT (fid, lonid, 'nav_model', &
+                       "Lambert projection of PROMES")
+  iret = NF90_PUT_ATT (fid, lonid, 'valid_min', &
+                       REAL(MINVAL(lon1),KIND=4))
+  iret = NF90_PUT_ATT (fid, lonid, 'valid_max', &
+                       REAL(MAXVAL(lon1),KIND=4))
+!-
+! The Latitude
+!-
+  IF (check) WRITE(*,*) 'flincre Latitude axis'
+!-
+  iret = NF90_DEF_VAR (fid, "nav_lat", NF90_FLOAT, &
+                     (/ nlonid1, nlatid1 /), latid)
+  iret = NF90_PUT_ATT (fid, latid, 'units', "degrees_north")
+  iret = NF90_PUT_ATT (fid, latid, 'title', "Latitude")
+  iret = NF90_PUT_ATT (fid, latid, 'nav_model', &
+                       "Lambert projection of PROMES")
+  iret = NF90_PUT_ATT (fid, latid, 'valid_min', &
+                       REAL(MINVAL(lat1),KIND=4))
+  iret = NF90_PUT_ATT (fid, latid, 'valid_max', &
+                       REAL(MAXVAL(lat1),KIND=4))
+!-
+! The time coordinates
+!-
+  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'delta_tstep_sec', &
+                       REAL(dt,KIND=4))
+!-
+  CALL ju2ymds (time0, year, month, day, sec)
+!-
+  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'year0',  REAL(year,KIND=4))
+  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'month0', REAL(month,KIND=4))
+  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'day0',   REAL(day,KIND=4))
+  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'sec0',   REAL(sec,KIND=4))
+!-
+  iret = NF90_ENDDEF (fid)
+!-
+  IF (check) WRITE(*,*) 'flincre Variable'
+!-
+  iret = NF90_PUT_VAR (fid, levid, lev1(1:llm1))
+!-
+  IF (check) WRITE(*,*) 'flincre Time Variable'
+!-
+  iret = NF90_PUT_VAR (fid, timeid, REAL(itaus(1:ttm1)))
+!-
+  IF (check) WRITE(*,*) 'flincre Longitude'
+!-
+  iret = NF90_PUT_VAR (fid, lonid, lon1(1:iim1,1:jjm1))
+!-
+  IF (check) WRITE(*,*) 'flincre Latitude'
+!-
+  iret = NF90_PUT_VAR (fid, latid, lat1(1:iim1,1:jjm1))
+!-
+! Keep all this information
+!-
+  nbfiles = nbfiles+1
+!-
+  IF (nbfiles > nbfile_max) THEN
+    CALL histerr (3,'flincre', &
+     'Too many files. Please increase nbfil_max', &
+     'in program flincom.F90.',' ')
+  ENDIF
+!-
+  ncids(nbfiles) = fid
+  ncnbd(nbfiles) = 4
+!-
+  ncdims(nbfiles,1:4) = (/ iim1, jjm1, llm1, ttm1 /)
+!-
+  ncfunli(nbfiles) = -1
+  ncnba(nbfiles)   =  4
+  ncnbva(nbfiles)  =  0
+  ncfileopen(nbfiles) = .TRUE.
+!-
+  fid_out = nbfiles
+!---------------------
+END SUBROUTINE flincre
+!-
+!===
+!-
+SUBROUTINE flinopen_zoom2d &
+  (filename, iideb, iilen, jjdeb, jjlen, do_test, &
+  iim, jjm, llm, lon, lat, lev, ttm, itaus, date0, dt, fid_out)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  CHARACTER(LEN=*) :: filename
+  LOGICAL :: do_test
+  INTEGER :: iim, jjm, llm, ttm, iideb, iilen, jjdeb, jjlen
+  REAL :: lon(iilen,jjlen), lat(iilen,jjlen), lev(llm)
+  INTEGER :: itaus(ttm)
+  REAL :: date0, dt
+  INTEGER :: fid_out
+!-
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) WRITE (*,*) ' iideb, iilen, jjdeb, jjlen, iim, jjm ', &
+                           iideb, iilen, jjdeb, jjlen, iim, jjm
+  IF (check) WRITE (*,*) ' lon ', lon(1,1), lon(iilen,jjlen)
+  IF (check) WRITE (*,*) ' lat ', lat(1,1), lat(iilen,jjlen)
+!-
+  CALL flinopen_work &
+    (filename, iideb, iilen, jjdeb, jjlen, do_test, &
+     iim, jjm, llm, lon, lat, lev, ttm, itaus, date0, dt, fid_out)
+!-----------------------------
+END SUBROUTINE flinopen_zoom2d
+!-
+!===
+!-
+SUBROUTINE flinopen_nozoom &
+  (filename, do_test, iim, jjm, llm, lon, lat, lev, ttm, &
+   itaus, date0, dt, fid_out)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  CHARACTER(LEN=*) :: filename
+  LOGICAL :: do_test
+  INTEGER :: iim, jjm, llm, ttm
+  REAL :: lon(iim,jjm), lat(iim,jjm), lev(llm)
+  INTEGER :: itaus(ttm)
+  REAL :: date0, dt
+  INTEGER :: fid_out
+!---------------------------------------------------------------------
+  CALL flinopen_work &
+    (filename, 1, iim, 1, jjm, do_test, &
+     iim, jjm, llm, lon, lat, lev, ttm, itaus, date0, dt, fid_out)
+!-------------------------
+END SUBROUTINE flinopen_nozoom
+!-
+!===
+!-
+SUBROUTINE flinopen_work &
+  (filename, iideb, iilen, jjdeb, jjlen, do_test, &
+   iim, jjm, llm, lon, lat, lev, ttm, itaus, date0, dt, fid_out)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  CHARACTER(LEN=*) :: filename
+  LOGICAL :: do_test
+  INTEGER :: iim, jjm, llm, ttm, iideb, iilen, jjdeb, jjlen
+  REAL :: lon(iilen,jjlen), lat(iilen,jjlen), lev(llm)
+  INTEGER :: itaus(ttm)
+  REAL :: date0, dt
+  INTEGER :: fid_out
+!-
+! LOCAL
+!-
+  REAL, PARAMETER :: eps = 1.e-4
+!-
+  INTEGER :: iret, vid, fid, nbdim, i, iilast, jjlast
+  INTEGER :: gdtt_id, old_id, iv, gdtmaf_id
+  CHARACTER(LEN=250) :: name
+  CHARACTER(LEN=80) :: units, calendar
+  INTEGER :: tmp_iim, tmp_jjm, tmp_llm, tmp_ttm
+  REAL :: x_first, x_last
+  INTEGER :: year, month, day
+  REAL :: r_year, r_month, r_day
+  INTEGER :: year0, month0, day0, hours0, minutes0, seci
+  REAL :: sec, sec0
+  CHARACTER :: strc
+!-
+  REAL,DIMENSION(:),ALLOCATABLE :: vec_tmp
+!-
+  LOGICAL :: open_file
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  iilast = iideb+iilen-1
+  jjlast = jjdeb+jjlen-1
+  IF (check) WRITE (*,*) &
+    ' flinopen_work zoom 2D information '// &
+    ' iideb, iilen, iilast, jjdeb, jjlen, jjlast ', &
+      iideb, iilen, iilast, jjdeb, jjlen, jjlast
+!-
+! 1.0 get all infos on the file
+!-
+! Either the fid_out has not been initialized (0 or very large)
+! then we have to open anyway. Else we only need to open the file
+! if it has not been opened before.
+!-
+  IF ( (fid_out < 1).OR.(fid_out > nbfile_max) ) THEN
+    open_file = .TRUE.
+  ELSE IF (.NOT.ncfileopen(fid_out)) THEN
+    open_file = .TRUE.
+  ELSE
+    open_file = .FALSE.
+  ENDIF
+!-
+  IF (open_file) THEN
+    CALL flininfo (filename,tmp_iim,tmp_jjm,tmp_llm,tmp_ttm,fid_out)
+  ELSE
+!-- The user has already opened the file
+!-- and we trust that he knows the dimensions
+    tmp_iim = iim
+    tmp_jjm = jjm
+    tmp_llm = llm
+    tmp_ttm = ttm
+  ENDIF
+!-
+  IF (check) &
+    WRITE(*,*) 'OUT OF flininfo :',tmp_iim,tmp_jjm,tmp_llm,tmp_ttm
+!-
+  fid = ncids(fid_out)
+!-
+! 2.0 get the sizes and names of the different coordinates
+!     and do a first set of verification.
+!-
+! 2.2 We test the axis if we have to.
+!-
+  IF (check) &
+    WRITE(*,*) 'flininfo 2.2 We test if we have to test : ',do_test
+!-
+  IF (do_test) THEN
+    IF      (iim /= tmp_iim) THEN
+      CALL histerr (3,'flinopen', &
+        'file '//filename//' does not have the ', &
+        'required dimension in x direction (longitude)',' ')
+    ELSE IF (jjm /= tmp_jjm) THEN
+      CALL histerr (3,'flinopen', &
+        'file '//filename//' does not have the ', &
+        'required dimension in y direction (latitude)',' ')
+    ELSE IF ( llm /= tmp_llm .AND. llm > 0 ) THEN
+      CALL histerr (3,'flinopen', &
+        'file '//filename//' does not have the ', &
+        'required dimension in the vertical',' ')
+    ENDIF
+  ELSE
+!---
+!-- 2.3 Else the sizes of the axes are returned to the user
+!---
+    IF (check) WRITE(*,*) 'flinopen 2.3 Else sizes are returned'
+!---
+    iim = tmp_iim
+    jjm = tmp_jjm
+    llm = tmp_llm
+  ENDIF
+!-
+  ttm = tmp_ttm
+!-
+! 3.0 Check if we are realy talking about the same coodinate system
+!     if not then we get the lon, lat and lev variables from the file
+!-
+  IF (check) WRITE(*,*) 'flinopen 3.0 we are realy talking'
+!-
+  IF (do_test) THEN
+!---
+    CALL flinfindcood (fid_out, 'lon', vid, nbdim)
+    iret = NF90_GET_VAR (fid, vid, x_first, start=(/ iideb, jjdeb /))
+    iret = NF90_GET_VAR (fid, vid, x_last, start=(/ iilast, jjlast /))
+!---
+    IF (check) &
+      WRITE(*,*) 'from file lon first and last, modulo 360. ', &
+        x_first, x_last, MODULO(x_first,360.), MODULO(x_last,360.)
+    IF (check) &
+      WRITE(*,*) 'from model lon first and last, modulo 360. ', &
+        lon(1,1),lon(iilen,jjlen), &
+        MODULO(lon(1,1),360.), MODULO(lon(iilen,jjlen),360.)
+    IF (    (ABS( MODULO(x_first,360.) &
+                 -MODULO(lon(1,1),360.)) > eps) &
+        .OR.(ABS( MODULO(x_last,360.) &
+                 -MODULO(lon(iilen ,jjlen),360.)) > eps ) ) THEN
+      CALL histerr (3,'flinopen', &
+        'file '//filename//' and the model do not', &
+        'share the same longitude coordinate', &
+        'Obtained by comparing the first and last values ')
+    ENDIF
+!---
+    CALL flinfindcood (fid_out, 'lat', vid, nbdim)
+    iret = NF90_GET_VAR (fid, vid, x_first, start=(/ iideb, jjdeb /))
+    iret = NF90_GET_VAR (fid, vid, x_last, start=(/ iilast, jjlast /))
+!---
+    IF (check) WRITE(*,*) &
+      'from file lat first and last ',x_first,x_last
+    IF (check) WRITE(*,*) &
+      'from model lat first and last ',lat(1,1),lat(iilen,jjlen)
+!---
+    IF (    (ABS(x_first-lat(1,1)) > eps) &
+        .OR.(ABS(x_last-lat(iilen,jjlen)) > eps) ) THEN
+      CALL histerr (3,'flinopen', &
+        'file '//filename//' and the model do not', &
+        'share the same latitude coordinate', &
+        'Obtained by comparing the first and last values ')
+    ENDIF
+!---
+    IF (llm > 0) THEN
+      CALL flinfindcood (fid_out, 'lev', vid, nbdim)
+      iret = NF90_GET_VAR (fid, vid, x_first, start=(/ 1 /))
+      iret = NF90_GET_VAR (fid, vid, x_last, start=(/ llm /))
+!-----
+      IF (check) WRITE(*,*) &
+        'from file lev first and last ',x_first ,x_last
+      IF (check) WRITE(*,*) &
+        'from model lev first and last ',lev(1),lev(llm)
+!-----
+      IF (    (ABS(x_first-lev(1)) > eps) &
+          .OR.(ABS(x_last-lev(llm)) > eps) ) THEN
+        CALL histerr (3,'flinopen', &
+          'file '//filename//' and the model do not', &
+          'share the same vertical coordinate', &
+          'Obtained by comparing the first and last values')
+      ENDIF
+    ENDIF
+!---
+  ELSE
+!---
+!-- 4.0 extracting the coordinates if we do not check
+!---
+    IF (check) WRITE(*,*) 'flinopen 4.0 extracting the coordinates'
+!---
+    CALL flinfindcood (fid_out, 'lon', vid, nbdim)
+    IF (nbdim == 2) THEN
+      iret = NF90_GET_VAR (fid, vid, lon, &
+               start=(/ iideb, jjdeb /), count=(/ iilen, jjlen /))
+    ELSE
+      ALLOCATE(vec_tmp(iilen))
+      iret = NF90_GET_VAR (fid, vid, vec_tmp, &
+               start=(/ iideb /), count=(/ iilen /))
+      DO i=1,jjlen
+        lon(:,i) = vec_tmp(:)
+      ENDDO
+      DEALLOCATE(vec_tmp)
+    ENDIF
+!---
+    CALL flinfindcood (fid_out, 'lat', vid, nbdim)
+    IF (nbdim == 2) THEN
+      iret = NF90_GET_VAR (fid, vid, lat, &
+               start=(/ iideb, jjdeb /), count=(/ iilen, jjlen /))
+    ELSE
+      ALLOCATE(vec_tmp(jjlen))
+      iret = NF90_GET_VAR (fid, vid, vec_tmp, &
+               start=(/ jjdeb /), count=(/ jjlen /))
+      DO i=1,iilen
+        lat(i,:) = vec_tmp(:)
+      ENDDO
+      DEALLOCATE(vec_tmp)
+    ENDIF
+!---
+    IF (llm > 0) THEN
+      CALL flinfindcood (fid_out, 'lev', vid, nbdim)
+      IF (nbdim == 1) THEN
+        iret = NF90_GET_VAR (fid, vid, lev, &
+                 start=(/ 1 /), count=(/ llm /))
+      ELSE
+        CALL histerr (3,'flinopen', &
+          'Can not handle vertical coordinates that have more',&
+          'than 1 dimension',' ')
+      ENDIF
+    ENDIF
+  ENDIF
+!-
+! 5.0 Get all the details for the time if possible needed
+!-
+  IF (check) WRITE(*,*) 'flinopen 5.0 Get time'
+!-
+  IF (ttm > 0) THEN
+!---
+!-- 5.1 Find the time axis. Prefered method is the 'timestep since'
+!---
+    gdtmaf_id = -1
+    gdtt_id = -1
+    old_id = -1
+    DO iv=1,ncnbva(fid_out)
+      name=''
+      iret = NF90_INQUIRE_VARIABLE (fid, iv, name=name)
+      units=''
+      iret = NF90_GET_ATT (fid, iv, 'units', units)
+      IF (INDEX(units,'seconds since') > 0) gdtmaf_id = iv
+      IF (INDEX(units,'timesteps since') > 0) gdtt_id = iv
+      IF (INDEX(name, 'tstep') > 0) old_id = iv
+    ENDDO
+!---
+    IF (gdtt_id > 0) THEN
+      vid = gdtt_id
+    ELSE IF (gdtmaf_id > 0) THEN
+      vid = gdtmaf_id
+    ELSE IF (old_id > 0) THEN
+      vid = old_id
+    ELSE
+      CALL histerr (3, 'flinopen', 'No time axis found',' ',' ')
+    ENDIF
+!---
+    ALLOCATE(vec_tmp(ttm))
+    iret = NF90_GET_VAR (fid,vid,vec_tmp,start=(/ 1 /),count=(/ ttm /))
+    itaus(1:ttm) = NINT(vec_tmp(1:ttm))
+    DEALLOCATE(vec_tmp)
+!---
+    IF (check) WRITE(*,*) 'flinopen 5.1 Times ',itaus
+!---
+!-- Getting all the details for the time axis
+!---
+!-- Find the calendar
+    calendar = ''
+    iret = NF90_GET_ATT (fid,gdtmaf_id,'calendar',calendar)
+    IF (iret == NF90_NOERR) THEN
+      CALL ioconf_calendar(calendar)
+    ENDIF
+!--
+    units = ''
+    iret = NF90_GET_ATT (fid,vid,'units',units)
+    IF (gdtt_id > 0) THEN
+      units = units(INDEX(units,'since')+6:LEN_TRIM(units))
+      READ (units,'(I4.4,5(a,I2.2))') &
+        year0, strc, month0, strc, day0, &
+               strc, hours0, strc, minutes0, strc, seci
+      sec0 = hours0*3600. + minutes0*60. + seci
+      CALL ymds2ju (year0, month0, day0, sec0, date0)
+      IF (check) &
+        WRITE(*,*) 'flinopen 5.1 gdtt_id year0 ... date0 ', &
+                   year0, month0, day0, sec0, date0
+!-----
+      iret = NF90_GET_ATT (fid, gdtt_id, 'tstep_sec', dt)
+    ELSE IF (gdtmaf_id > 0) THEN
+      units = units(INDEX(units,'since')+6:LEN_TRIM(units))
+      READ (units,'(I4.4,5(a,I2.2))') &
+        year0, strc, month0, strc, day0, &
+               strc, hours0, strc, minutes0, strc, seci
+      sec0 = hours0*3600. + minutes0*60. + seci
+      CALL ymds2ju (year0, month0, day0, sec0, date0)
+!-----
+      IF (check) &
+        WRITE(*,*) 'flinopen 5.1 gdtmaf_id year0 ... date0 ', &
+                   year0, month0, day0, sec0, date0
+    ELSE IF (old_id > 0) THEN
+      iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'delta_tstep_sec', dt)
+      iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'day0', r_day)
+      iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'sec0', sec)
+      iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'year0', r_year)
+      iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'month0', r_month)
+!-----
+      day = INT(r_day)
+      month = INT(r_month)
+      year = INT(r_year)
+!-----
+      CALL ymds2ju (year, month, day, sec, date0)
+    ENDIF
+  ENDIF
+!-
+  IF (check) WRITE(*,*) 'flinopen 6.0 File opened', date0, dt
+!---------------------------
+END SUBROUTINE flinopen_work
+!-
+!===
+!-
+SUBROUTINE flininfo (filename, iim, jjm, llm, ttm, fid_out)
+!---------------------------------------------------------------------
+!- This subroutine allows to get some information.
+!- It is usualy done within flinopen but the user may want to call
+!- it before in order to allocate the space needed to extract the
+!- data from the file.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  CHARACTER(LEN=*) :: filename
+  INTEGER :: iim, jjm, llm, ttm, fid_out
+!-
+! LOCAL
+!-
+  INTEGER :: iret, fid, ndims, nvars, nb_atts, id_unlim
+  INTEGER :: iv, lll
+  INTEGER :: xid, yid, zid, tid
+  CHARACTER(LEN=80) :: name
+  CHARACTER(LEN=30) :: axname
+!-
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  lll = LEN_TRIM(filename)
+  IF (filename(lll-2:lll) /= '.nc') THEN
+    name = filename(1:lll)//'.nc'
+  ELSE
+    name = filename(1:lll)
+  ENDIF
+!-
+  iret = NF90_OPEN (name, NF90_NOWRITE, fid)
+  IF (iret /= NF90_NOERR) THEN
+    CALL histerr(3, 'flininfo','Could not open file :',TRIM(name),' ')
+  ENDIF
+!-
+  iret = NF90_INQUIRE (fid, nDimensions=ndims, nVariables=nvars, &
+                      nAttributes=nb_atts, unlimitedDimId=id_unlim)
+!-
+  xid = -1; iim = 0;
+  yid = -1; jjm = 0;
+  zid = -1; llm = 0;
+  tid = -1; ttm = 0;
+!-
+  DO iv=1,ndims
+!---
+    iret = NF90_INQUIRE_DIMENSION (fid, iv, name=axname, len=lll)
+    CALL strlowercase (axname)
+    axname = ADJUSTL(axname)
+!---
+    IF (check) WRITE(*,*) &
+      'flininfo - getting axname',iv,axname,lll
+!---
+    IF      (    (INDEX(axname,'x') == 1) &
+             .OR.(INDEX(axname,'lon') == 1) ) THEN
+      xid = iv; iim = lll;
+    ELSE IF (    (INDEX(axname,'y') == 1) &
+             .OR.(INDEX(axname,'lat') == 1) ) THEN
+      yid = iv; jjm = lll;
+    ELSE IF (    (INDEX(axname,'lev') == 1) &
+             .OR.(INDEX(axname,'plev') == 1) &
+             .OR.(INDEX(axname,'z') == 1) &
+             .OR.(INDEX(axname,'depth') == 1) ) THEN
+      zid = iv; llm = lll;
+    ELSE IF (    (INDEX(axname,'tstep') == 1) &
+             .OR.(INDEX(axname,'time_counter') == 1) ) THEN
+!---- For the time we certainly need to allow for other names
+      tid = iv; ttm = lll;
+    ELSE IF (ndims == 1) THEN
+!---- Nothing was found and ndims=1 then we have a vector of data
+      xid = 1; iim = lll;
+    ENDIF
+!---
+  ENDDO
+!-
+! Keep all this information
+!-
+  nbfiles = nbfiles+1
+!-
+  IF (nbfiles > nbfile_max) THEN
+    CALL histerr (3,'flininfo', &
+      'Too many files. Please increase nbfil_max', &
+      'in program flincom.F90.',' ')
+  ENDIF
+!-
+  ncids(nbfiles) = fid
+  ncnbd(nbfiles) = ndims
+!-
+  ncdims(nbfiles,1:4) = (/ iim, jjm, llm, ttm /)
+!-
+  ncfunli(nbfiles) = id_unlim
+  ncnba(nbfiles)   = nb_atts
+  ncnbva(nbfiles)  = nvars
+  ncfileopen(nbfiles) = .TRUE.
+!-
+  fid_out = nbfiles
+!----------------------
+END SUBROUTINE flininfo
+!-
+!===
+!-
+SUBROUTINE flinput_r1d &
+  (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
+  REAL :: var(:)
+!-
+  INTEGER :: fid, ncvarid, ndim, iret
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) WRITE(*,*) &
+     "flinput_r1d : SIZE(var) = ",SIZE(var)
+!-
+  CALL flinput_mat &
+    (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, &
+     fid,ncvarid,ndim)
+!-
+  iret = NF90_PUT_VAR (fid, ncvarid, var, &
+           start=w_sta(1:ndim), count=w_len(1:ndim))
+!-------------------------
+END SUBROUTINE flinput_r1d
+!-
+!===
+!-
+SUBROUTINE flinput_r2d &
+  (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
+  REAL :: var(:,:)
+!-
+  INTEGER :: fid, ncvarid, ndim, iret
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) WRITE(*,*) &
+     "flinput_r2d : SIZE(var) = ",SIZE(var)
+!-
+  CALL flinput_mat &
+    (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, &
+     fid,ncvarid,ndim)
+!-
+  iret = NF90_PUT_VAR (fid, ncvarid, var, &
+           start=w_sta(1:ndim), count=w_len(1:ndim))
+!-------------------------
+END SUBROUTINE flinput_r2d
+!-
+!===
+!-
+SUBROUTINE flinput_r3d &
+  (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
+  REAL :: var(:,:,:)
+!-
+  INTEGER :: fid, ncvarid, ndim, iret
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) WRITE(*,*) &
+     "flinput_r3d : SIZE(var) = ",SIZE(var)
+!-
+  CALL flinput_mat &
+    (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, &
+     fid,ncvarid,ndim)
+!-
+  iret = NF90_PUT_VAR (fid, ncvarid, var, &
+           start=w_sta(1:ndim), count=w_len(1:ndim))
+!-------------------------
+END SUBROUTINE flinput_r3d
+!-
+!===
+!-
+SUBROUTINE flinput_r4d &
+  (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
+  REAL :: var(:,:,:,:)
+!-
+  INTEGER :: fid, ncvarid, ndim, iret
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) WRITE(*,*) &
+     "flinput_r4d : SIZE(var) = ",SIZE(var)
+!-
+  CALL flinput_mat &
+    (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, &
+     fid,ncvarid,ndim)
+!-
+  iret = NF90_PUT_VAR (fid, ncvarid, var, &
+           start=w_sta(1:ndim), count=w_len(1:ndim))
+!-------------------------
+END SUBROUTINE flinput_r4d
+!-
+!===
+!-
+SUBROUTINE flinput_mat &
+  (fid_in,varname,iim,nlonid,jjm,nlatid, &
+                  llm,zdimid,ttm,tdimid,fid,ncvarid,ndim)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
+  INTEGER :: fid, ncvarid, ndim
+!-
+! LOCAL
+!-
+  INTEGER :: iret
+!---------------------------------------------------------------------
+  fid = ncids(fid_in)
+!-
+  w_sta(1:4) = (/      1,      1,  1,  1 /)
+  w_len(1:2) = (/    iim,    jjm /)
+  w_dim(1:2) = (/ nlonid, nlatid /)
+!-
+  IF ( (llm > 0).AND.(ttm > 0) ) THEN
+    ndim = 4
+    w_len(3:4) = (/    llm,    ttm /)
+    w_dim(3:4) = (/ zdimid, tdimid /)
+  ELSE IF (llm > 0) THEN
+    ndim = 3
+    w_dim(3) = zdimid
+    w_len(3) = llm
+  ELSE IF (ttm > 0) THEN
+    ndim = 3
+    w_dim(3) = tdimid
+    w_len(3) = ttm
+  ELSE
+    ndim = 2
+  ENDIF
+!-
+  iret = NF90_REDEF   (fid)
+  iret = NF90_DEF_VAR (fid,varname,NF90_FLOAT,w_dim(1:ndim),ncvarid)
+  iret = NF90_PUT_ATT (fid,ncvarid,'short_name',TRIM(varname))
+  iret = NF90_ENDDEF  (fid)
+!--------------------------
+END  SUBROUTINE flinput_mat
+!-
+!===
+!-
+SUBROUTINE flinput_scal &
+  (fid_in, varname, iim, nlonid, jjm, nlatid, &
+                    llm, zdimid, ttm, tdimid, var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
+  REAL :: var
+!-
+! LOCAL
+!-
+  INTEGER :: fid, iret
+!---------------------------------------------------------------------
+  fid = ncids(fid_in)
+!-
+  iret = NF90_REDEF   (fid)
+  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, varname, REAL(var,KIND=4))
+  iret = NF90_ENDDEF  (fid)
+!---------------------------
+END  SUBROUTINE flinput_scal
+!-
+!===
+!-
+SUBROUTINE flinget_r1d &
+  (fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin
+  REAL :: var(:)
+!-
+  INTEGER :: jl, ji
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r1d : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r1d : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,1,iim,1,jjm,buff_tmp)
+!-
+  jl=0
+  DO ji=1,SIZE(var,1)
+    jl=jl+1
+    var(ji) = buff_tmp(jl)
+  ENDDO
+!-------------------------
+END SUBROUTINE flinget_r1d
+!-
+!===
+!-
+SUBROUTINE flinget_r2d &
+  (fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin
+  REAL :: var(:,:)
+!-
+  INTEGER :: jl, jj, ji
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r2d : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r2d : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,1,iim,1,jjm,buff_tmp)
+!-
+  jl=0
+  DO jj=1,SIZE(var,2)
+    DO ji=1,SIZE(var,1)
+      jl=jl+1
+      var(ji,jj) = buff_tmp(jl)
+    ENDDO
+  ENDDO
+!-------------------------
+END SUBROUTINE flinget_r2d
+!-
+!===
+!-
+SUBROUTINE flinget_r2d_zoom2d &
+  (fid_in,varname,iim,jjm,llm,ttm, &
+   itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim,jjm,llm,ttm,itau_dep,itau_fin,iideb,jjdeb,iilen,jjlen
+  REAL :: var(:,:)
+!-
+  INTEGER :: jl, jj, ji
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r2d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r2d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,buff_tmp)
+!-
+  jl=0
+  DO jj=1,SIZE(var,2)
+    DO ji=1,SIZE(var,1)
+      jl=jl+1
+      var(ji,jj) = buff_tmp(jl)
+    ENDDO
+  ENDDO
+!--------------------------------
+END SUBROUTINE flinget_r2d_zoom2d
+!-
+!===
+!-
+SUBROUTINE flinget_r3d &
+  (fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin
+  REAL :: var(:,:,:)
+!-
+  INTEGER :: jl, jk, jj, ji
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r3d : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r3d : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,1,iim,1,jjm,buff_tmp)
+!-
+  jl=0
+  DO jk=1,SIZE(var,3)
+    DO jj=1,SIZE(var,2)
+      DO ji=1,SIZE(var,1)
+        jl=jl+1
+        var(ji,jj,jk) = buff_tmp(jl)
+      ENDDO
+    ENDDO
+  ENDDO
+!-------------------------
+END SUBROUTINE flinget_r3d
+!-
+!===
+!-
+SUBROUTINE flinget_r3d_zoom2d &
+  (fid_in,varname,iim,jjm,llm,ttm, &
+   itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim,jjm,llm,ttm,itau_dep,itau_fin,iideb,jjdeb,iilen,jjlen
+  REAL :: var(:,:,:)
+!-
+  INTEGER :: jl, jk, jj, ji
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r3d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r3d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,buff_tmp)
+!-
+  jl=0
+  DO jk=1,SIZE(var,3)
+    DO jj=1,SIZE(var,2)
+      DO ji=1,SIZE(var,1)
+        jl=jl+1
+        var(ji,jj,jk) = buff_tmp(jl)
+      ENDDO
+    ENDDO
+  ENDDO
+!--------------------------------
+END SUBROUTINE flinget_r3d_zoom2d
+!-
+!===
+!-
+SUBROUTINE flinget_r4d &
+  (fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin
+  REAL :: var(:,:,:,:)
+!-
+  INTEGER :: jl, jk, jj, ji, jm
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r4d : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r4d : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,1,iim,1,jjm,buff_tmp)
+!-
+  jl=0
+  DO jm=1,SIZE(var,4)
+    DO jk=1,SIZE(var,3)
+      DO jj=1,SIZE(var,2)
+        DO ji=1,SIZE(var,1)
+          jl=jl+1
+          var(ji,jj,jk,jm) = buff_tmp(jl)
+        ENDDO
+      ENDDO
+    ENDDO
+  ENDDO
+!-------------------------
+END SUBROUTINE flinget_r4d
+!-
+!===
+!-
+SUBROUTINE flinget_r4d_zoom2d &
+  (fid_in,varname,iim,jjm,llm,ttm, &
+   itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim,jjm,llm,ttm,itau_dep,itau_fin,iideb,jjdeb,iilen,jjlen
+  REAL :: var(:,:,:,:)
+!-
+  INTEGER :: jl, jk, jj, ji, jm
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r4d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r4d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,buff_tmp)
+!-
+  jl=0
+  DO jm=1,SIZE(var,4)
+    DO jk=1,SIZE(var,3)
+      DO jj=1,SIZE(var,2)
+        DO ji=1,SIZE(var,1)
+          jl=jl+1
+          var(ji,jj,jk,jm) = buff_tmp(jl)
+        ENDDO
+      ENDDO
+    ENDDO
+  ENDDO
+!--------------------------------
+END SUBROUTINE flinget_r4d_zoom2d
+!-
+!===
+!-
+SUBROUTINE flinget_mat &
+  (fid_in, varname, iim, jjm, llm, ttm, itau_dep, &
+   itau_fin, iideb, iilen, jjdeb, jjlen, var)
+!---------------------------------------------------------------------
+!- This subroutine will read the variable named varname from
+!- the file previously opened by flinopen and identified by fid
+!-
+!- It is checked that the dimensions of the variable to be read
+!- correspond to what the user requested when he specified
+!- iim, jjm and llm. The only exception which is allowed is
+!- for compressed data where the horizontal grid is not expected
+!- to be iim x jjm.
+!-
+!- If variable is of size zero a global attribute is read.
+!- This global attribute will be of type real
+!-
+!- INPUT
+!-
+!- fid      : File ID returned by flinopen
+!- varname  : Name of the variable to be read from the file
+!- iim      : | These three variables give the size of the variables
+!- jjm      : | to be read. It will be verified that the variables
+!- llm      : | fits in there.
+!- ttm      : |
+!- itau_dep : Time step at which we will start to read
+!- itau_fin : Time step until which we are going to read
+!-            For the moment this is done on indexes
+!-            but it should be in the physical space.
+!-            If there is no time-axis in the file then use a
+!-            itau_fin < itau_dep, this will tell flinget not to
+!-            expect a time-axis in the file.
+!- iideb    : index i for zoom
+!- iilen    : length of zoom
+!- jjdeb    : index j for zoom
+!- jjlen    : length of zoom
+!-
+!- OUTPUT
+!-
+!- var      : array that will contain the data
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, jjm, llm, ttm
+  INTEGER :: itau_dep, itau_fin, iideb, iilen, jjdeb, jjlen
+  REAL :: var(:)
+!-
+! LOCAL
+!-
+  INTEGER :: iret, fid
+  INTEGER :: vid, cvid, clen
+  CHARACTER(LEN=70) :: str1
+  CHARACTER(LEN=250) :: att_n, tmp_n
+  CHARACTER(LEN=5) :: axs_l
+  INTEGER :: tmp_i
+  REAL,SAVE :: mis_v=0.
+  REAL :: tmp_r
+  INTEGER :: ndims, x_typ, nb_atts
+  INTEGER,DIMENSION(NF90_MAX_VAR_DIMS) :: dimids
+  INTEGER :: i, nvars, i2d, cnd
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: var_tmp
+  LOGICAL :: uncompress = .FALSE.
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  fid = ncids(fid_in)
+!-
+  IF (check) THEN
+    WRITE(*,*) &
+    'flinget_mat : fid_in, fid, varname :', fid_in, fid, TRIM(varname)
+    WRITE(*,*) &
+    'flinget_mat : iim, jjm, llm, ttm, itau_dep, itau_fin :', &
+    iim, jjm, llm, ttm, itau_dep, itau_fin
+    WRITE(*,*) &
+    'flinget_mat : iideb, iilen, jjdeb, jjlen :', &
+    iideb, iilen, jjdeb, jjlen
+  ENDIF
+!-
+  uncompress = .FALSE.
+!-
+! 1.0 We get first all the details on this variable from the file
+!-
+  nvars = ncnbva(fid_in)
+!-
+  vid = -1
+  iret = NF90_INQ_VARID (fid, varname, vid)
+!-
+  IF (vid < 0 .OR. iret /= NF90_NOERR) THEN
+    CALL histerr (3,'flinget', &
+      'Variable '//TRIM(varname)//' not found in file',' ',' ')
+  ENDIF
+!-
+  iret = NF90_INQUIRE_VARIABLE (fid, vid, &
+           ndims=ndims, dimids=dimids, nAtts=nb_atts)
+  IF (check) THEN
+    WRITE(*,*) &
+    'flinget_mat : fid, vid :', fid, vid
+    WRITE(*,*) &
+    'flinget_mat : ndims, dimids(1:ndims), nb_atts :', &
+    ndims, dimids(1:ndims), nb_atts
+  ENDIF
+!-
+  w_dim(:) = 0
+  DO i=1,ndims
+    iret  = NF90_INQUIRE_DIMENSION (fid, dimids(i), len=w_dim(i))
+  ENDDO
+  IF (check) WRITE(*,*) &
+    'flinget_mat : w_dim :', w_dim(1:ndims)
+!-
+  mis_v = 0.0; axs_l = ' ';
+!-
+  IF (nb_atts > 0) THEN
+    IF (check) THEN
+      WRITE(*,*) 'flinget_mat : attributes for variable :'
+    ENDIF
+  ENDIF
+  DO i=1,nb_atts
+    iret = NF90_INQ_ATTNAME (fid, vid, i, att_n)
+    iret = NF90_INQUIRE_ATTRIBUTE (fid, vid, att_n, xtype=x_typ)
+    CALL strlowercase (att_n)
+    IF      (    (x_typ == NF90_INT).OR.(x_typ == NF90_SHORT) &
+             .OR.(x_typ == NF90_BYTE) ) THEN
+      iret = NF90_GET_ATT (fid, vid, att_n, tmp_i)
+      IF (check) THEN
+        WRITE(*,*) '   ',TRIM(att_n),' : ',tmp_i
+      ENDIF
+    ELSE IF ( (x_typ == NF90_FLOAT).OR.(x_typ == NF90_DOUBLE) ) THEN
+      iret = NF90_GET_ATT (fid, vid, att_n, tmp_r)
+      IF (check) THEN
+        WRITE(*,*) '   ',TRIM(att_n),' : ',tmp_r
+      ENDIF
+      IF (index(att_n,'missing_value') > 0) THEN
+        mis_v = tmp_r
+      ENDIF
+    ELSE
+      tmp_n = ''
+      iret = NF90_GET_ATT (fid, vid, att_n, tmp_n)
+      IF (check) THEN
+        WRITE(*,*) '   ',TRIM(att_n),' : ',TRIM(tmp_n)
+      ENDIF
+      IF (index(att_n,'axis') > 0) THEN
+        axs_l = tmp_n
+      ENDIF
+    ENDIF
+  ENDDO
+!?
+!!!!!!!!!! We will need a verification on the type of the variable
+!?
+!-
+! 2.0 The dimensions are analysed to determine what is to be read
+!-
+! 2.1 the longitudes
+!-
+  IF ( w_dim(1) /= iim .OR. w_dim(2) /= jjm) THEN
+!---
+!-- There is a possibility that we have to deal with a compressed axis !
+!---
+    iret = NF90_INQUIRE_DIMENSION (fid, dimids(1), &
+             name=tmp_n, len=clen)
+    iret = NF90_INQ_VARID (fid, tmp_n, cvid)
+!---
+    IF (check) WRITE(*,*) &
+      'Dimname, iret , NF90_NOERR : ',TRIM(tmp_n),iret,NF90_NOERR
+!---
+!-- If we have an axis which has the same name
+!-- as the dimension we can see if it is compressed
+!---
+!-- TODO TODO for zoom2d
+!---
+    IF (iret == NF90_NOERR) THEN
+      iret = NF90_GET_ATT (fid, cvid, 'compress', str1)
+!-----
+      IF (iret == NF90_NOERR) THEN
+        iret = NF90_INQUIRE_VARIABLE (fid,cvid,xtype=x_typ,ndims=cnd)
+!-------
+        IF ( cnd /= 1 .AND. x_typ /= NF90_INT) THEN
+          CALL histerr (3,'flinget', &
+            'Variable '//TRIM(tmp_n)//' can not be a compressed axis', &
+            'Either it has too many dimensions'// &
+            ' or it is not of type integer', ' ')
+        ELSE
+!---------
+!-------- Let us see if we already have that index table
+!---------
+          IF (    (cind_len /= clen).OR.(cind_vid /= cvid) &
+              .OR.(cind_fid /= fid) ) THEN
+            IF (ALLOCATED(cindex))   DEALLOCATE(cindex)
+            ALLOCATE(cindex(clen))
+            cind_len = clen
+            cind_vid = cvid
+            cind_fid = fid
+            iret = NF90_GET_VAR (fid, cvid, cindex)
+          ENDIF
+!---------
+!-------- In any case we need to set the slab of data to be read
+!---------
+          uncompress = .TRUE.
+          w_sta(1) = 1
+          w_len(1) = clen
+          i2d = 1
+        ENDIF
+      ELSE
+        str1 = 'The horizontal dimensions of '//varname
+        CALL histerr (3,'flinget',str1, &
+          'is not compressed and does not'// &
+          ' correspond to the requested size',' ')
+      ENDIF
+    ELSE
+      IF (w_dim(1) /= iim) THEN
+        str1 = 'The longitude dimension of '//varname
+        CALL histerr (3,'flinget',str1, &
+          'in the file is not equal to the dimension', &
+          'that should be read')
+      ENDIF
+      IF (w_dim(2) /= jjm) THEN
+        str1 = 'The latitude dimension of '//varname
+        CALL histerr (3,'flinget',str1, &
+          'in the file is not equal to the dimension', &
+          'that should be read')
+      ENDIF
+    ENDIF
+  ELSE
+    w_sta(1:2) = (/ iideb, jjdeb /)
+    w_len(1:2) = (/ iilen, jjlen /)
+    i2d = 2
+  ENDIF
+!-
+! 2.3 Now the difficult part, the 3rd dimension which can be
+! time or levels.
+!-
+! Priority is given to the time axis if only three axes are present.
+!-
+  IF (ndims > i2d) THEN
+!---
+!-- 2.3.1 We have a vertical axis
+!---
+    IF (llm == 1 .AND. ndims == i2d+2 .OR. llm == w_dim(i2d+1)) THEN
+!-----
+      IF (w_dim(i2d+1) /= llm) THEN
+        CALL histerr (3,'flinget', &
+          'The vertical dimension of '//varname, &
+          'in the file is not equal to the dimension', &
+          'that should be read')
+      ELSE
+        w_sta(i2d+1) = 1
+        IF (llm > 0) THEN
+          w_len(i2d+1) = llm
+        ELSE
+          w_len(i2d+1) = w_sta(i2d+1)
+        ENDIF
+      ENDIF
+!-----
+      IF ((itau_fin-itau_dep) >= 0) THEN
+        IF      (ndims /= i2d+2) THEN
+          CALL histerr (3,'flinget', &
+            'You attempt to read a time slab', &
+            'but there is no time axis on this variable', varname)
+        ELSE IF ((itau_fin - itau_dep) <= w_dim(i2d+2)) THEN
+          w_sta(i2d+2) = itau_dep
+          w_len(i2d+2) = itau_fin-itau_dep+1
+        ELSE
+          CALL histerr (3,'flinget', &
+            'The time step you try to read is not', &
+            'in the file (1)', varname)
+        ENDIF
+      ELSE IF (ndims == i2d+2 .AND. w_dim(i2d+2) > 1) THEN
+        CALL histerr (3,'flinget', &
+          'There is a time axis in the file but no', &
+          'time step give in the call', varname)
+      ELSE
+        w_sta(i2d+2) = 1
+        w_len(i2d+2) = 1
+      ENDIF
+    ELSE
+!-----
+!---- 2.3.2 We do not have any vertical axis
+!-----
+      IF (ndims == i2d+2) THEN
+        CALL histerr (3,'flinget', &
+          'The file contains 4 dimensions', &
+          'but only 3 are requestes for variable ', varname)
+      ENDIF
+      IF ((itau_fin-itau_dep) >= 0) THEN
+        IF (ndims == i2d+1) THEN
+          IF ((itau_fin-itau_dep) < w_dim(i2d+1) ) THEN
+            w_sta(i2d+1) = itau_dep
+            w_len(i2d+1) = itau_fin-itau_dep+1
+          ELSE
+            CALL histerr (3,'flinget', &
+              'The time step you try to read is not', &
+              'in the file (2)', varname)
+          ENDIF
+        ELSE
+          CALL histerr (3,'flinget', &
+            'From your input you sould have 3 dimensions', &
+            'in the file but there are 4', varname)
+        ENDIF
+      ELSE
+        IF (ndims == i2d+1 .AND. w_dim(i2d+1) > 1) THEN
+          CALL histerr (3,'flinget', &
+            'There is a time axis in the file but no', &
+            'time step given in the call', varname)
+        ELSE
+          w_sta(i2d+1) = 1
+          w_len(i2d+1) = 1
+        ENDIF
+      ENDIF
+    ENDIF
+  ELSE
+!---
+!-- 2.3.3 We do not have any vertical axis
+!---
+    w_sta(i2d+1:i2d+2) = (/ 0, 0 /)
+    w_len(i2d+1:i2d+2) = (/ 0, 0 /)
+  ENDIF
+!-
+! 3.0 Reading the data
+!-
+  IF (check) WRITE(*,*) &
+    'flinget_mat 3.0 : ', uncompress, w_sta, w_len
+!---
+  IF (uncompress) THEN
+!---
+    IF (ALLOCATED(var_tmp)) THEN
+      IF (SIZE(var_tmp) < clen) THEN
+        DEALLOCATE(var_tmp)
+        ALLOCATE(var_tmp(clen))
+      ENDIF
+    ELSE
+      ALLOCATE(var_tmp(clen))
+    ENDIF
+!---
+    iret = NF90_GET_VAR (fid, vid, var_tmp, &
+             start=w_sta(:), count=w_len(:))
+!---
+    var(:) = mis_v
+    var(cindex(:)) = var_tmp(:)
+!---
+  ELSE
+    iret = NF90_GET_VAR (fid, vid, var, &
+             start=w_sta(:), count=w_len(:))
+  ENDIF
+!-
+  IF (check) WRITE(*,*) 'flinget_mat 3.1 : ',NF90_STRERROR (iret)
+!--------------------------
+END  SUBROUTINE flinget_mat
+!-
+!===
+!-
+SUBROUTINE flinget_scal &
+  (fid_in, varname, iim, jjm, llm, ttm, itau_dep, itau_fin, var)
+!---------------------------------------------------------------------
+!- This subroutine will read the variable named varname from
+!- the file previously opened by flinopen and identified by fid
+!-
+!- If variable is of size zero a global attribute is read. This
+!- global attribute will be of type real
+!-
+!- INPUT
+!-
+!- fid      : File ID returned by flinopen
+!- varname  : Name of the variable to be read from the file
+!- iim      : | These three variables give the size of the variables
+!- jjm      : | to be read. It will be verified that the variables
+!- llm      : | fits in there.
+!- ttm      : |
+!- itau_dep : Time step at which we will start to read
+!- itau_fin : Time step until which we are going to read
+!-           For the moment this is done on indeces but it should be
+!-           in the physical space
+!-           If there is no time-axis in the file then use a
+!-           itau_fin < itau_dep, this will tell flinget not to
+!-           expect a time-axis in the file.
+!-
+!- OUTPUT
+!-
+!- var      : scalar that will contain the data
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin
+  REAL :: var
+!-
+! LOCAL
+!-
+  INTEGER :: iret, fid
+!-
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) THEN
+    WRITE (*,*) 'flinget_scal in file with id ',fid_in
+  ENDIF
+!-
+  fid = ncids(fid_in)
+!-
+! 1.0 Reading a global attribute
+!-
+  iret = NF90_GET_ATT (fid, NF90_GLOBAL, varname, var)
+!---------------------------
+END  SUBROUTINE flinget_scal
+!-
+!===
+!-
+SUBROUTINE flinfindcood (fid_in, axtype, vid, ndim)
+!---------------------------------------------------------------------
+!- This subroutine explores the file in order to find
+!- the coordinate according to a number of rules
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  INTEGER :: fid_in, vid, ndim
+  CHARACTER(LEN=3) :: axtype
+!-
+! LOCAL
+!-
+  INTEGER :: iv, iret, dimnb
+  CHARACTER(LEN=40) :: dimname, dimuni1, dimuni2, dimuni3
+  CHARACTER(LEN=80) :: str1
+  LOGICAL :: found_rule = .FALSE.
+!---------------------------------------------------------------------
+  vid = -1
+!-
+! Make sure all strings are invalid
+!-
+  dimname = '?-?'
+  dimuni1 = '?-?'
+  dimuni2 = '?-?'
+  dimuni3 = '?-?'
+!-
+! First rule : we look for the correct units
+! lon : east
+! lat : north
+! We make an exact check as it would be too easy to mistake
+! some units by just comparing the substrings.
+!-
+  SELECTCASE(axtype)
+  CASE ('lon')
+    dimuni1 = 'degree_e'
+    dimuni2 = 'degrees_e'
+    found_rule = .TRUE.
+  CASE('lat')
+    dimuni1 = 'degree_n'
+    dimuni2 = 'degrees_n'
+    found_rule = .TRUE.
+  CASE('lev')
+    dimuni1 = 'm'
+    dimuni2 = 'km'
+    dimuni3 = 'hpa'
+    found_rule = .TRUE.
+  CASE DEFAULT
+    found_rule = .FALSE.
+  END SELECT
+!-
+  IF (found_rule) THEN
+    iv = 0
+    DO WHILE ( (vid < 0).AND.(iv < ncnbva(fid_in)) )
+      iv = iv+1
+      str1 = ''
+      iret = NF90_GET_ATT (ncids(fid_in), iv, 'units', str1)
+      IF (iret == NF90_NOERR) THEN
+        CALL strlowercase (str1)
+        IF (    (INDEX(str1, TRIM(dimuni1)) == 1) &
+            .OR.(INDEX(str1, TRIM(dimuni2)) == 1) &
+            .OR.(INDEX(str1, TRIM(dimuni3)) == 1) ) THEN
+          vid = iv
+          iret = NF90_INQUIRE_VARIABLE (ncids(fid_in), iv, ndims=ndim)
+        ENDIF
+      ENDIF
+    ENDDO
+  ENDIF
+!-
+! Second rule : we find specific names :
+! lon : nav_lon
+! lat : nav_lat
+! Here we can check if we find the substring as the
+! names are more specific.
+!-
+  SELECTCASE(axtype)
+  CASE ('lon')
+    dimname = 'nav_lon lon longitude'
+    found_rule = .TRUE.
+  CASE('lat')
+    dimname = 'nav_lat lat latitude'
+    found_rule = .TRUE.
+  CASE('lev')
+    dimname = 'plev level depth deptht'
+    found_rule = .TRUE.
+  CASE DEFAULT
+    found_rule = .FALSE.
+  END SELECT
+!-
+  IF (found_rule) THEN
+    iv = 0
+    DO WHILE ( (vid < 0).AND.(iv < ncnbva(fid_in)) )
+      iv = iv+1
+      str1=''
+      iret = NF90_INQUIRE_VARIABLE (ncids(fid_in), iv, &
+                                    name=str1, ndims=ndim)
+      IF (INDEX(dimname,TRIM(str1)) >= 1) THEN
+        vid = iv
+      ENDIF
+    ENDDO
+  ENDIF
+!-
+! Third rule : we find a variable with the same name as the dimension
+! lon = 1
+! lat = 2
+! lev = 3
+!-
+  IF (vid < 0) THEN
+    SELECTCASE(axtype)
+    CASE ('lon')
+      dimnb = 1
+      found_rule = .TRUE.
+    CASE('lat')
+      dimnb = 2
+      found_rule = .TRUE.
+    CASE('lev')
+      dimnb = 3
+      found_rule = .TRUE.
+    CASE DEFAULT
+      found_rule = .FALSE.
+    END SELECT
+!---
+    IF (found_rule) THEN
+      iret = NF90_INQUIRE_DIMENSION (ncids(fid_in), dimnb, name=dimname)
+      iv = 0
+      DO WHILE ( (vid < 0).AND.(iv < ncnbva(fid_in)) )
+        iv = iv+1
+        str1=''
+        iret = NF90_INQUIRE_VARIABLE (ncids(fid_in), iv, &
+                                      name=str1, ndims=ndim)
+        IF (INDEX(dimname,TRIM(str1)) == 1) THEN
+          vid = iv
+        ENDIF
+      ENDDO
+    ENDIF
+  ENDIF
+!-
+! Stop the program if no coordinate was found
+!-
+  IF (vid < 0) THEN
+    CALL histerr (3,'flinfindcood', &
+           'No coordinate axis was found in the file', &
+           'The data in this file can not be used', axtype)
+  ENDIF
+!--------------------------
+END SUBROUTINE flinfindcood
+!-
+!===
+!-
+SUBROUTINE flinclo (fid_in)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+!-
+  INTEGER :: iret
+!---------------------------------------------------------------------
+  iret = NF90_CLOSE (ncids(fid_in))
+  ncfileopen(fid_in) = .FALSE.
+!---------------------
+END SUBROUTINE flinclo
+!-
+!===
+!-
+SUBROUTINE flinquery_var(fid_in, varname, exists)
+!---------------------------------------------------------------------
+!- Queries the existance of a variable in the file.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) varname
+  LOGICAL :: exists
+!-
+  INTEGER :: iret, fid, vid
+!---------------------------------------------------------------------
+  fid = ncids(fid_in)
+  vid = -1
+  iret = NF90_INQ_VARID (fid, varname, vid)
+!-
+  exists = ( (vid >= 0).AND.(iret == NF90_NOERR) )
+!---------------------------
+END SUBROUTINE flinquery_var
+!-
+!===
+!-
+SUBROUTINE flininspect (fid_in)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! fid : File id to inspect
+!-
+  INTEGER :: fid_in
+!-
+!- LOCAL
+!-
+  INTEGER :: iim, jjm, llm, ttm, fid_out
+  INTEGER :: iret, fid, ndims, nvars, nb_atts, id_unlim
+  INTEGER :: iv, in, lll
+  INTEGER :: xid, yid, zid, tid
+  INTEGER,DIMENSION(NF90_MAX_VAR_DIMS) :: idimid
+  CHARACTER(LEN=80) :: name
+  CHARACTER(LEN=30) :: axname
+!---------------------------------------------------------------------
+  fid = ncids(fid_in)
+!-
+  iret = NF90_INQUIRE (fid, nDimensions=ndims, nVariables=nvars, &
+                       nAttributes=nb_atts, unlimitedDimId=id_unlim)
+!-
+  WRITE (*,*) 'IOIPSL ID                   : ',fid_in
+  WRITE (*,*) 'NetCDF ID                   : ',fid
+  WRITE (*,*) 'Number of dimensions        : ',ndims
+  WRITE (*,*) 'Number of variables         : ',nvars
+  WRITE (*,*) 'Number of global attributes : ',nb_atts
+  WRITE (*,*) 'ID unlimited                : ',id_unlim
+!-
+  xid = -1; iim = 0;
+  yid = -1; jjm = 0;
+  zid = -1; llm = 0;
+  tid = -1; ttm = 0;
+!-
+  DO iv=1,ndims
+!---
+    iret = NF90_INQUIRE_DIMENSION (fid, iv, name=axname, len=lll)
+    CALL strlowercase (axname)
+    axname = ADJUSTL(axname)
+!---
+    WRITE (*,*) 'Dimension number : ',iv
+    WRITE (*,*) 'Dimension name   : ',TRIM(axname)
+!---
+    IF      (    (INDEX(axname,'x') == 1) &
+             .OR.(INDEX(axname,'lon') == 1)) THEN
+      xid = iv; iim = lll;
+      WRITE (*,*) 'Dimension X size   : ',iim
+    ELSE IF (    (INDEX(axname,'y') == 1) &
+             .OR.(INDEX(axname,'lat') == 1)) THEN
+      yid = iv; jjm = lll;
+      WRITE (*,*) 'Dimension Y size   : ',jjm
+    ELSE IF (    (INDEX(axname,'lev') == 1) &
+             .OR.(INDEX(axname,'plev') == 1) &
+             .OR.(INDEX(axname,'z') == 1) &
+             .OR.(INDEX(axname,'depth') == 1)) THEN
+      zid = iv; llm = lll;
+      WRITE (*,*) 'Dimension Z size   : ',llm
+    ELSE IF (    (INDEX(axname,'tstep') == 1) &
+             .OR.(INDEX(axname,'time_counter') == 1)) THEN
+!---- For the time we certainly need to allow for other names
+      tid = iv; ttm = lll;
+    ELSE IF (ndims == 1) THEN
+!---- Nothing was found and ndims=1 then we have a vector of data
+      xid = 1; iim = lll;
+    ENDIF
+!---
+  ENDDO
+!-
+! Keep all this information
+!-
+  nbfiles = nbfiles+1
+!-
+  IF (nbfiles > nbfile_max) THEN
+    CALL histerr(3,'flininspect', &
+      'Too many files. Please increase nbfil_max', &
+      'in program flincom.F90.',' ')
+  ENDIF
+!-
+  ncids(nbfiles) = fid
+  ncnbd(nbfiles) = ndims
+!-
+  ncdims(nbfiles,1:4) = (/ iim, jjm, llm, ttm /)
+!-
+  ncfunli(nbfiles) = id_unlim
+  ncnba(nbfiles)   = nb_atts
+  ncnbva(nbfiles)  = nvars
+  ncfileopen(nbfiles) = .TRUE.
+!-
+  fid_out = nbfiles
+!-
+  DO in=1,nvars
+    iret = NF90_INQUIRE_VARIABLE (fid, in, &
+             name=name, ndims=ndims, dimids=idimid, nAtts=nb_atts)
+    WRITE (*,*) 'Variable number  ------------ > ', in
+    WRITE (*,*) 'Variable name        : ', TRIM(name)
+    WRITE (*,*) 'Number of dimensions : ', ndims
+    WRITE (*,*) 'Dimensions ID''s     : ', idimid(1:ndims)
+    WRITE (*,*) 'Number of attributes : ', nb_atts
+  ENDDO
+!-------------------------
+END SUBROUTINE flininspect
+!-
+!===
+!-
+!$AGRIF_END_DO_NOT_TREAT
+END MODULE flincom
Index: utils/tools/DOMAINcfg/src/fliocom.f90
===================================================================
--- utils/tools/DOMAINcfg/src/fliocom.f90	(revision 14623)
+++ utils/tools/DOMAINcfg/src/fliocom.f90	(revision 14623)
@@ -0,0 +1,5175 @@
+MODULE fliocom
+!$AGRIF_DO_NOT_TREAT
+!-
+!$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
+!-
+!===
+!-
+!$AGRIF_END_DO_NOT_TREAT
+END MODULE fliocom
Index: utils/tools/DOMAINcfg/src/getincom.f90
===================================================================
--- utils/tools/DOMAINcfg/src/getincom.f90	(revision 14623)
+++ utils/tools/DOMAINcfg/src/getincom.f90	(revision 14623)
@@ -0,0 +1,2010 @@
+MODULE getincom
+!$AGRIF_DO_NOT_TREAT
+!-
+!$Id: getincom.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, ONLY : ipslerr
+USE stringop, &
+ &   ONLY : nocomma,cmpblank,strlowercase
+!-
+IMPLICIT NONE
+!-
+PRIVATE
+PUBLIC :: getin_name, getin, getin_dump
+!-
+!!--------------------------------------------------------------------
+!! The "getin_name" routine allows the user to change the name
+!! of the definition file in which the data will be read.
+!! ("run.def" by default)
+!!
+!!  SUBROUTINE getin_name (file_name)
+!!
+!! OPTIONAL INPUT argument
+!!
+!! (C) file_name :  the name of the file
+!!                  in which the data will be read
+!!--------------------------------------------------------------------
+!-
+!-
+INTERFACE getin
+!!--------------------------------------------------------------------
+!! The "getin" routines get a variable.
+!! We first check if we find it in the database
+!! and if not we get it from the definition file.
+!!
+!! SUBROUTINE getin (target,ret_val)
+!!
+!! INPUT
+!!
+!! (C) target : Name of the variable
+!!
+!! OUTPUT
+!!
+!! (I/R/C/L) ret_val : scalar, vector or matrix that will contain
+!!                     that will contain the (standard)
+!!                     integer/real/character/logical values
+!!--------------------------------------------------------------------
+  MODULE PROCEDURE getinrs, getinr1d, getinr2d, &
+ &                 getinis, getini1d, getini2d, &
+ &                 getincs, getinc1d, getinc2d, &
+ &                 getinls, getinl1d, getinl2d
+END INTERFACE
+!-
+!!--------------------------------------------------------------------
+!! The "getin_dump" routine will dump the content of the database
+!! into a file which has the same format as the definition file.
+!! The idea is that the user can see which parameters were used
+!! and re-use the file for another run.
+!!
+!!  SUBROUTINE getin_dump (fileprefix)
+!!
+!! OPTIONAL INPUT argument
+!!
+!! (C) fileprefix : allows the user to change the name of the file
+!!                  in which the data will be archived
+!!--------------------------------------------------------------------
+!-
+  INTEGER,PARAMETER :: max_files=100
+  CHARACTER(LEN=100),DIMENSION(max_files),SAVE :: filelist
+  INTEGER,SAVE      :: nbfiles
+!-
+  INTEGER,SAVE :: allread=0
+  CHARACTER(LEN=100),SAVE :: def_file = 'run.def'
+!-
+  INTEGER,PARAMETER :: i_txtslab=1000,l_n=30
+  INTEGER,SAVE :: nb_lines,i_txtsize=0
+  CHARACTER(LEN=100),SAVE,ALLOCATABLE,DIMENSION(:) :: fichier
+  CHARACTER(LEN=l_n),SAVE,ALLOCATABLE,DIMENSION(:) :: targetlist
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: fromfile,compline
+!-
+  INTEGER,PARAMETER :: n_d_fmt=5,max_msgs=15
+  CHARACTER(LEN=6),SAVE :: c_i_fmt = '(I5.5)'
+!-
+! The data base of parameters
+!-
+  INTEGER,PARAMETER :: memslabs=200
+  INTEGER,PARAMETER :: compress_lim=20
+!-
+  INTEGER,SAVE :: nb_keys=0
+  INTEGER,SAVE :: keymemsize=0
+!-
+! keystr definition
+! name of a key
+!-
+! keystatus definition
+! keystatus = 1 : Value comes from the file defined by 'def_file'
+! keystatus = 2 : Default value is used
+! keystatus = 3 : Some vector elements were taken from default
+!-
+! keytype definition
+! keytype = 1 : Integer
+! keytype = 2 : Real
+! keytype = 3 : Character
+! keytype = 4 : Logical
+!-
+  INTEGER,PARAMETER :: k_i=1, k_r=2, k_c=3, k_l=4
+!-
+! Allow compression for keys (only for integer and real)
+! keycompress < 0 : not compressed
+! keycompress > 0 : number of repeat of the value
+!-
+TYPE :: t_key
+  CHARACTER(LEN=l_n) :: keystr
+  INTEGER :: keystatus, keytype, keycompress, &
+ &           keyfromfile, keymemstart, keymemlen
+END TYPE t_key
+!-
+  TYPE(t_key),SAVE,ALLOCATABLE,DIMENSION(:) :: key_tab
+!-
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: i_mem
+  INTEGER,SAVE :: i_memsize=0, i_mempos=0
+  REAL,SAVE,ALLOCATABLE,DIMENSION(:) :: r_mem
+  INTEGER,SAVE :: r_memsize=0, r_mempos=0
+  CHARACTER(LEN=100),SAVE,ALLOCATABLE,DIMENSION(:) :: c_mem
+  INTEGER,SAVE :: c_memsize=0, c_mempos=0
+  LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:) :: l_mem
+  INTEGER,SAVE :: l_memsize=0, l_mempos=0
+!-
+CONTAINS
+!-
+!=== DEFINITION FILE NAME INTERFACE
+!-
+SUBROUTINE getin_name (cname)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: cname
+!---------------------------------------------------------------------
+  IF (allread == 0) THEN
+    def_file = ADJUSTL(cname)
+  ELSE
+    CALL ipslerr (3,'getin_name', &
+ &   'The name of the database file (any_name.def)', &
+ &   'must be changed *before* any attempt','to read the database.')
+  ENDIF
+!------------------------
+END SUBROUTINE getin_name
+!-
+!=== INTEGER INTERFACE
+!-
+SUBROUTINE getinis (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER :: ret_val
+!-
+  INTEGER,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,i_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinis
+!===
+SUBROUTINE getini1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:) :: ret_val
+!-
+  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,i_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getini1d
+!===
+SUBROUTINE getini2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:,:) :: ret_val
+!-
+  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,i_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getini2d
+!-
+!=== REAL INTERFACE
+!-
+SUBROUTINE getinrs (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL :: ret_val
+!-
+  REAL,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,r_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinrs
+!===
+SUBROUTINE getinr1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL,DIMENSION(:) :: ret_val
+!-
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,r_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinr1d
+!===
+SUBROUTINE getinr2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL,DIMENSION(:,:) :: ret_val
+!-
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,r_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinr2d
+!-
+!=== CHARACTER INTERFACE
+!-
+SUBROUTINE getincs (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,c_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getincs
+!===
+SUBROUTINE getinc1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*),DIMENSION(:) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,c_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinc1d
+!===
+SUBROUTINE getinc2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*),DIMENSION(:,:) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,c_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinc2d
+!-
+!=== LOGICAL INTERFACE
+!-
+SUBROUTINE getinls (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL :: ret_val
+!-
+  LOGICAL,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,l_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinls
+!===
+SUBROUTINE getinl1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL,DIMENSION(:) :: ret_val
+!-
+  LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,l_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinl1d
+!===
+SUBROUTINE getinl2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL,DIMENSION(:,:) :: ret_val
+!-
+  LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,l_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinl2d
+!-
+!=== Generic file/database INTERFACE
+!-
+SUBROUTINE get_fil (target,status,fileorig,i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Subroutine that will extract from the file the values
+!- attributed to the keyword target
+!-
+!- (C) target    : target for which we will look in the file
+!- (I) status    : tells us from where we obtained the data
+!- (I) fileorig  : index of the file from which the key comes
+!- (I) i_val(:)  : INTEGER(nb_to_ret)   values
+!- (R) r_val(:)  : REAL(nb_to_ret)      values
+!- (L) l_val(:)  : LOGICAL(nb_to_ret)   values
+!- (C) c_val(:)  : CHARACTER(nb_to_ret) values
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,INTENT(OUT) :: status,fileorig
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ,nb_to_ret,it,pos,len_str,status_cnt,io_err
+  CHARACTER(LEN=n_d_fmt)  :: cnt
+  CHARACTER(LEN=80) :: str_READ,str_READ_lower
+  CHARACTER(LEN=9)  :: c_vtyp
+  LOGICAL,DIMENSION(:),ALLOCATABLE :: found
+  LOGICAL :: def_beha,compressed
+  CHARACTER(LEN=10) :: c_fmt
+  INTEGER :: i_cmpval
+  REAL    :: r_cmpval
+  INTEGER :: ipos_tr,ipos_fl
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    nb_to_ret = SIZE(i_val)
+  CASE(k_r)
+    nb_to_ret = SIZE(r_val)
+  CASE(k_c)
+    nb_to_ret = SIZE(c_val)
+  CASE(k_l)
+    nb_to_ret = SIZE(l_val)
+  CASE DEFAULT
+    CALL ipslerr (3,'get_fil', &
+ &   'Internal error','Unknown type of data',' ')
+  END SELECT
+!-
+! Read the file(s)
+  CALL getin_read
+!-
+! Allocate and initialize the memory we need
+  ALLOCATE(found(nb_to_ret))
+  found(:) = .FALSE.
+!-
+! See what we find in the files read
+  DO it=1,nb_to_ret
+!---
+!-- First try the target as it is
+    CALL get_findkey (2,target,pos)
+!---
+!-- Another try
+!---
+    IF (pos < 0) THEN
+      WRITE(UNIT=cnt,FMT=c_i_fmt) it
+      CALL get_findkey (2,TRIM(target)//'__'//cnt,pos)
+    ENDIF
+!---
+!-- We dont know from which file the target could come.
+!-- Thus by default we attribute it to the first file :
+    fileorig = 1
+!---
+    IF (pos > 0) THEN
+!-----
+      found(it) = .TRUE.
+      fileorig = fromfile(pos)
+!-----
+!---- DECODE
+!-----
+      str_READ = ADJUSTL(fichier(pos))
+      str_READ_lower = str_READ
+      CALL strlowercase (str_READ_lower)
+!-----
+      IF (    (TRIM(str_READ_lower) == 'def')     &
+ &        .OR.(TRIM(str_READ_lower) == 'default') ) THEN
+        def_beha = .TRUE.
+      ELSE
+        def_beha = .FALSE.
+        len_str = LEN_TRIM(str_READ)
+        io_err = 0
+        SELECT CASE (k_typ)
+        CASE(k_i)
+          WRITE (UNIT=c_fmt,FMT='("(I",I3.3,")")') len_str
+          READ (UNIT=str_READ(1:len_str), &
+ &              FMT=c_fmt,IOSTAT=io_err) i_val(it)
+        CASE(k_r)
+          READ (UNIT=str_READ(1:len_str), &
+ &              FMT=*,IOSTAT=io_err) r_val(it)
+        CASE(k_c)
+          c_val(it) = str_READ(1:len_str)
+        CASE(k_l)
+          ipos_tr = -1
+          ipos_fl = -1
+          ipos_tr = MAX(INDEX(str_READ_lower,'tru'), &
+ &                      INDEX(str_READ_lower,'y'))
+          ipos_fl = MAX(INDEX(str_READ_lower,'fal'), &
+ &                      INDEX(str_READ_lower,'n'))
+          IF (ipos_tr > 0) THEN
+            l_val(it) = .TRUE.
+          ELSE IF (ipos_fl > 0) THEN
+            l_val(it) = .FALSE.
+          ELSE
+            io_err = 100
+          ENDIF
+        END SELECT
+        IF (io_err /= 0) THEN
+          CALL ipslerr (3,'get_fil', &
+ &         'Target '//TRIM(target), &
+ &         'is not of '//TRIM(c_vtyp)//' type',' ')
+        ENDIF
+      ENDIF
+!-----
+      IF ( (k_typ == k_i).OR.(k_typ == k_r) ) THEN
+!-------
+!------ Is this the value of a compressed field ?
+        compressed = (compline(pos) > 0)
+        IF (compressed) THEN
+          IF (compline(pos) /= nb_to_ret) THEN
+            CALL ipslerr (2,'get_fil', &
+ &           'For key '//TRIM(target)//' we have a compressed field', &
+ &           'which does not have the right size.', &
+ &           'We will try to fix that.')
+          ENDIF
+          IF      (k_typ == k_i) THEN
+            i_cmpval = i_val(it)
+          ELSE IF (k_typ == k_r) THEN
+            r_cmpval = r_val(it)
+          ENDIF
+        ENDIF
+      ENDIF
+    ELSE
+      found(it) = .FALSE.
+      def_beha = .FALSE.
+      compressed = .FALSE.
+    ENDIF
+  ENDDO
+!-
+  IF ( (k_typ == k_i).OR.(k_typ == k_r) ) THEN
+!---
+!-- If this is a compressed field then we will uncompress it
+    IF (compressed) THEN
+      DO it=1,nb_to_ret
+        IF (.NOT.found(it)) THEN
+          IF      (k_typ == k_i) THEN
+            i_val(it) = i_cmpval
+          ELSE IF (k_typ == k_r) THEN
+          ENDIF
+          found(it) = .TRUE.
+        ENDIF
+      ENDDO
+    ENDIF
+  ENDIF
+!-
+! Now we set the status for what we found
+  IF (def_beha) THEN
+    status = 2
+    WRITE(*,*) 'USING DEFAULT BEHAVIOUR FOR ',TRIM(target)
+  ELSE
+    status_cnt = 0
+    DO it=1,nb_to_ret
+      IF (.NOT.found(it)) THEN
+        status_cnt = status_cnt+1
+        IF      (status_cnt <= max_msgs) THEN
+          WRITE (UNIT=*,FMT='(" USING DEFAULTS : ",A)', &
+ &               ADVANCE='NO') TRIM(target)
+          IF (nb_to_ret > 1) THEN
+            WRITE (UNIT=*,FMT='("__")',ADVANCE='NO')
+            WRITE (UNIT=*,FMT=c_i_fmt,ADVANCE='NO') it
+          ENDIF
+          SELECT CASE (k_typ)
+          CASE(k_i)
+            WRITE (UNIT=*,FMT=*) "=",i_val(it)
+          CASE(k_r)
+            WRITE (UNIT=*,FMT=*) "=",r_val(it)
+          CASE(k_c)
+            WRITE (UNIT=*,FMT=*) "=",c_val(it)
+          CASE(k_l)
+            WRITE (UNIT=*,FMT=*) "=",l_val(it)
+          END SELECT
+        ELSE IF (status_cnt == max_msgs+1) THEN
+          WRITE (UNIT=*,FMT='(" USING DEFAULTS ... ",A)')
+        ENDIF
+      ENDIF
+    ENDDO
+!---
+    IF (status_cnt == 0) THEN
+      status = 1
+    ELSE IF (status_cnt == nb_to_ret) THEN
+      status = 2
+    ELSE
+      status = 3
+    ENDIF
+  ENDIF
+! Deallocate the memory
+  DEALLOCATE(found)
+!---------------------
+END SUBROUTINE get_fil
+!===
+SUBROUTINE get_rdb (pos,size_of_in,target,i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Read the required variable in the database
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: pos,size_of_in
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ,k_beg,k_end
+  CHARACTER(LEN=9) :: c_vtyp
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  IF (     (k_typ /= k_i).AND.(k_typ /= k_r) &
+ &    .AND.(k_typ /= k_c).AND.(k_typ /= k_l) )THEN
+    CALL ipslerr (3,'get_rdb', &
+ &   'Internal error','Unknown type of data',' ')
+  ENDIF
+!-
+  IF (key_tab(pos)%keytype /= k_typ) THEN
+    CALL ipslerr (3,'get_rdb', &
+ &   'Wrong data type for keyword '//TRIM(target), &
+ &   '(NOT '//TRIM(c_vtyp)//')',' ')
+  ENDIF
+!-
+  IF (key_tab(pos)%keycompress > 0) THEN
+    IF (    (key_tab(pos)%keycompress /= size_of_in) &
+ &      .OR.(key_tab(pos)%keymemlen /= 1) ) THEN
+      CALL ipslerr (3,'get_rdb', &
+ &     'Wrong compression length','for keyword '//TRIM(target),' ')
+    ELSE
+      SELECT CASE (k_typ)
+      CASE(k_i)
+        i_val(1:size_of_in) = i_mem(key_tab(pos)%keymemstart)
+      CASE(k_r)
+        r_val(1:size_of_in) = r_mem(key_tab(pos)%keymemstart)
+      END SELECT
+    ENDIF
+  ELSE
+    IF (key_tab(pos)%keymemlen /= size_of_in) THEN
+      CALL ipslerr (3,'get_rdb', &
+ &     'Wrong array length','for keyword '//TRIM(target),' ')
+    ELSE
+      k_beg = key_tab(pos)%keymemstart
+      k_end = k_beg+key_tab(pos)%keymemlen-1
+      SELECT CASE (k_typ)
+      CASE(k_i)
+        i_val(1:size_of_in) = i_mem(k_beg:k_end)
+      CASE(k_r)
+        r_val(1:size_of_in) = r_mem(k_beg:k_end)
+      CASE(k_c)
+        c_val(1:size_of_in) = c_mem(k_beg:k_end)
+      CASE(k_l)
+        l_val(1:size_of_in) = l_mem(k_beg:k_end)
+      END SELECT
+    ENDIF
+  ENDIF
+!---------------------
+END SUBROUTINE get_rdb
+!===
+SUBROUTINE get_wdb &
+ &  (target,status,fileorig,size_of_in, &
+ &   i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Write data into the data base
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER :: status,fileorig,size_of_in
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ
+  CHARACTER(LEN=9) :: c_vtyp
+  INTEGER :: k_mempos,k_memsize,k_beg,k_end
+  LOGICAL :: l_cmp
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  IF (     (k_typ /= k_i).AND.(k_typ /= k_r) &
+ &    .AND.(k_typ /= k_c).AND.(k_typ /= k_l) )THEN
+    CALL ipslerr (3,'get_wdb', &
+ &   'Internal error','Unknown type of data',' ')
+  ENDIF
+!-
+! First check if we have sufficiant space for the new key
+  IF (nb_keys+1 > keymemsize) THEN
+    CALL getin_allockeys ()
+  ENDIF
+!-
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    k_mempos = i_mempos; k_memsize = i_memsize;
+    l_cmp = (MINVAL(i_val) == MAXVAL(i_val)) &
+ &         .AND.(size_of_in > compress_lim)
+  CASE(k_r)
+    k_mempos = r_mempos; k_memsize = r_memsize;
+    l_cmp = (MINVAL(r_val) == MAXVAL(r_val)) &
+ &         .AND.(size_of_in > compress_lim)
+  CASE(k_c)
+    k_mempos = c_mempos; k_memsize = c_memsize;
+    l_cmp = .FALSE.
+  CASE(k_l)
+    k_mempos = l_mempos; k_memsize = l_memsize;
+    l_cmp = .FALSE.
+  END SELECT
+!-
+! Fill out the items of the data base
+  nb_keys = nb_keys+1
+  key_tab(nb_keys)%keystr = target(1:MIN(LEN_TRIM(target),l_n))
+  key_tab(nb_keys)%keystatus = status
+  key_tab(nb_keys)%keytype = k_typ
+  key_tab(nb_keys)%keyfromfile = fileorig
+  key_tab(nb_keys)%keymemstart = k_mempos+1
+  IF (l_cmp) THEN
+    key_tab(nb_keys)%keycompress = size_of_in
+    key_tab(nb_keys)%keymemlen = 1
+  ELSE
+    key_tab(nb_keys)%keycompress = -1
+    key_tab(nb_keys)%keymemlen = size_of_in
+  ENDIF
+!-
+! Before writing the actual size lets see if we have the space
+  IF (key_tab(nb_keys)%keymemstart+key_tab(nb_keys)%keymemlen &
+ &    > k_memsize) THEN
+    CALL getin_allocmem (k_typ,key_tab(nb_keys)%keymemlen)
+  ENDIF
+!-
+  k_beg = key_tab(nb_keys)%keymemstart
+  k_end = k_beg+key_tab(nb_keys)%keymemlen-1
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    i_mem(k_beg:k_end) = i_val(1:key_tab(nb_keys)%keymemlen)
+    i_mempos = k_end
+  CASE(k_r)
+    r_mem(k_beg:k_end) = r_val(1:key_tab(nb_keys)%keymemlen)
+    r_mempos = k_end
+  CASE(k_c)
+    c_mem(k_beg:k_end) = c_val(1:key_tab(nb_keys)%keymemlen)
+    c_mempos = k_end
+  CASE(k_l)
+    l_mem(k_beg:k_end) = l_val(1:key_tab(nb_keys)%keymemlen)
+    l_mempos = k_end
+  END SELECT
+!---------------------
+END SUBROUTINE get_wdb
+!-
+!===
+!-
+SUBROUTINE getin_read
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,SAVE :: current
+!---------------------------------------------------------------------
+  IF (allread == 0) THEN
+!-- Allocate a first set of memory.
+    CALL getin_alloctxt ()
+    CALL getin_allockeys ()
+    CALL getin_allocmem (k_i,0)
+    CALL getin_allocmem (k_r,0)
+    CALL getin_allocmem (k_c,0)
+    CALL getin_allocmem (k_l,0)
+!-- Start with reading the files
+    nbfiles = 1
+    filelist(1) = TRIM(def_file)
+    current = 1
+!--
+    DO WHILE (current <= nbfiles)
+      CALL getin_readdef (current)
+      current = current+1
+    ENDDO
+    allread = 1
+    CALL getin_checkcohe ()
+  ENDIF
+!------------------------
+END SUBROUTINE getin_read
+!-
+!===
+!-
+  SUBROUTINE getin_readdef(current)
+!---------------------------------------------------------------------
+!- This subroutine will read the files and only keep the
+!- the relevant information. The information is kept as it
+!- found in the file. The data will be analysed later.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: current
+!-
+  CHARACTER(LEN=100) :: READ_str,NEW_str,last_key,key_str
+  CHARACTER(LEN=n_d_fmt) :: cnt
+  CHARACTER(LEN=10) :: c_fmt
+  INTEGER :: nb_lastkey
+!-
+  INTEGER :: eof,ptn,len_str,i,it,iund,io_err
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  eof = 0
+  ptn = 1
+  nb_lastkey = 0
+!-
+  IF (check) THEN
+    WRITE(*,*) 'getin_readdef : Open file ',TRIM(filelist(current))
+  ENDIF
+!-
+  OPEN (UNIT=22,FILE=filelist(current),STATUS="OLD",IOSTAT=io_err)
+  IF (io_err /= 0) THEN
+    CALL ipslerr (2,'getin_readdef', &
+ &  'Could not open file '//TRIM(filelist(current)),' ',' ')
+    RETURN
+  ENDIF
+!-
+  DO WHILE (eof /= 1)
+!---
+    CALL getin_skipafew (22,READ_str,eof,nb_lastkey)
+    len_str = LEN_TRIM(READ_str)
+    ptn = INDEX(READ_str,'=')
+!---
+    IF (ptn > 0) THEN
+!---- Get the target
+      key_str = TRIM(ADJUSTL(READ_str(1:ptn-1)))
+!---- Make sure that a vector keyword has the right length
+      iund = INDEX(key_str,'__')
+      IF (iund > 0) THEN
+        WRITE (UNIT=c_fmt,FMT='("(I",I3.3,")")') &
+ &        LEN_TRIM(key_str)-iund-1
+        READ(UNIT=key_str(iund+2:LEN_TRIM(key_str)), &
+ &           FMT=c_fmt,IOSTAT=io_err) it
+        IF ( (io_err == 0).AND.(it > 0) ) THEN
+          WRITE(UNIT=cnt,FMT=c_i_fmt) it
+          key_str = key_str(1:iund+1)//cnt
+        ELSE
+          CALL ipslerr (3,'getin_readdef', &
+ &         'A very strange key has just been found :', &
+ &         TRIM(key_str),' ')
+        ENDIF
+      ENDIF
+!---- Prepare the content
+      NEW_str = TRIM(ADJUSTL(READ_str(ptn+1:len_str)))
+      CALL nocomma (NEW_str)
+      CALL cmpblank (NEW_str)
+      NEW_str  = TRIM(ADJUSTL(NEW_str))
+      IF (check) THEN
+        WRITE(*,*) &
+ &        '--> getin_readdef : ',TRIM(key_str),' :: ',TRIM(NEW_str)
+      ENDIF
+!---- Decypher the content of NEW_str
+!-
+!---- This has to be a new key word, thus :
+      nb_lastkey = 0
+!----
+      CALL getin_decrypt (current,key_str,NEW_str,last_key,nb_lastkey)
+!----
+    ELSE IF (len_str > 0) THEN
+!---- Prepare the key if we have an old one to which
+!---- we will add the line just read
+      IF (nb_lastkey > 0) THEN
+        iund =  INDEX(last_key,'__')
+        IF (iund > 0) THEN
+!-------- We only continue a keyword, thus it is easy
+          key_str = last_key(1:iund-1)
+        ELSE
+          IF (nb_lastkey /= 1) THEN
+            CALL ipslerr (3,'getin_readdef', &
+ &           'We can not have a scalar keyword', &
+ &           'and a vector content',' ')
+          ENDIF
+!-------- The last keyword needs to be transformed into a vector.
+          WRITE(UNIT=cnt,FMT=c_i_fmt) 1
+          targetlist(nb_lines) = &
+ &         last_key(1:MIN(LEN_TRIM(last_key),l_n-n_d_fmt-2))//'__'//cnt
+          key_str = last_key(1:LEN_TRIM(last_key))
+        ENDIF
+      ENDIF
+!---- Prepare the content
+      NEW_str = TRIM(ADJUSTL(READ_str(1:len_str)))
+      CALL getin_decrypt (current,key_str,NEW_str,last_key,nb_lastkey)
+    ELSE
+!---- If we have an empty line then the keyword finishes
+      nb_lastkey = 0
+      IF (check) THEN
+        WRITE(*,*) 'getin_readdef : Have found an emtpy line '
+      ENDIF
+    ENDIF
+  ENDDO
+!-
+  CLOSE(UNIT=22)
+!-
+  IF (check) THEN
+    OPEN (UNIT=22,file=TRIM(def_file)//'.test')
+    DO i=1,nb_lines
+      WRITE(UNIT=22,FMT=*) targetlist(i)," : ",fichier(i)
+    ENDDO
+    CLOSE(UNIT=22)
+  ENDIF
+!---------------------------
+END SUBROUTINE getin_readdef
+!-
+!===
+!-
+SUBROUTINE getin_decrypt(current,key_str,NEW_str,last_key,nb_lastkey)
+!---------------------------------------------------------------------
+!- This subroutine is going to decypher the line.
+!- It essentialy checks how many items are included and
+!- it they can be attached to a key.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  INTEGER :: current,nb_lastkey
+  CHARACTER(LEN=*) :: key_str,NEW_str,last_key
+!-
+! LOCAL
+!-
+  INTEGER :: len_str,blk,nbve,starpos
+  CHARACTER(LEN=100) :: tmp_str,new_key,mult
+  CHARACTER(LEN=n_d_fmt) :: cnt
+  CHARACTER(LEN=10) :: c_fmt
+!---------------------------------------------------------------------
+  len_str = LEN_TRIM(NEW_str)
+  blk = INDEX(NEW_str(1:len_str),' ')
+  tmp_str = NEW_str(1:len_str)
+!-
+! If the key is a new file then we take it up. Else
+! we save the line and go on.
+!-
+  IF (INDEX(key_str,'INCLUDEDEF') > 0) THEN
+    DO WHILE (blk > 0)
+      IF (nbfiles+1 > max_files) THEN
+        CALL ipslerr (3,'getin_decrypt', &
+ &       'Too many files to include',' ',' ')
+      ENDIF
+!-----
+      nbfiles = nbfiles+1
+      filelist(nbfiles) = tmp_str(1:blk)
+!-----
+      tmp_str = TRIM(ADJUSTL(tmp_str(blk+1:LEN_TRIM(tmp_str))))
+      blk = INDEX(tmp_str(1:LEN_TRIM(tmp_str)),' ')
+    ENDDO
+!---
+    IF (nbfiles+1 > max_files) THEN
+      CALL ipslerr (3,'getin_decrypt', &
+ &     'Too many files to include',' ',' ')
+    ENDIF
+!---
+    nbfiles =  nbfiles+1
+    filelist(nbfiles) = TRIM(ADJUSTL(tmp_str))
+!---
+    last_key = 'INCLUDEDEF'
+    nb_lastkey = 1
+  ELSE
+!-
+!-- We are working on a new line of input
+!-
+    IF (nb_lines+1 > i_txtsize) THEN
+      CALL getin_alloctxt ()
+    ENDIF
+    nb_lines = nb_lines+1
+!-
+!-- First we solve the issue of conpressed information. Once
+!-- this is done all line can be handled in the same way.
+!-
+    starpos = INDEX(NEW_str(1:len_str),'*')
+    IF ( (starpos > 0).AND.(tmp_str(1:1) /= '"') &
+ &                    .AND.(tmp_str(1:1) /= "'") ) THEN
+!-----
+      IF (INDEX(key_str(1:LEN_TRIM(key_str)),'__') > 0) THEN
+        CALL ipslerr (3,'getin_decrypt', &
+ &       'We can not have a compressed field of values', &
+ &       'in a vector notation (TARGET__n).', &
+ &       'The key at fault : '//TRIM(key_str))
+      ENDIF
+!-
+!---- Read the multiplied
+!-
+      mult = TRIM(ADJUSTL(NEW_str(1:starpos-1)))
+!---- Construct the new string and its parameters
+      NEW_str = TRIM(ADJUSTL(NEW_str(starpos+1:len_str)))
+      len_str = LEN_TRIM(NEW_str)
+      blk = INDEX(NEW_str(1:len_str),' ')
+      IF (blk > 1) THEN
+        CALL ipslerr (2,'getin_decrypt', &
+ &       'This is a strange behavior','you could report',' ')
+      ENDIF
+      WRITE (UNIT=c_fmt,FMT='("(I",I5.5,")")') LEN_TRIM(mult)
+      READ(UNIT=mult,FMT=c_fmt) compline(nb_lines)
+!---
+    ELSE
+      compline(nb_lines) = -1
+    ENDIF
+!-
+!-- If there is no space wthin the line then the target is a scalar
+!-- or the element of a properly written vector.
+!-- (ie of the type TARGET__00001)
+!-
+    IF (    (blk <= 1) &
+ &      .OR.(tmp_str(1:1) == '"') &
+ &      .OR.(tmp_str(1:1) == "'") ) THEN
+!-
+      IF (nb_lastkey == 0) THEN
+!------ Save info of current keyword as a scalar
+!------ if it is not a continuation
+        targetlist(nb_lines) = key_str(1:MIN(LEN_TRIM(key_str),l_n))
+        last_key = key_str(1:MIN(LEN_TRIM(key_str),l_n))
+        nb_lastkey = 1
+      ELSE
+!------ We are continuing a vector so the keyword needs
+!------ to get the underscores
+        WRITE(UNIT=cnt,FMT=c_i_fmt) nb_lastkey+1
+        targetlist(nb_lines) = &
+ &        key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+        last_key = &
+ &        key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+        nb_lastkey = nb_lastkey+1
+      ENDIF
+!-----
+      fichier(nb_lines) = NEW_str(1:len_str)
+      fromfile(nb_lines) = current
+    ELSE
+!-
+!---- If there are blanks whithin the line then we are dealing
+!---- with a vector and we need to split it in many entries
+!---- with the TARGET__n notation.
+!----
+!---- Test if the targer is not already a vector target !
+!-
+      IF (INDEX(TRIM(key_str),'__') > 0) THEN
+        CALL ipslerr (3,'getin_decrypt', &
+ &       'We have found a mixed vector notation (TARGET__n).', &
+ &       'The key at fault : '//TRIM(key_str),' ')
+      ENDIF
+!-
+      nbve = nb_lastkey
+      nbve = nbve+1
+      WRITE(UNIT=cnt,FMT=c_i_fmt) nbve
+!-
+      DO WHILE (blk > 0)
+!-
+!------ Save the content of target__nbve
+!-
+        fichier(nb_lines) = tmp_str(1:blk)
+        new_key = &
+ &       key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+        targetlist(nb_lines) = new_key(1:MIN(LEN_TRIM(new_key),l_n))
+        fromfile(nb_lines) = current
+!-
+        tmp_str = TRIM(ADJUSTL(tmp_str(blk+1:LEN_TRIM(tmp_str))))
+        blk = INDEX(TRIM(tmp_str),' ')
+!-
+        IF (nb_lines+1 > i_txtsize) THEN
+          CALL getin_alloctxt ()
+        ENDIF
+        nb_lines = nb_lines+1
+        nbve = nbve+1
+        WRITE(UNIT=cnt,FMT=c_i_fmt) nbve
+!-
+      ENDDO
+!-
+!---- Save the content of the last target
+!-
+      fichier(nb_lines) = tmp_str(1:LEN_TRIM(tmp_str))
+      new_key = &
+ &      key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+      targetlist(nb_lines) = new_key(1:MIN(LEN_TRIM(new_key),l_n))
+      fromfile(nb_lines) = current
+!-
+      last_key = &
+ &      key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+      nb_lastkey = nbve
+!-
+    ENDIF
+!-
+  ENDIF
+!---------------------------
+END SUBROUTINE getin_decrypt
+!-
+!===
+!-
+SUBROUTINE getin_checkcohe ()
+!---------------------------------------------------------------------
+!- This subroutine checks for redundancies.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: line,n_k,k
+!---------------------------------------------------------------------
+  DO line=1,nb_lines-1
+!-
+    n_k = 0
+    DO k=line+1,nb_lines
+      IF (TRIM(targetlist(line)) == TRIM(targetlist(k))) THEN
+        n_k = k
+        EXIT
+      ENDIF
+    ENDDO
+!---
+!-- IF we have found it we have a problem to solve.
+!---
+    IF (n_k > 0) THEN
+      WRITE(*,*) 'COUNT : ',n_k
+      WRITE(*,*) &
+ &  'getin_checkcohe : Found a problem on key ',TRIM(targetlist(line))
+      WRITE(*,*) &
+ &  'getin_checkcohe : The following values were encoutered :'
+      WRITE(*,*) &
+ &  '                ',TRIM(targetlist(line)),' == ',fichier(line)
+      WRITE(*,*) &
+ &  '                ',TRIM(targetlist(k)),' == ',fichier(k)
+      WRITE(*,*) &
+ &  'getin_checkcohe : We will keep only the last value'
+      targetlist(line) = ' '
+    ENDIF
+  ENDDO
+!-----------------------------
+END SUBROUTINE getin_checkcohe
+!-
+!===
+!-
+SUBROUTINE getin_skipafew (unit,out_string,eof,nb_lastkey)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: unit,eof,nb_lastkey
+  CHARACTER(LEN=100) :: dummy
+  CHARACTER(LEN=100) :: out_string
+  CHARACTER(LEN=1) :: first
+!---------------------------------------------------------------------
+  first="#"
+  eof = 0
+  out_string = "    "
+!-
+  DO WHILE (first == "#")
+    READ (UNIT=unit,FMT='(A)',ERR=9998,END=7778) dummy
+    dummy = TRIM(ADJUSTL(dummy))
+    first=dummy(1:1)
+    IF (first == "#") THEN
+      nb_lastkey = 0
+    ENDIF
+  ENDDO
+  out_string=dummy
+!-
+  RETURN
+!-
+9998 CONTINUE
+  CALL ipslerr (3,'getin_skipafew','Error while reading file',' ',' ')
+!-
+7778 CONTINUE
+  eof = 1
+!----------------------------
+END SUBROUTINE getin_skipafew
+!-
+!===
+!-
+SUBROUTINE getin_allockeys ()
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  TYPE(t_key),ALLOCATABLE,DIMENSION(:) :: tmp_key_tab
+!-
+  INTEGER :: ier
+  CHARACTER(LEN=20) :: c_tmp
+!---------------------------------------------------------------------
+  IF (keymemsize == 0) THEN
+!---
+!-- Nothing exists in memory arrays and it is easy to do.
+!---
+    WRITE (UNIT=c_tmp,FMT=*) memslabs
+    ALLOCATE(key_tab(memslabs),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_allockeys', &
+ &     'Can not allocate key_tab', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+    ENDIF
+    nb_keys = 0
+    keymemsize = memslabs
+    key_tab(:)%keycompress = -1
+!---
+  ELSE
+!---
+!-- There is something already in the memory,
+!-- we need to transfer and reallocate.
+!---
+    WRITE (UNIT=c_tmp,FMT=*) keymemsize
+    ALLOCATE(tmp_key_tab(keymemsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_allockeys', &
+ &     'Can not allocate tmp_key_tab', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+    ENDIF
+    WRITE (UNIT=c_tmp,FMT=*) keymemsize+memslabs
+    tmp_key_tab(1:keymemsize) = key_tab(1:keymemsize)
+    DEALLOCATE(key_tab)
+    ALLOCATE(key_tab(keymemsize+memslabs),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_allockeys', &
+ &     'Can not allocate key_tab', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+    ENDIF
+    key_tab(:)%keycompress = -1
+    key_tab(1:keymemsize) = tmp_key_tab(1:keymemsize)
+    DEALLOCATE(tmp_key_tab)
+    keymemsize = keymemsize+memslabs
+  ENDIF
+!-----------------------------
+END SUBROUTINE getin_allockeys
+!-
+!===
+!-
+SUBROUTINE getin_allocmem (type,len_wanted)
+!---------------------------------------------------------------------
+!- Allocate the memory of the data base for all 4 types of memory
+!- INTEGER / REAL / CHARACTER / LOGICAL
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: type,len_wanted
+!-
+  INTEGER,ALLOCATABLE :: tmp_int(:)
+  REAL,ALLOCATABLE :: tmp_real(:)
+  CHARACTER(LEN=100),ALLOCATABLE :: tmp_char(:)
+  LOGICAL,ALLOCATABLE :: tmp_logic(:)
+  INTEGER :: ier
+  CHARACTER(LEN=20) :: c_tmp
+!---------------------------------------------------------------------
+  SELECT CASE (type)
+  CASE(k_i)
+    IF (i_memsize == 0) THEN
+      ALLOCATE(i_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'i_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      i_memsize=memslabs
+    ELSE
+      ALLOCATE(tmp_int(i_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) i_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_int', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_int(1:i_memsize) = i_mem(1:i_memsize)
+      DEALLOCATE(i_mem)
+      ALLOCATE(i_mem(i_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) i_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'i_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      i_mem(1:i_memsize) = tmp_int(1:i_memsize)
+      i_memsize = i_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_int)
+    ENDIF
+  CASE(k_r)
+    IF (r_memsize == 0) THEN
+      ALLOCATE(r_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'r_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      r_memsize =  memslabs
+    ELSE
+      ALLOCATE(tmp_real(r_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) r_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_real', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_real(1:r_memsize) = r_mem(1:r_memsize)
+      DEALLOCATE(r_mem)
+      ALLOCATE(r_mem(r_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) r_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'r_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      r_mem(1:r_memsize) = tmp_real(1:r_memsize)
+      r_memsize = r_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_real)
+    ENDIF
+  CASE(k_c)
+    IF (c_memsize == 0) THEN
+      ALLOCATE(c_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'c_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      c_memsize = memslabs
+    ELSE
+      ALLOCATE(tmp_char(c_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) c_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_char', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_char(1:c_memsize) = c_mem(1:c_memsize)
+      DEALLOCATE(c_mem)
+      ALLOCATE(c_mem(c_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) c_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'c_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      c_mem(1:c_memsize) = tmp_char(1:c_memsize)
+      c_memsize = c_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_char)
+    ENDIF
+  CASE(k_l)
+    IF (l_memsize == 0) THEN
+      ALLOCATE(l_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'l_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      l_memsize = memslabs
+    ELSE
+      ALLOCATE(tmp_logic(l_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) l_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_logic', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_logic(1:l_memsize) = l_mem(1:l_memsize)
+      DEALLOCATE(l_mem)
+      ALLOCATE(l_mem(l_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) l_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'l_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      l_mem(1:l_memsize) = tmp_logic(1:l_memsize)
+      l_memsize = l_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_logic)
+    ENDIF
+  CASE DEFAULT
+    CALL ipslerr (3,'getin_allocmem','Unknown type of data',' ',' ')
+  END SELECT
+!----------------------------
+END SUBROUTINE getin_allocmem
+!-
+!===
+!-
+SUBROUTINE getin_alloctxt ()
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=100),ALLOCATABLE :: tmp_fic(:)
+  CHARACTER(LEN=l_n),ALLOCATABLE :: tmp_tgl(:)
+  INTEGER,ALLOCATABLE :: tmp_int(:)
+!-
+  INTEGER :: ier
+  CHARACTER(LEN=20) :: c_tmp1,c_tmp2
+!---------------------------------------------------------------------
+  IF (i_txtsize == 0) THEN
+!---
+!-- Nothing exists in memory arrays and it is easy to do.
+!---
+    WRITE (UNIT=c_tmp1,FMT=*) i_txtslab
+    ALLOCATE(fichier(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fichier', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(targetlist(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate targetlist', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(fromfile(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fromfile', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(compline(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate compline', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    nb_lines = 0
+    i_txtsize = i_txtslab
+  ELSE
+!---
+!-- There is something already in the memory,
+!-- we need to transfer and reallocate.
+!---
+    WRITE (UNIT=c_tmp1,FMT=*) i_txtsize
+    WRITE (UNIT=c_tmp2,FMT=*) i_txtsize+i_txtslab
+    ALLOCATE(tmp_fic(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_fic', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_fic(1:i_txtsize) = fichier(1:i_txtsize)
+    DEALLOCATE(fichier)
+    ALLOCATE(fichier(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fichier', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    fichier(1:i_txtsize) = tmp_fic(1:i_txtsize)
+    DEALLOCATE(tmp_fic)
+!---
+    ALLOCATE(tmp_tgl(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_tgl', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_tgl(1:i_txtsize) = targetlist(1:i_txtsize)
+    DEALLOCATE(targetlist)
+    ALLOCATE(targetlist(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate targetlist', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    targetlist(1:i_txtsize) = tmp_tgl(1:i_txtsize)
+    DEALLOCATE(tmp_tgl)
+!---
+    ALLOCATE(tmp_int(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_int', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_int(1:i_txtsize) = fromfile(1:i_txtsize)
+    DEALLOCATE(fromfile)
+    ALLOCATE(fromfile(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fromfile', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    fromfile(1:i_txtsize) = tmp_int(1:i_txtsize)
+!---
+    tmp_int(1:i_txtsize) = compline(1:i_txtsize)
+    DEALLOCATE(compline)
+    ALLOCATE(compline(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate compline', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    compline(1:i_txtsize) = tmp_int(1:i_txtsize)
+    DEALLOCATE(tmp_int)
+!---
+    i_txtsize = i_txtsize+i_txtslab
+  ENDIF
+!----------------------------
+END SUBROUTINE getin_alloctxt
+!-
+!===
+!-
+SUBROUTINE getin_dump (fileprefix)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(*),OPTIONAL :: fileprefix
+!-
+  CHARACTER(LEN=80) :: usedfileprefix
+  INTEGER :: ikey,if,iff,iv
+  CHARACTER(LEN=20) :: c_tmp
+  CHARACTER(LEN=100) :: tmp_str,used_filename
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (PRESENT(fileprefix)) THEN
+    usedfileprefix = fileprefix(1:MIN(LEN_TRIM(fileprefix),80))
+  ELSE
+    usedfileprefix = "used"
+  ENDIF
+!-
+  DO if=1,nbfiles
+!---
+    used_filename = TRIM(usedfileprefix)//'_'//TRIM(filelist(if))
+    IF (check) THEN
+      WRITE(*,*) &
+ &      'GETIN_DUMP : opens file : ',TRIM(used_filename),' if = ',if
+      WRITE(*,*) 'GETIN_DUMP : NUMBER OF KEYS : ',nb_keys
+    ENDIF
+    OPEN (UNIT=22,FILE=used_filename)
+!---
+!-- If this is the first file we need to add the list
+!-- of file which belong to it
+    IF ( (if == 1).AND.(nbfiles > 1) ) THEN
+      WRITE(22,*) '# '
+      WRITE(22,*) '# This file is linked to the following files :'
+      WRITE(22,*) '# '
+      DO iff=2,nbfiles
+        WRITE(22,*) 'INCLUDEDEF = ',TRIM(filelist(iff))
+      ENDDO
+      WRITE(22,*) '# '
+    ENDIF
+!---
+    DO ikey=1,nb_keys
+!-----
+!---- Is this key from this file ?
+      IF (key_tab(ikey)%keyfromfile == if) THEN
+!-------
+!------ Write some comments
+        WRITE(22,*) '#'
+        SELECT CASE (key_tab(ikey)%keystatus)
+        CASE(1)
+          WRITE(22,*) '# Values of ', &
+ &          TRIM(key_tab(ikey)%keystr),' comes from ',TRIM(def_file)
+        CASE(2)
+          WRITE(22,*) '# Values of ', &
+ &          TRIM(key_tab(ikey)%keystr),' are all defaults.'
+        CASE(3)
+          WRITE(22,*) '# Values of ', &
+ &          TRIM(key_tab(ikey)%keystr), &
+ &          ' are a mix of ',TRIM(def_file),' and defaults.'
+        CASE DEFAULT
+          WRITE(22,*) '# Dont know from where the value of ', &
+ &          TRIM(key_tab(ikey)%keystr),' comes.'
+        END SELECT
+        WRITE(22,*) '#'
+!-------
+!------ Write the values
+        SELECT CASE (key_tab(ikey)%keytype)
+        CASE(k_i)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            IF (key_tab(ikey)%keycompress < 0) THEN
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',i_mem(key_tab(ikey)%keymemstart)
+            ELSE
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',key_tab(ikey)%keycompress, &
+ &              ' * ',i_mem(key_tab(ikey)%keymemstart)
+            ENDIF
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              '__',TRIM(ADJUSTL(c_tmp)), &
+ &              ' = ',i_mem(key_tab(ikey)%keymemstart+iv)
+            ENDDO
+          ENDIF
+        CASE(k_r)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            IF (key_tab(ikey)%keycompress < 0) THEN
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',r_mem(key_tab(ikey)%keymemstart)
+            ELSE
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',key_tab(ikey)%keycompress, &
+                   & ' * ',r_mem(key_tab(ikey)%keymemstart)
+            ENDIF
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr),'__',TRIM(ADJUSTL(c_tmp)), &
+ &              ' = ',r_mem(key_tab(ikey)%keymemstart+iv)
+            ENDDO
+          ENDIF
+        CASE(k_c)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            tmp_str = c_mem(key_tab(ikey)%keymemstart)
+            WRITE(22,*) TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',TRIM(tmp_str)
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              tmp_str = c_mem(key_tab(ikey)%keymemstart+iv)
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              '__',TRIM(ADJUSTL(c_tmp)), &
+ &              ' = ',TRIM(tmp_str)
+            ENDDO
+          ENDIF
+        CASE(k_l)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            IF (l_mem(key_tab(ikey)%keymemstart)) THEN
+              WRITE(22,*) TRIM(key_tab(ikey)%keystr),' = TRUE '
+            ELSE
+              WRITE(22,*) TRIM(key_tab(ikey)%keystr),' = FALSE '
+            ENDIF
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              IF (l_mem(key_tab(ikey)%keymemstart+iv)) THEN
+                WRITE(22,*) TRIM(key_tab(ikey)%keystr),'__', &
+ &                          TRIM(ADJUSTL(c_tmp)),' = TRUE '
+              ELSE
+                WRITE(22,*) TRIM(key_tab(ikey)%keystr),'__', &
+ &                          TRIM(ADJUSTL(c_tmp)),' = FALSE '
+              ENDIF
+            ENDDO
+          ENDIF
+        CASE DEFAULT
+          CALL ipslerr (3,'getin_dump', &
+ &         'Unknown type for variable '//TRIM(key_tab(ikey)%keystr), &
+ &         ' ',' ')
+        END SELECT
+      ENDIF
+    ENDDO
+!-
+    CLOSE(UNIT=22)
+!-
+  ENDDO
+!------------------------
+END SUBROUTINE getin_dump
+!===
+SUBROUTINE get_qtyp (k_typ,c_vtyp,i_v,r_v,c_v,l_v)
+!---------------------------------------------------------------------
+!- Returns the type of the argument (mutually exclusive)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(OUT) :: k_typ
+  CHARACTER(LEN=*),INTENT(OUT) :: c_vtyp
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_v
+  REAL,DIMENSION(:),OPTIONAL             :: r_v
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_v
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_v
+!---------------------------------------------------------------------
+  k_typ = 0
+  IF (COUNT((/PRESENT(i_v),PRESENT(r_v),PRESENT(c_v),PRESENT(l_v)/)) &
+ &    /= 1) THEN
+    CALL ipslerr (3,'get_qtyp', &
+ &   'Invalid number of optional arguments','(/= 1)',' ')
+  ENDIF
+!-
+  IF     (PRESENT(i_v)) THEN
+    k_typ = k_i
+    c_vtyp = 'INTEGER'
+  ELSEIF (PRESENT(r_v)) THEN
+    k_typ = k_r
+    c_vtyp = 'REAL'
+  ELSEIF (PRESENT(c_v)) THEN
+    k_typ = k_c
+    c_vtyp = 'CHARACTER'
+  ELSEIF (PRESENT(l_v)) THEN
+    k_typ = k_l
+    c_vtyp = 'LOGICAL'
+  ENDIF
+!----------------------
+END SUBROUTINE get_qtyp
+!===
+SUBROUTINE get_findkey (i_tab,c_key,pos)
+!---------------------------------------------------------------------
+!- This subroutine looks for a key in a table
+!---------------------------------------------------------------------
+!- INPUT
+!-   i_tab  : 1 -> search in key_tab(1:nb_keys)%keystr
+!-            2 -> search in targetlist(1:nb_lines)
+!-   c_key  : Name of the key we are looking for
+!- OUTPUT
+!-   pos    : -1 if key not found, else value in the table
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(in) :: i_tab
+  CHARACTER(LEN=*),INTENT(in) :: c_key
+  INTEGER,INTENT(out) :: pos
+!-
+  INTEGER :: ikey_max,ikey
+  CHARACTER(LEN=l_n) :: c_q_key
+!---------------------------------------------------------------------
+  pos = -1
+  IF     (i_tab == 1) THEN
+    ikey_max = nb_keys
+  ELSEIF (i_tab == 2) THEN
+    ikey_max = nb_lines
+  ELSE
+    ikey_max = 0
+  ENDIF
+  IF ( ikey_max > 0 ) THEN
+    DO ikey=1,ikey_max
+      IF (i_tab == 1) THEN
+        c_q_key = key_tab(ikey)%keystr
+      ELSE
+        c_q_key = targetlist(ikey)
+      ENDIF
+      IF (TRIM(c_q_key) == TRIM(c_key)) THEN
+        pos = ikey
+        EXIT
+      ENDIF
+    ENDDO
+  ENDIF
+!-------------------------
+END SUBROUTINE get_findkey
+!===
+!------------------
+!$AGRIF_END_DO_NOT_TREAT
+END MODULE getincom
Index: utils/tools/DOMAINcfg/src/halo_mng.F90
===================================================================
--- utils/tools/DOMAINcfg/src/halo_mng.F90	(revision 14623)
+++ utils/tools/DOMAINcfg/src/halo_mng.F90	(revision 14623)
@@ -0,0 +1,194 @@
+MODULE halo_mng
+   !!======================================================================
+   !!                       ***  MODULE  halo_mng  ***
+   !! Ocean numerics:  massively parallel processing library
+   !!=====================================================================
+   !! History :  OPA  !  1994  (M. Guyon, J. Escobar, M. Imbard)
+   !Original code
+   !!            4.0  !  2019  (CMCC - ASC)  initial version of halo management module
+   !in_out_manager
+   !!----------------------------------------------------------------------
+
+   USE dom_oce       ! ocean space and time domain
+   USE lbclnk        ! ocean lateral boundary condition (or mpp link) 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTERFACE halo_mng_resize
+      MODULE PROCEDURE halo_mng_resize_2D, halo_mng_resize_3D, halo_mng_resize_4D, halo_mng_resize_5D
+   END INTERFACE
+
+   PUBLIC halo_mng_resize
+   PUBLIC halo_mng_init
+   PUBLIC halo_mng_set
+
+   INTEGER :: jpi_1, jpj_1
+   INTEGER :: jpimax_1, jpjmax_1
+   INTEGER :: Nis0_1, Njs0_1
+   INTEGER :: Nie0_1, Nje0_1
+CONTAINS
+
+   SUBROUTINE halo_mng_init( )
+
+        jpi_1 = jpi
+        jpj_1 = jpj
+
+        Nis0_1 = Nis0
+        Njs0_1 = Njs0
+
+        Nie0_1 = Nie0
+        Nje0_1 = Nje0
+
+   	jpimax_1 = jpimax
+   	jpjmax_1 = jpjmax
+
+   END SUBROUTINE halo_mng_init
+
+   SUBROUTINE halo_mng_set( khls )
+   
+        INTEGER, INTENT(in   )    ::   khls
+
+        nn_hls = khls
+
+        jpi = jpi_1 + 2*khls -2
+        jpj = jpj_1 + 2*khls -2
+
+        jpi = jpi_1 + 2*khls -2
+        jpj = jpj_1 + 2*khls -2
+        
+        jpimax = jpimax_1 + 2*khls -2
+        jpjmax = jpjmax_1 + 2*khls -2
+
+        Nis0 = Nis0_1 + khls - 1
+        Njs0 = Njs0_1 + khls - 1
+
+        Nie0 = Nie0_1 + khls - 1
+        Nje0 = Nje0_1 + khls - 1
+
+   END SUBROUTINE halo_mng_set
+   
+	SUBROUTINE halo_mng_resize_2D(pta, cdna, psgn, fillval)
+	
+		REAL(wp), POINTER, DIMENSION(:,:) :: pta
+		CHARACTER(len=1), INTENT(in)  :: cdna
+		REAL(wp), INTENT(in)  :: psgn
+		REAL(wp), OPTIONAL, INTENT(in ) :: fillval
+		REAL(wp), POINTER, DIMENSION(:,:) :: zpta
+		INTEGER :: offset
+		INTEGER :: pta_size_i, pta_size_j
+
+		pta_size_i = SIZE(pta,1)
+		pta_size_j = SIZE(pta,2)
+		
+		! check if the current size of pta is equal to the current expected dimension
+		IF (pta_size_i .ne. jpi) THEN
+			ALLOCATE (zpta(jpi, jpj))
+			offset = abs((jpi - pta_size_i) / 2) 
+
+			IF (pta_size_i .lt. jpi) THEN
+				zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j) = pta
+			ELSE
+				zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj)
+			END IF
+			CALL lbc_lnk( 'halo_mng_resize_2D', zpta, cdna, psgn, pfillval=fillval)
+			DEALLOCATE(pta)
+			pta => zpta
+		END IF
+		
+	END SUBROUTINE halo_mng_resize_2D
+
+	SUBROUTINE halo_mng_resize_3D(pta, cdna, psgn, fillval)
+	
+		REAL(wp), POINTER, DIMENSION(:,:,:) :: pta
+		CHARACTER(len=1), INTENT(in)  :: cdna
+		REAL(wp), INTENT(in)  :: psgn
+		REAL(wp), OPTIONAL, INTENT(in ) :: fillval
+		REAL(wp), POINTER, DIMENSION(:,:,:) :: zpta
+		INTEGER :: offset
+		INTEGER :: pta_size_i, pta_size_j
+
+		pta_size_i = SIZE(pta,1)
+		pta_size_j = SIZE(pta,2)
+		
+		! check if the current size of pta is equal to the current expected dimension
+		IF (pta_size_i .ne. jpi) THEN
+			ALLOCATE (zpta(jpi, jpj, jpk))
+			offset = abs((jpi - pta_size_i) / 2) 
+
+			IF (pta_size_i .lt. jpi) THEN
+				zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :) = pta
+			ELSE
+				zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :)
+			END IF
+			CALL lbc_lnk( 'halo_mng_resize_3D', zpta, cdna, psgn, pfillval=fillval)
+			DEALLOCATE(pta)
+			pta => zpta
+		END IF
+		
+	END SUBROUTINE halo_mng_resize_3D
+
+	SUBROUTINE halo_mng_resize_4D(pta, cdna, psgn, fillval, fjpt)
+	
+		REAL(wp), POINTER, DIMENSION(:,:,:,:) :: pta
+		CHARACTER(len=1), INTENT(in)  :: cdna
+		REAL(wp), INTENT(in)  :: psgn
+		REAL(wp), OPTIONAL, INTENT(in) :: fillval
+		INTEGER , INTENT(in) ::   fjpt 
+		REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zpta
+		INTEGER :: offset
+		INTEGER :: pta_size_i, pta_size_j
+
+		pta_size_i = SIZE(pta,1)
+		pta_size_j = SIZE(pta,2)
+		
+		! check if the current size of pta is equal to the current expected dimension
+		IF (pta_size_i .ne. jpi) THEN
+			ALLOCATE (zpta(jpi, jpj, jpk, jpt))
+			offset = abs((jpi - pta_size_i) / 2) 
+
+			IF (pta_size_i .lt. jpi) THEN
+				zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :, :) = pta
+			ELSE
+				zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :, :)
+			END IF
+			CALL lbc_lnk( 'halo_mng_resize_4D', zpta(:,:,:,fjpt), cdna, psgn, pfillval=fillval)
+			DEALLOCATE(pta)
+			pta => zpta
+		END IF
+		
+	END SUBROUTINE halo_mng_resize_4D
+	
+	SUBROUTINE halo_mng_resize_5D(pta, cdna, psgn, fillval, kjpt, fjpt)
+	
+		REAL(wp), POINTER, DIMENSION(:,:,:,:,:) :: pta
+		CHARACTER(len=1), INTENT(in)  :: cdna
+		REAL(wp), INTENT(in)  :: psgn
+		REAL(wp), OPTIONAL, INTENT(in) :: fillval
+		INTEGER , OPTIONAL, INTENT(in) :: kjpt            ! number of tracers
+		INTEGER , INTENT(in) :: fjpt            
+		REAL(wp), POINTER, DIMENSION(:,:,:,:,:) :: zpta
+		INTEGER :: offset
+		INTEGER :: pta_size_i, pta_size_j
+
+		pta_size_i = SIZE(pta,1)
+		pta_size_j = SIZE(pta,2)
+		
+		! check if the current size of pta is equal to the current expected dimension
+		IF (pta_size_i .ne. jpi) THEN
+			ALLOCATE (zpta(jpi, jpj, jpk, kjpt, jpt))
+			offset = abs((jpi - pta_size_i) / 2) 
+
+			IF (pta_size_i .lt. jpi) THEN
+				zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :, :, :) = pta
+			ELSE
+				zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :, :, :)
+			END IF
+			CALL lbc_lnk( 'halo_mng_resize_5D', zpta(:,:,:,:,fjpt), cdna, psgn, pfillval=fillval)
+			DEALLOCATE(pta)
+			pta => zpta
+		END IF
+		
+	END SUBROUTINE halo_mng_resize_5D
+	
+END MODULE
Index: utils/tools/DOMAINcfg/src/histcom.f90
===================================================================
--- utils/tools/DOMAINcfg/src/histcom.f90	(revision 14623)
+++ utils/tools/DOMAINcfg/src/histcom.f90	(revision 14623)
@@ -0,0 +1,2503 @@
+MODULE histcom
+!$AGRIF_DO_NOT_TREAT
+!-
+!$Id: histcom.f90 2368 2010-11-09 15:38:45Z acc $
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!-
+  USE netcdf
+  USE nc4interface ! needed to allow compilation with netcdf3 libraries
+!-
+  USE stringop, ONLY : nocomma,cmpblank,findpos,find_str,strlowercase
+  USE mathelp,  ONLY : mathop,moycum,buildop
+  USE fliocom,  ONLY : flio_dom_file,flio_dom_att
+  USE calendar
+  USE errioipsl, ONLY : ipslerr,ipsldbg
+!-
+  IMPLICIT NONE
+!-
+  PRIVATE
+  PUBLIC :: histbeg,histdef,histhori,histvert,histend, &
+ &          histwrite,histclo,histsync,ioconf_modname
+!---------------------------------------------------------------------
+!- Some confusing vocabulary in this code !
+!- =========================================
+!-
+!- A REGULAR grid is a grid which is i,j indexes
+!- and thus it is stored in a 2D matrix.
+!- This is opposed to a IRREGULAR grid which is only in a vector
+!- and where we do not know which neighbors we have.
+!- As a consequence we need the bounds for each grid-cell.
+!-
+!- A RECTILINEAR grid is a special case of a regular grid
+!- in which all longitudes for i constant are equal
+!- and all latitudes for j constant.
+!- In other words we do not need the full 2D matrix
+!- to describe the grid, just two vectors.
+!---------------------------------------------------------------------
+!-
+  INTERFACE histbeg
+    MODULE PROCEDURE histb_reg1d,histb_reg2d,histb_irreg
+  END INTERFACE
+!-
+  INTERFACE histhori
+    MODULE PROCEDURE histh_reg1d,histh_reg2d,histh_irreg
+  END INTERFACE
+!-
+  INTERFACE histwrite
+!---------------------------------------------------------------------
+!- The "histwrite" routines will give the data to the I/O system.
+!- It will trigger the operations to be performed,
+!- and the writting to the file if needed
+!-
+!- We test for the work to be done at this time here so that at a
+!- later stage we can call different operation and write subroutine
+!- for the REAL and INTEGER interfaces
+!-
+!- INPUT
+!- idf      : The ID of the file on which this variable is to be,
+!-            written. The variable should have been defined in
+!-            this file before.
+!- pvarname : The short name of the variable
+!- pitau    : Current timestep
+!- pdata    : The variable, I mean the real data !
+!- nbindex  : The number of indexes provided. If it is equal to
+!-            the size of the full field as provided in histdef
+!-            then nothing is done.
+!- nindex   : The indices used to expand the variable (pdata)
+!-            onto the full field.
+!---------------------------------------------------------------------
+!- histwrite - we have to prepare different type of fields :
+!-             real and integer, 1,2 or 3D
+    MODULE PROCEDURE histwrite_r1d,histwrite_r2d,histwrite_r3d
+  END INTERFACE
+!-
+! Fixed parameter
+!-
+  INTEGER,PARAMETER :: nb_files_max=20,nb_var_max=400, &
+ &                     nb_hax_max=5,nb_zax_max=10,nbopp_max=10
+  REAL,PARAMETER :: missing_val=nf90_fill_real
+  INTEGER,PARAMETER,PUBLIC :: &
+ &  hist_r4=nf90_real4, hist_r8=nf90_real8
+!-
+! Variable derived type
+!-
+TYPE T_D_V
+  INTEGER :: ncvid
+  INTEGER :: nbopp
+  CHARACTER(LEN=20)  :: v_name,unit_name
+  CHARACTER(LEN=256) :: title,std_name
+  CHARACTER(LEN=80)  :: fullop
+  CHARACTER(LEN=7)   :: topp
+  CHARACTER(LEN=7),DIMENSION(nbopp_max) :: sopp
+  REAL,DIMENSION(nbopp_max) :: scal
+!-External type (for R4/R8)
+  INTEGER :: v_typ
+!-Sizes of the associated grid and zommed area
+  INTEGER,DIMENSION(3) :: scsize,zorig,zsize
+!-Sizes for the data as it goes through the various math operations
+  INTEGER,DIMENSION(3) :: datasz_in = -1
+  INTEGER :: datasz_max = -1
+!-
+  INTEGER :: h_axid,z_axid,t_axid
+!-
+  REAL,DIMENSION(2) :: hist_minmax
+  LOGICAL :: hist_calc_rng=.FALSE.,hist_wrt_rng=.FALSE.
+!-Book keeping of the axes
+  INTEGER :: tdimid,tbndid=-1,tax_last
+  LOGICAL :: l_bnd
+  CHARACTER(LEN=40) :: tax_name
+!-
+  REAL :: freq_opp,freq_wrt
+  INTEGER :: &
+ &  last_opp,last_wrt,last_opp_chk,last_wrt_chk,nb_opp,nb_wrt
+!- For future optimization
+  REAL,POINTER,DIMENSION(:) :: t_bf
+!#  REAL,ALLOCATABLE,DIMENSION(:) :: V_1_D
+!#  REAL,ALLOCATABLE,DIMENSION(:,:) :: V_2_D
+!#  REAL,ALLOCATABLE,DIMENSION(:,:,:) :: V_3_D
+END TYPE T_D_V
+!-
+! File derived type
+!-
+TYPE :: T_D_F
+!-NETCDF IDs for file
+  INTEGER :: ncfid=-1
+!-Time variables
+  INTEGER :: itau0=0
+  REAL :: date0,deltat
+!-Counter of elements (variables, time-horizontal-vertical axis
+  INTEGER :: n_var=0,n_tax=0,n_hax=0,n_zax=0
+!-NETCDF dimension IDs for time-[time_bounds]-longitude-latitude
+  INTEGER :: tid,bid,xid,yid
+!-General definitions in the NETCDF file
+  INTEGER,DIMENSION(2) :: full_size=0,slab_ori,slab_siz
+!-The horizontal axes
+  CHARACTER(LEN=25),DIMENSION(nb_hax_max,2) :: hax_name
+!-The vertical axes
+  INTEGER,DIMENSION(nb_zax_max) :: zax_size,zax_ids
+  CHARACTER(LEN=20),DIMENSION(nb_zax_max) :: zax_name
+!-
+  LOGICAL :: regular=.TRUE.
+!-DOMAIN ID
+  INTEGER :: dom_id_svg=-1
+!-
+  TYPE(T_D_V),DIMENSION(nb_var_max) :: W_V
+END TYPE T_D_F
+!-
+TYPE(T_D_F),DIMENSION(nb_files_max),SAVE :: W_F
+!-
+! A list of functions which require special action
+! (Needs to be updated when functions are added
+!  but they are well located here)
+!-
+  CHARACTER(LEN=30),SAVE :: fuchnbout = 'scatter, fill'
+!- Some configurable variables with locks
+  CHARACTER(LEN=80),SAVE :: model_name='An IPSL model'
+  LOGICAL,SAVE :: lock_modname=.FALSE.
+!-
+!===
+CONTAINS
+!===
+!-
+SUBROUTINE histb_reg1d                 &
+ & (pfilename,pim,plon,pjm,plat,       &
+ &  par_orix,par_szx,par_oriy,par_szy, &
+ &  pitau0,pdate0,pdeltat,phoriid,idf,domain_id,mode,snc4chunks)
+!---------------------------------------------------------------------
+!- histbeg for 1D regular horizontal coordinates (see histb_all)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: pfilename
+  INTEGER,INTENT(IN) :: pim,pjm
+  REAL,DIMENSION(pim),INTENT(IN) :: plon
+  REAL,DIMENSION(pjm),INTENT(IN) :: plat
+  INTEGER,INTENT(IN):: par_orix,par_szx,par_oriy,par_szy
+  INTEGER,INTENT(IN) :: pitau0
+  REAL,INTENT(IN) :: pdate0,pdeltat
+  INTEGER,INTENT(OUT) :: idf,phoriid
+  INTEGER,INTENT(IN),OPTIONAL :: domain_id
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: mode
+  TYPE(snc4_ctl), OPTIONAL,INTENT(IN) :: snc4chunks
+!---------------------------------------------------------------------
+  CALL histb_all &
+ & (1,pfilename,pim,pjm,pitau0,pdate0,pdeltat,phoriid,idf, &
+ &  x_1d=plon,y_1d=plat, &
+ &  k_orx=par_orix,k_szx=par_szx,k_ory=par_oriy,k_szy=par_szy, &
+ &  domain_id=domain_id,mode=mode,snc4chunks=snc4chunks)
+!-------------------------
+END SUBROUTINE histb_reg1d
+!===
+SUBROUTINE histb_reg2d &
+ & (pfilename,pim,plon,pjm,plat,       &
+ &  par_orix,par_szx,par_oriy,par_szy, &
+ &  pitau0,pdate0,pdeltat,phoriid,idf,domain_id,mode,snc4chunks)
+!---------------------------------------------------------------------
+!- histbeg for 2D regular horizontal coordinates (see histb_all)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: pfilename
+  INTEGER,INTENT(IN) :: pim,pjm
+  REAL,DIMENSION(pim,pjm),INTENT(IN) :: plon,plat
+  INTEGER,INTENT(IN):: par_orix,par_szx,par_oriy,par_szy
+  INTEGER,INTENT(IN) :: pitau0
+  REAL,INTENT(IN) :: pdate0,pdeltat
+  INTEGER,INTENT(OUT) :: idf,phoriid
+  INTEGER,INTENT(IN),OPTIONAL :: domain_id
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: mode
+  TYPE(snc4_ctl), OPTIONAL,INTENT(IN) :: snc4chunks
+!---------------------------------------------------------------------
+  CALL histb_all &
+ & (2,pfilename,pim,pjm,pitau0,pdate0,pdeltat,phoriid,idf,  &
+ &  x_2d=plon,y_2d=plat, &
+ &  k_orx=par_orix,k_szx=par_szx,k_ory=par_oriy,k_szy=par_szy,    &
+ &  domain_id=domain_id,mode=mode,snc4chunks=snc4chunks)
+!-------------------------
+END SUBROUTINE histb_reg2d
+!===
+SUBROUTINE histb_irreg &
+ &  (pfilename,pim,plon,plon_bounds,plat,plat_bounds, &
+ &   pitau0,pdate0,pdeltat,phoriid,idf,domain_id,mode,snc4chunks)
+!---------------------------------------------------------------------
+!- histbeg for irregular horizontal coordinates (see histb_all)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: pfilename
+  INTEGER,INTENT(IN) :: pim
+  REAL,DIMENSION(pim),INTENT(IN) :: plon,plat
+  REAL,DIMENSION(:,:),INTENT(IN) :: plon_bounds,plat_bounds
+  INTEGER,INTENT(IN) :: pitau0
+  REAL,INTENT(IN) :: pdate0,pdeltat
+  INTEGER,INTENT(OUT) :: idf,phoriid
+  INTEGER,INTENT(IN),OPTIONAL :: domain_id
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: mode
+  TYPE(snc4_ctl), OPTIONAL,INTENT(IN) :: snc4chunks
+!---------------------------------------------------------------------
+  CALL histb_all &
+ & (3,pfilename,pim,pim,pitau0,pdate0,pdeltat,phoriid,idf,  &
+ &  x_1d=plon,y_1d=plat,x_bnds=plon_bounds,y_bnds=plat_bounds, &
+ &  domain_id=domain_id,mode=mode,snc4chunks=snc4chunks)
+!-------------------------
+END SUBROUTINE histb_irreg
+!===
+SUBROUTINE histb_all &
+ & (k_typ,nc_name,pim,pjm,pitau0,pdate0,pdeltat,phoriid,idf, &
+ &  x_1d,y_1d,x_2d,y_2d,k_orx,k_szx,k_ory,k_szy, &
+ &  x_bnds,y_bnds,domain_id,mode,snc4chunks)
+!---------------------------------------------------------------------
+!- General interface for horizontal grids.
+!- This subroutine initializes a netcdf file and returns the ID.
+!- It will set up the geographical space on which the data will be
+!- stored and offers the possibility of seting a zoom.
+!- In the case of irregular grids, all the data comes in as vectors
+!- and for the grid we have the coordinates of the 4 corners.
+!- It also gets the global parameters into the I/O subsystem.
+!-
+!- INPUT
+!-
+!- k_typ    : Type of the grid (1 rectilinear, 2 regular, 3 irregular)
+!- nc_name  : Name of the netcdf file to be created
+!- pim      : Size of arrays in longitude direction
+!- pjm      : Size of arrays in latitude direction (pjm=pim for type 3)
+!-
+!- pitau0   : time step at which the history tape starts
+!- pdate0   : The Julian date at which the itau was equal to 0
+!- pdeltat  : Time step, in seconds, of the counter itau
+!-            used in histwrite for instance
+!-
+!- OUTPUT
+!-
+!- phoriid  : Identifier of the horizontal grid
+!- idf      : Identifier of the file
+!-
+!- Optional INPUT arguments
+!-
+!- For rectilinear or irregular grid
+!- x_1d  : The longitudes
+!- y_1d  : The latitudes
+!- For regular grid
+!- x_2d  : The longitudes
+!- y_2d  : The latitudes
+!- One pair (x_1d,y_1d) or (x_2d,y_2d) must be supplied.
+!-
+!- For regular grid (reg1d or reg2d),
+!- the next 4 arguments allow to define a horizontal zoom
+!- for this file. It is assumed that all variables to come
+!- have the same index space. This can not be assumed for
+!- the z axis and thus we define the zoom in histdef.
+!- k_orx  : Origin of the slab of data within the X axis (pim)
+!- k_szx  : Size of the slab of data in X
+!- k_ory  : Origin of the slab of data within the Y axis (pjm)
+!- k_szy  : Size of the slab of data in Y
+!-
+!- For irregular grid.
+!- x_bnds : The boundaries of the grid in longitude
+!- y_bnds : The boundaries of the grid in latitude
+!-
+!- For all grids.
+!-
+!- domain_id  : Domain identifier
+!-
+!- mode       : String of (case insensitive) blank-separated words
+!-              defining the mode used to create the file.
+!-              Supported keywords : 32, 64
+!-              "32/64" defines the offset mode.
+!-              The default offset mode is 64 bits.
+!-              Keywords "NETCDF4" and "CLASSIC" are reserved
+!-              for future use.
+!-
+!- snc4chunks    : Structure containing chunk partitioning parameters
+!-              for 4-D variables and a logical switch to toggle
+!-              between netcdf3 o/p (false) and netcdf4 chunked
+!-              and compressed o/p (true)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: k_typ
+  CHARACTER(LEN=*),INTENT(IN) :: nc_name
+  INTEGER,INTENT(IN) :: pim,pjm
+  INTEGER,INTENT(IN) :: pitau0
+  REAL,INTENT(IN) :: pdate0,pdeltat
+  INTEGER,INTENT(OUT) :: idf,phoriid
+  REAL,DIMENSION(:),INTENT(IN),OPTIONAL :: x_1d,y_1d
+  REAL,DIMENSION(:,:),INTENT(IN),OPTIONAL :: x_2d,y_2d
+  INTEGER,INTENT(IN),OPTIONAL :: k_orx,k_szx,k_ory,k_szy
+  REAL,DIMENSION(:,:),INTENT(IN),OPTIONAL :: x_bnds,y_bnds
+  INTEGER,INTENT(IN),OPTIONAL :: domain_id
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: mode
+  TYPE(snc4_ctl), OPTIONAL,INTENT(IN) :: snc4chunks
+!-
+  INTEGER :: nfid,iret,m_c
+  CHARACTER(LEN=120) :: file
+  CHARACTER(LEN=30) :: timenow
+  CHARACTER(LEN=11) :: c_nam
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF     (k_typ == 1) THEN
+    c_nam = 'histb_reg1d'
+  ELSEIF (k_typ == 2) THEN
+    c_nam = 'histb_reg2d'
+  ELSEIF (k_typ == 3) THEN
+    c_nam = 'histb_irreg'
+  ELSE
+    CALL ipslerr (3,"histbeg", &
+ &    'Illegal value of k_typ argument','in internal interface','?')
+  ENDIF
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 0.0"
+!-
+! Search for a free index
+!-
+  idf = -1
+  DO nfid=1,nb_files_max
+    IF (W_F(nfid)%ncfid < 0) THEN
+      idf = nfid; EXIT;
+    ENDIF
+  ENDDO
+  IF (idf < 0) THEN
+    CALL ipslerr (3,"histbeg", &
+   &  'Table of files too small. You should increase nb_files_max', &
+   &  'in histcom.f90 in order to accomodate all these files',' ')
+  ENDIF
+!-
+! 1.0 Transfering into the common for future use
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 1.0"
+!-
+  W_F(idf)%itau0  = pitau0
+  W_F(idf)%date0  = pdate0
+  W_F(idf)%deltat = pdeltat
+!-
+! 2.0 Initializes all variables for this file
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 2.0"
+!-
+  W_F(idf)%n_var = 0
+  W_F(idf)%n_tax = 0
+  W_F(idf)%n_hax = 0
+  W_F(idf)%n_zax = 0
+!-
+  IF ( (k_typ == 1).OR.(k_typ == 2) ) THEN
+    W_F(idf)%slab_ori(1:2) = (/ k_orx,k_ory /)
+    W_F(idf)%slab_siz(1:2)  = (/ k_szx,k_szy /)
+  ELSE
+    W_F(idf)%slab_ori(1:2) = (/ 1,1 /)
+    W_F(idf)%slab_siz(1:2) = (/ pim,1 /)
+  ENDIF
+!-
+! 3.0 Opening netcdf file and defining dimensions
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 3.0"
+!-
+! Add DOMAIN number and ".nc" suffix in file name if needed
+!-
+  file = nc_name
+  CALL flio_dom_file (file,domain_id)
+!-
+! Check the mode
+!? See fliocom for HDF4 ????????????????????????????????????????????????
+!-
+  IF (PRESENT(mode)) THEN
+    SELECT CASE (TRIM(mode))
+    CASE('32')
+      m_c = NF90_CLOBBER
+    CASE('64')
+      m_c = IOR(NF90_CLOBBER,NF90_64BIT_OFFSET)
+    CASE DEFAULT
+      CALL ipslerr (3,"histbeg", &
+ &      'Invalid argument mode for file :',TRIM(file), &
+ &      'Supported values are 32 or 64')
+    END SELECT
+  ELSE
+    m_c = IOR(NF90_CLOBBER,NF90_64BIT_OFFSET)
+  ENDIF
+!-
+  IF (PRESENT(snc4chunks)) THEN
+    IF (snc4chunks%luse) CALL get_nf90_symbol("NF90_HDF5", m_c)
+  ENDIF
+!-
+! Create file
+!-
+  iret = NF90_CREATE(file,m_c,nfid)
+!-
+  IF     (k_typ == 1) THEN
+    iret = NF90_DEF_DIM(nfid,'lon',k_szx,W_F(idf)%xid)
+    iret = NF90_DEF_DIM(nfid,'lat',k_szy,W_F(idf)%yid)
+  ELSEIF (k_typ == 2) THEN
+    iret = NF90_DEF_DIM(nfid,'x',k_szx,W_F(idf)%xid)
+    iret = NF90_DEF_DIM(nfid,'y',k_szy,W_F(idf)%yid)
+  ELSEIF (k_typ == 3) THEN
+    iret = NF90_DEF_DIM(nfid,'x',pim,W_F(idf)%xid)
+    W_F(idf)%yid = W_F(idf)%xid
+  ENDIF
+!-
+! 4.0 Declaring the geographical coordinates and other attributes
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 4.0"
+!-
+  iret = NF90_PUT_ATT(nfid,NF90_GLOBAL,'Conventions','CF-1.1')
+  iret = NF90_PUT_ATT(nfid,NF90_GLOBAL,'file_name',TRIM(file))
+  iret = NF90_PUT_ATT(nfid,NF90_GLOBAL,'production',TRIM(model_name))
+  lock_modname = .TRUE.
+  CALL ioget_timestamp (timenow)
+  iret = NF90_PUT_ATT(nfid,NF90_GLOBAL,'TimeStamp',TRIM(timenow))
+!-
+! 5.0 Saving some important information on this file in the common
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 5.0"
+!-
+  IF (PRESENT(domain_id)) THEN
+    W_F(idf)%dom_id_svg = domain_id
+  ENDIF
+  W_F(idf)%ncfid = nfid
+  IF ( (k_typ == 1).OR.(k_typ == 2) ) THEN
+    W_F(idf)%full_size(1:2) = (/ pim,pjm /)
+    W_F(idf)%regular=.TRUE.
+  ELSEIF (k_typ == 3) THEN
+    W_F(idf)%full_size(1:2) = (/ pim,1 /)
+    W_F(idf)%regular=.FALSE.
+  ENDIF
+!-
+! 6.0 storing the geographical coordinates
+!-
+  IF     (k_typ == 1) THEN
+    CALL histh_all &
+ &   (k_typ,idf,pim,pjm,' ','Default grid',phoriid, &
+ &    x_1d=x_1d,y_1d=y_1d)
+  ELSEIF (k_typ == 2) THEN
+    CALL histh_all &
+ &   (k_typ,idf,pim,pjm,' ','Default grid',phoriid, &
+ &    x_2d=x_2d,y_2d=y_2d)
+  ELSEIF (k_typ == 3) THEN
+    CALL histh_all &
+ &   (k_typ,idf,pim,pim,' ','Default grid',phoriid, &
+ &    x_1d=x_1d,y_1d=y_1d,x_bnds=x_bnds,y_bnds=y_bnds)
+  ENDIF
+!-----------------------
+END SUBROUTINE histb_all
+!===
+SUBROUTINE histh_reg1d &
+ &  (idf,pim,plon,pjm,plat,phname,phtitle,phid)
+!---------------------------------------------------------------------
+!- histhori for 1d regular grid (see histh_all)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pim,pjm
+  REAL,INTENT(IN),DIMENSION(:) :: plon,plat
+  CHARACTER(LEN=*),INTENT(IN) :: phname,phtitle
+  INTEGER,INTENT(OUT) :: phid
+!---------------------------------------------------------------------
+  CALL histh_all &
+ & (1,idf,pim,pjm,phname,phtitle,phid,x_1d=plon,y_1d=plat)
+!-------------------------
+END SUBROUTINE histh_reg1d
+!===
+SUBROUTINE histh_reg2d &
+ & (idf,pim,plon,pjm,plat,phname,phtitle,phid)
+!---------------------------------------------------------------------
+!- histhori for 2d regular grid (see histh_all)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pim,pjm
+  REAL,INTENT(IN),DIMENSION(:,:) :: plon,plat
+  CHARACTER(LEN=*),INTENT(IN) :: phname,phtitle
+  INTEGER,INTENT(OUT) :: phid
+!---------------------------------------------------------------------
+  CALL histh_all &
+ & (2,idf,pim,pjm,phname,phtitle,phid,x_2d=plon,y_2d=plat)
+!-------------------------
+END SUBROUTINE histh_reg2d
+!===
+SUBROUTINE histh_irreg &
+ & (idf,pim,plon,plon_bounds,plat,plat_bounds,phname,phtitle,phid)
+!---------------------------------------------------------------------
+!- histhori for irregular grid (see histh_all)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pim
+  REAL,DIMENSION(:),INTENT(IN) :: plon,plat
+  REAL,DIMENSION(:,:),INTENT(IN) :: plon_bounds,plat_bounds
+  CHARACTER(LEN=*),INTENT(IN) :: phname,phtitle
+  INTEGER,INTENT(OUT) :: phid
+!---------------------------------------------------------------------
+  CALL histh_all &
+ & (3,idf,pim,pim,phname,phtitle,phid, &
+ &  x_1d=plon,y_1d=plat,x_bnds=plon_bounds,y_bnds=plat_bounds)
+!-------------------------
+END SUBROUTINE histh_irreg
+!===
+SUBROUTINE histh_all &
+ & (k_typ,idf,pim,pjm,phname,phtitle,phid, &
+ &  x_1d,y_1d,x_2d,y_2d,x_bnds,y_bnds)
+!---------------------------------------------------------------------
+!- General interface for horizontal grids.
+!- This subroutine is made to declare a new horizontal grid.
+!- It has to have the same number of points as
+!- the original and thus in this routine we will only
+!- add two variable (longitude and latitude).
+!- Any variable in the file can thus point to this pair
+!- through an attribute. This routine is very usefull
+!- to allow staggered grids.
+!-
+!- INPUT
+!-
+!- k_typ   : Type of the grid (1 rectilinear, 2 regular, 3 irregular)
+!- idf     : The id of the file to which the grid should be added
+!- pim     : Size in the longitude direction
+!- pjm     : Size in the latitude direction (pjm=pim for type 3)
+!- phname  : The name of grid
+!- phtitle : The title of the grid
+!-
+!- OUTPUT
+!-
+!- phid    : Id of the created grid
+!-
+!- Optional INPUT arguments
+!-
+!- For rectilinear or irregular grid
+!- x_1d  : The longitudes
+!- y_1d  : The latitudes
+!- For regular grid
+!- x_2d  : The longitudes
+!- y_2d  : The latitudes
+!- One pair (x_1d,y_1d) or (x_2d,y_2d) must be supplied.
+!-
+!- For irregular grid.
+!- x_bnds : The boundaries of the grid in longitude
+!- y_bnds : The boundaries of the grid in latitude
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: k_typ
+  INTEGER,INTENT(IN) :: idf,pim,pjm
+  CHARACTER(LEN=*),INTENT(IN) :: phname,phtitle
+  INTEGER,INTENT(OUT) :: phid
+  REAL,DIMENSION(:),INTENT(IN),OPTIONAL :: x_1d,y_1d
+  REAL,DIMENSION(:,:),INTENT(IN),OPTIONAL :: x_2d,y_2d
+  REAL,DIMENSION(:,:),INTENT(IN),OPTIONAL :: x_bnds,y_bnds
+!-
+  CHARACTER(LEN=25) :: lon_name,lat_name
+  CHARACTER(LEN=30) :: lonbound_name,latbound_name
+  INTEGER :: i_s,i_e
+  INTEGER,DIMENSION(2) :: dims,dims_b
+  INTEGER :: nbbounds
+  INTEGER :: nlonidb,nlatidb,twoid
+  LOGICAL :: transp = .FALSE.
+  REAL,ALLOCATABLE,DIMENSION(:,:) :: bounds_trans
+  REAL :: wmn,wmx
+  INTEGER :: nlonid,nlatid
+  INTEGER :: o_x,o_y,s_x,s_y
+  INTEGER :: iret,nfid
+  CHARACTER(LEN=11) :: c_nam
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF     (k_typ == 1) THEN
+    c_nam = 'histh_reg1d'
+  ELSEIF (k_typ == 2) THEN
+    c_nam = 'histh_reg2d'
+  ELSEIF (k_typ == 3) THEN
+    c_nam = 'histh_irreg'
+  ELSE
+    CALL ipslerr (3,"histhori", &
+ &    'Illegal value of k_typ argument','in internal interface','?')
+  ENDIF
+!-
+! 1.0 Check that all fits in the buffers
+!-
+  IF (    (pim /= W_F(idf)%full_size(1)) &
+ &    .OR.(W_F(idf)%regular.AND.(pjm /= W_F(idf)%full_size(2)))  &
+ &    .OR.(.NOT.W_F(idf)%regular.AND.(W_F(idf)%full_size(2) /= 1)) ) THEN
+    CALL ipslerr (3,"histhori", &
+ &   'The new horizontal grid does not have the same size', &
+ &   'as the one provided to histbeg. This is not yet ', &
+ &   'possible in the hist package.')
+  ENDIF
+!-
+! 1.1 Create all the variables needed
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 1.0"
+!-
+  nfid = W_F(idf)%ncfid
+!-
+  IF (k_typ == 3) THEN
+    IF     (SIZE(x_bnds,DIM=1) == pim) THEN
+      nbbounds = SIZE(x_bnds,DIM=2)
+      transp = .TRUE.
+    ELSEIF (SIZE(x_bnds,DIM=2) == pim) THEN
+      nbbounds = SIZE(x_bnds,DIM=1)
+      transp = .FALSE.
+    ELSE
+      CALL ipslerr (3,"histhori", &
+ &     'The boundary variable does not have any axis corresponding', &
+ &     'to the size of the longitude or latitude variable','.')
+    ENDIF
+    ALLOCATE(bounds_trans(nbbounds,pim))
+    iret = NF90_DEF_DIM(nfid,'nbnd',nbbounds,twoid)
+    dims_b(1:2) = (/ twoid,W_F(idf)%xid /)
+  ENDIF
+!-
+  dims(1:2) = (/ W_F(idf)%xid,W_F(idf)%yid /)
+!-
+  IF     (k_typ == 1) THEN
+    IF (W_F(idf)%n_hax == 0) THEN
+      lon_name = 'lon'
+      lat_name = 'lat'
+    ELSE
+      lon_name = 'lon_'//TRIM(phname)
+      lat_name = 'lat_'//TRIM(phname)
+    ENDIF
+  ELSEIF (k_typ == 2) THEN
+    IF (W_F(idf)%n_hax == 0) THEN
+      lon_name = 'nav_lon'
+      lat_name = 'nav_lat'
+    ELSE
+      lon_name = 'nav_lon_'//TRIM(phname)
+      lat_name = 'nav_lat_'//TRIM(phname)
+    ENDIF
+  ELSEIF (k_typ == 3) THEN
+    IF (W_F(idf)%n_hax == 0) THEN
+      lon_name = 'nav_lon'
+      lat_name = 'nav_lat'
+    ELSE
+      lon_name = 'nav_lon_'//TRIM(phname)
+      lat_name = 'nav_lat_'//TRIM(phname)
+    ENDIF
+    lonbound_name = TRIM(lon_name)//'_bounds'
+    latbound_name = TRIM(lat_name)//'_bounds'
+  ENDIF
+!-
+! 1.2 Save the informations
+!-
+  phid = W_F(idf)%n_hax+1
+  W_F(idf)%n_hax = phid
+  W_F(idf)%hax_name(phid,1:2) = (/ lon_name,lat_name /)
+!-
+! 2.0 Longitude
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 2.0"
+!-
+  i_s = 1;
+  IF ( (k_typ == 1).OR.(k_typ == 3) ) THEN
+    i_e = 1; wmn = MINVAL(x_1d); wmx = MAXVAL(x_1d);
+  ELSEIF (k_typ == 2) THEN
+    i_e = 2; wmn = MINVAL(x_2d); wmx = MAXVAL(x_2d);
+  ENDIF
+  iret = NF90_DEF_VAR(nfid,lon_name,NF90_REAL4,dims(i_s:i_e),nlonid)
+  IF (k_typ == 1) THEN
+    iret = NF90_PUT_ATT(nfid,nlonid,'axis',"X")
+  ENDIF
+  iret = NF90_PUT_ATT(nfid,nlonid,'standard_name',"longitude")
+  iret = NF90_PUT_ATT(nfid,nlonid,'units',"degrees_east")
+  iret = NF90_PUT_ATT(nfid,nlonid,'valid_min',REAL(wmn,KIND=4))
+  iret = NF90_PUT_ATT(nfid,nlonid,'valid_max',REAL(wmx,KIND=4))
+  iret = NF90_PUT_ATT(nfid,nlonid,'long_name',"Longitude")
+  iret = NF90_PUT_ATT(nfid,nlonid,'nav_model',TRIM(phtitle))
+!-
+  IF (k_typ == 3) THEN
+!---
+!-- 2.1 Longitude bounds
+!---
+    iret = NF90_PUT_ATT(nfid,nlonid,'bounds',TRIM(lonbound_name))
+    iret = NF90_DEF_VAR(nfid,lonbound_name,NF90_REAL4,dims_b(1:2),nlonidb)
+    iret = NF90_PUT_ATT(nfid,nlonidb,'long_name', &
+ &          'Boundaries for coordinate variable '//TRIM(lon_name))
+  ENDIF
+!-
+! 3.0 Latitude
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 3.0"
+!-
+  i_e = 2;
+  IF ( (k_typ == 1).OR.(k_typ == 3) ) THEN
+    i_s = 2; wmn = MINVAL(y_1d); wmx = MAXVAL(y_1d);
+  ELSEIF (k_typ == 2) THEN
+    i_s = 1; wmn = MINVAL(y_2d); wmx = MAXVAL(y_2d);
+  ENDIF
+  iret = NF90_DEF_VAR(nfid,lat_name,NF90_REAL4,dims(i_s:i_e),nlatid)
+  IF (k_typ == 1) THEN
+    iret = NF90_PUT_ATT(nfid,nlatid,'axis',"Y")
+  ENDIF
+!-
+  iret = NF90_PUT_ATT(nfid,nlatid,'standard_name',"latitude")
+  iret = NF90_PUT_ATT(nfid,nlatid,'units',"degrees_north")
+  iret = NF90_PUT_ATT(nfid,nlatid,'valid_min',REAL(wmn,KIND=4))
+  iret = NF90_PUT_ATT(nfid,nlatid,'valid_max',REAL(wmx,KIND=4))
+  iret = NF90_PUT_ATT(nfid,nlatid,'long_name',"Latitude")
+  iret = NF90_PUT_ATT(nfid,nlatid,'nav_model',TRIM(phtitle))
+!-
+  IF (k_typ == 3) THEN
+!---
+!-- 3.1 Latitude bounds
+!---
+    iret = NF90_PUT_ATT(nfid,nlatid,'bounds',TRIM(latbound_name))
+    iret = NF90_DEF_VAR(nfid,latbound_name,NF90_REAL4,dims_b(1:2),nlatidb)
+    iret = NF90_PUT_ATT(nfid,nlatidb,'long_name', &
+ &          'Boundaries for coordinate variable '//TRIM(lat_name))
+  ENDIF
+!-
+  iret = NF90_ENDDEF(nfid)
+!-
+! 4.0 storing the geographical coordinates
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 4.0"
+!-
+  IF ( (k_typ == 1).OR.(k_typ == 2) ) THEN
+    o_x = W_F(idf)%slab_ori(1)
+    o_y = W_F(idf)%slab_ori(2)
+    s_x = W_F(idf)%slab_siz(1)
+    s_y = W_F(idf)%slab_siz(2)
+!---
+!-- Transfer the longitude and  the latitude
+!---
+    IF     (k_typ == 1) THEN
+      iret = NF90_PUT_VAR(nfid,nlonid,x_1d(o_x:o_x+s_x-1))
+      iret = NF90_PUT_VAR(nfid,nlatid,y_1d(o_y:o_y+s_y-1))
+    ELSEIF (k_typ == 2) THEN
+      iret = NF90_PUT_VAR(nfid,nlonid, &
+ &            x_2d(o_x:o_x+s_x-1,o_y:o_y+s_y-1))
+      iret = NF90_PUT_VAR(nfid,nlatid, &
+ &            y_2d(o_x:o_x+s_x-1,o_y:o_y+s_y-1))
+    ENDIF
+  ELSEIF (k_typ == 3) THEN
+!---
+!-- Transfer the longitude and the longitude bounds
+!---
+    iret = NF90_PUT_VAR(nfid,nlonid,x_1d(1:pim))
+!---
+    IF (transp) THEN
+      bounds_trans = TRANSPOSE(x_bnds)
+    ELSE
+      bounds_trans = x_bnds
+    ENDIF
+    iret = NF90_PUT_VAR(nfid,nlonidb,bounds_trans(1:nbbounds,1:pim))
+!---
+!-- Transfer the latitude and the latitude bounds
+!---
+    iret = NF90_PUT_VAR(nfid,nlatid,y_1d(1:pim))
+!---
+    IF (transp) THEN
+      bounds_trans = TRANSPOSE(y_bnds)
+    ELSE
+      bounds_trans = y_bnds
+    ENDIF
+    iret = NF90_PUT_VAR(nfid,nlatidb,bounds_trans(1:nbbounds,1:pim))
+!---
+    DEALLOCATE(bounds_trans)
+  ENDIF
+!-
+  iret = NF90_REDEF(nfid)
+!-----------------------
+END SUBROUTINE histh_all
+!===
+SUBROUTINE histvert (idf,pzaxname,pzaxtitle,pzaxunit, &
+ &                   pzsize,pzvalues,pzaxid,pdirect)
+!---------------------------------------------------------------------
+!- This subroutine defines a vertical axis and returns it s id.
+!- It gives the user the possibility to the user to define many
+!- different vertical axes. For each variable defined with histdef a
+!- vertical axis can be specified with by it s ID.
+!-
+!- INPUT
+!-
+!- idf      : ID of the file the variable should be archived in
+!- pzaxname : Name of the vertical axis
+!- pzaxtitle: title of the vertical axis
+!- pzaxunit : Units of the vertical axis (no units if blank string)
+!- pzsize   : size of the vertical axis
+!- pzvalues : Coordinate values of the vetical axis
+!-
+!- pdirect  : is an optional argument which allows to specify the
+!-            the positive direction of the axis : up or down.
+!- OUTPUT
+!-
+!- pzaxid   : Returns the ID of the axis.
+!-            Note that this is not the netCDF ID !
+!-
+!- VERSION
+!-
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pzsize
+  CHARACTER(LEN=*),INTENT(IN) :: pzaxname,pzaxunit,pzaxtitle
+  REAL,INTENT(IN) :: pzvalues(pzsize)
+  INTEGER,INTENT(OUT) :: pzaxid
+  CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: pdirect
+!-
+  INTEGER :: pos,iv,zdimid,zaxid_tmp
+  CHARACTER(LEN=70) :: str71
+  CHARACTER(LEN=20) :: direction
+  INTEGER :: iret,leng,nfid
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Verifications :
+!    Do we have enough space for an extra axis ?
+!    Is the name already in use ?
+!-
+  IF (l_dbg) WRITE(*,*) "histvert : 1.0 Verifications", &
+ &                      pzaxname,'---',pzaxunit,'---',pzaxtitle
+!-
+! Direction of the vertical axis. Can we get if from the user.
+!-
+  IF (PRESENT(pdirect)) THEN
+    direction = TRIM(pdirect)
+    CALL strlowercase (direction)
+  ELSE
+    direction = 'unknown'
+  ENDIF
+!-
+! Check the consistency of the attribute
+!-
+  IF (     PRESENT(pdirect)    &
+ &    .AND.(direction /= 'up') &
+ &    .AND.(direction /= 'down') ) THEN
+    direction = 'unknown'
+    CALL ipslerr (2,"histvert",&
+ & "The specified positive direction for the vertical axis is invalid.",&
+ & "The value must be up or down.","The attribute will not be written.")
+  ENDIF
+!-
+  IF (W_F(idf)%n_zax+1 > nb_zax_max) THEN
+    CALL ipslerr (3,"histvert", &
+   &  'Table of vertical axes too small. You should increase ',&
+   &  'nb_zax_max in histcom.f90 in order to accomodate all ', &
+   &  'these variables ')
+  ENDIF
+!-
+  iv = W_F(idf)%n_zax
+  IF (iv > 1) THEN
+    CALL find_str (W_F(idf)%zax_name(1:iv-1),pzaxname,pos)
+  ELSE
+    pos = 0
+  ENDIF
+!-
+  IF (pos > 0) THEN
+    WRITE(str71,'("Check variable ",A," in file",I3)') &
+ &    TRIM(pzaxname),idf
+    CALL ipslerr (3,"histvert", &
+ &    "Vertical axis already exists",TRIM(str71), &
+ &    "Can also be a wrong file ID in another declaration")
+  ENDIF
+!-
+  iv = W_F(idf)%n_zax+1
+!-
+! 2.0 Add the information to the file
+!-
+  IF (l_dbg) &
+ &  WRITE(*,*) "histvert : 2.0 Add the information to the file"
+!-
+  nfid = W_F(idf)%ncfid
+!-
+  leng = MIN(LEN_TRIM(pzaxname),20)
+  iret = NF90_DEF_DIM (nfid,pzaxname(1:leng),pzsize,zaxid_tmp)
+  iret = NF90_DEF_VAR (nfid,pzaxname(1:leng),NF90_REAL4, &
+ &                     zaxid_tmp,zdimid)
+  iret = NF90_PUT_ATT (nfid,zdimid,'axis',"Z")
+  iret = NF90_PUT_ATT (nfid,zdimid,'standard_name',"model_level_number")
+  leng = MIN(LEN_TRIM(pzaxunit),20)
+  IF (leng > 0) THEN
+    iret = NF90_PUT_ATT (nfid,zdimid,'units',pzaxunit(1:leng))
+  ENDIF
+  IF (direction /= 'unknown') THEN
+    iret = NF90_PUT_ATT (nfid,zdimid,'positive',TRIM(direction))
+  ENDIF
+  iret = NF90_PUT_ATT (nfid,zdimid,'valid_min', &
+ &                     REAL(MINVAL(pzvalues(1:pzsize)),KIND=4))
+  iret = NF90_PUT_ATT (nfid,zdimid,'valid_max', &
+ &                     REAL(MAXVAL(pzvalues(1:pzsize)),KIND=4))
+  leng = MIN(LEN_TRIM(pzaxname),20)
+  iret = NF90_PUT_ATT (nfid,zdimid,'title',pzaxname(1:leng))
+  leng = MIN(LEN_TRIM(pzaxtitle),80)
+  iret = NF90_PUT_ATT (nfid,zdimid,'long_name',pzaxtitle(1:leng))
+!-
+  iret = NF90_ENDDEF (nfid)
+!-
+  iret = NF90_PUT_VAR (nfid,zdimid,pzvalues(1:pzsize))
+!-
+  iret = NF90_REDEF (nfid)
+!-
+!- 3.0 add the information to the common
+!-
+  IF (l_dbg) &
+  &  WRITE(*,*) "histvert : 3.0 add the information to the common"
+!-
+  W_F(idf)%n_zax = iv
+  W_F(idf)%zax_size(iv) = pzsize
+  W_F(idf)%zax_name(iv) = pzaxname
+  W_F(idf)%zax_ids(iv) = zaxid_tmp
+  pzaxid = iv
+!----------------------
+END SUBROUTINE histvert
+!===
+SUBROUTINE histdef &
+ &  (idf,pvarname,ptitle,punit, &
+ &   pxsize,pysize,phoriid,pzsize,par_oriz,par_szz,pzid, &
+ &   xtype,popp,pfreq_opp,pfreq_wrt,var_range,standard_name)
+!---------------------------------------------------------------------
+!- With this subroutine each variable to be archived on the history
+!- tape should be declared.
+!-
+!- It gives the user the choise of operation
+!- to be performed on the variables, the frequency of this operation
+!- and finaly the frequency of the archiving.
+!-
+!- INPUT
+!-
+!- idf      : ID of the file the variable should be archived in
+!- pvarname : Name of the variable, short and easy to remember
+!- ptitle   : Full name of the variable
+!- punit    : Units of the variable (no units if blank string)
+!-
+!- The next 3 arguments give the size of that data
+!- that will be passed to histwrite. The zoom will be
+!- done there with the horizontal information obtained
+!- in histbeg and the vertical information to follow.
+!-
+!- pxsize   : Size in X direction (size of the data that will be
+!-            given to histwrite)
+!- pysize   : Size in Y direction
+!- phoriid  : ID of the horizontal axis
+!-
+!- The next two arguments give the vertical zoom to use.
+!-
+!- pzsize   : Size in Z direction (If 1 then no axis is declared
+!-            for this variable and pzid is not used)
+!- par_oriz : Off set of the zoom
+!- par_szz  : Size of the zoom
+!-
+!- pzid     : ID of the vertical axis to use. It has to have
+!-            the size of the zoom.
+!- xtype    : External netCDF type (hist_r4/hist_r8)
+!- popp     : Operation to be performed. The following options
+!-            exist today :
+!- inst : keeps instantaneous values for writting
+!- ave  : Computes the average from call between writes
+!- pfreq_opp: Frequency of this operation (in seconds)
+!- pfreq_wrt: Frequency at which the variable should be
+!-            written (in seconds)
+!- var_range: Range of the variable.
+!-            If the minimum is greater than the maximum,
+!-            the values will be calculated.
+!-
+!- VERSION
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pxsize,pysize,pzsize,pzid
+  INTEGER,INTENT(IN) :: par_oriz,par_szz,xtype,phoriid
+  CHARACTER(LEN=*),INTENT(IN) :: pvarname,punit,popp,ptitle
+  REAL,INTENT(IN) :: pfreq_opp,pfreq_wrt
+  REAL,DIMENSION(2),OPTIONAL,INTENT(IN) :: var_range
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: standard_name
+!-
+  INTEGER :: iv
+  CHARACTER(LEN=70) :: str70,str71,str72
+  CHARACTER(LEN=20) :: tmp_name
+  CHARACTER(LEN=40) :: str40
+  CHARACTER(LEN=10) :: str10
+  CHARACTER(LEN=120) :: ex_topps
+  REAL :: un_an,un_jour,test_fopp,test_fwrt
+  INTEGER :: pos,buff_sz
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  ex_topps = 'ave, inst, t_min, t_max, t_sum, once, never, l_max, l_min'
+!-
+  W_F(idf)%n_var = W_F(idf)%n_var+1
+  iv = W_F(idf)%n_var
+!-
+  IF (iv > nb_var_max) THEN
+    CALL ipslerr (3,"histdef", &
+   &  'Table of variables too small. You should increase nb_var_max',&
+   &  'in histcom.f90 in order to accomodate all these variables', &
+   &  ' ')
+  ENDIF
+!-
+! 1.0 Transfer informations on the variable to the common
+!     and verify that it does not already exist
+!-
+  IF (l_dbg) WRITE(*,*) "histdef : 1.0"
+!-
+  IF (iv > 1) THEN
+    CALL find_str (W_F(idf)%W_V(1:iv-1)%v_name,pvarname,pos)
+  ELSE
+    pos = 0
+  ENDIF
+!-
+  IF (pos > 0) THEN
+    str70 = "Variable already exists"
+    WRITE(str71,'("Check variable  ",a," in file",I3)') &
+ &    TRIM(pvarname),idf
+    str72 = "Can also be a wrong file ID in another declaration"
+    CALL ipslerr (3,"histdef",str70,str71,str72)
+  ENDIF
+!-
+  W_F(idf)%W_V(iv)%v_name = pvarname
+  W_F(idf)%W_V(iv)%title = ptitle
+  W_F(idf)%W_V(iv)%unit_name = punit
+  IF (PRESENT(standard_name)) THEN
+    W_F(idf)%W_V(iv)%std_name = standard_name
+  ELSE
+    W_F(idf)%W_V(iv)%std_name = ptitle
+  ENDIF
+  tmp_name = W_F(idf)%W_V(iv)%v_name
+!-
+! 1.1 decode the operations
+!-
+  W_F(idf)%W_V(iv)%fullop = popp
+  CALL buildop &
+ &  (TRIM(popp),ex_topps,W_F(idf)%W_V(iv)%topp,missing_val, &
+ &   W_F(idf)%W_V(iv)%sopp,W_F(idf)%W_V(iv)%scal, &
+ &   W_F(idf)%W_V(iv)%nbopp)
+!-
+! 1.2 If we have an even number of operations
+!     then we need to add identity
+!-
+  IF ( MOD(W_F(idf)%W_V(iv)%nbopp,2) == 0) THEN
+    W_F(idf)%W_V(iv)%nbopp = W_F(idf)%W_V(iv)%nbopp+1
+    W_F(idf)%W_V(iv)%sopp(W_F(idf)%W_V(iv)%nbopp) = 'ident'
+    W_F(idf)%W_V(iv)%scal(W_F(idf)%W_V(iv)%nbopp) = missing_val
+  ENDIF
+!-
+! 1.3 External type of the variable
+!-
+  IF (xtype == hist_r8) THEN
+    W_F(idf)%W_V(iv)%v_typ = hist_r8
+  ELSE
+    W_F(idf)%W_V(iv)%v_typ = hist_r4
+  ENDIF
+!-
+! 2.0 Put the size of the variable in the common and check
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "histdef : 2.0",idf,iv,W_F(idf)%W_V(iv)%nbopp, &
+ &    W_F(idf)%W_V(iv)%sopp(1:W_F(idf)%W_V(iv)%nbopp), &
+ &    W_F(idf)%W_V(iv)%scal(1:W_F(idf)%W_V(iv)%nbopp)
+  ENDIF
+!-
+  W_F(idf)%W_V(iv)%scsize(1:3) = (/ pxsize,pysize,pzsize /)
+  W_F(idf)%W_V(iv)%zorig(1:3) = &
+ &  (/ W_F(idf)%slab_ori(1),W_F(idf)%slab_ori(2),par_oriz /)
+  W_F(idf)%W_V(iv)%zsize(1:3) = &
+ &  (/ W_F(idf)%slab_siz(1),W_F(idf)%slab_siz(2),par_szz /)
+!-
+! Is the size of the full array the same as that of the coordinates ?
+!-
+  IF (    (pxsize > W_F(idf)%full_size(1)) &
+ &    .OR.(pysize > W_F(idf)%full_size(2)) ) THEN
+!-
+    str70 = "The size of the variable is different "// &
+ &          "from the one of the coordinates"
+    WRITE(str71,'("Size of coordinates :",2I4)') &
+ &   W_F(idf)%full_size(1),W_F(idf)%full_size(2)
+    WRITE(str72,'("Size declared for variable ",a," :",2I4)') &
+ &   TRIM(tmp_name),pxsize,pysize
+    CALL ipslerr (3,"histdef",str70,str71,str72)
+  ENDIF
+!-
+! Is the size of the zoom smaller than the coordinates ?
+!-
+  IF (    (W_F(idf)%full_size(1) < W_F(idf)%slab_siz(1)) &
+ &    .OR.(W_F(idf)%full_size(2) < W_F(idf)%slab_siz(2)) ) THEN
+    str70 = &
+ &   "Size of variable should be greater or equal to those of the zoom"
+    WRITE(str71,'("Size of XY zoom :",2I4)') &
+ &   W_F(idf)%slab_siz(1),W_F(idf)%slab_siz(2)
+    WRITE(str72,'("Size declared for variable ",A," :",2I4)') &
+ &   TRIM(tmp_name),pxsize,pysize
+    CALL ipslerr (3,"histdef",str70,str71,str72)
+  ENDIF
+!-
+! 2.1 We store the horizontal grid information with minimal
+!     and a fall back onto the default grid
+!-
+  IF ( (phoriid > 0).AND.(phoriid <= W_F(idf)%n_hax) ) THEN
+    W_F(idf)%W_V(iv)%h_axid = phoriid
+  ELSE
+    W_F(idf)%W_V(iv)%h_axid = 1
+    CALL ipslerr (2,"histdef", &
+   &  'We use the default grid for variable as an invalide',&
+   &  'ID was provided for variable : ',TRIM(pvarname))
+  ENDIF
+!-
+! 2.2 Check the vertical coordinates if needed
+!-
+  IF (par_szz > 1) THEN
+!-
+!-- Does the vertical coordinate exist ?
+!-
+    IF (pzid > W_F(idf)%n_zax) THEN
+      WRITE(str70, &
+ &    '("The vertical coordinate chosen for variable ",A)') &
+ &     TRIM(tmp_name)
+      str71 = " Does not exist."
+      CALL ipslerr (3,"histdef",str70,str71," ")
+    ENDIF
+!-
+!-- Is the vertical size of the variable equal to that of the axis ?
+!-
+    IF (par_szz /= W_F(idf)%zax_size(pzid)) THEN
+      str70 = "The size of the zoom does not correspond "// &
+ &            "to the size of the chosen vertical axis"
+      WRITE(str71,'("Size of zoom in z :",I4)') par_szz
+      WRITE(str72,'("Size declared for axis ",A," :",I4)') &
+ &     TRIM(W_F(idf)%zax_name(pzid)),W_F(idf)%zax_size(pzid)
+      CALL ipslerr (3,"histdef",str70,str71,str72)
+    ENDIF
+!-
+!-- Is the zoom smaller that the total size of the variable ?
+!-
+    IF (pzsize < par_szz) THEN
+      str70 = "The vertical size of variable "// &
+ &            "is smaller than that of the zoom."
+      WRITE(str71,'("Declared vertical size of data :",I5)') pzsize
+      WRITE(str72,'("Size of zoom for variable ",a," = ",I5)') &
+ &     TRIM(tmp_name),par_szz
+      CALL ipslerr (3,"histdef",str70,str71,str72)
+    ENDIF
+    W_F(idf)%W_V(iv)%z_axid = pzid
+  ELSE
+    W_F(idf)%W_V(iv)%z_axid = -99
+  ENDIF
+!-
+! 3.0 We get the size of the arrays histwrite will get
+!     and eventually allocate the time_buffer
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "histdef : 3.0"
+  ENDIF
+!-
+  buff_sz = W_F(idf)%W_V(iv)%zsize(1) &
+ &         *W_F(idf)%W_V(iv)%zsize(2) &
+ &         *W_F(idf)%W_V(iv)%zsize(3)
+!-
+  IF (     (TRIM(W_F(idf)%W_V(iv)%topp) /= "inst") &
+ &    .AND.(TRIM(W_F(idf)%W_V(iv)%topp) /= "once") &
+ &    .AND.(TRIM(W_F(idf)%W_V(iv)%topp) /= "never") )THEN
+    ALLOCATE(W_F(idf)%W_V(iv)%t_bf(buff_sz))
+    W_F(idf)%W_V(iv)%t_bf(:) = 0.
+    IF (l_dbg) THEN
+      WRITE(*,*) "histdef : 3.0 allocating time_buffer for", &
+ &      " idf = ",idf," iv = ",iv," size = ",buff_sz
+    ENDIF
+  ENDIF
+!-
+! 4.0 Transfer the frequency of the operations and check
+!     for validity. We have to pay attention to negative values
+!     of the frequency which indicate monthly time-steps.
+!     The strategy is to bring it back to seconds for the tests
+!-
+  IF (l_dbg) WRITE(*,*) "histdef : 4.0"
+!-
+  W_F(idf)%W_V(iv)%freq_opp = pfreq_opp
+  W_F(idf)%W_V(iv)%freq_wrt = pfreq_wrt
+!-
+  CALL ioget_calendar(un_an,un_jour)
+  IF (pfreq_opp < 0) THEN
+    CALL ioget_calendar(un_an)
+    test_fopp = pfreq_opp*(-1.)*un_an/12.*un_jour
+  ELSE
+    test_fopp = pfreq_opp
+  ENDIF
+  IF (pfreq_wrt < 0) THEN
+    CALL ioget_calendar(un_an)
+    test_fwrt = pfreq_wrt*(-1.)*un_an/12.*un_jour
+  ELSE
+    test_fwrt = pfreq_wrt
+  ENDIF
+!-
+! 4.1 Frequency of operations and output should be larger than deltat !
+!-
+  IF (test_fopp < W_F(idf)%deltat) THEN
+    str70 = 'Frequency of operations should be larger than deltat'
+    WRITE(str71,'("It is not the case for variable ",a," :",F10.4)') &
+ &   TRIM(tmp_name),pfreq_opp
+    str72 = "PATCH : frequency set to deltat"
+!-
+    CALL ipslerr (2,"histdef",str70,str71,str72)
+!-
+    W_F(idf)%W_V(iv)%freq_opp = W_F(idf)%deltat
+  ENDIF
+!-
+  IF (test_fwrt < W_F(idf)%deltat) THEN
+    str70 = 'Frequency of output should be larger than deltat'
+    WRITE(str71,'("It is not the case for variable ",a," :",F10.4)') &
+ &   TRIM(tmp_name),pfreq_wrt
+    str72 = "PATCH : frequency set to deltat"
+!-
+    CALL ipslerr (2,"histdef",str70,str71,str72)
+!-
+    W_F(idf)%W_V(iv)%freq_wrt = W_F(idf)%deltat
+  ENDIF
+!-
+! 4.2 First the existence of the operation is tested and then
+!     its compaticility with the choice of frequencies
+!-
+  IF (TRIM(W_F(idf)%W_V(iv)%topp) == "inst") THEN
+    IF (test_fopp /= test_fwrt) THEN
+      str70 = 'For instantaneous output the frequency '// &
+ &            'of operations and output'
+      WRITE(str71, &
+ &     '("should be the same, this was not case for variable ",a)') &
+ &      TRIM(tmp_name)
+      str72 = "PATCH : The smalest frequency of both is used"
+      CALL ipslerr (2,"histdef",str70,str71,str72)
+      IF (test_fopp < test_fwrt) THEN
+        W_F(idf)%W_V(iv)%freq_opp = pfreq_opp
+        W_F(idf)%W_V(iv)%freq_wrt = pfreq_opp
+      ELSE
+        W_F(idf)%W_V(iv)%freq_opp = pfreq_wrt
+        W_F(idf)%W_V(iv)%freq_wrt = pfreq_wrt
+      ENDIF
+    ENDIF
+  ELSE IF (INDEX(ex_topps,TRIM(W_F(idf)%W_V(iv)%topp)) > 0) THEN
+    IF (test_fopp > test_fwrt) THEN
+      str70 = 'For averages the frequency of operations '// &
+ &            'should be smaller or equal'
+      WRITE(str71, &
+ &     '("to that of output. It is not the case for variable ",a)') &
+ &     TRIM(tmp_name)
+      str72 = 'PATCH : The output frequency is used for both'
+      CALL ipslerr (2,"histdef",str70,str71,str72)
+      W_F(idf)%W_V(iv)%freq_opp = pfreq_wrt
+    ENDIF
+  ELSE
+    WRITE (str70,'("Operation on variable ",A," is unknown")') &
+ &   TRIM(tmp_name)
+    WRITE (str71,'("operation requested is :",A)') &
+ &   W_F(idf)%W_V(iv)%topp
+    WRITE (str72,'("File ID :",I3)') idf
+    CALL ipslerr (3,"histdef",str70,str71,str72)
+  ENDIF
+!-
+! 5.0 Initialize other variables of the common
+!-
+  IF (l_dbg) WRITE(*,*) "histdef : 5.0"
+!-
+  W_F(idf)%W_V(iv)%hist_wrt_rng = (PRESENT(var_range))
+  IF (W_F(idf)%W_V(iv)%hist_wrt_rng) THEN
+    W_F(idf)%W_V(iv)%hist_calc_rng = (var_range(1) > var_range(2))
+    IF (W_F(idf)%W_V(iv)%hist_calc_rng) THEN
+      W_F(idf)%W_V(iv)%hist_minmax(1:2) = &
+ &      (/ ABS(missing_val),-ABS(missing_val) /)
+    ELSE
+      W_F(idf)%W_V(iv)%hist_minmax(1:2) = var_range(1:2)
+    ENDIF
+  ENDIF
+!-
+! - freq_opp(idf,iv)/2./deltat(idf)
+  W_F(idf)%W_V(iv)%last_opp = W_F(idf)%itau0
+! - freq_wrt(idf,iv)/2./deltat(idf)
+  W_F(idf)%W_V(iv)%last_wrt = W_F(idf)%itau0
+! - freq_opp(idf,iv)/2./deltat(idf)
+  W_F(idf)%W_V(iv)%last_opp_chk = W_F(idf)%itau0
+! - freq_wrt(idf,iv)/2./deltat(idf)
+  W_F(idf)%W_V(iv)%last_wrt_chk = W_F(idf)%itau0
+  W_F(idf)%W_V(iv)%nb_opp = 0
+  W_F(idf)%W_V(iv)%nb_wrt = 0
+!-
+! 6.0 Get the time axis for this variable
+!-
+  IF (l_dbg) WRITE(*,*) "histdef : 6.0"
+!-
+! No time axis for once, l_max, l_min or never operation
+!-
+  IF (     (TRIM(W_F(idf)%W_V(iv)%topp) /= 'once')  &
+ &    .AND.(TRIM(W_F(idf)%W_V(iv)%topp) /= 'never') &
+ &    .AND.(TRIM(W_F(idf)%W_V(iv)%topp) /= 'l_max') &
+ &    .AND.(TRIM(W_F(idf)%W_V(iv)%topp) /= 'l_min') ) THEN
+    IF (TRIM(W_F(idf)%W_V(iv)%topp) == 'inst') THEN
+      str10 = 't_inst_'
+    ELSE
+      str10 = 't_op_'
+    ENDIF
+    IF (W_F(idf)%W_V(iv)%freq_wrt > 0) THEN
+      WRITE (UNIT=str40,FMT='(A,I8.8)') &
+&      TRIM(str10),INT(W_F(idf)%W_V(iv)%freq_wrt)
+    ELSE
+      WRITE (UNIT=str40,FMT='(A,I2.2,"month")') &
+&      TRIM(str10),ABS(INT(W_F(idf)%W_V(iv)%freq_wrt))
+    ENDIF
+    CALL find_str (W_F(idf)%W_V(1:W_F(idf)%n_tax)%tax_name,str40,pos)
+    IF (pos < 0) THEN
+      W_F(idf)%n_tax = W_F(idf)%n_tax+1
+      W_F(idf)%W_V(iv)%l_bnd = &
+ &      (TRIM(W_F(idf)%W_V(iv)%topp) /= 'inst')
+      W_F(idf)%W_V(W_F(idf)%n_tax)%tax_name = str40
+      W_F(idf)%W_V(W_F(idf)%n_tax)%tax_last = 0
+      W_F(idf)%W_V(iv)%t_axid = W_F(idf)%n_tax
+    ELSE
+      W_F(idf)%W_V(iv)%t_axid = pos
+    ENDIF
+  ELSE
+    IF (l_dbg) THEN
+      WRITE(*,*) "histdef : 7.0 ",TRIM(W_F(idf)%W_V(iv)%topp),'----'
+    ENDIF
+    W_F(idf)%W_V(iv)%t_axid = -99
+  ENDIF
+!-
+! 7.0 prepare frequence of writing and operation
+!     for never or once operation
+!-
+  IF (    (TRIM(W_F(idf)%W_V(iv)%topp) == 'once')  &
+ &    .OR.(TRIM(W_F(idf)%W_V(iv)%topp) == 'never') ) THEN
+    W_F(idf)%W_V(iv)%freq_opp = 0.
+    W_F(idf)%W_V(iv)%freq_wrt = 0.
+  ENDIF
+!---------------------
+END SUBROUTINE histdef
+!===
+SUBROUTINE histend (idf, snc4chunks)
+!---------------------------------------------------------------------
+!- This subroutine end the decalaration of variables and sets the
+!- time axes in the netcdf file and puts it into the write mode.
+!-
+!- INPUT
+!-
+!- idf : ID of the file to be worked on
+!-
+!- VERSION
+!-
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf
+  TYPE(snc4_ctl), OPTIONAL,INTENT(IN) :: snc4chunks
+!-
+  INTEGER :: nfid,nvid,iret,ndim,iv,itx,ziv,itax,dim_cnt
+  INTEGER,DIMENSION(4) :: dims
+  INTEGER :: year,month,day,hours,minutes
+  REAL :: sec
+  REAL :: rtime0
+  CHARACTER(LEN=30) :: str30
+  CHARACTER(LEN=35) :: str35
+  CHARACTER(LEN=120) :: assoc
+  CHARACTER(LEN=70) :: str70
+  CHARACTER(LEN=3),DIMENSION(12) :: cal =   &
+ &  (/ 'JAN','FEB','MAR','APR','MAY','JUN', &
+ &     'JUL','AUG','SEP','OCT','NOV','DEC' /)
+  CHARACTER(LEN=7) :: tmp_opp
+  LOGICAL :: l_b
+  LOGICAL :: l_dbg
+  INTEGER, DIMENSION(4) :: ichunksz    ! NETCDF4 chunk sizes
+  INTEGER :: ichunkalg, ishuffle,&
+             ideflate, ideflate_level
+  LOGICAL :: lchunk = .FALSE.   ! logical switch to activate chunking when appropriate
+!-
+  ! NetCDF4 chunking and compression parameters
+  ichunkalg = 0
+  ishuffle = 1
+  ideflate = 1
+  ideflate_level = 1
+  !
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  nfid = W_F(idf)%ncfid
+!-
+! 1.0 Create the time axes
+!-
+  IF (l_dbg) WRITE(*,*) "histend : 1.0"
+!-
+! 1.1 Define the time dimensions needed for this file
+!-
+  iret = NF90_DEF_DIM (nfid,'time_counter', &
+ &                     NF90_UNLIMITED,W_F(idf)%tid)
+  DO iv=1,W_F(idf)%n_var
+    IF (W_F(idf)%W_V(iv)%l_bnd) THEN
+      iret = NF90_DEF_DIM (nfid,'tbnds',2,W_F(idf)%bid)
+      EXIT
+    ENDIF
+  ENDDO
+!-
+! 1.2 Define all the time axes needed for this file
+!-
+  DO itx=1,W_F(idf)%n_tax
+    dims(1) = W_F(idf)%tid
+    l_b = (INDEX(W_F(idf)%W_V(itx)%tax_name,"t_op_") == 1)
+    IF (itx > 1) THEN
+      str30 = W_F(idf)%W_V(itx)%tax_name
+    ELSE
+      str30 = "time_counter"
+    ENDIF
+    IF (l_b) THEN
+      str35 = TRIM(str30)//'_bnds'
+    ENDIF
+    iret = NF90_DEF_VAR (nfid,TRIM(str30),NF90_REAL8, &
+ &          dims(1),W_F(idf)%W_V(itx)%tdimid)
+    IF (itx <= 1) THEN
+      iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid,'axis',"T")
+    ENDIF
+    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &          'standard_name',"time")
+!---
+!   To transform the current itau into a real date and take it
+!   as the origin of the file requires the time counter to change.
+!   Thus it is an operation the user has to ask for.
+!   This function should thus only be re-instated
+!   if there is a ioconf routine to control it.
+!---
+!-- rtime0 = itau2date(itau0(idf),date0(idf),deltat(idf))
+    rtime0 = W_F(idf)%date0
+!-
+    CALL ju2ymds(rtime0,year,month,day,sec)
+!---
+!   Catch any error induced by a change in calendar !
+!---
+    IF (year < 0) THEN
+      year = 2000+year
+    ENDIF
+!-
+    hours = INT(sec/(60.*60.))
+    minutes = INT((sec-hours*60.*60.)/60.)
+    sec = sec-(hours*60.*60.+minutes*60.)
+!-
+    WRITE (UNIT=str70, &
+ &   FMT='(A,I4.4,"-",I2.2,"-",I2.2," ",I2.2,":",I2.2,":",I2.2)') &
+ &    'seconds since ',year,month,day,hours,minutes,INT(sec)
+    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &           'units',TRIM(str70))
+!-
+    CALL ioget_calendar (str30)
+    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &           'calendar',TRIM(str30))
+!-
+    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &           'title','Time')
+!-
+    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &           'long_name','Time axis')
+!-
+    WRITE (UNIT=str70, &
+ &   FMT='(" ",I4.4,"-",A3,"-",I2.2," ",I2.2,":",I2.2,":",I2.2)') &
+ &    year,cal(month),day,hours,minutes,INT(sec)
+    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &           'time_origin',TRIM(str70))
+!---
+    IF (l_b) THEN
+      iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &             'bounds',TRIM(str35))
+      dims(1:2) = (/ W_F(idf)%bid,W_F(idf)%tid /)
+      iret = NF90_DEF_VAR (nfid,TRIM(str35),NF90_REAL8, &
+ &            dims(1:2),W_F(idf)%W_V(itx)%tbndid)
+    ENDIF
+  ENDDO
+!-
+! 2.0 declare the variables
+!-
+  IF (l_dbg) WRITE(*,*) "histend : 2.0"
+!-
+  DO iv=1,W_F(idf)%n_var
+!---
+    itax = W_F(idf)%W_V(iv)%t_axid
+!---
+    IF (W_F(idf)%regular) THEN
+      dims(1:2) = (/ W_F(idf)%xid,W_F(idf)%yid /)
+      dim_cnt = 2
+    ELSE
+      dims(1) = W_F(idf)%xid
+      dim_cnt = 1
+    ENDIF
+!---
+    tmp_opp = W_F(idf)%W_V(iv)%topp
+    ziv = W_F(idf)%W_V(iv)%z_axid
+!---
+!   2.1 dimension of field
+!---
+    IF ((TRIM(tmp_opp) /= 'never')) THEN
+      IF (     (TRIM(tmp_opp) /= 'once')  &
+     &    .AND.(TRIM(tmp_opp) /= 'l_max') &
+     &    .AND.(TRIM(tmp_opp) /= 'l_min') ) THEN
+        IF (ziv == -99) THEN
+          ndim = dim_cnt+1
+          dims(dim_cnt+1:dim_cnt+2) = (/ W_F(idf)%tid,0 /)
+        ELSE
+          ndim = dim_cnt+2
+          dims(dim_cnt+1:dim_cnt+2) = &
+ &         (/ W_F(idf)%zax_ids(ziv),W_F(idf)%tid /)
+        ENDIF
+      ELSE
+        IF (ziv == -99) THEN
+          ndim = dim_cnt
+          dims(dim_cnt+1:dim_cnt+2) = (/ 0,0 /)
+        ELSE
+          ndim = dim_cnt+1
+          dims(dim_cnt+1:dim_cnt+2) = (/ W_F(idf)%zax_ids(ziv),0 /)
+        ENDIF
+      ENDIF
+!-
+      iret = NF90_DEF_VAR (nfid,TRIM(W_F(idf)%W_V(iv)%v_name), &
+ &             W_F(idf)%W_V(iv)%v_typ,dims(1:ABS(ndim)),nvid)
+!-
+      IF( ndim == 4 ) THEN
+        IF( PRESENT( snc4chunks ) ) THEN
+          IF( snc4chunks%luse ) THEN
+           ichunksz = 1
+           iret = NF90_INQUIRE_DIMENSION( nfid, W_F(idf)%xid, len = ichunksz(1) )
+           iret = NF90_INQUIRE_DIMENSION( nfid, W_F(idf)%yid, len = ichunksz(2) )
+           IF ( ziv .NE. -99 ) &
+              iret = NF90_INQUIRE_DIMENSION( nfid, W_F(idf)%zax_ids(ziv), len = ichunksz(3) )
+           ichunksz(1) = MIN(ichunksz(1), MAX((ichunksz(1)-1)/snc4chunks%ni + 1,16))
+           ichunksz(2) = MIN(ichunksz(2), MAX((ichunksz(2)-1)/snc4chunks%nj + 1,16))
+           ichunksz(3) = MIN(ichunksz(3), MAX((ichunksz(3)-1)/snc4chunks%nk + 1, 1))
+           ! Always use a chunk size of 1 for the unlimited dimension
+           iret = SET_NF90_DEF_VAR_CHUNKING(nfid, nvid, ichunkalg, ichunksz)
+           iret = SET_NF90_DEF_VAR_DEFLATE(nfid, nvid, ishuffle, ideflate, ideflate_level)
+          ENDIF
+        ENDIF
+      ENDIF
+      W_F(idf)%W_V(iv)%ncvid = nvid
+!-
+      IF (LEN_TRIM(W_F(idf)%W_V(iv)%unit_name) > 0) THEN
+        iret = NF90_PUT_ATT (nfid,nvid,'units', &
+ &                           TRIM(W_F(idf)%W_V(iv)%unit_name))
+      ENDIF
+      iret = NF90_PUT_ATT (nfid,nvid,'standard_name', &
+ &                         TRIM(W_F(idf)%W_V(iv)%std_name))
+!-
+      IF (W_F(idf)%W_V(iv)%v_typ == hist_r8) THEN
+        iret = NF90_PUT_ATT (nfid,nvid,'_FillValue',NF90_FILL_REAL8)
+      ELSE
+        iret = NF90_PUT_ATT (nfid,nvid,'_FillValue',NF90_FILL_REAL4)
+      ENDIF
+      IF (W_F(idf)%W_V(iv)%hist_wrt_rng) THEN
+        IF (W_F(idf)%W_V(iv)%v_typ == hist_r8) THEN
+          iret = NF90_PUT_ATT (nfid,nvid,'valid_min', &
+ &                 REAL(W_F(idf)%W_V(iv)%hist_minmax(1),KIND=8))
+          iret = NF90_PUT_ATT (nfid,nvid,'valid_max', &
+ &                 REAL(W_F(idf)%W_V(iv)%hist_minmax(2),KIND=8))
+        ELSE
+          iret = NF90_PUT_ATT (nfid,nvid,'valid_min', &
+ &                 REAL(W_F(idf)%W_V(iv)%hist_minmax(1),KIND=4))
+          iret = NF90_PUT_ATT (nfid,nvid,'valid_max', &
+ &                 REAL(W_F(idf)%W_V(iv)%hist_minmax(2),KIND=4))
+        ENDIF
+      ENDIF
+      iret = NF90_PUT_ATT (nfid,nvid,'long_name', &
+ &                         TRIM(W_F(idf)%W_V(iv)%title))
+      iret = NF90_PUT_ATT (nfid,nvid,'online_operation', &
+ &                         TRIM(W_F(idf)%W_V(iv)%fullop))
+!-
+      SELECT CASE(ndim)
+      CASE(-3,2:4)
+      CASE DEFAULT
+        CALL ipslerr (3,"histend", &
+       &  'less than 2 or more than 4 dimensions are not', &
+       &  'allowed at this stage',' ')
+      END SELECT
+!-
+      assoc=TRIM(W_F(idf)%hax_name(W_F(idf)%W_V(iv)%h_axid,2)) &
+ &   //' '//TRIM(W_F(idf)%hax_name(W_F(idf)%W_V(iv)%h_axid,1))
+!-
+      ziv = W_F(idf)%W_V(iv)%z_axid
+      IF (ziv > 0) THEN
+        str30 = W_F(idf)%zax_name(ziv)
+        assoc = TRIM(str30)//' '//TRIM(assoc)
+      ENDIF
+!-
+      IF (itax > 0) THEN
+        IF (itax > 1) THEN
+          str30 = W_F(idf)%W_V(itax)%tax_name
+        ELSE
+          str30 = "time_counter"
+        ENDIF
+        assoc = TRIM(str30)//' '//TRIM(assoc)
+!-
+        IF (l_dbg) THEN
+          WRITE(*,*) "histend : 2.0.n, freq_opp, freq_wrt", &
+ &          W_F(idf)%W_V(iv)%freq_opp,W_F(idf)%W_V(iv)%freq_wrt
+        ENDIF
+!-
+        iret = NF90_PUT_ATT (nfid,nvid,'interval_operation', &
+ &                           REAL(W_F(idf)%W_V(iv)%freq_opp,KIND=4))
+        iret = NF90_PUT_ATT (nfid,nvid,'interval_write', &
+ &                           REAL(W_F(idf)%W_V(iv)%freq_wrt,KIND=4))
+      ENDIF
+      iret = NF90_PUT_ATT (nfid,nvid,'coordinates',TRIM(assoc))
+    ENDIF
+  ENDDO
+!-
+! 2.2 Add DOMAIN attributes if needed
+!-
+  IF (W_F(idf)%dom_id_svg >= 0) THEN
+    CALL flio_dom_att (nfid,W_F(idf)%dom_id_svg)
+  ENDIF
+!-
+! 3.0 Put the netcdf file into write mode
+!-
+  IF (l_dbg) WRITE(*,*) "histend : 3.0"
+!-
+  iret = NF90_ENDDEF (nfid)
+!-
+! 4.0 Give some informations to the user
+!-
+  IF (l_dbg) WRITE(*,*) "histend : 4.0"
+!-
+!!$  WRITE(str70,'("All variables have been initialized on file :",I3)') idf
+!!$  CALL ipslerr (1,'histend',str70,'',' ')
+!---------------------
+END SUBROUTINE histend
+!===
+SUBROUTINE histwrite_r1d (idf,pvarname,pitau,pdata,nbindex,nindex)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pitau,nbindex
+  INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex
+  REAL,DIMENSION(:),INTENT(IN) :: pdata
+  CHARACTER(LEN=*),INTENT(IN) :: pvarname
+!---------------------------------------------------------------------
+  CALL histw_rnd (idf,pvarname,pitau,nbindex,nindex,pdata_1d=pdata)
+!---------------------------
+END SUBROUTINE histwrite_r1d
+!===
+SUBROUTINE histwrite_r2d (idf,pvarname,pitau,pdata,nbindex,nindex)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pitau,nbindex
+  INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex
+  REAL,DIMENSION(:,:),INTENT(IN) :: pdata
+  CHARACTER(LEN=*),INTENT(IN) :: pvarname
+!---------------------------------------------------------------------
+  CALL histw_rnd (idf,pvarname,pitau,nbindex,nindex,pdata_2d=pdata)
+!---------------------------
+END SUBROUTINE histwrite_r2d
+!===
+SUBROUTINE histwrite_r3d (idf,pvarname,pitau,pdata,nbindex,nindex)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pitau,nbindex
+  INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex
+  REAL,DIMENSION(:,:,:),INTENT(IN) :: pdata
+  CHARACTER(LEN=*),INTENT(IN) :: pvarname
+!---------------------------------------------------------------------
+  CALL histw_rnd (idf,pvarname,pitau,nbindex,nindex,pdata_3d=pdata)
+!---------------------------
+END SUBROUTINE histwrite_r3d
+!===
+SUBROUTINE histw_rnd (idf,pvarname,pitau,nbindex,nindex, &
+  &                   pdata_1d,pdata_2d,pdata_3d)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pitau,nbindex
+  INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex
+  CHARACTER(LEN=*),INTENT(IN) :: pvarname
+  REAL,DIMENSION(:),INTENT(IN),OPTIONAL     :: pdata_1d
+  REAL,DIMENSION(:,:),INTENT(IN),OPTIONAL   :: pdata_2d
+  REAL,DIMENSION(:,:,:),INTENT(IN),OPTIONAL :: pdata_3d
+!-
+  LOGICAL :: do_oper,do_write,largebuf,l1d,l2d,l3d
+  INTEGER :: iv,io,nbpt_out
+  INTEGER              :: nbpt_in1
+  INTEGER,DIMENSION(2) :: nbpt_in2
+  INTEGER,DIMENSION(3) :: nbpt_in3
+  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: tbf_1
+  CHARACTER(LEN=7) :: tmp_opp
+  CHARACTER(LEN=13) :: c_nam
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  l1d=PRESENT(pdata_1d); l2d=PRESENT(pdata_2d); l3d=PRESENT(pdata_3d);
+  IF      (l1d) THEN
+    c_nam = 'histwrite_r1d'
+  ELSE IF (l2d) THEN
+    c_nam = 'histwrite_r2d'
+  ELSE IF (l3d) THEN
+    c_nam = 'histwrite_r3d'
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "histwrite : ",c_nam
+  ENDIF
+!-
+! 1.0 Try to catch errors like specifying the wrong file ID.
+!     Thanks Marine for showing us what errors users can make !
+!-
+  IF ( (idf < 1).OR.(idf > nb_files_max) ) THEN
+    CALL ipslerr (3,"histwrite", &
+ &    'Illegal file ID in the histwrite of variable',pvarname,' ')
+  ENDIF
+!-
+! 1.1 Find the id of the variable to be written and the real time
+!-
+  CALL histvar_seq (idf,pvarname,iv)
+!-
+! 2.0 do nothing for never operation
+!-
+  tmp_opp = W_F(idf)%W_V(iv)%topp
+!-
+  IF (TRIM(tmp_opp) == "never") THEN
+    W_F(idf)%W_V(iv)%last_opp_chk = -99
+    W_F(idf)%W_V(iv)%last_wrt_chk = -99
+  ENDIF
+!-
+! 3.0 We check if we need to do an operation
+!-
+  IF (W_F(idf)%W_V(iv)%last_opp_chk == pitau) THEN
+    CALL ipslerr (3,"histwrite", &
+ &    'This variable has already been analysed at the present', &
+ &    'time step',TRIM(pvarname))
+  ENDIF
+!-
+  CALL isittime &
+ &  (pitau,W_F(idf)%date0,W_F(idf)%deltat, &
+ &   W_F(idf)%W_V(iv)%freq_opp, &
+ &   W_F(idf)%W_V(iv)%last_opp, &
+ &   W_F(idf)%W_V(iv)%last_opp_chk,do_oper)
+!-
+! 4.0 We check if we need to write the data
+!-
+  IF (W_F(idf)%W_V(iv)%last_wrt_chk == pitau) THEN
+    CALL ipslerr (3,"histwrite", &
+ &    'This variable as already been written for the present', &
+ &    'time step',' ')
+  ENDIF
+!-
+  CALL isittime &
+ &  (pitau,W_F(idf)%date0,W_F(idf)%deltat, &
+ &   W_F(idf)%W_V(iv)%freq_wrt, &
+ &   W_F(idf)%W_V(iv)%last_wrt, &
+ &   W_F(idf)%W_V(iv)%last_wrt_chk,do_write)
+!-
+! 5.0 histwrite called
+!-
+  IF (do_oper.OR.do_write) THEN
+!-
+!-- 5.1 Get the sizes of the data we will handle
+!-
+    IF (W_F(idf)%W_V(iv)%datasz_in(1) <= 0) THEN
+!---- There is the risk here that the user has over-sized the array.
+!---- But how can we catch this ?
+!---- In the worst case we will do impossible operations
+!---- on part of the data !
+      W_F(idf)%W_V(iv)%datasz_in(1:3) = -1
+      IF      (l1d) THEN
+        W_F(idf)%W_V(iv)%datasz_in(1) = SIZE(pdata_1d)
+      ELSE IF (l2d) THEN
+        W_F(idf)%W_V(iv)%datasz_in(1) = SIZE(pdata_2d,DIM=1)
+        W_F(idf)%W_V(iv)%datasz_in(2) = SIZE(pdata_2d,DIM=2)
+      ELSE IF (l3d) THEN
+        W_F(idf)%W_V(iv)%datasz_in(1) = SIZE(pdata_3d,DIM=1)
+        W_F(idf)%W_V(iv)%datasz_in(2) = SIZE(pdata_3d,DIM=2)
+        W_F(idf)%W_V(iv)%datasz_in(3) = SIZE(pdata_3d,DIM=3)
+      ENDIF
+    ENDIF
+!-
+!-- 5.2 The maximum size of the data will give the size of the buffer
+!-
+    IF (W_F(idf)%W_V(iv)%datasz_max <= 0) THEN
+      largebuf = .FALSE.
+      DO io=1,W_F(idf)%W_V(iv)%nbopp
+        IF (INDEX(fuchnbout,W_F(idf)%W_V(iv)%sopp(io)) > 0) THEN
+          largebuf = .TRUE.
+        ENDIF
+      ENDDO
+      IF (largebuf) THEN
+        W_F(idf)%W_V(iv)%datasz_max = &
+ &        W_F(idf)%W_V(iv)%scsize(1) &
+ &       *W_F(idf)%W_V(iv)%scsize(2) &
+ &       *W_F(idf)%W_V(iv)%scsize(3)
+      ELSE
+        IF      (l1d) THEN
+          W_F(idf)%W_V(iv)%datasz_max = &
+ &          W_F(idf)%W_V(iv)%datasz_in(1)
+        ELSE IF (l2d) THEN
+          W_F(idf)%W_V(iv)%datasz_max = &
+ &          W_F(idf)%W_V(iv)%datasz_in(1) &
+ &         *W_F(idf)%W_V(iv)%datasz_in(2)
+        ELSE IF (l3d) THEN
+          W_F(idf)%W_V(iv)%datasz_max = &
+ &          W_F(idf)%W_V(iv)%datasz_in(1) &
+ &         *W_F(idf)%W_V(iv)%datasz_in(2) &
+ &         *W_F(idf)%W_V(iv)%datasz_in(3)
+        ENDIF
+      ENDIF
+    ENDIF
+!-
+    IF (.NOT.ALLOCATED(tbf_1)) THEN
+      IF (l_dbg) THEN
+        WRITE(*,*) &
+ &       c_nam//" : allocate tbf_1 for size = ", &
+ &       W_F(idf)%W_V(iv)%datasz_max
+      ENDIF
+      ALLOCATE(tbf_1(W_F(idf)%W_V(iv)%datasz_max))
+    ELSE IF (W_F(idf)%W_V(iv)%datasz_max > SIZE(tbf_1)) THEN
+      IF (l_dbg) THEN
+        WRITE(*,*) &
+ &       c_nam//" : re-allocate tbf_1 for size = ", &
+ &       W_F(idf)%W_V(iv)%datasz_max
+      ENDIF
+      DEALLOCATE(tbf_1)
+      ALLOCATE(tbf_1(W_F(idf)%W_V(iv)%datasz_max))
+    ENDIF
+!-
+!-- We have to do the first operation anyway.
+!-- Thus we do it here and change the ranke
+!-- of the data at the same time. This should speed up things.
+!-
+    nbpt_out = W_F(idf)%W_V(iv)%datasz_max
+    IF      (l1d) THEN
+      nbpt_in1 = W_F(idf)%W_V(iv)%datasz_in(1)
+      CALL mathop (W_F(idf)%W_V(iv)%sopp(1),nbpt_in1,pdata_1d, &
+ &                 missing_val,nbindex,nindex, &
+ &                 W_F(idf)%W_V(iv)%scal(1),nbpt_out,tbf_1)
+    ELSE IF (l2d) THEN
+      nbpt_in2(1:2) = W_F(idf)%W_V(iv)%datasz_in(1:2)
+      CALL mathop (W_F(idf)%W_V(iv)%sopp(1),nbpt_in2,pdata_2d, &
+ &                 missing_val,nbindex,nindex, &
+ &                 W_F(idf)%W_V(iv)%scal(1),nbpt_out,tbf_1)
+    ELSE IF (l3d) THEN
+      nbpt_in3(1:3) = W_F(idf)%W_V(iv)%datasz_in(1:3)
+      CALL mathop (W_F(idf)%W_V(iv)%sopp(1),nbpt_in3,pdata_3d, &
+ &                 missing_val,nbindex,nindex, &
+ &                 W_F(idf)%W_V(iv)%scal(1),nbpt_out,tbf_1)
+    ENDIF
+    CALL histwrite_real (idf,iv,pitau,nbpt_out, &
+ &            tbf_1,nbindex,nindex,do_oper,do_write)
+  ENDIF
+!-
+! 6.0 Manage time steps
+!-
+  IF ((TRIM(tmp_opp) /= "once").AND.(TRIM(tmp_opp) /= "never")) THEN
+    W_F(idf)%W_V(iv)%last_opp_chk = pitau
+    W_F(idf)%W_V(iv)%last_wrt_chk = pitau
+  ELSE
+    W_F(idf)%W_V(iv)%last_opp_chk = -99
+    W_F(idf)%W_V(iv)%last_wrt_chk = -99
+  ENDIF
+!-----------------------
+END SUBROUTINE histw_rnd
+!===
+SUBROUTINE histwrite_real &
+ & (idf,iv,pitau,nbdpt,tbf_1,nbindex,nindex,do_oper,do_write)
+!---------------------------------------------------------------------
+!- This subroutine is internal and does the calculations and writing
+!- if needed. At a later stage it should be split into an operation
+!- and writing subroutines.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pitau,iv, &
+ &                      nbindex,nindex(nbindex),nbdpt
+  REAL,DIMENSION(:)  :: tbf_1
+  LOGICAL,INTENT(IN) :: do_oper,do_write
+!-
+  INTEGER :: tsz,nfid,nvid,iret,itax,io,nbin,nbout
+  INTEGER :: nx,ny,nz,ky,kz,kt,kc
+  INTEGER,DIMENSION(4) :: corner,edges
+  INTEGER :: itime
+!-
+  REAL :: rtime
+  REAL,DIMENSION(2) :: t_bnd
+  CHARACTER(LEN=7) :: tmp_opp
+  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: tbf_2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "histwrite 0.0 : VAR : ",W_F(idf)%W_V(iv)%v_name
+    WRITE(*,*) "histwrite 0.0 : nbindex :",nbindex
+    WRITE(*,*) "histwrite 0.0 : nindex  :",nindex(1:MIN(3,nbindex)),'...'
+  ENDIF
+!-
+! The sizes which can be encoutered
+!-
+  tsz =  W_F(idf)%W_V(iv)%zsize(1) &
+ &      *W_F(idf)%W_V(iv)%zsize(2) &
+ &      *W_F(idf)%W_V(iv)%zsize(3)
+!-
+! 1.0 We allocate and the temporary space needed for operations.
+!     The buffers are only deallocated when more space is needed.
+!     This reduces the umber of allocates but increases memory needs.
+!-
+  IF (.NOT.ALLOCATED(tbf_2)) THEN
+    IF (l_dbg) THEN
+      WRITE(*,*) "histwrite_real 1.1 allocate tbf_2 ",SIZE(tbf_1)
+    ENDIF
+    ALLOCATE(tbf_2(W_F(idf)%W_V(iv)%datasz_max))
+  ELSE IF (W_F(idf)%W_V(iv)%datasz_max > SIZE(tbf_2)) THEN
+    IF (l_dbg) THEN
+      WRITE(*,*) "histwrite_real 1.2 re-allocate tbf_2 : ", &
+     & SIZE(tbf_1)," instead of ",SIZE(tbf_2)
+    ENDIF
+    DEALLOCATE(tbf_2)
+    ALLOCATE(tbf_2(W_F(idf)%W_V(iv)%datasz_max))
+  ENDIF
+!-
+  rtime = pitau*W_F(idf)%deltat
+  tmp_opp = W_F(idf)%W_V(iv)%topp
+!-
+! 3.0 Do the operations or transfer the slab of data into tbf_1
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "histwrite: 3.0",idf
+  ENDIF
+!-
+! 3.1 DO the Operations only if needed
+!-
+  IF (do_oper) THEN
+    nbout = nbdpt
+!-
+!-- 3.4 We continue the sequence of operations
+!--     we started in the interface routine
+!-
+    DO io=2,W_F(idf)%W_V(iv)%nbopp,2
+      nbin = nbout
+      nbout = W_F(idf)%W_V(iv)%datasz_max
+      CALL mathop(W_F(idf)%W_V(iv)%sopp(io),nbin,tbf_1, &
+ &      missing_val,nbindex,nindex,W_F(idf)%W_V(iv)%scal(io), &
+ &      nbout,tbf_2)
+      IF (l_dbg) THEN
+        WRITE(*,*) &
+ &       "histwrite: 3.4a nbout : ",nbin,nbout,W_F(idf)%W_V(iv)%sopp(io)
+      ENDIF
+!-
+      nbin = nbout
+      nbout = W_F(idf)%W_V(iv)%datasz_max
+      CALL mathop(W_F(idf)%W_V(iv)%sopp(io+1),nbin,tbf_2, &
+ &      missing_val,nbindex,nindex,W_F(idf)%W_V(iv)%scal(io+1), &
+ &      nbout,tbf_1)
+      IF (l_dbg) THEN
+        WRITE(*,*) &
+ &     "histwrite: 3.4b nbout : ",nbin,nbout,W_F(idf)%W_V(iv)%sopp(io+1)
+      ENDIF
+    ENDDO
+!-
+!   3.5 Zoom into the data
+!-
+    IF (l_dbg) THEN
+      WRITE(*,*) &
+ &     "histwrite: 3.5 size(tbf_1) : ",SIZE(tbf_1)
+      WRITE(*,*) &
+ &     "histwrite: 3.5 slab in X :", &
+ &     W_F(idf)%W_V(iv)%zorig(1),W_F(idf)%W_V(iv)%zsize(1)
+      WRITE(*,*) &
+ &     "histwrite: 3.5 slab in Y :", &
+ &     W_F(idf)%W_V(iv)%zorig(2),W_F(idf)%W_V(iv)%zsize(2)
+      WRITE(*,*) &
+ &     "histwrite: 3.5 slab in Z :", &
+ &     W_F(idf)%W_V(iv)%zorig(3),W_F(idf)%W_V(iv)%zsize(3)
+      WRITE(*,*) &
+ &     "histwrite: 3.5 slab of input:", &
+ &     W_F(idf)%W_V(iv)%scsize(1), &
+ &     W_F(idf)%W_V(iv)%scsize(2), &
+ &     W_F(idf)%W_V(iv)%scsize(3)
+    ENDIF
+!---
+!-- We have to consider blocks of contiguous data
+!---
+    nx=MAX(W_F(idf)%W_V(iv)%zsize(1),1)
+    ny=MAX(W_F(idf)%W_V(iv)%zsize(2),1)
+    nz=MAX(W_F(idf)%W_V(iv)%zsize(3),1)
+    IF     (     (W_F(idf)%W_V(iv)%zorig(1) == 1) &
+ &          .AND.(   W_F(idf)%W_V(iv)%zsize(1) &
+ &                == W_F(idf)%W_V(iv)%scsize(1)) &
+ &          .AND.(W_F(idf)%W_V(iv)%zorig(2) == 1) &
+ &          .AND.(   W_F(idf)%W_V(iv)%zsize(2) &
+ &                == W_F(idf)%W_V(iv)%scsize(2))) THEN
+      kt = (W_F(idf)%W_V(iv)%zorig(3)-1)*nx*ny
+      tbf_2(1:nx*ny*nz) = tbf_1(kt+1:kt+nx*ny*nz)
+    ELSEIF (     (W_F(idf)%W_V(iv)%zorig(1) == 1) &
+ &          .AND.(   W_F(idf)%W_V(iv)%zsize(1) &
+ &                == W_F(idf)%W_V(iv)%scsize(1))) THEN
+      kc = -nx*ny
+      DO kz=W_F(idf)%W_V(iv)%zorig(3),W_F(idf)%W_V(iv)%zorig(3)+nz-1
+        kc = kc+nx*ny
+        kt = ( (kz-1)*W_F(idf)%W_V(iv)%scsize(2) &
+ &            +W_F(idf)%W_V(iv)%zorig(2)-1)*nx
+        tbf_2(kc+1:kc+nx*ny) = tbf_1(kt+1:kt+nx*ny)
+      ENDDO
+    ELSE
+      kc = -nx
+      DO kz=W_F(idf)%W_V(iv)%zorig(3),W_F(idf)%W_V(iv)%zorig(3)+nz-1
+        DO ky=W_F(idf)%W_V(iv)%zorig(2),W_F(idf)%W_V(iv)%zorig(2)+ny-1
+          kc = kc+nx
+          kt = ((kz-1)*W_F(idf)%W_V(iv)%scsize(2)+ky-1) &
+ &            *W_F(idf)%W_V(iv)%scsize(1) &
+ &            +W_F(idf)%W_V(iv)%zorig(1)-1
+          tbf_2(kc+1:kc+nx) = tbf_1(kt+1:kt+nx)
+        ENDDO
+      ENDDO
+    ENDIF
+!-
+!-- 4.0 Get the min and max of the field
+!-
+    IF (l_dbg) THEN
+      WRITE(*,*) "histwrite: 4.0 tbf_1",idf,iv, &
+ &      TRIM(tmp_opp),' ---- ',LEN_TRIM(tmp_opp),nbindex
+    ENDIF
+!-
+    IF (W_F(idf)%W_V(iv)%hist_calc_rng) THEN
+      W_F(idf)%W_V(iv)%hist_minmax(1) = &
+ &      MIN(W_F(idf)%W_V(iv)%hist_minmax(1), &
+ &      MINVAL(tbf_2(1:tsz),MASK=tbf_2(1:tsz) /= missing_val))
+      W_F(idf)%W_V(iv)%hist_minmax(2) = &
+ &      MAX(W_F(idf)%W_V(iv)%hist_minmax(2), &
+ &      MAXVAL(tbf_2(1:tsz),MASK=tbf_2(1:tsz) /= missing_val))
+    ENDIF
+!-
+!-- 5.0 Do the operations if needed. In the case of instantaneous
+!--     output we do not transfer to the time_buffer.
+!-
+    IF (l_dbg) THEN
+      WRITE(*,*) "histwrite: 5.0 idf : ",idf," iv : ",iv," tsz : ",tsz
+    ENDIF
+!-
+    IF (     (TRIM(tmp_opp) /= "inst") &
+ &      .AND.(TRIM(tmp_opp) /= "once") ) THEN
+      CALL moycum(tmp_opp,tsz,W_F(idf)%W_V(iv)%t_bf, &
+ &           tbf_2,W_F(idf)%W_V(iv)%nb_opp)
+    ENDIF
+!-
+    W_F(idf)%W_V(iv)%last_opp = pitau
+    W_F(idf)%W_V(iv)%nb_opp = W_F(idf)%W_V(iv)%nb_opp+1
+!-
+  ENDIF
+!-
+! 6.0 Write to file if needed
+!-
+  IF (l_dbg) WRITE(*,*) "histwrite: 6.0",idf
+!-
+  IF (do_write) THEN
+!-
+    nfid = W_F(idf)%ncfid
+    nvid = W_F(idf)%W_V(iv)%ncvid
+!-
+!-- 6.1 Do the operations that are needed before writting
+!-
+    IF (l_dbg) WRITE(*,*) "histwrite: 6.1",idf
+!-
+    IF (     (TRIM(tmp_opp) /= "inst") &
+ &      .AND.(TRIM(tmp_opp) /= "once") ) THEN
+      t_bnd(1:2) = (/ W_F(idf)%W_V(iv)%last_wrt*W_F(idf)%deltat,rtime /)
+      rtime = (t_bnd(1)+t_bnd(2))/2.0
+    ENDIF
+!-
+!-- 6.2 Add a value to the time axis of this variable if needed
+!-
+    IF (     (TRIM(tmp_opp) /= "l_max") &
+ &      .AND.(TRIM(tmp_opp) /= "l_min") &
+ &      .AND.(TRIM(tmp_opp) /= "once") ) THEN
+!-
+      IF (l_dbg) WRITE(*,*) "histwrite: 6.2",idf
+!-
+      itax  = W_F(idf)%W_V(iv)%t_axid
+      itime = W_F(idf)%W_V(iv)%nb_wrt+1
+!-
+      IF (W_F(idf)%W_V(itax)%tax_last < itime) THEN
+        iret = NF90_PUT_VAR (nfid,W_F(idf)%W_V(itax)%tdimid, &
+ &               (/ rtime /),start=(/ itime /),count=(/ 1 /))
+        IF (W_F(idf)%W_V(itax)%tbndid > 0) THEN
+          iret = NF90_PUT_VAR (nfid,W_F(idf)%W_V(itax)%tbndid, &
+ &                 t_bnd,start=(/ 1,itime /),count=(/ 2,1 /))
+        ENDIF
+        W_F(idf)%W_V(itax)%tax_last = itime
+      ENDIF
+    ELSE
+      itime=1
+    ENDIF
+!-
+!-- 6.3 Write the data. Only in the case of instantaneous output
+!       we do not write the buffer.
+!-
+    IF (l_dbg) THEN
+      WRITE(*,*) "histwrite: 6.3",idf,nfid,nvid,iv,itime
+    ENDIF
+!-
+    IF (W_F(idf)%W_V(iv)%scsize(3) == 1) THEN
+      IF (W_F(idf)%regular) THEN
+        corner(1:4) = (/ 1,1,itime,0 /)
+        edges(1:4) = (/ W_F(idf)%W_V(iv)%zsize(1), &
+ &                      W_F(idf)%W_V(iv)%zsize(2),1,0 /)
+      ELSE
+        corner(1:4) = (/ 1,itime,0,0 /)
+        edges(1:4) = (/ W_F(idf)%W_V(iv)%zsize(1),1,0,0 /)
+      ENDIF
+    ELSE
+      IF (W_F(idf)%regular) THEN
+        corner(1:4) = (/ 1,1,1,itime /)
+        edges(1:4) = (/ W_F(idf)%W_V(iv)%zsize(1), &
+ &                      W_F(idf)%W_V(iv)%zsize(2), &
+ &                      W_F(idf)%W_V(iv)%zsize(3),1 /)
+      ELSE
+        corner(1:4) = (/ 1,1,itime,0 /)
+        edges(1:4) = (/ W_F(idf)%W_V(iv)%zsize(1), &
+ &                      W_F(idf)%W_V(iv)%zsize(3),1,0 /)
+      ENDIF
+    ENDIF
+!-
+    IF (     (TRIM(tmp_opp) /= "inst") &
+ &      .AND.(TRIM(tmp_opp) /= "once") ) THEN
+      iret = NF90_PUT_VAR (nfid,nvid,W_F(idf)%W_V(iv)%t_bf, &
+ &                         start=corner(1:4),count=edges(1:4))
+    ELSE
+      iret = NF90_PUT_VAR (nfid,nvid,tbf_2, &
+ &                         start=corner(1:4),count=edges(1:4))
+    ENDIF
+!-
+    W_F(idf)%W_V(iv)%last_wrt = pitau
+    W_F(idf)%W_V(iv)%nb_wrt = W_F(idf)%W_V(iv)%nb_wrt+1
+    W_F(idf)%W_V(iv)%nb_opp = 0
+!---
+!   After the write the file can be synchronized so that no data is
+!   lost in case of a crash. This feature gives up on the benefits of
+!   buffering and should only be used in debuging mode. A flag is
+!   needed here to switch to this mode.
+!---
+!   iret = NF90_SYNC (nfid)
+!-
+  ENDIF
+!----------------------------
+END SUBROUTINE histwrite_real
+!===
+SUBROUTINE histvar_seq (idf,pvarname,idv)
+!---------------------------------------------------------------------
+!- This subroutine optimize the search for the variable in the table.
+!- In a first phase it will learn the succession of the variables
+!- called and then it will use the table to guess what comes next.
+!- It is the best solution to avoid lengthy searches through array
+!- vectors.
+!-
+!- ARGUMENTS :
+!-
+!- idf      : id of the file on which we work
+!- pvarname : The name of the variable we are looking for
+!- idv      : The var id we found
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(in)  :: idf
+  CHARACTER(LEN=*),INTENT(IN) :: pvarname
+  INTEGER,INTENT(out) :: idv
+!-
+  LOGICAL,SAVE :: learning(nb_files_max)=.TRUE.
+  INTEGER,SAVE :: overlap(nb_files_max) = -1
+  INTEGER,SAVE :: varseq(nb_files_max,nb_var_max*3)
+  INTEGER,SAVE :: varseq_len(nb_files_max) = 0
+  INTEGER,SAVE :: varseq_pos(nb_files_max)
+  INTEGER,SAVE :: varseq_err(nb_files_max) = 0
+  INTEGER      :: ib,sp,nn,pos
+  CHARACTER(LEN=70) :: str70
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'histvar_seq, start of the subroutine :',learning(idf)
+  ENDIF
+!-
+  IF (learning(idf)) THEN
+!-
+!-- 1.0 We compute the length over which we are going
+!--     to check the overlap
+!-
+    IF (overlap(idf) <= 0) THEN
+      IF (W_F(idf)%n_var > 6) THEN
+        overlap(idf) = W_F(idf)%n_var/3*2
+      ELSE
+        overlap(idf) = W_F(idf)%n_var
+      ENDIF
+    ENDIF
+!-
+!-- 1.1 Find the position of this string
+!-
+    CALL find_str (W_F(idf)%W_V(1:W_F(idf)%n_var)%v_name,pvarname,pos)
+    IF (pos > 0) THEN
+      idv = pos
+    ELSE
+      CALL ipslerr (3,"histvar_seq", &
+ &      'The name of the variable you gave has not been declared', &
+ &      'You should use subroutine histdef for declaring variable', &
+ &      TRIM(pvarname))
+    ENDIF
+!-
+!-- 1.2 If we have not given up we store the position
+!--     in the sequence of calls
+!-
+    IF (varseq_err(idf) >= 0) THEN
+      sp = varseq_len(idf)+1
+      IF (sp <= nb_var_max*3) THEN
+        varseq(idf,sp) = idv
+        varseq_len(idf) = sp
+      ELSE
+        CALL ipslerr (2,"histvar_seq",&
+ &       'The learning process has failed and we give up. '// &
+ &       'Either you sequence is',&
+ &       'too complex or I am too dumb. '// &
+ &       'This will only affect the efficiency',&
+ &       'of your code. Thus if you wish to save time'// &
+ &       ' contact the IOIPSL team. ')
+        WRITE(*,*) 'The sequence we have found up to now :'
+        WRITE(*,*) varseq(idf,1:sp-1)
+        varseq_err(idf) = -1
+      ENDIF
+!-
+!---- 1.3 Check if we have found the right overlap
+!-
+      IF (varseq_len(idf) >= overlap(idf)*2) THEN
+!-
+!------ We skip a few variables if needed as they could come
+!------ from the initialisation of the model.
+!-
+        DO ib = 0,sp-overlap(idf)*2
+          IF ( learning(idf) .AND.&
+            & SUM(ABS(varseq(idf,ib+1:ib+overlap(idf)) -&
+            & varseq(idf,sp-overlap(idf)+1:sp))) == 0 ) THEN
+            learning(idf) = .FALSE.
+            varseq_len(idf) = sp-overlap(idf)-ib
+            varseq_pos(idf) = overlap(idf)+ib
+            varseq(idf,1:varseq_len(idf)) = &
+ &            varseq(idf,ib+1:ib+varseq_len(idf))
+          ENDIF
+        ENDDO
+      ENDIF
+    ENDIF
+  ELSE
+!-
+!-- 2.0 Now we know how the calls to histwrite are sequenced
+!--     and we can get a guess at the var ID
+!-
+    nn = varseq_pos(idf)+1
+    IF (nn > varseq_len(idf)) nn = 1
+!-
+    idv = varseq(idf,nn)
+!-
+    IF (TRIM(W_F(idf)%W_V(idv)%v_name) /= TRIM(pvarname)) THEN
+      CALL find_str (W_F(idf)%W_V(1:W_F(idf)%n_var)%v_name,pvarname,pos)
+      IF (pos > 0) THEN
+        idv = pos
+      ELSE
+        CALL ipslerr (3,"histvar_seq", &
+ &  'The name of the variable you gave has not been declared',&
+ &  'You should use subroutine histdef for declaring variable', &
+ &  TRIM(pvarname))
+      ENDIF
+      varseq_err(idf) = varseq_err(idf)+1
+    ELSE
+!-
+!---- We only keep the new position if we have found the variable
+!---- this way. This way an out of sequence call to histwrite does
+!---- not defeat the process.
+!-
+      varseq_pos(idf) = nn
+    ENDIF
+!-
+!!$    IF (varseq_err(idf) >= 10) THEN
+!!$      WRITE(str70,'("for file ",I3)') idf
+!!$      CALL ipslerr (2,"histvar_seq", &
+!!$ &  'There were 10 errors in the learned sequence of variables',&
+!!$ &  str70,'This looks like a bug, please report it.')
+!!$         varseq_err(idf) = 0
+!!$    ENDIF
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) &
+ &   'histvar_seq, end of the subroutine :',TRIM(pvarname),idv
+  ENDIF
+!-------------------------
+END SUBROUTINE histvar_seq
+!===
+SUBROUTINE histsync (idf)
+!---------------------------------------------------------------------
+!- This subroutine will synchronise all
+!- (or one if defined) opened files.
+!-
+!- VERSION
+!-
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! idf  : optional argument for fileid
+  INTEGER,INTENT(in),OPTIONAL :: idf
+!-
+  INTEGER :: ifile,iret,i_s,i_e
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->histsync"
+  ENDIF
+!-
+  IF (PRESENT(idf)) THEN
+    IF ( (idf >= 1).AND.(idf <= nb_files_max) ) THEN
+      IF (W_F(idf)%ncfid > 0) THEN
+        i_s = idf
+        i_e = idf
+      ELSE
+        i_s = 1
+        i_e = 0
+        CALL ipslerr (2,'histsync', &
+ &       'Unable to synchronise the file :','probably','not opened')
+      ENDIF
+    ELSE
+      CALL ipslerr (3,'histsync','Invalid file identifier',' ',' ')
+    ENDIF
+  ELSE
+    i_s = 1
+    i_e = nb_files_max
+  ENDIF
+!-
+  DO ifile=i_s,i_e
+    IF (W_F(ifile)%ncfid > 0) THEN
+      IF (l_dbg) THEN
+        WRITE(*,*) '  histsync - synchronising file number ',ifile
+      ENDIF
+      iret = NF90_SYNC(W_F(ifile)%ncfid)
+    ENDIF
+  ENDDO
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-histsync"
+  ENDIF
+!----------------------
+END SUBROUTINE histsync
+!===
+SUBROUTINE histclo (idf)
+!---------------------------------------------------------------------
+!- This subroutine will close all (or one if defined) opened files
+!-
+!- VERSION
+!-
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! idf  : optional argument for fileid
+  INTEGER,INTENT(in),OPTIONAL :: idf
+!-
+  INTEGER :: ifile,nfid,nvid,iret,iv,i_s,i_e
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->histclo"
+  ENDIF
+!-
+  IF (PRESENT(idf)) THEN
+    IF ( (idf >= 1).AND.(idf <= nb_files_max) ) THEN
+      IF (W_F(idf)%ncfid > 0) THEN
+        i_s = idf
+        i_e = idf
+      ELSE
+        i_s = 1
+        i_e = 0
+        CALL ipslerr (2,'histclo', &
+ &       'Unable to close the file :','probably','not opened')
+      ENDIF
+    ELSE
+      CALL ipslerr (3,'histclo','Invalid file identifier',' ',' ')
+    ENDIF
+  ELSE
+    i_s = 1
+    i_e = nb_files_max
+  ENDIF
+!-
+  DO ifile=i_s,i_e
+    IF (W_F(ifile)%ncfid > 0) THEN
+      IF (l_dbg) THEN
+        WRITE(*,*) '  histclo - closing specified file number :',ifile
+      ENDIF
+      nfid = W_F(ifile)%ncfid
+      iret = NF90_REDEF(nfid)
+!-----
+!---- 1. Loop on the number of variables to add some final information
+!-----
+      IF (l_dbg) THEN
+        WRITE(*,*) '  Entering loop on vars : ',W_F(ifile)%n_var
+      ENDIF
+      DO iv=1,W_F(ifile)%n_var
+!------ Extrema
+        IF (W_F(ifile)%W_V(iv)%hist_wrt_rng) THEN
+          IF (l_dbg) THEN
+            WRITE(*,*) 'min value for file :',ifile,' var n. :',iv, &
+ &                     ' is : ',W_F(ifile)%W_V(iv)%hist_minmax(1)
+            WRITE(*,*) 'max value for file :',ifile,' var n. :',iv, &
+ &                     ' is : ',W_F(ifile)%W_V(iv)%hist_minmax(2)
+          ENDIF
+          IF (W_F(ifile)%W_V(iv)%hist_calc_rng) THEN
+!---------- Put the min and max values on the file
+            nvid = W_F(ifile)%W_V(iv)%ncvid
+            IF (W_F(ifile)%W_V(iv)%v_typ == hist_r8) THEN
+              iret = NF90_PUT_ATT(nfid,nvid,'valid_min', &
+ &                     REAL(W_F(ifile)%W_V(iv)%hist_minmax(1),KIND=8))
+              iret = NF90_PUT_ATT(nfid,nvid,'valid_max', &
+ &                     REAL(W_F(ifile)%W_V(iv)%hist_minmax(2),KIND=8))
+            ELSE
+              iret = NF90_PUT_ATT(nfid,nvid,'valid_min', &
+ &                     REAL(W_F(ifile)%W_V(iv)%hist_minmax(1),KIND=4))
+              iret = NF90_PUT_ATT(nfid,nvid,'valid_max', &
+ &                     REAL(W_F(ifile)%W_V(iv)%hist_minmax(2),KIND=4))
+            ENDIF
+          ENDIF
+        ENDIF
+!------ Time-Buffers
+        IF (ASSOCIATED(W_F(ifile)%W_V(iv)%t_bf)) THEN
+          DEALLOCATE(W_F(ifile)%W_V(iv)%t_bf)
+        ENDIF
+!------ Reinitialize the sizes
+        W_F(ifile)%W_V(iv)%datasz_in(:) = -1
+        W_F(ifile)%W_V(iv)%datasz_max = -1
+      ENDDO
+!-----
+!---- 2. Close the file
+!-----
+      IF (l_dbg) WRITE(*,*) '  close file :',nfid
+      iret = NF90_CLOSE(nfid)
+      W_F(ifile)%ncfid = -1
+      W_F(ifile)%dom_id_svg = -1
+    ENDIF
+  ENDDO
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-histclo"
+  ENDIF
+!---------------------
+END SUBROUTINE histclo
+!===
+SUBROUTINE ioconf_modname (str)
+!---------------------------------------------------------------------
+!- This subroutine allows to configure the name
+!- of the model written into the file
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: str
+!---------------------------------------------------------------------
+  IF (.NOT.lock_modname) THEN
+    model_name = str(1:MIN(LEN_TRIM(str),80))
+    lock_modname = .TRUE.
+  ELSE
+    CALL ipslerr (2,"ioconf_modname", &
+   &  'The model name can only be changed once and only', &
+   &  'before it is used. It is now set to :',model_name)
+  ENDIF
+!----------------------------
+END SUBROUTINE ioconf_modname
+!-
+!===
+!-
+!-----------------
+!$AGRIF_END_DO_NOT_TREAT
+END MODULE histcom
Index: utils/tools/DOMAINcfg/src/in_out_manager.F90
===================================================================
--- utils/tools/DOMAINcfg/src/in_out_manager.F90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/in_out_manager.F90	(revision 14623)
@@ -22,4 +22,12 @@
    !!----------------------------------------------------------------------
    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
@@ -27,4 +35,8 @@
    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
@@ -33,4 +45,5 @@
    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
@@ -61,8 +74,54 @@
 
    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)
+
+   !!----------------------------------------------------------------------
+   !! 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 
+   LOGICAL ::   lrst_abl              !: logical to control the abl 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 ::   numrar                !: logical unit for abl   restart (read)
+   INTEGER ::   numrow                !: logical unit for ocean restart (write)
+   INTEGER ::   numriw                !: logical unit for ice   restart (write)
+   INTEGER ::   numraw                !: logical unit for abl   restart (write)
+   INTEGER ::   nrst_lst              !: number of restart to output next
+
+   !!----------------------------------------------------------------------
+   !!                    output monitoring
+   !!----------------------------------------------------------------------
+   TYPE :: sn_ctl                !: structure for control over output selection
+      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_prtctl  = .FALSE.  !: Produce/do not produce mpp.output_XXXX files (T/F)
+      LOGICAL :: l_prttrc  = .FALSE.  !: Produce/do not produce mpp.top.output_XXXX files (T/F)
+      LOGICAL :: l_oasout  = .FALSE.  !: Produce/do not write oasis setup info to ocean.output (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
+   TYPE(sn_ctl), SAVE :: sn_cfctl     !: run control structure for selective output, must have SAVE for default init. of sn_ctl
+   LOGICAL ::   ln_timing        !: run control for timing
+   LOGICAL ::   ln_diacfl        !: flag whether to create CFL diagnostics
+   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
 
    !!----------------------------------------------------------------------
@@ -74,9 +133,19 @@
    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 ::   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 volume 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
+      !
+   CHARACTER(LEN=:), ALLOCATABLE :: numnam_ref      !: character buffer for reference namelist
+   CHARACTER(LEN=:), ALLOCATABLE :: numnam_cfg      !: character buffer for configuration specific namelist
+   CHARACTER(LEN=:), ALLOCATABLE :: numnam_ice_ref  !: character buffer for ice reference namelist
+   CHARACTER(LEN=:), ALLOCATABLE :: numnam_ice_cfg  !: character buffer for ice configuration specific namelist
 
    !!----------------------------------------------------------------------
@@ -85,4 +154,7 @@
    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)
+!$AGRIF_DO_NOT_TREAT
+   INTEGER       ::   ngrdstop = -1         !: grid number having nstop > 1
+!$AGRIF_END_DO_NOT_TREAT
    INTEGER       ::   nwarn = 0             !: warning flag (=number of warning found during the run)
    CHARACTER(lc) ::   ctmp1, ctmp2, ctmp3   !: temporary characters 1 to 3
@@ -90,15 +162,16 @@
    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       ::   lwp      = .FALSE.    !: boolean : true on the 1st processor only .OR. sn_cfctl%l_oceout=T
+   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
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: in_out_manager.F90 10570 2019-01-24 15:14:49Z acc $
+   !! $Id: in_out_manager.F90 13286 2020-07-09 15:48:29Z smasson $
    !! Software governed by the CeCILL license (see ./LICENSE)
    !!=====================================================================
Index: utils/tools/DOMAINcfg/src/ioipsl.f90
===================================================================
--- utils/tools/DOMAINcfg/src/ioipsl.f90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/ioipsl.f90	(revision 14623)
@@ -1,3 +1,4 @@
 MODULE ioipsl
+!$AGRIF_DO_NOT_TREAT
 !
 !$Id: ioipsl.f90 2281 2010-10-15 14:21:13Z smasson $
@@ -6,7 +7,13 @@
 ! See IOIPSL/IOIPSL_License_CeCILL.txt
 !
-  USE errioipsl   
+  USE errioipsl 
+  USE stringop
+  USE mathelp    
+  USE getincom
   USE calendar   
-  USE stringop
-
+  USE fliocom    
+  USE flincom    
+  USE histcom    
+  USE restcom
+!$AGRIF_END_DO_NOT_TREAT
 END MODULE ioipsl
Index: utils/tools/DOMAINcfg/src/iom.F90
===================================================================
--- utils/tools/DOMAINcfg/src/iom.F90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/iom.F90	(revision 14623)
@@ -21,4 +21,7 @@
    !!----------------------------------------------------------------------
    USE dom_oce         ! ocean space and time domain
+   USE domutl          ! 
+   !USE c1d             ! 1D vertical configuration
+   !USE flo_oce         ! floats module declarations
    USE lbclnk          ! lateal boundary condition / mpp exchanges
    USE iom_def         ! iom variables definitions
@@ -26,45 +29,51 @@
    USE in_out_manager  ! I/O manager
    USE lib_mpp           ! MPP library
-#if defined key_xios
-   USE sbc_oce  , ONLY :   nn_fsbc         ! ocean space and time domain
-   USE trc_oce  , ONLY :   nn_dttrc        !  !: frequency of step on passive tracers
+#if defined key_iomput
+   USE sbc_oce  , ONLY :   nn_fsbc, ght_abl, ghw_abl, e3t_abl, e3w_abl, jpka, jpkam1
    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 dianam          ! build name of file
    USE xios
 # endif
    USE ioipsl, ONLY :  ju2ymds    ! for calendar
+  ! USE crs             ! Grid coarsening
 #if defined key_top
    USE trc, ONLY    :  profsed
 #endif
    USE lib_fortran 
+   !USE diu_bulk, ONLY : ln_diurnal_only, ln_diurnal
 
    IMPLICIT NONE
    PUBLIC   !   must be public to be able to access iom_def through iom
    
-#if defined key_xios
+#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_init, iom_init_closedef, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_get_var
    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_xios
+   PUBLIC iom_use, iom_context_finalize, iom_update_file_name, iom_miss_val
+
+   PRIVATE iom_rp0d_sp, iom_rp1d_sp, iom_rp2d_sp, iom_rp3d_sp
+   PRIVATE iom_rp0d_dp, iom_rp1d_dp, iom_rp2d_dp, iom_rp3d_dp
+   PRIVATE iom_get_123d
+   PRIVATE iom_g0d_sp, iom_g1d_sp, iom_g2d_sp, iom_g3d_sp
+   PRIVATE iom_g0d_dp, iom_g1d_dp, iom_g2d_dp, iom_g3d_dp
+   PRIVATE iom_p1d_sp, iom_p2d_sp, iom_p3d_sp, iom_p4d_sp
+   PRIVATE iom_p1d_dp, iom_p2d_dp, iom_p3d_dp, iom_p4d_dp
+#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 set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, 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
+   PUBLIC iom_set_rstw_var_active, iom_set_rstw_core, iom_set_rst_vars
 
    INTERFACE iom_get
-      MODULE PROCEDURE iom_g0d, iom_g1d, iom_g2d, iom_g3d
+      MODULE PROCEDURE iom_g0d_sp, iom_g1d_sp, iom_g2d_sp, iom_g3d_sp
+      MODULE PROCEDURE iom_g0d_dp, iom_g1d_dp, iom_g2d_dp, iom_g3d_dp
    END INTERFACE
    INTERFACE iom_getatt
@@ -75,18 +84,22 @@
    END INTERFACE
    INTERFACE iom_rstput
-      MODULE PROCEDURE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
+      MODULE PROCEDURE iom_rp0d_sp, iom_rp1d_sp, iom_rp2d_sp, iom_rp3d_sp
+      MODULE PROCEDURE iom_rp0d_dp, iom_rp1d_dp, iom_rp2d_dp, iom_rp3d_dp
    END INTERFACE
    INTERFACE iom_put
-      MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d
+      MODULE PROCEDURE iom_p0d_sp, iom_p1d_sp, iom_p2d_sp, iom_p3d_sp, iom_p4d_sp
+      MODULE PROCEDURE iom_p0d_dp, iom_p1d_dp, iom_p2d_dp, iom_p3d_dp, iom_p4d_dp
    END INTERFACE iom_put
   
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: iom.F90 10523 2019-01-16 09:36:03Z smasson $
+   !! $Id: iom.F90 13295 2020-07-10 18:24:21Z acc $
    !! Software governed by the CeCILL license (see ./LICENSE)
    !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE iom_init( cdname, fname, ld_tmppatch ) 
+   SUBROUTINE iom_init( cdname, fname, ld_closedef ) 
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE   ***
@@ -97,31 +110,20 @@
       CHARACTER(len=*),           INTENT(in)  :: cdname
       CHARACTER(len=*), OPTIONAL, INTENT(in)  :: fname
-      LOGICAL         , OPTIONAL, INTENT(in)  :: ld_tmppatch
-#if defined key_xios
+      LOGICAL         , OPTIONAL, INTENT(in)  :: ld_closedef
+#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
+      INTEGER             :: irefyear, irefmonth, irefday
+      INTEGER           :: ji
       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
+      REAL(wp), DIMENSION(2,jpkam1)         :: za_bnds   ! ABL vertical boundaries
+      LOGICAL ::   ll_closedef = .TRUE.
+      !!----------------------------------------------------------------------
+      !
+      IF ( PRESENT(ld_closedef) ) ll_closedef = ld_closedef
       !
       ALLOCATE( zt_bnds(2,jpk), zw_bnds(2,jpk) )
@@ -134,11 +136,15 @@
 
       ! Calendar type is now defined in xml file 
+      IF (.NOT.(xios_getvar('ref_year' ,irefyear ))) irefyear  = 1900
+      IF (.NOT.(xios_getvar('ref_month',irefmonth))) irefmonth = 01
+      IF (.NOT.(xios_getvar('ref_day'  ,irefday  ))) irefday   = 01
+
       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) )
+      CASE ( 1)   ;   CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0),   &
+          &                                                          start_date  = xios_date(   nyear,   nmonth,   nday,0,0,0) )
+      CASE ( 0)   ;   CALL xios_define_calendar( TYPE = "NoLeap"   , time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0),   &
+          &                                                          start_date  = xios_date(   nyear,   nmonth,   nday,0,0,0) )
+      CASE (30)   ;   CALL xios_define_calendar( TYPE = "D360"     , time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0),   &
+          &                                                          start_date  = xios_date(   nyear,   nmonth,   nday,0,0,0) )
       END SELECT
 
@@ -154,8 +160,8 @@
          !
          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 iom_set_domain_attr("grid_T", area = real( e1e2t(Nis0:Nie0, Njs0:Nje0), dp))
+            CALL iom_set_domain_attr("grid_U", area = real( e1e2u(Nis0:Nie0, Njs0:Nje0), dp))
+            CALL iom_set_domain_attr("grid_V", area = real( e1e2v(Nis0:Nie0, Njs0:Nje0), dp))
+            CALL iom_set_domain_attr("grid_W", area = real( e1e2t(Nis0:Nie0, Njs0:Nje0), dp))
             CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit )
             CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu )
@@ -177,8 +183,8 @@
          !
          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 iom_set_domain_attr("grid_T", area = real(e1e2t_crs(Nis0:Nie0, Njs0:Nje0), dp))
+            CALL iom_set_domain_attr("grid_U", area = real(e1u_crs(Nis0:Nie0, Njs0:Nje0) * e2u_crs(Nis0:Nie0, Njs0:Nje0), dp))
+            CALL iom_set_domain_attr("grid_V", area = real(e1v_crs(Nis0:Nie0, Njs0:Nje0) * e2v_crs(Nis0:Nie0, Njs0:Nje0), dp))
+            CALL iom_set_domain_attr("grid_W", area = real(e1e2t_crs(Nis0:Nie0, Njs0:Nje0), dp))
             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 )
@@ -190,25 +196,39 @@
       ! 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 )
-
+          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 )
+
+          ! ABL
+          IF( .NOT. ALLOCATED(ght_abl) ) THEN   ! force definition for xml files (xios) 
+             ALLOCATE( ght_abl(jpka), ghw_abl(jpka), e3t_abl(jpka), e3w_abl(jpka) )   ! default allocation needed by iom
+             ght_abl(:) = -1._wp   ;   ghw_abl(:) = -1._wp
+             e3t_abl(:) = -1._wp   ;   e3w_abl(:) = -1._wp
+          ENDIF
+          CALL iom_set_axis_attr( "ght_abl", ght_abl(2:jpka) )
+          CALL iom_set_axis_attr( "ghw_abl", ghw_abl(2:jpka) )
+          
           ! 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
+          zt_bnds(2,:      ) = gdept_1d(:)
+          zt_bnds(1,2: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(2: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 )
+
+          ! ABL
+          za_bnds(1,:) = ghw_abl(1:jpkam1)
+          za_bnds(2,:) = ghw_abl(2:jpka  )
+          CALL iom_set_axis_attr( "ght_abl", bounds=za_bnds )
+          za_bnds(1,:) = ght_abl(2:jpka  )
+          za_bnds(2,:) = ght_abl(2:jpka  ) + e3w_abl(2:jpka)
+          CALL iom_set_axis_attr( "ghw_abl", bounds=za_bnds )
+
           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) /) )
@@ -217,9 +237,11 @@
 # endif
 #if defined key_top
-          CALL iom_set_axis_attr( "profsed", paxis = profsed )
+          IF( ALLOCATED(profsed) ) 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) /) )
+          CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) )   ! strange syntaxe and idea...
+          CALL iom_set_axis_attr( "iax_26C", (/ REAL(26,wp) /) )   ! strange syntaxe and idea...
+          CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) )   ! strange syntaxe and idea...
+          CALL iom_set_axis_attr( "basin"  , (/ (REAL(ji,wp), ji=1,5) /) )
       ENDIF
       !
@@ -241,19 +263,34 @@
       ENDIF
       !
-      ! end file definition
-      dtime%second = rdt
+      ! set time step length
+      dtime%second = rn_Dt
       CALL xios_set_timestep( dtime )
+      !
+      ! conditional closure of context definition
+      IF ( ll_closedef ) CALL iom_init_closedef
+      !
+      DEALLOCATE( zt_bnds, zw_bnds )
+      !
+#endif
+      !
+   END SUBROUTINE iom_init
+
+   SUBROUTINE iom_init_closedef
+      !!----------------------------------------------------------------------
+      !!            ***  SUBROUTINE iom_init_closedef  ***
+      !!----------------------------------------------------------------------
+      !!
+      !! ** Purpose : Closure of context definition
+      !!
+      !!----------------------------------------------------------------------
+
+#if defined key_iomput
       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
+#else
+      IF( .FALSE. )   WRITE(numout,*) 'iom_init_closedef: should not see this'   ! useless statement to avoid compilation warnings
+#endif
+
+   END SUBROUTINE iom_init_closedef
 
    SUBROUTINE iom_set_rstw_var_active(field)
@@ -268,5 +305,5 @@
    CHARACTER(LEN=256) :: clinfo    ! info character
 
-#if defined key_xios
+#if defined key_iomput
    llis_set = .FALSE.
 
@@ -284,5 +321,5 @@
    ENDIF
 #else
-        clinfo = 'iom_set_rstw_var_active: key_xios is needed to use XIOS restart read/write functionality'
+        clinfo = 'iom_set_rstw_var_active: key_iomput is needed to use XIOS restart read/write functionality'
         CALL ctl_stop('STOP', TRIM(clinfo))
 #endif
@@ -301,5 +338,5 @@
    CHARACTER(len=256) :: rst_file
 
-#if defined key_xios
+#if defined key_iomput
    TYPE(xios_field) :: field_hdl
    TYPE(xios_file) :: file_hdl
@@ -348,4 +385,41 @@
    END SUBROUTINE iom_set_rstr_active
 
+   SUBROUTINE iom_set_rstw_core(cdmdl)
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_set_rstw_core  ***
+      !!
+      !! ** Purpose :  set variables which are always in restart file 
+      !!---------------------------------------------------------------------
+   CHARACTER (len=*), INTENT (IN) :: cdmdl ! model OPA or SAS
+   CHARACTER(LEN=256)             :: clinfo    ! info character
+#if defined key_iomput
+   IF(cdmdl == "OPA") THEN
+!from restart.F90
+   CALL iom_set_rstw_var_active("rn_Dt")
+   IF ( .NOT. ln_diurnal_only ) THEN
+        CALL iom_set_rstw_var_active('ub'  )
+        CALL iom_set_rstw_var_active('vb'  )
+        CALL iom_set_rstw_var_active('tb'  )
+        CALL iom_set_rstw_var_active('sb'  )
+        CALL iom_set_rstw_var_active('sshb')
+        !
+        CALL iom_set_rstw_var_active('un'  )
+        CALL iom_set_rstw_var_active('vn'  )
+        CALL iom_set_rstw_var_active('tn'  )
+        CALL iom_set_rstw_var_active('sn'  )
+        CALL iom_set_rstw_var_active('sshn')
+        CALL iom_set_rstw_var_active('rhop')
+      ENDIF
+      IF(ln_diurnal) CALL iom_set_rstw_var_active('Dsst')
+!from trasbc.F90
+         CALL iom_set_rstw_var_active('sbc_hc_b')
+         CALL iom_set_rstw_var_active('sbc_sc_b')
+   ENDIF
+#else
+        clinfo = 'iom_set_rstw_core: key_iomput is needed to use XIOS restart read/write functionality'
+        CALL ctl_stop('STOP', TRIM(clinfo))
+#endif
+   END SUBROUTINE iom_set_rstw_core
+
    SUBROUTINE iom_set_rst_vars(fields)
       !!---------------------------------------------------------------------
@@ -360,5 +434,5 @@
 
         i = 0
-        i = i + 1; fields(i)%vname="rdt";            fields(i)%grid="grid_scalar"
+        i = i + 1; fields(i)%vname="rn_Dt";            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"
@@ -476,5 +550,5 @@
 !sets enabled = .TRUE. for each field in restart file
    CHARACTER(len=*) :: cdrst_file
-#if defined key_xios
+#if defined key_iomput
    TYPE(xios_field) :: field_hdl
    TYPE(xios_file) :: file_hdl
@@ -531,5 +605,5 @@
 !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_xios
+#if defined key_iomput
    TYPE(xios_domaingroup)            :: domaingroup_hdl 
    TYPE(xios_domain)                 :: domain_hdl 
@@ -562,5 +636,5 @@
       !!---------------------------------------------------------------------
       CHARACTER(len=*), INTENT(in) :: cdname
-#if defined key_xios
+#if defined key_iomput
       TYPE(xios_context) :: nemo_hdl
 
@@ -577,5 +651,5 @@
 
 
-   SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, lagrif, ldstop, ldiof, kdlev )
+   SUBROUTINE iom_open( cdname, kiomid, ldwrt, ldstop, ldiof, kdlev, cdcomp )
       !!---------------------------------------------------------------------
       !!                   ***  SUBROUTINE  iom_open  ***
@@ -586,9 +660,8 @@
       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=3), INTENT(in   ), OPTIONAL ::   cdcomp   ! name of component calling iom_nf90_open
       !
       CHARACTER(LEN=256)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu]
@@ -599,13 +672,9 @@
       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
@@ -613,8 +682,4 @@
       ! 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
@@ -623,15 +688,4 @@
       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)
@@ -650,21 +704,12 @@
       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
+      IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN
          iln    = INDEX(clname,'/') 
          cltmpn = clname(1:iln)
@@ -702,37 +747,4 @@
          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
       ! =============
@@ -758,9 +770,6 @@
       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
+         CALL iom_nf90_open( clname, kiomid, llwrt, llok, kdlev = kdlev, cdcomp = cdcomp )
+      ENDIF
       !
    END SUBROUTINE iom_open
@@ -781,4 +790,6 @@
       CHARACTER(LEN=100)    ::   clinfo    ! info character
       !---------------------------------------------------------------------
+      !
+      IF( iom_open_init == 0 )   RETURN   ! avoid to use iom_file(jf)%nfid that us not yet initialized
       !
       clinfo = '                    iom_close ~~~  '
@@ -808,5 +819,5 @@
 
 
-   FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, ldstop )  
+   FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, lduld, ldstop )  
       !!-----------------------------------------------------------------------
       !!                  ***  FUNCTION  iom_varid  ***
@@ -817,5 +828,6 @@
       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
+      INTEGER              , INTENT(  out), OPTIONAL ::   kndims   ! number of dimensions
+      LOGICAL              , INTENT(  out), OPTIONAL ::   lduld    ! true if the last dimension is unlimited (time)
       LOGICAL              , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if looking for non-existing variable (default = .TRUE.)
       !
@@ -847,5 +859,5 @@
                iiv = iiv + 1
                IF( iiv <= jpmax_vars ) THEN
-                  iom_varid = iom_nf90_varid( kiomid, cdvar, iiv, kdimsz, kndims )
+                  iom_varid = iom_nf90_varid( kiomid, cdvar, iiv, kdimsz, kndims, lduld )
                ELSE
                   CALL ctl_stop( trim(clinfo), 'Too many variables in the file '//iom_file(kiomid)%name,   &
@@ -865,4 +877,5 @@
                ENDIF
                IF( PRESENT(kndims) )  kndims = iom_file(kiomid)%ndims(iiv)
+               IF( PRESENT( lduld) )  lduld  = iom_file(kiomid)%luld( iiv)
             ENDIF
          ENDIF
@@ -875,8 +888,60 @@
    !!                   INTERFACE iom_get
    !!----------------------------------------------------------------------
-   SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime, ldxios )
+   SUBROUTINE iom_g0d_sp( 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
+      REAL(sp)        , INTENT(  out)                 ::   pvar      ! read field
+      REAL(dp)                                        ::   ztmp_pvar ! tmp var to 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, ztmp_pvar, itime )
+               pvar = ztmp_pvar
+            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_sp
+
+   SUBROUTINE iom_g0d_dp( kiomid, cdvar, pvar, ktime, ldxios )
+      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   )                 ::   cdvar     ! Name of the variable
+      REAL(dp)        , INTENT(  out)                 ::   pvar      ! read field
       INTEGER         , INTENT(in   ),     OPTIONAL   ::   ktime     ! record number
       LOGICAL         , INTENT(in   ),     OPTIONAL   ::   ldxios    ! use xios to read restart
@@ -913,5 +978,5 @@
          ENDIF
       ELSE
-#if defined key_xios
+#if defined key_iomput
          IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar)
          CALL iom_swap( TRIM(crxios_context) )
@@ -923,11 +988,12 @@
 #endif
       ENDIF
-   END SUBROUTINE iom_g0d
-
-   SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, ldxios )
+   END SUBROUTINE iom_g0d_dp
+
+   SUBROUTINE iom_g1d_sp( 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
+      REAL(sp)        , INTENT(  out), DIMENSION(:)           ::   pvar      ! read field
+      REAL(dp)        , ALLOCATABLE  , DIMENSION(:)           ::   ztmp_pvar ! tmp var to read field
       INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number
       INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kstart    ! start axis position of the reading 
@@ -936,57 +1002,131 @@
       !
       IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) THEN
+            ALLOCATE(ztmp_pvar(size(pvar,1)))
+            CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r1d=ztmp_pvar,   &
+              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, &
+              &                                                     ldxios=ldxios )
+            pvar = ztmp_pvar
+            DEALLOCATE(ztmp_pvar)
+         END IF
+      ENDIF
+   END SUBROUTINE iom_g1d_sp
+
+
+   SUBROUTINE iom_g1d_dp( 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(dp)        , 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
+   END SUBROUTINE iom_g1d_dp
+
+   SUBROUTINE iom_g2d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, 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(sp)        , INTENT(  out), DIMENSION(:,:)         ::   pvar      ! read field
+      REAL(dp)        , ALLOCATABLE  , DIMENSION(:,:)         ::   ztmp_pvar ! tmp var to read field
+      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number
+      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W)
+      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.): (not) change sign across the north fold
+      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk
+      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 ::   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( iom_file(kiomid)%nfid > 0 ) THEN
+            ALLOCATE(ztmp_pvar(size(pvar,1), size(pvar,2)))
+            CALL iom_get_123d( kiomid, kdom, cdvar      , pv_r2d = ztmp_pvar  , ktime = ktime,   &
+             &                                                      cd_type = cd_type, psgn   = psgn  , kfill = kfill,   &
+             &                                                      kstart  = kstart , kcount = kcount, ldxios=ldxios  )
+            pvar = ztmp_pvar
+            DEALLOCATE(ztmp_pvar)
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_g2d_sp
+
+   SUBROUTINE iom_g2d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, 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(dp)        , INTENT(  out), DIMENSION(:,:)         ::   pvar      ! read field
+      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number
+      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W)
+      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.): (not) change sign across the north fold
+      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk
+      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 ::   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
+         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar      , pv_r2d = pvar  , ktime = ktime,   &
+            &                                                       cd_type = cd_type, psgn   = psgn  , kfill = kfill,   &
+            &                                                       kstart  = kstart , kcount = kcount, ldxios=ldxios  )
+      ENDIF
+   END SUBROUTINE iom_g2d_dp
+
+   SUBROUTINE iom_g3d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, 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(sp)        , INTENT(  out), DIMENSION(:,:,:)       ::   pvar      ! read field
+      REAL(dp)        , ALLOCATABLE  , DIMENSION(:,:,:)       ::   ztmp_pvar ! tmp var to read field
+      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number
+      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W)
+      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold
+      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk
+      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 ::   ldxios    ! read data using XIOS
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) THEN
+            ALLOCATE(ztmp_pvar(size(pvar,1), size(pvar,2), size(pvar,3)))
+            CALL iom_get_123d( kiomid, kdom, cdvar      , pv_r3d = ztmp_pvar  , ktime = ktime,   &
+            &                                                       cd_type = cd_type, psgn   = psgn  , kfill = kfill,   &
+            &                                                       kstart  = kstart , kcount = kcount, ldxios=ldxios  )
+            pvar = ztmp_pvar
+            DEALLOCATE(ztmp_pvar)
+         END IF
+      ENDIF
+   END SUBROUTINE iom_g3d_sp
+
+   SUBROUTINE iom_g3d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, 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(dp)        , INTENT(  out), DIMENSION(:,:,:)       ::   pvar      ! read field
+      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number
+      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W)
+      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold
+      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk
+      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 ::   ldxios    ! read data using XIOS
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) THEN
+            CALL iom_get_123d( kiomid, kdom, cdvar      , pv_r3d = pvar  , ktime = ktime,   &
+            &                                                       cd_type = cd_type, psgn   = psgn  , kfill = kfill,   &
+            &                                                       kstart  = kstart , kcount = kcount, ldxios=ldxios  )
+         END IF
+      ENDIF
+   END SUBROUTINE iom_g3d_dp
+
    !!----------------------------------------------------------------------
 
-   SUBROUTINE iom_get_123d( kiomid, kdom  , cdvar ,   &
-         &                  pv_r1d, pv_r2d, pv_r3d,   &
-         &                  ktime , kstart, kcount,   &
-         &                  lrowattr, ldxios        )
+   SUBROUTINE iom_get_123d( kiomid , kdom, cdvar, pv_r1d, pv_r2d, pv_r3d, ktime ,   &
+         &                  cd_type, psgn, kfill, kstart, kcount, ldxios )
       !!-----------------------------------------------------------------------
       !!                  ***  ROUTINE  iom_get_123d  ***
@@ -996,23 +1136,20 @@
       !! ** 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                    , 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(dp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d    ! read field (1D case)
+      REAL(dp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d    ! read field (2D case)
+      REAL(dp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d    ! read field (3D case)
+      INTEGER                    , INTENT(in   ), OPTIONAL ::   ktime     ! record number
+      CHARACTER(len=1)           , INTENT(in   ), OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W)
+      REAL(dp)                   , INTENT(in   ), OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold
+      INTEGER                    , INTENT(in   ), OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk
+      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 ::   ldxios    ! use XIOS to read restart
+      !
+      LOGICAL                        ::   llok        ! true if ok!
+      LOGICAL                        ::   llxios      ! local definition for XIOS read
       INTEGER                        ::   jl          ! loop on number of dimension 
       INTEGER                        ::   idom        ! type of domain
@@ -1030,12 +1167,14 @@
       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
+      REAL(dp)                       ::   zscf, zofs  ! sacle_factor and add_offset
+      REAL(wp)                       ::   zsgn        ! local value of psgn
       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.
+      CHARACTER(LEN=1)               ::   cl_type     ! local value of cd_type
+      LOGICAL                        ::   ll_only3rd  ! 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
+      REAL(dp)                       ::   gma, gmi
       !---------------------------------------------------------------------
       !
@@ -1044,36 +1183,26 @@
       !
       llxios = .FALSE.
-      if(PRESENT(ldxios)) llxios = ldxios
-      idvar = iom_varid( kiomid, cdvar ) 
+      IF( PRESENT(ldxios) )   llxios = ldxios
+      !
       idom = kdom
+      istop = nstop
       !
       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
-
+         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_auto_xy ) &
+            &          CALL ctl_stop(TRIM(clinfo), 'kstart present needs idom = jpdom_unknown or idom = jpdom_auto_xy')
+         IF( idom == jpdom_auto_xy .AND. .NOT. PRESENT(kstart) ) &
+            &          CALL ctl_stop(TRIM(clinfo), 'idom = jpdom_auto_xy requires kstart to be present')
+         !
          ! Search for the variable in the data base (eventually actualize data)
-         istop = nstop
          !
+         idvar = iom_varid( kiomid, cdvar ) 
          IF( idvar > 0 ) THEN
-            ! to write iom_file(kiomid)%dimsz in a shorter way !
-            idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) 
+            !
+            idimsz(:) = iom_file(kiomid)%dimsz(:, idvar)      ! to write iom_file(kiomid)%dimsz in a shorter way
             inbdim = iom_file(kiomid)%ndims(idvar)            ! number of dimensions in the file
             idmspc = inbdim                                   ! number of spatial dimensions in the file
@@ -1081,27 +1210,11 @@
             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
+            ! Identify the domain in case of jpdom_auto definition
+            IF( idom == jpdom_auto .OR. idom == jpdom_auto_xy ) THEN            
+               idom = jpdom_global   ! default
+               ! else: if the file name finishes with _xxxx.nc with xxxx any number
                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
             !
@@ -1116,20 +1229,30 @@
             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...' )
+            IF(     idmspc <  irankpv ) THEN                     ! it seems we want to read more than we can...
+               IF(     irankpv == 3 .AND. idmspc == 2 ) THEN     !   3D input array from 2D spatial data in the file:
+                  llok = inlev == 1                              !     -> 3rd dimension must be equal to 1
+               ELSEIF( irankpv == 3 .AND. idmspc == 1 ) THEN     !   3D input array from 1D spatial data in the file:
+                  llok = inlev == 1 .AND. SIZE(pv_r3d, 2) == 1   !     -> 2nd and 3rd dimensions must be equal to 1
+               ELSEIF( irankpv == 2 .AND. idmspc == 2 ) THEN     !   2D input array from 1D spatial data in the file:
+                  llok = SIZE(pv_r2d, 2) == 1                    !     -> 2nd dimension must be equal to 1
+               ELSE
+                  llok = .FALSE.
+               ENDIF
+               IF( .NOT. llok )   CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   &
+                  &                                            '=> cannot read a true '//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
+            ELSEIF( idmspc >  irankpv ) THEN                     ! it seems we want to read less than we should...
                   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...'              ,   &
+                     CALL ctl_warn( trim(clinfo), '2D array input but 3 spatial dimensions in the file...'              ,   &
                            &         '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' )
+                  !!GS: possibility to read 3D ABL atmopsheric forcing and use 1st level to force BULK simulation
+                  !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
@@ -1137,45 +1260,29 @@
             ! 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
+            icnt  (:) = 1              ! default definition (simple way to deal with special cases listed above) 
+            istart(:) = 1              ! default definition (simple way to deal with special cases listed above) 
+            istart(idmspc+1) = itime   ! temporal dimenstion
+            !
+            IF( idom == jpdom_unknown ) THEN
+               IF( PRESENT(kstart) .AND. idom /= jpdom_auto_xy ) THEN 
+                  istart(1:idmspc) = kstart(1:idmspc) 
+                  icnt  (1:idmspc) = kcount(1:idmspc)
+               ELSE
+                  icnt  (1:idmspc) = idimsz(1:idmspc)
+               ENDIF
+            ELSE   !   not a 1D array as pv_r1d requires jpdom_unknown
+               ! we do not read the overlap and the extra-halos -> from Nis0 to Nie0 and from Njs0 to Nje0 
+               IF( idom == jpdom_global )   istart(1:2) = (/ mig0(Nis0), mjg0(Njs0) /)
+               icnt(1:2) = (/ Ni_0, Nj_0 /)
+               IF( PRESENT(pv_r3d) ) THEN
+                  IF( idom == jpdom_auto_xy ) THEN
+                     istart(3) = kstart(3)
+                     icnt  (3) = kcount(3)
+                  ELSE
+                     icnt  (3) = inlev
                   ENDIF
                ENDIF
             ENDIF
-
+            !
             ! check that istart and icnt can be used with this file
             !-
@@ -1188,5 +1295,5 @@
                ENDIF
             END DO
-
+            !
             ! check that icnt matches the input array
             !-     
@@ -1198,19 +1305,10 @@
             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
+                  ishape(1:2) = SHAPE(pv_r2d(Nis0:Nie0,Njs0:Nje0  ))   ;   ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0)'
                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
+                  ishape(1:3) = SHAPE(pv_r3d(Nis0:Nie0,Njs0:Nje0,:))   ;   ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0,:)'
                ENDIF
-            ENDIF
-         
+            ENDIF         
             DO jl = 1, irankpv
                WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl)
@@ -1224,35 +1322,23 @@
          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
+            ! find the right index of the array to be read
+            IF( idom /= jpdom_unknown ) THEN   ;   ix1 = Nis0   ;   ix2 = Nie0      ;   iy1 = Njs0   ;   iy2 = Nje0
+            ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
             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)
-             
+
+               cl_type = 'T'
+               IF( PRESENT(cd_type) )   cl_type = cd_type
+               zsgn = 1._wp
+               IF( PRESENT(psgn   ) )   zsgn    = psgn
                !--- 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
+               IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN
+                  CALL lbc_lnk( 'iom', pv_r2d, cl_type, zsgn, kfillmode = kfill )
+               ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN
+                  CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = kfill )
                ENDIF
                !
@@ -1267,24 +1353,17 @@
          !
       ELSE        ! read using XIOS. Only if KEY_IOMPUT is defined
-#if defined key_xios
+#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)
+            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
+            IF(idom /= jpdom_unknown )   CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing)
          ELSEIF( PRESENT(pv_r2d) ) THEN
-            pv_r2d(:, :) = 0.
-            if(lwp) write(numout,*) 'XIOS RST READ (2D): ', trim(cdvar)
+            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
+            IF(idom /= jpdom_unknown )   CALL lbc_lnk('iom', pv_r2d,'Z',-999., kfillmode = jpfillnothing)
          ELSEIF( PRESENT(pv_r1d) ) THEN
-            pv_r1d(:) = 0.
-            if(lwp) write(numout,*) 'XIOS RST READ (1D): ', trim(cdvar)
+            IF(lwp) WRITE(numout,*) 'XIOS RST READ (1D): ', TRIM(cdvar)
             CALL xios_recv_field( trim(cdvar), pv_r1d)
          ENDIF
@@ -1297,4 +1376,6 @@
 !some final adjustments
       ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain
+ !     IF( lk_c1d .AND. PRESENT(pv_r2d) )   CALL lbc_lnk( 'iom', pv_r2d,'Z',1.0_wp )
+ !     IF( lk_c1d .AND. PRESENT(pv_r3d) )   CALL lbc_lnk( 'iom', pv_r3d,'Z',1.0_wp )
 
       !--- Apply scale_factor and offset
@@ -1314,4 +1395,17 @@
    END SUBROUTINE iom_get_123d
 
+   SUBROUTINE iom_get_var( cdname, z2d)
+      CHARACTER(LEN=*), INTENT(in ) ::   cdname
+      REAL(wp), DIMENSION(jpi,jpj) ::   z2d 
+#if defined key_iomput
+      IF( xios_field_is_active( cdname, at_current_timestep_arg = .TRUE. ) ) THEN
+         z2d(:,:) = 0._wp
+         CALL xios_recv_field( cdname, z2d)
+      ENDIF
+#else
+      IF( .FALSE. )   WRITE(numout,*) cdname, z2d ! useless test to avoid compilation warnings
+#endif
+   END SUBROUTINE iom_get_var
+
 
    FUNCTION iom_getszuld ( kiomid )  
@@ -1470,10 +1564,10 @@
    !!                   INTERFACE iom_rstput
    !!----------------------------------------------------------------------
-   SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios )
+   SUBROUTINE iom_rp0d_sp( 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
+      REAL(sp)        , INTENT(in)                         ::   pvar     ! written field
       INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
       LOGICAL, OPTIONAL :: ldxios   ! xios write flag
@@ -1484,5 +1578,35 @@
       IF(PRESENT(ldxios)) llx = ldxios
       IF( llx ) THEN
-#ifdef key_xios
+#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 = real(pvar, dp) )
+            ENDIF
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_rp0d_sp
+
+   SUBROUTINE iom_rp0d_dp( 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(dp)        , 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)
@@ -1498,12 +1622,13 @@
          ENDIF
       ENDIF
-   END SUBROUTINE iom_rp0d
-
-   SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios )
+   END SUBROUTINE iom_rp0d_dp
+
+
+   SUBROUTINE iom_rp1d_sp( 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
+      REAL(sp)        , INTENT(in), DIMENSION(          :) ::   pvar     ! written field
       INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
       LOGICAL, OPTIONAL                                    ::   ldxios   ! xios write flag
@@ -1514,5 +1639,35 @@
       IF(PRESENT(ldxios)) llx = ldxios
       IF( llx ) THEN
-#ifdef key_xios
+#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 = real(pvar, dp) )
+            ENDIF
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_rp1d_sp
+
+   SUBROUTINE iom_rp1d_dp( 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(dp)        , 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)
@@ -1528,12 +1683,13 @@
          ENDIF
       ENDIF
-   END SUBROUTINE iom_rp1d
-
-   SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios )
+   END SUBROUTINE iom_rp1d_dp
+
+
+   SUBROUTINE iom_rp2d_sp( 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
+      REAL(sp)        , INTENT(in), DIMENSION(:,    :    ) ::   pvar     ! written field
       INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
       LOGICAL, OPTIONAL :: ldxios   ! xios write flag
@@ -1544,5 +1700,35 @@
       IF(PRESENT(ldxios)) llx = ldxios
       IF( llx ) THEN
-#ifdef key_xios
+#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 = real(pvar, dp) )
+            ENDIF
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_rp2d_sp
+
+   SUBROUTINE iom_rp2d_dp( 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(dp)        , 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)
@@ -1558,12 +1744,13 @@
          ENDIF
       ENDIF
-   END SUBROUTINE iom_rp2d
-
-   SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios )
+   END SUBROUTINE iom_rp2d_dp
+
+
+   SUBROUTINE iom_rp3d_sp( 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
+      REAL(sp)        , INTENT(in),       DIMENSION(:,:,:) ::   pvar     ! written field
       INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
       LOGICAL, OPTIONAL :: ldxios   ! xios write flag
@@ -1574,5 +1761,35 @@
       IF(PRESENT(ldxios)) llx = ldxios
       IF( llx ) THEN
-#ifdef key_xios
+#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 = real(pvar, dp) )
+            ENDIF
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_rp3d_sp
+
+   SUBROUTINE iom_rp3d_dp( 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(dp)        , 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)
@@ -1588,5 +1805,6 @@
          ENDIF
       ENDIF
-   END SUBROUTINE iom_rp3d
+   END SUBROUTINE iom_rp3d_dp
+
 
 
@@ -1640,50 +1858,150 @@
    !!                   INTERFACE iom_put
    !!----------------------------------------------------------------------
-   SUBROUTINE iom_p0d( cdname, pfield0d )
+   SUBROUTINE iom_p0d_sp( cdname, pfield0d )
       CHARACTER(LEN=*), INTENT(in) ::   cdname
-      REAL(wp)        , INTENT(in) ::   pfield0d
-      REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson
-#if defined key_xios
-      zz(:,:)=pfield0d
-      CALL xios_send_field(cdname, zz)
-      !CALL xios_send_field(cdname, (/pfield0d/)) 
+      REAL(sp)        , INTENT(in) ::   pfield0d
+!!      REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson
+#if defined key_iomput
+!!clem      zz(:,:)=pfield0d
+!!clem      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 )
+   END SUBROUTINE iom_p0d_sp
+
+   SUBROUTINE iom_p0d_dp( cdname, pfield0d )
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+      REAL(dp)        , INTENT(in) ::   pfield0d
+!!      REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson
+#if defined key_iomput
+!!clem      zz(:,:)=pfield0d
+!!clem      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_dp
+
+
+   SUBROUTINE iom_p1d_sp( cdname, pfield1d )
       CHARACTER(LEN=*)          , INTENT(in) ::   cdname
-      REAL(wp),     DIMENSION(:), INTENT(in) ::   pfield1d
-#if defined key_xios
+      REAL(sp),     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 )
+   END SUBROUTINE iom_p1d_sp
+
+   SUBROUTINE iom_p1d_dp( cdname, pfield1d )
+      CHARACTER(LEN=*)          , INTENT(in) ::   cdname
+      REAL(dp),     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_dp
+
+   SUBROUTINE iom_p2d_sp( cdname, pfield2d )
       CHARACTER(LEN=*)            , INTENT(in) ::   cdname
-      REAL(wp),     DIMENSION(:,:), INTENT(in) ::   pfield2d
-#if defined key_xios
-      CALL xios_send_field(cdname, pfield2d)
+      REAL(sp),     DIMENSION(:,:), INTENT(in) ::   pfield2d
+      IF( iom_use(cdname) ) THEN
+#if defined key_iomput
+         IF( SIZE(pfield2d, dim=1) == jpi .AND. SIZE(pfield2d, dim=2) == jpj ) THEN
+            CALL xios_send_field( cdname, pfield2d(Nis0:Nie0, Njs0:Nje0) )       ! this extraction will create a copy of pfield2d
+         ELSE
+            CALL xios_send_field( cdname, pfield2d )
+         ENDIF
 #else
-      IF( .FALSE. )   WRITE(numout,*) cdname, pfield2d   ! useless test to avoid compilation warnings
-#endif
-   END SUBROUTINE iom_p2d
-
-   SUBROUTINE iom_p3d( cdname, pfield3d )
+         WRITE(numout,*) pfield2d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
+#endif
+      ENDIF
+   END SUBROUTINE iom_p2d_sp
+
+   SUBROUTINE iom_p2d_dp( cdname, pfield2d )
+      CHARACTER(LEN=*)            , INTENT(in) ::   cdname
+      REAL(dp),     DIMENSION(:,:), INTENT(in) ::   pfield2d
+      IF( iom_use(cdname) ) THEN
+#if defined key_iomput
+         IF( SIZE(pfield2d, dim=1) == jpi .AND. SIZE(pfield2d, dim=2) == jpj ) THEN
+            CALL xios_send_field( cdname, pfield2d(Nis0:Nie0, Njs0:Nje0) )       ! this extraction will create a copy of pfield2d
+         ELSE
+            CALL xios_send_field( cdname, pfield2d )
+         ENDIF
+#else
+         WRITE(numout,*) pfield2d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
+#endif
+      ENDIF
+   END SUBROUTINE iom_p2d_dp
+
+   SUBROUTINE iom_p3d_sp( cdname, pfield3d )
       CHARACTER(LEN=*)                , INTENT(in) ::   cdname
-      REAL(wp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d
-#if defined key_xios
-      CALL xios_send_field( cdname, pfield3d )
+      REAL(sp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d
+      IF( iom_use(cdname) ) THEN
+#if defined key_iomput
+         IF( SIZE(pfield3d, dim=1) == jpi .AND. SIZE(pfield3d, dim=2) == jpj ) THEN
+            CALL xios_send_field( cdname, pfield3d(Nis0:Nie0, Njs0:Nje0,:) )     ! this extraction will create a copy of pfield3d
+         ELSE
+            CALL xios_send_field( cdname, pfield3d )
+         ENDIF
 #else
-      IF( .FALSE. )   WRITE(numout,*) cdname, pfield3d   ! useless test to avoid compilation warnings
-#endif
-   END SUBROUTINE iom_p3d
-
-#if defined key_xios
+         WRITE(numout,*) pfield3d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
+#endif
+      ENDIF
+   END SUBROUTINE iom_p3d_sp
+
+   SUBROUTINE iom_p3d_dp( cdname, pfield3d )
+      CHARACTER(LEN=*)                , INTENT(in) ::   cdname
+      REAL(dp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d
+      IF( iom_use(cdname) ) THEN
+#if defined key_iomput
+         IF( SIZE(pfield3d, dim=1) == jpi .AND. SIZE(pfield3d, dim=2) == jpj ) THEN
+            CALL xios_send_field( cdname, pfield3d(Nis0:Nie0, Njs0:Nje0,:) )     ! this extraction will create a copy of pfield3d
+         ELSE
+            CALL xios_send_field( cdname, pfield3d )
+         ENDIF
+#else
+         WRITE(numout,*) pfield3d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
+#endif
+      ENDIF
+   END SUBROUTINE iom_p3d_dp
+
+   SUBROUTINE iom_p4d_sp( cdname, pfield4d )
+      CHARACTER(LEN=*)                , INTENT(in) ::   cdname
+      REAL(sp),       DIMENSION(:,:,:,:), INTENT(in) ::   pfield4d
+      IF( iom_use(cdname) ) THEN
+#if defined key_iomput
+         IF( SIZE(pfield4d, dim=1) == jpi .AND. SIZE(pfield4d, dim=2) == jpj ) THEN
+            CALL xios_send_field( cdname, pfield4d(Nis0:Nie0, Njs0:Nje0,:,:) )   ! this extraction will create a copy of pfield4d
+         ELSE
+            CALL xios_send_field (cdname, pfield4d )
+         ENDIF
+#else
+         WRITE(numout,*) pfield4d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
+#endif
+      ENDIF
+   END SUBROUTINE iom_p4d_sp
+
+   SUBROUTINE iom_p4d_dp( cdname, pfield4d )
+      CHARACTER(LEN=*)                , INTENT(in) ::   cdname
+      REAL(dp),       DIMENSION(:,:,:,:), INTENT(in) ::   pfield4d
+      IF( iom_use(cdname) ) THEN
+#if defined key_iomput
+         IF( SIZE(pfield4d, dim=1) == jpi .AND. SIZE(pfield4d, dim=2) == jpj ) THEN
+            CALL xios_send_field( cdname, pfield4d(Nis0:Nie0, Njs0:Nje0,:,:) )   ! this extraction will create a copy of pfield4d
+         ELSE
+            CALL xios_send_field (cdname, pfield4d )
+         ENDIF
+#else
+         WRITE(numout,*) pfield4d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
+#endif
+      ENDIF
+   END SUBROUTINE iom_p4d_dp
+
+#if defined key_iomput
    !!----------------------------------------------------------------------
-   !!   'key_xios'                                         XIOS interface
+   !!   'key_iomput'                                         XIOS interface
    !!----------------------------------------------------------------------
 
@@ -1697,6 +2015,6 @@
       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
+      REAL(dp), DIMENSION(:)  , OPTIONAL, INTENT(in) ::   lonvalue, latvalue
+      REAL(dp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds_lon, bounds_lat, area
       LOGICAL , DIMENSION(:)  , OPTIONAL, INTENT(in) ::   mask
       !!----------------------------------------------------------------------
@@ -1761,9 +2079,14 @@
       !!----------------------------------------------------------------------
       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 )
+         IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, n_glo=SIZE(paxis), value=real(paxis, dp) )
+         IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=real(paxis, dp) )
+      ENDIF
+      IF( PRESENT(bounds) ) THEN
+         IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, bounds=real(bounds, dp) )
+         IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, bounds=real(bounds, dp) )
+      ELSE
+         IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid)
+         IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid)
+      END IF
       CALL xios_solve_inheritance()
    END SUBROUTINE iom_set_axis_attr
@@ -1872,18 +2195,14 @@
       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)
+      CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=Ni0glo,nj_glo=Nj0glo,ibegin=mig0(Nis0)-1,jbegin=mjg0(Njs0)-1,ni=Ni_0,nj=Nj_0)
+      CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 0, data_ni = Ni_0, data_jbegin = 0, data_nj = Nj_0)
 !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 /)))  
+         CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = real(RESHAPE(plon(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp),   &
+         &                                        latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp ))  
       !
       IF ( ln_mskland .AND. (.NOT.ldxios) ) THEN
@@ -1891,15 +2210,14 @@
          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('U')   ;   zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:)
+         CASE('V')   ;   zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:)
          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. )
+         CALL iom_set_domain_attr( "grid_"//cdgrd       , mask = RESHAPE(zmask(Nis0:Nie0,Njs0:Nje0,1),(/Ni_0*Nj_0    /)) /= 0. )
+         CALL iom_set_grid_attr  ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(Nis0:Nie0,Njs0:Nje0,:),(/Ni_0,Nj_0,jpk/)) /= 0. )
       ENDIF
       !
    END SUBROUTINE set_grid
-
 
    SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt )
@@ -1914,7 +2232,9 @@
       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)
+      INTEGER :: ji, jj, jn
+      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
@@ -1931,81 +2251,34 @@
       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
+      CALL lbc_lnk( 'iom', z_fld, cdgrd, -1.0_wp )    ! 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 ) 
+      DO_2D( 0, 0, 0, 0 )
+         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_2D
+      !
+      DO_2D( 0, 0, 0, 0 )
+         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_2D
+      !
+      CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = real(RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,1),(/ 4,Ni_0*Nj_0 /)), dp),           &
+          &                                    bounds_lon = real(RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,2),(/ 4,Ni_0*Nj_0 /)), dp), nvertex=4 )
+      !
+      DEALLOCATE( z_bnds, z_fld, z_rot )
       !
    END SUBROUTINE set_grid_bounds
 
-
    SUBROUTINE set_grid_znl( plat )
       !!----------------------------------------------------------------------
@@ -2017,20 +2290,17 @@
       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat
       !
-      INTEGER  :: ni, nj, ix, iy
+      INTEGER  :: 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)
+      ALLOCATE( zlon(Ni_0*Nj_0) )       ;       zlon(:) = 0._wp
+      !
+!      CALL dom_ngb( -168.53_wp, 65.03_wp, ix, iy, 'T' ) !  i-line that passes through Bering Strait: Reference latitude (used in plots)
+      CALL dom_ngb( 180.0_wp, 90.0_wp, ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots)
+      CALL iom_set_domain_attr("gznl", ni_glo=Ni0glo, nj_glo=Nj0glo, ibegin=mig0(Nis0)-1, jbegin=mjg0(Njs0)-1, ni=Ni_0, nj=Nj_0)
+      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 0, data_ni = Ni_0, data_jbegin = 0, data_nj = Nj_0)
+      CALL iom_set_domain_attr("gznl", lonvalue = real(zlon, dp),   &
+         &                             latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp))  
+      CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=Nj_0)
       !
       CALL iom_update_file_name('ptr')
@@ -2046,5 +2316,5 @@
       !!
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(1)   ::   zz = 1.
+      REAL(dp), DIMENSION(1)   ::   zz = 1.
       !!----------------------------------------------------------------------
       !
@@ -2087,6 +2357,5 @@
       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)
+      f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('ABL'             , freq_op=f_op, freq_offset=f_of)
 
       ! output file names (attribut: name)
@@ -2109,6 +2378,6 @@
          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 dom_ngb( 0.0_wp, 0.0_wp, ix, iy, cl1 )
+         CALL iom_set_zoom_domain_attr('Eq'//cl1, ibegin=0, jbegin=iy-1, ni=Ni0glo, nj=1 )
          CALL iom_get_file_attr   ('Eq'//cl1, name_suffix = clsuff             )
          CALL iom_set_file_attr   ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq')
@@ -2269,5 +2538,5 @@
             idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
             DO WHILE ( idx /= 0 ) 
-               cldate = iom_sdate( fjulday - rdt / rday )
+               cldate = iom_sdate( fjulday - rn_Dt / rday )
                clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname))
                idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
@@ -2276,5 +2545,5 @@
             idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@')
             DO WHILE ( idx /= 0 ) 
-               cldate = iom_sdate( fjulday - rdt / rday, ldfull = .TRUE. )
+               cldate = iom_sdate( fjulday - rn_Dt / rday, ldfull = .TRUE. )
                clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname))
                idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@')
@@ -2283,5 +2552,5 @@
             idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@')
             DO WHILE ( idx /= 0 ) 
-               cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. )
+               cldate = iom_sdate( fjulday + rn_Dt / 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@')
@@ -2290,5 +2559,5 @@
             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. )
+               cldate = iom_sdate( fjulday + rn_Dt / 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@')
@@ -2335,5 +2604,5 @@
       !
       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 )
+         CALL ju2ymds( pjday - 1.0_wp, iyear, imonth, iday, zsec )
          isec = 86400
       ENDIF
@@ -2361,7 +2630,6 @@
 #else
    !!----------------------------------------------------------------------
-   !!   NOT 'key_xios'                               a few dummy routines
+   !!   NOT 'key_iomput'                               a few dummy routines
    !!----------------------------------------------------------------------
-
    SUBROUTINE iom_setkt( kt, cdname )
       INTEGER         , INTENT(in)::   kt 
@@ -2375,12 +2643,14 @@
    END SUBROUTINE iom_context_finalize
 
+   SUBROUTINE iom_update_file_name( cdid )
+      CHARACTER(LEN=*), INTENT(in) ::   cdid
+      IF( .FALSE. )   WRITE(numout,*)  cdid   ! useless test to avoid compilation warnings
+   END SUBROUTINE iom_update_file_name
+
 #endif
 
    LOGICAL FUNCTION iom_use( cdname )
-      !!----------------------------------------------------------------------
-      !!----------------------------------------------------------------------
       CHARACTER(LEN=*), INTENT(in) ::   cdname
-      !!----------------------------------------------------------------------
-#if defined key_xios
+#if defined key_iomput
       iom_use = xios_field_is_active( cdname )
 #else
@@ -2388,5 +2658,19 @@
 #endif
    END FUNCTION iom_use
-   
+
+   SUBROUTINE iom_miss_val( cdname, pmiss_val )
+      CHARACTER(LEN=*), INTENT(in ) ::   cdname
+      REAL(wp)        , INTENT(out) ::   pmiss_val   
+      REAL(dp)                      ::   ztmp_pmiss_val   
+#if defined key_iomput
+      ! get missing value
+      CALL xios_get_field_attr( cdname, default_value = ztmp_pmiss_val )
+      pmiss_val = ztmp_pmiss_val
+#else
+      IF( .FALSE. )   WRITE(numout,*) cdname, pmiss_val   ! useless test to avoid compilation warnings
+      IF( .FALSE. )   pmiss_val = 0._wp                   ! useless assignment to avoid compilation warnings
+#endif
+   END SUBROUTINE iom_miss_val
+  
    !!======================================================================
 END MODULE iom
Index: utils/tools/DOMAINcfg/src/iom_def.F90
===================================================================
--- utils/tools/DOMAINcfg/src/iom_def.F90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/iom_def.F90	(revision 14623)
@@ -13,14 +13,11 @@
    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 ::   jpdom_global        = 1   !: ( 1  :Ni0glo, 1  :Nj0glo)
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_local         = 2   !: (Nis0: Nie0 ,Njs0: Nje0 )
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_unknown       = 3   !: No dimension checking
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_auto          = 4   !: 
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_auto_xy       = 5   !: Automatically set horizontal dimensions only
+
+   INTEGER, PARAMETER, PUBLIC ::   jpdom_data = jpdom_global
 
    INTEGER, PARAMETER, PUBLIC ::   jp_r8    = 200      !: write REAL(8)
@@ -33,6 +30,5 @@
    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
-
+   INTEGER, PARAMETER, PUBLIC ::   jpmax_digits =  9   !: maximum number of digits for the cpu number in the file name
 
 !$AGRIF_DO_NOT_TREAT
@@ -46,8 +42,7 @@
    LOGICAL, PUBLIC            ::   lxios_set  = .FALSE. 
 
-
-
    TYPE, PUBLIC ::   file_descriptor
       CHARACTER(LEN=240)                        ::   name     !: name of the file
+      CHARACTER(LEN=3  )                        ::   comp     !: name of component opening the file ('OCE', 'ICE'...)
       INTEGER                                   ::   nfid     !: identifier of the file (0 if closed)
                                                               !: jpioipsl option has been removed)
@@ -64,5 +59,4 @@
       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
@@ -77,7 +71,9 @@
    TYPE(RST_FIELD), PUBLIC, SAVE :: rst_wfields(max_rst_fields), rst_rfields(max_rst_fields)
    !
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: iom_def.F90 10425 2018-12-19 21:54:16Z smasson $
+   !! $Id: iom_def.F90 13286 2020-07-09 15:48:29Z smasson $
    !! Software governed by the CeCILL license (see ./LICENSE)
    !!======================================================================
Index: utils/tools/DOMAINcfg/src/iom_nf90.F90
===================================================================
--- utils/tools/DOMAINcfg/src/iom_nf90.F90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/iom_nf90.F90	(revision 14623)
@@ -19,4 +19,5 @@
    !!----------------------------------------------------------------------
    USE dom_oce         ! ocean space and time domain
+   !USE sbc_oce, ONLY: ght_abl ! abl vertical level number and height
    USE lbclnk          ! lateal boundary condition / mpp exchanges
    USE iom_def         ! iom variables definitions
@@ -32,18 +33,19 @@
 
    INTERFACE iom_nf90_get
-      MODULE PROCEDURE iom_nf90_g0d, iom_nf90_g123d
+      MODULE PROCEDURE iom_nf90_g0d_sp                   
+      MODULE PROCEDURE iom_nf90_g0d_dp, iom_nf90_g123d_dp
    END INTERFACE
    INTERFACE iom_nf90_rstput
-      MODULE PROCEDURE iom_nf90_rp0123d
+      MODULE PROCEDURE iom_nf90_rp0123d_dp
    END INTERFACE
 
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: iom_nf90.F90 10522 2019-01-16 08:35:15Z smasson $
+   !! $Id: iom_nf90.F90 13286 2020-07-09 15:48:29Z smasson $
    !! Software governed by the CeCILL license (see ./LICENSE)
    !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar, kdlev )
+   SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdlev, cdcomp )
       !!---------------------------------------------------------------------
       !!                   ***  SUBROUTINE  iom_open  ***
@@ -55,9 +57,12 @@
       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
+      INTEGER                , INTENT(in   ), OPTIONAL ::   kdlev       ! size of the ice/abl third dimension
+      CHARACTER(len=3)       , INTENT(in   ), OPTIONAL ::   cdcomp      ! name of component calling iom_nf90_open
 
       CHARACTER(LEN=256) ::   clinfo           ! info character
       CHARACTER(LEN=256) ::   cltmp            ! temporary character
+      CHARACTER(LEN=12 ) ::   clfmt            ! writing format
+      CHARACTER(LEN=3  ) ::   clcomp           ! name of component calling iom_nf90_open
+      INTEGER            ::   idg              ! number of digits
       INTEGER            ::   iln              ! lengths of character
       INTEGER            ::   istop            ! temporary storage of nstop
@@ -69,5 +74,4 @@
       INTEGER            ::   ihdf5            ! local variable for retrieval of value for NF90_HDF5
       LOGICAL            ::   llclobber        ! local definition of ln_clobber
-      INTEGER            ::   ilevels           ! vertical levels
       !---------------------------------------------------------------------
       !
@@ -76,6 +80,9 @@
       !
       !                 !number of vertical levels
-      IF( PRESENT(kdlev) ) THEN   ;   ilevels = kdlev    ! use input value (useful for sea-ice)
-      ELSE                        ;   ilevels = jpk      ! by default jpk
+      IF( PRESENT(cdcomp) )   THEN
+         IF( .NOT. PRESENT(kdlev) ) CALL ctl_stop( 'iom_nf90_open: cdcomp and kdlev must both be present' )
+         clcomp = cdcomp    ! use input value
+      ELSE
+         clcomp = 'OCE'     ! by default 
       ENDIF
       !
@@ -104,5 +111,7 @@
          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'
+               idg = MAX( INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1, 4 )          ! how many digits to we need to write? min=4, max=9
+               WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg          ! '(a,a,ix.x,a)'
+               WRITE(cltmp,clfmt) cdname(1:iln-1), '_', narea-1, '.nc'
                cdname = TRIM(cltmp)
             ENDIF
@@ -124,21 +133,25 @@
             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)
+                               CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'x',  Ni_0, idmy ), clinfo)
+                               CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'y',  Nj_0, idmy ), clinfo)
+            SELECT CASE (clcomp)
+            CASE ('OCE')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev',   jpk, idmy ), clinfo)
+            CASE ('ICE')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,       'numcat', kdlev, idmy ), clinfo)
+            CASE ('ABL')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev', kdlev, idmy ), clinfo)
+            CASE ('SED')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,       'numsed', kdlev, idmy ), clinfo)
+            CASE DEFAULT   ;   CALL ctl_stop( 'iom_nf90_open unknown component type' )
+            END SELECT
+                               CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, 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)
+            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'    , (/ Ni0glo    , Nj0glo     /) ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_local'     , (/ Ni_0      , Nj_0       /) ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_first' , (/ mig0(Nis0), mjg0(Njs0) /) ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_last'  , (/ mig0(Nie0), mjg0(Nje0) /) ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_start', (/ 0         , 0          /) ), clinfo)
+            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_end'  , (/ 0         , 0          /) ), 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...' )
@@ -155,8 +168,8 @@
          ENDDO
          iom_file(kiomid)%name   = TRIM(cdname)
+         iom_file(kiomid)%comp   = clcomp
          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
@@ -187,5 +200,5 @@
 
 
-   FUNCTION iom_nf90_varid ( kiomid, cdvar, kiv, kdimsz, kndims )  
+   FUNCTION iom_nf90_varid ( kiomid, cdvar, kiv, kdimsz, kndims, lduld )  
       !!-----------------------------------------------------------------------
       !!                  ***  FUNCTION  iom_varid  ***
@@ -196,6 +209,7 @@
       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, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of each dimension
+      INTEGER              , INTENT(  out), OPTIONAL ::   kndims   ! number of dimensions
+      LOGICAL              , INTENT(  out), OPTIONAL ::   lduld    ! true if the last dimension is unlimited (time)
       !
       INTEGER                        ::   iom_nf90_varid   ! iom variable Id
@@ -251,4 +265,5 @@
          ENDIF
          IF( PRESENT(kndims) )  kndims = iom_file(kiomid)%ndims(kiv)
+         IF( PRESENT( lduld) )  lduld  = iom_file(kiomid)%luld(kiv)
       ELSE  
          iom_nf90_varid = -1   !   variable not found, return error code: -1
@@ -261,5 +276,5 @@
    !!----------------------------------------------------------------------
 
-   SUBROUTINE iom_nf90_g0d( kiomid, kvid, pvar, kstart )
+   SUBROUTINE iom_nf90_g0d_sp( kiomid, kvid, pvar, kstart )
       !!-----------------------------------------------------------------------
       !!                  ***  ROUTINE  iom_nf90_g0d  ***
@@ -269,5 +284,5 @@
       INTEGER ,               INTENT(in   )            ::   kiomid   ! Identifier of the file
       INTEGER ,               INTENT(in   )            ::   kvid     ! variable id
-      REAL(wp),               INTENT(  out)            ::   pvar     ! read field
+      REAL(sp),               INTENT(  out)            ::   pvar     ! read field
       INTEGER , DIMENSION(1), INTENT(in   ), OPTIONAL  ::   kstart   ! start position of the reading in each axis
       !
@@ -276,8 +291,24 @@
       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,   &
+   END SUBROUTINE iom_nf90_g0d_sp
+
+   SUBROUTINE iom_nf90_g0d_dp( 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(dp),               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_dp
+
+   SUBROUTINE iom_nf90_g123d_dp( kiomid, kvid, knbdim, kstart, kcount, kx1, kx2, ky1, ky2,   &
          &                    pv_r1d, pv_r2d, pv_r3d )
       !!-----------------------------------------------------------------------
@@ -294,7 +325,7 @@
       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)
+      REAL(dp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d    ! read field (1D case)
+      REAL(dp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d    ! read field (2D case)
+      REAL(dp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d    ! read field (3D case)
       !
       CHARACTER(LEN=100) ::   clinfo               ! info character
@@ -317,5 +348,6 @@
       ENDIF
       !
-   END SUBROUTINE iom_nf90_g123d
+   END SUBROUTINE iom_nf90_g123d_dp
+
 
 
@@ -491,6 +523,5 @@
    END SUBROUTINE iom_nf90_putatt
 
-
-   SUBROUTINE iom_nf90_rp0123d( kt, kwrite, kiomid, cdvar , kvid  , ktype,   &
+   SUBROUTINE iom_nf90_rp0123d_dp( kt, kwrite, kiomid, cdvar , kvid  , ktype,   &
          &                                  pv_r0d, pv_r1d, pv_r2d, pv_r3d )
       !!--------------------------------------------------------------------
@@ -505,8 +536,8 @@
       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
+      REAL(dp)                    , INTENT(in), OPTIONAL ::   pv_r0d   ! written Od field
+      REAL(dp), DIMENSION(      :), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field
+      REAL(dp), DIMENSION(:, :   ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field
+      REAL(dp), DIMENSION(:, :, :), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field
       !
       INTEGER               :: idims                ! number of dimension
@@ -517,7 +548,5 @@
       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
@@ -528,22 +557,8 @@
       !                                             ! 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
@@ -555,24 +570,20 @@
          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)
+         DO jd = 1, 2
+            CALL iom_nf90_check(NF90_INQUIRE_DIMENSION(if90id,jd,iom_file(kiomid)%cn_var(jd),iom_file(kiomid)%dimsz(jd,jd)),clinfo)
+            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(iom_file(kiomid)%cn_var(jd)), NF90_FLOAT , (/ 1, 2 /),   &
+               &                              iom_file(kiomid)%nvid(jd) ), clinfo)
+         END DO
+         iom_file(kiomid)%dimsz(2,1) = iom_file(kiomid)%dimsz(2,2)   ! second dim of first  variable
+         iom_file(kiomid)%dimsz(1,2) = iom_file(kiomid)%dimsz(1,1)   ! first  dim of second variable
+         DO jd = 3, 4
+            CALL iom_nf90_check(NF90_INQUIRE_DIMENSION(if90id,jd,iom_file(kiomid)%cn_var(jd),iom_file(kiomid)%dimsz(1,jd)), clinfo)
+            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(iom_file(kiomid)%cn_var(jd)), NF90_FLOAT , (/ jd   /),   &
+               &                              iom_file(kiomid)%nvid(jd) ), clinfo)
+         END DO
          ! 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
@@ -595,14 +606,8 @@
          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/)
+                                              idims = 2   ;   idimid(1:idims) = (/3,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/)
+                                              idims = 4   ;   idimid(1:idims) = (/1,2,3,4/)
          ENDIF
          IF( PRESENT(ktype) ) THEN   ! variable external type
@@ -666,9 +671,9 @@
          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
+            IF(     idimsz(1) == Ni_0 .AND. idimsz(2) == Nj_0 ) THEN
+               ix1 = Nis0   ;   ix2 = Nie0   ;   iy1 = Njs0   ;   iy2 = Nje0
+            ELSEIF( idimsz(1) == jpi  .AND. idimsz(2) == jpj  ) THEN
+               ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj
+            ELSEIF( idimsz(1) == jpi  .AND. idimsz(2) == jpj  ) THEN
                ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj
             ELSE 
@@ -679,23 +684,19 @@
             ! =============
             ! 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( iom_file(kiomid)%dimsz(1, 4) == 0 ) THEN   ! time_counter = 0
+               CALL iom_nf90_check(    NF90_PUT_VAR( if90id, 1,                            glamt(ix1:ix2, iy1:iy2) ), clinfo )
+               CALL iom_nf90_check(    NF90_PUT_VAR( if90id, 2,                            gphit(ix1:ix2, iy1:iy2) ), clinfo )
+               SELECT CASE (iom_file(kiomid)%comp)
+               CASE ('OCE')  
+                  CALL iom_nf90_check( NF90_PUT_VAR( if90id, 3,                                           gdept_1d ), clinfo )
+            !   CASE ('ABL')
+            !      CALL iom_nf90_check( NF90_PUT_VAR( if90id, 3,                                            ght_abl ), clinfo )
+               CASE DEFAULT
+                  CALL iom_nf90_check( NF90_PUT_VAR( if90id, 3, (/ (idlv, idlv = 1,iom_file(kiomid)%dimsz(1,3)) /) ), clinfo )
+               END SELECT
+               ! "wrong" value: to be improved but not really useful...
+               CALL iom_nf90_check(   NF90_PUT_VAR( if90id, 4,                                                  kt ), clinfo )   
+               ! update the size of the variable corresponding to the unlimited dimension
+               iom_file(kiomid)%dimsz(1, 4) = 1   ! so we don't enter this IF case any more...
                IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done'
             ENDIF
@@ -718,9 +719,6 @@
          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
+   END SUBROUTINE iom_nf90_rp0123d_dp
 
 
Index: utils/tools/DOMAINcfg/src/lbc_lnk_multi_generic.h90
===================================================================
--- utils/tools/DOMAINcfg/src/lbc_lnk_multi_generic.h90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/lbc_lnk_multi_generic.h90	(revision 14623)
@@ -1,36 +1,59 @@
-#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
+#if defined SINGLE_PRECISION
+#   if defined DIM_2d
+#      define ARRAY_TYPE(i,j,k,l)   REAL(sp), DIMENSION(i,j)
+#      define PTR_TYPE              TYPE(PTR_2D_sp)
+#      define PTR_ptab              pt2d
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_TYPE(i,j,k,l)   REAL(sp), DIMENSION(i,j,k)
+#      define PTR_TYPE              TYPE(PTR_3D_sp)
+#      define PTR_ptab              pt3d
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_TYPE(i,j,k,l)   REAL(sp), DIMENSION(i,j,k,l)
+#      define PTR_TYPE              TYPE(PTR_4D_sp)
+#      define PTR_ptab              pt4d
+#   endif
+#   define PRECISION sp
+#else
+#   if defined DIM_2d
+#      define ARRAY_TYPE(i,j,k,l)   REAL(dp), DIMENSION(i,j)
+#      define PTR_TYPE              TYPE(PTR_2D_dp)
+#      define PTR_ptab              pt2d
+#   endif
+#   if defined DIM_3d
+#      define ARRAY_TYPE(i,j,k,l)   REAL(dp), DIMENSION(i,j,k)
+#      define PTR_TYPE              TYPE(PTR_3D_dp)
+#      define PTR_ptab              pt3d
+#   endif
+#   if defined DIM_4d
+#      define ARRAY_TYPE(i,j,k,l)   REAL(dp), DIMENSION(i,j,k,l)
+#      define PTR_TYPE              TYPE(PTR_4D_dp)
+#      define PTR_ptab              pt4d
+#   endif
+#   define PRECISION dp
 #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)
+
+   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, pt10, cdna10, psgn10, pt11, cdna11, psgn11                      &
+      &                    , kfillmode, pfillval, lsend, lrecv )
       !!---------------------------------------------------------------------
-      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)
+      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  , pt10  , pt11
+      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, cdna10, cdna11
+      REAL(wp)                             , INTENT(in   ) :: psgn1   ! sign used across the north fold
+      REAL(wp)           , OPTIONAL        , INTENT(in   ) :: psgn2, psgn3, psgn4, psgn5, psgn6, psgn7, psgn8, psgn9, psgn10, psgn11
+      INTEGER            , OPTIONAL        , INTENT(in   ) :: kfillmode   ! filling method for halo over land (default = constant)
+      REAL(wp)           , OPTIONAL        , INTENT(in   ) :: pfillval    ! background value (used at closed boundaries)
+      LOGICAL, DIMENSION(4), OPTIONAL      , INTENT(in   ) :: lsend, lrecv   ! indicate how communications are to be carried out
       !!
-      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
+      INTEGER                          ::   kfld        ! number of elements that will be attributed
+      PTR_TYPE         , DIMENSION(11) ::   ptab_ptr    ! pointer array
+      CHARACTER(len=1) , DIMENSION(11) ::   cdna_ptr    ! nature of ptab_ptr grid-points
+      REAL(wp)         , DIMENSION(11) ::   psgn_ptr    ! sign used across the north fold boundary
       !!---------------------------------------------------------------------
       !
@@ -41,14 +64,16 @@
       !
       !                 ! 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 )
+      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 )
+      IF( PRESENT(psgn10) )   CALL ROUTINE_LOAD( pt10, cdna10, psgn10, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn11) )   CALL ROUTINE_LOAD( pt11, cdna11, psgn11, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
       !
-      CALL lbc_lnk_ptr( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, cd_mpp, pval )
+      CALL lbc_lnk_ptr    ( cdname,               ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv )
       !
    END SUBROUTINE ROUTINE_MULTI
@@ -72,4 +97,6 @@
       !
    END SUBROUTINE ROUTINE_LOAD
+
+#undef PRECISION
 #undef ARRAY_TYPE
 #undef PTR_TYPE
Index: utils/tools/DOMAINcfg/src/lbc_nfd_ext_generic.h90
===================================================================
--- utils/tools/DOMAINcfg/src/lbc_nfd_ext_generic.h90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/lbc_nfd_ext_generic.h90	(revision 14623)
@@ -8,5 +8,11 @@
 #   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)
+#if defined SINGLE_PRECISION
+#   define ARRAY_TYPE(i,j,k,l,f)    REAL(sp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
+#   define PRECISION sp
+#else
+#   define ARRAY_TYPE(i,j,k,l,f)    REAL(dp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
+#   define PRECISION dp
+#endif
 
    SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kextj )
@@ -28,5 +34,5 @@
       !
       SELECT CASE ( jpni )
-      CASE ( 1 )     ;   ipj = nlcj       ! 1 proc only  along the i-direction
+      CASE ( 1 )     ;   ipj = jpj        ! 1 proc only  along the i-direction
       CASE DEFAULT   ;   ipj = 4          ! several proc along the i-direction
       END SELECT
@@ -149,4 +155,5 @@
    END SUBROUTINE ROUTINE_NFD
 
+#undef PRECISION
 #undef ARRAY_TYPE
 #undef ARRAY_IN
Index: utils/tools/DOMAINcfg/src/lbc_nfd_generic.h90
===================================================================
--- utils/tools/DOMAINcfg/src/lbc_nfd_generic.h90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/lbc_nfd_generic.h90	(revision 14623)
@@ -4,18 +4,33 @@
 #   define F_SIZE(ptab)             kfld
 #   if defined DIM_2d
-#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D),INTENT(inout)::ptab(f)
+#      if defined SINGLE_PRECISION
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D_sp),INTENT(inout)::ptab(f)
+#      else
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D_dp),INTENT(inout)::ptab(f)
+#      endif
 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
+#      define J_SIZE(ptab)             SIZE(ptab(1)%pt2d,2)
 #      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)
+#      if defined SINGLE_PRECISION
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D_sp),INTENT(inout)::ptab(f)
+#      else
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D_dp),INTENT(inout)::ptab(f)
+#      endif
 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
+#      define J_SIZE(ptab)             SIZE(ptab(1)%pt3d,2)
 #      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)
+#      if defined SINGLE_PRECISION
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D_sp),INTENT(inout)::ptab(f)
+#      else
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D_dp),INTENT(inout)::ptab(f)
+#      endif
 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
+#      define J_SIZE(ptab)             SIZE(ptab(1)%pt4d,2)
 #      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
 #      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4)
@@ -28,4 +43,5 @@
 #   if defined DIM_2d
 #      define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
+#      define J_SIZE(ptab)          SIZE(ptab,2)
 #      define K_SIZE(ptab)          1
 #      define L_SIZE(ptab)          1
@@ -33,4 +49,5 @@
 #   if defined DIM_3d
 #      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k)
+#      define J_SIZE(ptab)          SIZE(ptab,2)
 #      define K_SIZE(ptab)          SIZE(ptab,3)
 #      define L_SIZE(ptab)          1
@@ -38,9 +55,20 @@
 #   if defined DIM_4d
 #      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l)
+#      define J_SIZE(ptab)          SIZE(ptab,2)
 #      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)
+#   if defined SINGLE_PRECISION
+#      define ARRAY_TYPE(i,j,k,l,f)    REAL(sp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
+#   else
+#      define ARRAY_TYPE(i,j,k,l,f)    REAL(dp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
+#   endif
 #endif
+
+#   if defined SINGLE_PRECISION
+#      define PRECISION sp
+#   else
+#      define PRECISION dp
+#   endif
 
 #if defined MULTI
@@ -54,20 +82,13 @@
       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
+      INTEGER  ::    ji,  jj,  jk,  jl,  jf   ! dummy loop indices
+      INTEGER  ::        ipj, ipk, ipl, ipf   ! dimension of the input array
+      INTEGER  ::   ii1, ii2, ij1, ij2
       !!----------------------------------------------------------------------
       !
-      ipk = K_SIZE(ptab)   ! 3rd dimension
+      ipj = J_SIZE(ptab)   ! 2nd dimension
+      ipk = K_SIZE(ptab)   ! 3rd    -
       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
@@ -79,40 +100,166 @@
             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
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  !
+                  ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full
+               	  DO jj = 1, nn_hls
+               	     ij1 = ipj            - jj + 1       ! ends at: ipj - nn_hls + 1
+                     ij2 = ipj - 2*nn_hls + jj - 1       ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 1
+                     !
+                     DO ji = 1, nn_hls            ! first nn_hls points
+                        ii1 =                ji          ! ends at: nn_hls
+                        ii2 = 2*nn_hls + 2 - ji          ! ends at: 2*nn_hls + 2 - nn_hls = nn_hls + 2
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, 1                 ! point nn_hls+1
+                        ii1 = nn_hls + ji
+                        ii2 = ii1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, Ni0glo - 1        ! points from nn_hls+2 to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls)
+                        ii1 = 2 + nn_hls      + ji - 1   ! ends at: 2 + nn_hls + jpiglo - 2*nn_hls - 1 - 1 = jpiglo - nn_hls
+                        ii2 = jpiglo - nn_hls - ji + 1   ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) + 1 = nn_hls + 2
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, 1                 ! point jpiglo - nn_hls + 1
+                        ii1 = jpiglo - nn_hls + ji
+                        ii2 =          nn_hls + ji
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, nn_hls-1          ! last nn_hls-1 points
+                        ii1 = jpiglo - nn_hls + 1 + ji   ! ends at: jpiglo - nn_hls + 1 + nn_hls - 1 = jpiglo
+                        ii2 = jpiglo - nn_hls + 1 - ji   ! ends at: jpiglo - nn_hls + 1 - nn_hls + 1 = jpiglo - 2*nn_hls + 2
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                  END DO
+                  !
+                  ! line number ipj-nn_hls : right half
+               	  DO jj = 1, 1
+                     ij1 = ipj - nn_hls
+                     ij2 = ij1   ! same line
+                     !
+                     DO ji = 1, Ni0glo/2-1        ! points from jpiglo/2+2 to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls)
+                        ii1 = jpiglo/2 + ji + 1          ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls - 1) + 1 = jpiglo - nn_hls
+                        ii2 = jpiglo/2 - ji + 1          ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls - 1) + 1 = nn_hls + 2
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, nn_hls            ! first nn_hls points: redo them just in case (if e-w periodocity already done)
+                        !                         ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls  
+                        ii1 =                ji          ! ends at: nn_hls
+                        ii2 = 2*nn_hls + 2 - ji          ! ends at: 2*nn_hls + 2 - nn_hls = nn_hls + 2
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     !                            ! last nn_hls-1 points: have been / will done by e-w periodicity 
+                  END DO
+                  !
+               END DO; 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
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  !
+                  ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full
+               	  DO jj = 1, nn_hls
+               	     ij1 = ipj            - jj + 1       ! ends at: ipj - nn_hls + 1
+                     ij2 = ipj - 2*nn_hls + jj - 1       ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 1
+                     !
+                     DO ji = 1, nn_hls            ! first nn_hls points
+                        ii1 =                ji          ! ends at: nn_hls
+                        ii2 = 2*nn_hls + 1 - ji          ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, Ni0glo            ! points from nn_hls to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls)
+                        ii1 = nn_hls          + ji       ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls
+                        ii2 = jpiglo - nn_hls - ji + 1   ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, nn_hls            ! last nn_hls points
+                        ii1 = jpiglo - nn_hls + ji       ! ends at: jpiglo - nn_hls + nn_hls = jpiglo
+                        ii2 = jpiglo - nn_hls + 1 - ji   ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                  END DO
+                  !
+                  ! line number ipj-nn_hls : right half
+               	  DO jj = 1, 1
+                     ij1 = ipj - nn_hls
+                     ij2 = ij1   ! same line
+                     !
+                     DO ji = 1, Ni0glo/2          ! points from jpiglo/2+1 to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls)
+                        ii1 = jpiglo/2 + ji              ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls
+                        ii2 = jpiglo/2 - ji + 1          ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls) + 1 = nn_hls + 1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, nn_hls            ! first nn_hls points: redo them just in case (if e-w periodocity already done)
+                        !                         ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls  
+                        ii1 =                ji          ! ends at: nn_hls
+                        ii2 = 2*nn_hls + 1 - ji          ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     !                            ! last nn_hls-1 points: have been / will done by e-w periodicity 
+                  END DO
+                  !
+               END DO; 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) 
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  !
+                  ! last nn_hls+1 lines (from ipj to ipj-nn_hls) : full
+               	  DO jj = 1, nn_hls+1
+               	     ij1 = ipj            - jj + 1       ! ends at: ipj - ( nn_hls + 1 ) + 1 = ipj - nn_hls
+                     ij2 = ipj - 2*nn_hls + jj - 2       ! ends at: ipj - 2*nn_hls + nn_hls + 1 - 2 = ipj - nn_hls - 1
+                     !
+                     DO ji = 1, nn_hls            ! first nn_hls points
+                        ii1 =                ji          ! ends at: nn_hls
+                        ii2 = 2*nn_hls + 2 - ji          ! ends at: 2*nn_hls + 2 - nn_hls = nn_hls + 2
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, 1                 ! point nn_hls+1
+                        ii1 = nn_hls + ji
+                        ii2 = ii1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, Ni0glo - 1        ! points from nn_hls+2 to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls)
+                        ii1 = 2 + nn_hls      + ji - 1   ! ends at: 2 + nn_hls + jpiglo - 2*nn_hls - 1 - 1 = jpiglo - nn_hls
+                        ii2 = jpiglo - nn_hls - ji + 1   ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) + 1 = nn_hls + 2
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, 1                 ! point jpiglo - nn_hls + 1
+                        ii1 = jpiglo - nn_hls + ji
+                        ii2 =          nn_hls + ji
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, nn_hls-1          ! last nn_hls-1 points
+                        ii1 = jpiglo - nn_hls + 1 + ji   ! ends at: jpiglo - nn_hls + 1 + nn_hls - 1 = jpiglo
+                        ii2 = jpiglo - nn_hls + 1 - ji   ! ends at: jpiglo - nn_hls + 1 - nn_hls + 1 = jpiglo - 2*nn_hls + 2
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                  END DO
+                  !
+               END DO; END DO
             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
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  !
+                  ! last nn_hls+1 lines (from ipj to ipj-nn_hls) : full
+               	  DO jj = 1, nn_hls+1
+               	     ij1 = ipj            - jj + 1       ! ends at: ipj - ( nn_hls + 1 ) + 1 = ipj - nn_hls
+                     ij2 = ipj - 2*nn_hls + jj - 2       ! ends at: ipj - 2*nn_hls + nn_hls + 1 - 2 = ipj - nn_hls - 1
+                     !
+                     DO ji = 1, nn_hls            ! first nn_hls points
+                        ii1 =                ji          ! ends at: nn_hls
+                        ii2 = 2*nn_hls + 1 - ji          ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, Ni0glo            ! points from nn_hls to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls)
+                        ii1 = nn_hls          + ji       ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls
+                        ii2 = jpiglo - nn_hls - ji + 1   ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, nn_hls            ! last nn_hls points
+                        ii1 = jpiglo - nn_hls + ji       ! ends at: jpiglo - nn_hls + nn_hls = jpiglo
+                        ii2 = jpiglo - nn_hls + 1 - ji   ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                  END DO
+                  !
+               END DO; END DO
+            END SELECT   ! NAT_IN(jf)
             !
          CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
@@ -120,55 +267,202 @@
             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
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  !
+                  ! first: line number ipj-nn_hls : 3 points
+               	  DO jj = 1, 1
+                     ij1 = ipj - nn_hls
+                     ij2 = ij1   ! same line
+                     !
+                     DO ji = 1, 1            ! points from jpiglo/2+1
+                        ii1 = jpiglo/2 + ji
+                        ii2 = jpiglo/2 - ji + 1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) =              ARRAY_IN(ii2,ij2,jk,jl,jf)   ! Warning: pb with sign...
+                     END DO
+                     DO ji = 1, 1            ! points jpiglo - nn_hls
+                        ii1 = jpiglo - nn_hls + ji - 1
+                        ii2 =          nn_hls + ji
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) =              ARRAY_IN(ii2,ij2,jk,jl,jf)   ! Warning: pb with sign...
+                     END DO
+                     DO ji = 1, 1            ! point nn_hls: redo it just in case (if e-w periodocity already done)
+                        !                    ! as we just changed point jpiglo - nn_hls
+                        ii1 = nn_hls + ji - 1
+                        ii2 = nn_hls + ji
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) =              ARRAY_IN(ii2,ij2,jk,jl,jf)   ! Warning: pb with sign...
+                     END DO
+                  END DO
+                  !
+                  ! Second: last nn_hls lines (from ipj to ipj-nn_hls+1) : full
+               	  DO jj = 1, nn_hls
+               	     ij1 = ipj + 1        - jj           ! ends at: ipj + 1 - nn_hls
+                     ij2 = ipj - 2*nn_hls + jj           ! ends at: ipj - 2*nn_hls + nn_hls = ipj - nn_hls
+                     !
+                     DO ji = 1, nn_hls            ! first nn_hls points
+                        ii1 =                ji          ! ends at: nn_hls
+                        ii2 = 2*nn_hls + 1 - ji          ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, Ni0glo            ! points from nn_hls to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls)
+                        ii1 = nn_hls          + ji       ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls
+                        ii2 = jpiglo - nn_hls - ji + 1   ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, nn_hls            ! last nn_hls points
+                        ii1 = jpiglo - nn_hls + ji       ! ends at: jpiglo - nn_hls + nn_hls = jpiglo
+                        ii2 = jpiglo - nn_hls + 1 - ji   ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                  END DO
+                  !
+               END DO; 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)
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  !
+                  ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full
+               	  DO jj = 1, nn_hls
+               	     ij1 = ipj + 1        - jj           ! ends at: ipj + 1 - nn_hls
+                     ij2 = ipj - 2*nn_hls + jj           ! ends at: ipj - 2*nn_hls + nn_hls = ipj - nn_hls
+                     !
+                     DO ji = 1, nn_hls-1          ! first nn_hls-1 points
+                        ii1 =            ji              ! ends at: nn_hls-1
+                        ii2 = 2*nn_hls - ji              ! ends at: 2*nn_hls - ( nn_hls - 1 ) = nn_hls + 1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, 1                 ! point nn_hls
+                        ii1 = nn_hls + ji - 1
+                        ii2 = jpiglo - ii1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, Ni0glo - 1        ! points from nn_hls+1 to jpiglo - nn_hls - 1  (note: Ni0glo = jpiglo - 2*nn_hls)
+                        ii1 =          nn_hls + ji       ! ends at: nn_hls + ( jpiglo - 2*nn_hls - 1 ) = jpiglo - nn_hls - 1
+                        ii2 = jpiglo - nn_hls - ji       ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) = nn_hls + 1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, 1                 ! point jpiglo - nn_hls
+                        ii1 = jpiglo - nn_hls + ji - 1
+                        ii2 = ii1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, nn_hls            ! last nn_hls points
+                        ii1 = jpiglo - nn_hls + ji       ! ends at: jpiglo - nn_hls + nn_hls = jpiglo
+                        ii2 = jpiglo - nn_hls - ji       ! ends at: jpiglo - nn_hls - nn_hls = jpiglo - 2*nn_hls
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                  END DO
+                  !
+               END DO; END DO
             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
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  !
+                  ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full
+               	  DO jj = 1, nn_hls
+               	     ij1 = ipj            - jj + 1       ! ends at: ipj - nn_hls + 1
+                     ij2 = ipj - 2*nn_hls + jj - 1       ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 1
+                     !
+                     DO ji = 1, nn_hls            ! first nn_hls points
+                        ii1 =                ji          ! ends at: nn_hls
+                        ii2 = 2*nn_hls + 1 - ji          ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, Ni0glo            ! points from nn_hls to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls)
+                        ii1 = nn_hls          + ji       ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls
+                        ii2 = jpiglo - nn_hls - ji + 1   ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, nn_hls            ! last nn_hls points
+                        ii1 = jpiglo - nn_hls + ji       ! ends at: jpiglo - nn_hls + nn_hls = jpiglo
+                        ii2 = jpiglo - nn_hls + 1 - ji   ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                  END DO   
+                  !
+                  ! line number ipj-nn_hls : right half
+               	  DO jj = 1, 1
+                     ij1 = ipj - nn_hls
+                     ij2 = ij1   ! same line
+                     !
+                     DO ji = 1, Ni0glo/2          ! points from jpiglo/2+1 to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls)
+                        ii1 = jpiglo/2 + ji              ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls
+                        ii2 = jpiglo/2 - ji + 1          ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls) + 1 = nn_hls + 1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, nn_hls            ! first nn_hls points: redo them just in case (if e-w periodocity already done)
+                        !                         ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls  
+                        ii1 =                ji          ! ends at: nn_hls
+                        ii2 = 2*nn_hls + 1 - ji          ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     !                            ! last nn_hls points: have been / will done by e-w periodicity 
+                  END DO
+                  !
+               END DO; 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
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  !
+                  ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full
+               	  DO jj = 1, nn_hls
+               	     ij1 = ipj            - jj + 1       ! ends at: ipj - nn_hls + 1
+                     ij2 = ipj - 2*nn_hls + jj - 1       ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 1
+                     !
+                     DO ji = 1, nn_hls-1          ! first nn_hls-1 points
+                        ii1 =            ji              ! ends at: nn_hls-1
+                        ii2 = 2*nn_hls - ji              ! ends at: 2*nn_hls - ( nn_hls - 1 ) = nn_hls + 1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, 1                 ! point nn_hls
+                        ii1 = nn_hls + ji - 1
+                        ii2 = jpiglo - ii1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, Ni0glo - 1        ! points from nn_hls+1 to jpiglo - nn_hls - 1  (note: Ni0glo = jpiglo - 2*nn_hls)
+                        ii1 =          nn_hls + ji       ! ends at: nn_hls + ( jpiglo - 2*nn_hls - 1 ) = jpiglo - nn_hls - 1
+                        ii2 = jpiglo - nn_hls - ji       ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) = nn_hls + 1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, 1                 ! point jpiglo - nn_hls
+                        ii1 = jpiglo - nn_hls + ji - 1
+                        ii2 = ii1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, nn_hls            ! last nn_hls points
+                        ii1 = jpiglo - nn_hls + ji       ! ends at: jpiglo - nn_hls + nn_hls = jpiglo
+                        ii2 = jpiglo - nn_hls - ji       ! ends at: jpiglo - nn_hls - nn_hls = jpiglo - 2*nn_hls
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                  END DO   
+                  !
+                  ! line number ipj-nn_hls : right half
+               	  DO jj = 1, 1
+                     ij1 = ipj - nn_hls
+                     ij2 = ij1   ! same line
+                     !
+                     DO ji = 1, Ni0glo/2-1        ! points from jpiglo/2+1 to jpiglo - nn_hls-1  (note: Ni0glo = jpiglo - 2*nn_hls)
+                        ii1 = jpiglo/2 + ji              ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls
+                        ii2 = jpiglo/2 - ji              ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls - 1 ) = nn_hls + 1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     DO ji = 1, nn_hls-1          ! first nn_hls-1 points: redo them just in case (if e-w periodocity already done)
+                        !                         ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hl-1  
+                        ii1 =            ji              ! ends at: nn_hls
+                        ii2 = 2*nn_hls - ji              ! ends at: 2*nn_hls - ( nn_hls - 1 ) = nn_hls + 1
+                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
+                     END DO
+                     !                            ! last nn_hls points: have been / will done by e-w periodicity 
+                  END DO
+                  !
+               END DO; END DO
+            END SELECT   ! NAT_IN(jf)
             !
-         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 SELECT   ! npolj
          !
-      END DO
+      END DO   ! ipf
       !
    END SUBROUTINE ROUTINE_NFD
 
+#undef PRECISION
 #undef ARRAY_TYPE
 #undef ARRAY_IN
 #undef NAT_IN
 #undef SGN_IN
+#undef J_SIZE
 #undef K_SIZE
 #undef L_SIZE
Index: utils/tools/DOMAINcfg/src/lbc_nfd_nogather_generic.h90
===================================================================
--- utils/tools/DOMAINcfg/src/lbc_nfd_nogather_generic.h90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/lbc_nfd_nogather_generic.h90	(revision 14623)
@@ -4,5 +4,9 @@
 #   define F_SIZE(ptab)             kfld
 #   if defined DIM_2d
-#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D),INTENT(inout)::ptab(f)
+#      if defined SINGLE_PRECISION
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D_sp),INTENT(inout)::ptab(f)
+#      else
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D_dp),INTENT(inout)::ptab(f)
+#      endif 
 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
 #      define K_SIZE(ptab)             1
@@ -10,5 +14,9 @@
 #   endif
 #   if defined DIM_3d
-#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D),INTENT(inout)::ptab(f)
+#      if defined SINGLE_PRECISION
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D_sp),INTENT(inout)::ptab(f)
+#      else
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D_dp),INTENT(inout)::ptab(f)
+#      endif 
 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
 #      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3)
@@ -16,10 +24,18 @@
 #   endif
 #   if defined DIM_4d
-#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D),INTENT(inout)::ptab(f)
+#      if defined SINGLE_PRECISION
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D_sp),INTENT(inout)::ptab(f)
+#      else
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D_dp),INTENT(inout)::ptab(f)
+#      endif 
 #      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)
+#   if defined SINGLE_PRECISION
+#      define ARRAY2_TYPE(i,j,k,l,f)   TYPE(PTR_4D_sp),INTENT(inout)::ptab2(f)
+#   else
+#      define ARRAY2_TYPE(i,j,k,l,f)   TYPE(PTR_4D_dp),INTENT(inout)::ptab2(f)
+#   endif
 #   define J_SIZE(ptab2)            SIZE(ptab2(1)%pt4d,2)
 #   define ARRAY2_IN(i,j,k,l,f)     ptab2(f)%pt4d(i,j,k,l)
@@ -44,10 +60,19 @@
 #      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
-
+#   define ARRAY2_IN(i,j,k,l,f)   ptab2(i,j,k,l)
+#   if defined SINGLE_PRECISION
+#      define ARRAY_TYPE(i,j,k,l,f)     REAL(sp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
+#      define ARRAY2_TYPE(i,j,k,l,f)    REAL(sp),INTENT(inout)::ARRAY2_IN(i,j,k,l,f)
+#   else
+#      define ARRAY_TYPE(i,j,k,l,f)     REAL(dp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
+#      define ARRAY2_TYPE(i,j,k,l,f)    REAL(dp),INTENT(inout)::ARRAY2_IN(i,j,k,l,f)
+#   endif
+#   endif
+#   ifdef SINGLE_PRECISION
+#      define PRECISION sp
+#   else
+#      define PRECISION dp
+#   endif
    SUBROUTINE ROUTINE_NFD( ptab, ptab2, cd_nat, psgn, kfld )
       !!----------------------------------------------------------------------
@@ -57,13 +82,13 @@
       !!
       !!----------------------------------------------------------------------
-      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
+      ARRAY_TYPE(:,:,:,:,:)
+      ARRAY2_TYPE(:,:,:,:,:) 
       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
+      INTEGER  ::    ji,  jj,   jk, jn, ii,   jl,   jh,  jf   ! dummy loop indices
+      INTEGER  ::   ipi, ipj,  ipk,    ipl,  ipf, iij, ijj   ! dimension of the input array
+      INTEGER  ::   ijt, iju, ijta, ijua, jia, startloop, endloop
       LOGICAL  ::   l_fast_exchanges
       !!----------------------------------------------------------------------
@@ -74,13 +99,5 @@
       !
       ! 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
-      
+      IF ( ipf > 1 ) CALL ctl_stop( 'STOP', 'lbc_nfd_nogather: multiple fields not allowed. Revise implementation...' )
       ! 2nd dimension determines exchange speed
       IF (ipj == 1 ) THEN
@@ -99,38 +116,46 @@
             !
             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)
+               IF ( nimpp /= 1 ) THEN  ;  startloop = 1 
+               ELSE                    ;  startloop = 1 + nn_hls
+               ENDIF
+               !
+               DO jl = 1, ipl; DO jk = 1, ipk
+               	  DO jj = 1, nn_hls
+               	     ijj = jpj -jj +1
+                     DO ji = startloop, jpi
+                    	ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4
+                     	ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf)
+                     END DO
                   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
+                     DO jj = 1, nn_hls
+               	  	ijj = jpj -jj +1
+               	  	DO ii = 0, nn_hls-1
+                  	   ARRAY_IN(ii+1,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii+1,jpj-2*nn_hls+jj-1,jk,jl,jf)
+                  	END DO
+                     END DO
+                  END DO; END DO
+               ENDIF              
+               !
+               IF ( .NOT. l_fast_exchanges ) THEN
+                  IF( nimpp >= Ni0glo/2+2 ) 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
+                  ELSEIF( nimpp+jpi-1 >= Ni0glo/2+2 .AND. nimpp < Ni0glo/2+2 ) THEN
+                     startloop = Ni0glo/2+2 - nimpp + nn_hls
+                  ELSE
+                     startloop = jpi + 1
+                  ENDIF
+                  IF( startloop <= jpi ) THEN
                      DO jl = 1, ipl; DO jk = 1, ipk
-                        DO ji = startloop, nlci
-                           ijt  = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
+                        DO ji = startloop, jpi
+                           ijt  = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 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)
+                              ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+nn_hls,jpj-nn_hls,jk,jl,jf)
                            ELSE
-                              ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjp1,jk,jl,jf)
+                              ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf)
                            ENDIF
                         END DO
@@ -138,34 +163,46 @@
                   ENDIF
                ENDIF
-
             CASE ( 'U' )                                     ! U-point
-               IF( nimpp + nlci - 1 /= jpiglo ) THEN
-                  endloop = nlci
+               IF( nimpp + jpi - 1 /= jpiglo ) THEN
+                  endloop = jpi
                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)
+                  endloop = jpi - nn_hls
+               ENDIF
+               DO jl = 1, ipl; DO jk = 1, ipk
+		  DO jj = 1, nn_hls
+        	     ijj = jpj -jj +1
+                     DO ji = 1, endloop
+                        iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3
+                        ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf)
+                     END DO
                   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
+		  DO jj = 1, nn_hls
+		     ijj = jpj -jj +1
+		     DO ii = 0, nn_hls-1
+		 	ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls+jj-1,:,:,jf)
+		     END DO
+                  END DO
+               ENDIF
+               IF((nimpp + jpi - 1) .eq. jpiglo) THEN
+                  DO jj = 1, nn_hls
+               	     ijj = jpj -jj +1
+			DO ii = 1, nn_hls
+		   	   ARRAY_IN(jpi-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls+jj-1,:,:,jf)
+			END DO
+		  END DO
+               ENDIF
+               !
+               IF ( .NOT. l_fast_exchanges ) THEN
+                  IF( nimpp + jpi - 1 /= jpiglo ) THEN
+                     endloop = jpi
+                  ELSE
+                     endloop = jpi - nn_hls
+                  ENDIF
+                  IF( nimpp >= Ni0glo/2+1 ) THEN
+                     startloop = nn_hls
+                  ELSEIF( ( nimpp + jpi - 1 >= Ni0glo/2+1 ) .AND. ( nimpp < Ni0glo/2+1 ) ) THEN
+                     startloop = Ni0glo/2+1 - nimpp + nn_hls 
                   ELSE
                      startloop = endloop + 1
@@ -174,11 +211,11 @@
                   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
+                        iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 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)
+                           ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+1,jpj-nn_hls,jk,jl,jf)
                         ELSE
-                           ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjp1,jk,jl,jf)
+                           ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf)
                         ENDIF
                      END DO
@@ -189,57 +226,84 @@
             CASE ( 'V' )                                     ! V-point
                IF( nimpp /= 1 ) THEN
-                 startloop = 1
+                 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)
+                 startloop = 1 + nn_hls
+               ENDIF
+               IF ( .NOT. l_fast_exchanges ) THEN
+                  DO jl = 1, ipl; DO jk = 1, ipk
+               	     DO jj = 2, nn_hls+1
+               	  	ijj = jpj -jj +1
+                     	DO ji = startloop, jpi
+                           ijt=jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4
+                           ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf)
+                     	END DO
+                    END DO
+                  END DO; END DO
+               ENDIF
+               DO jl = 1, ipl; DO jk = 1, ipk
+                  DO ji = startloop, jpi
+                     ijt=jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4
+                     ARRAY_IN(ji,jpj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,1,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)
+		  DO jj = 1, nn_hls
+               	     ijj = jpj-jj+1
+               	     DO ii = 0, nn_hls-1
+                        ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii+1,jpj-2*nn_hls+jj-1,:,:,jf)
+		     END DO
+		  END DO
                ENDIF
             CASE ( 'F' )                                     ! F-point
-               IF( nimpp + nlci - 1 /= jpiglo ) THEN
-                  endloop = nlci
+               IF( nimpp + jpi - 1 /= jpiglo ) THEN
+                  endloop = jpi
                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
+                  endloop = jpi - nn_hls
+               ENDIF
+               IF ( .NOT. l_fast_exchanges ) THEN
+                  DO jl = 1, ipl; DO jk = 1, ipk
+               	     DO jj = 2, nn_hls+1
+               	  	ijj = jpj -jj +1
+                     	DO ji = 1, endloop
+                           iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3
+                           ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf)
+                     	END DO
+                    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
+                     iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3
+                     ARRAY_IN(ji,jpj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,1,jk,jl,jf)
+                  END DO
+               END DO; END DO
+		IF (nimpp .eq. 1) THEN               
+		   DO ii = 1, nn_hls
+	              ARRAY_IN(ii,jpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls-1,:,:,jf)
+		   END DO
+		   IF ( .NOT. l_fast_exchanges ) THEN
+		      DO jj = 1, nn_hls
+               	 	 ijj = jpj -jj
+               		 DO ii = 0, nn_hls-1
+                    	    ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls+jj-1,:,:,jf)
+                 	 END DO
+                      END DO
+               	   ENDIF
+		ENDIF
+		IF((nimpp + jpi - 1 ) .eq. jpiglo) THEN
+                   DO ii = 1, nn_hls
+	              ARRAY_IN(jpi-ii+1,jpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls-1,:,:,jf)
+		   END DO
+		   IF ( .NOT. l_fast_exchanges ) THEN
+		      DO jj = 1, nn_hls
+               	         ijj = jpj -jj
+	               	 DO ii = 1, nn_hls
+                    	    ARRAY_IN(jpi-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls+jj-1,:,:,jf)
+                     	 END DO
+                      END DO
+               	   ENDIF
+               	ENDIF
+               	!
+	    END SELECT
             !
          CASE ( 5, 6 )                        ! *  North fold  F-point pivot
@@ -248,25 +312,37 @@
             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
+		  DO jj = 1, nn_hls
+ 		     ijj = jpj-jj+1
+		     DO ji = 1, jpi
+                     	ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3
+                     	ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf)
+                     END DO
+		  END DO
                END DO; END DO
                !
             CASE ( 'U' )                                     ! U-point
-               IF( nimpp + nlci - 1 /= jpiglo ) THEN
-                  endloop = nlci
+               IF( nimpp + jpi - 1 /= jpiglo ) THEN
+                  endloop = jpi
                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)
+                  endloop = jpi - nn_hls
+               ENDIF
+               DO jl = 1, ipl; DO jk = 1, ipk
+		  DO jj = 1, nn_hls
+ 		     ijj = jpj-jj+1
+                     DO ji = 1, endloop
+                        iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 2
+                        ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf)
+                     END DO
+                  END DO
+               END DO; END DO
+               IF(nimpp + jpi - 1 .eq. jpiglo) THEN
+                  DO jl = 1, ipl; DO jk = 1, ipk
+                     DO jj = 1, nn_hls
+               	        ijj = jpj-jj+1
+                        DO ii = 1, nn_hls
+			   iij = jpi-ii+1
+                           ARRAY_IN(iij,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii-1,jpj-2*nn_hls+jj,jk,jl,jf)
+                        END DO
+                     END DO
                   END DO; END DO
                ENDIF
@@ -274,24 +350,27 @@
             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)
+		  DO jj = 1, nn_hls
+		     ijj = jpj -jj +1
+                     DO ji = 1, jpi
+                        ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3
+                        ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf)
+                     END DO
                   END DO
                END DO; END DO
 
                IF ( .NOT. l_fast_exchanges ) THEN
-                  IF( nimpp >= jpiglo/2+1 ) THEN
+                  IF( nimpp >= Ni0glo/2+2 ) 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
+                  ELSEIF( nimpp+jpi-1 >= Ni0glo/2+2 .AND. nimpp < Ni0glo/2+2 ) THEN
+                     startloop = Ni0glo/2+2 - nimpp + nn_hls
+                  ELSE
+                     startloop = jpi + 1
+                  ENDIF
+                  IF( startloop <= jpi ) THEN
+                  DO jl = 1, ipl; DO jk = 1, ipk
+                        DO ji = startloop, jpi
+                   	   ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3
+                           ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf)
+                        END DO
                   END DO; END DO
                   ENDIF
@@ -299,31 +378,40 @@
                !
             CASE ( 'F' )                               ! F-point
-               IF( nimpp + nlci - 1 /= jpiglo ) THEN
-                  endloop = nlci
+               IF( nimpp + jpi - 1 /= jpiglo ) THEN
+                  endloop = jpi
                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
+                  endloop = jpi - nn_hls
+               ENDIF
+               DO jl = 1, ipl; DO jk = 1, ipk
+		  DO jj = 1, nn_hls
+		    ijj = jpj -jj +1
+                    DO ji = 1, endloop
+                       iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 2
+                       ARRAY_IN(ji,ijj ,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf)
+                     END DO
+                  END DO
+               END DO; END DO
+               IF((nimpp + jpi - 1) .eq. jpiglo) THEN
+                  DO jl = 1, ipl; DO jk = 1, ipk
+                     DO jj = 1, nn_hls
+                        ijj = jpj -jj +1
+                        DO ii = 1, nn_hls
+			   iij = jpi -ii+1
+                     	   ARRAY_IN(iij,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii-1,jpj-2*nn_hls+jj-1,jk,jl,jf)
+                        END DO
+                     END DO
+                  END DO; END DO
+               ENDIF
+               !
+               IF ( .NOT. l_fast_exchanges ) THEN
+                  IF( nimpp + jpi - 1 /= jpiglo ) THEN
+                     endloop = jpi
+                  ELSE
+                     endloop = jpi - nn_hls
+                  ENDIF
+                  IF( nimpp >= Ni0glo/2+2 ) THEN
+                     startloop = 1 
+                  ELSEIF( nimpp+jpi-1 >= Ni0glo/2+2 .AND. nimpp < Ni0glo/2+2 ) THEN
+                     startloop = Ni0glo/2+2 - nimpp + nn_hls
                   ELSE
                      startloop = endloop + 1
@@ -332,6 +420,6 @@
                      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)
+                           iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 2
+                           ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf)
                         END DO
                      END DO; END DO
@@ -349,4 +437,5 @@
       END DO            ! End jf loop
    END SUBROUTINE ROUTINE_NFD
+#undef PRECISION
 #undef ARRAY_TYPE
 #undef ARRAY_IN
Index: utils/tools/DOMAINcfg/src/lbclnk.F90
===================================================================
--- utils/tools/DOMAINcfg/src/lbclnk.F90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/lbclnk.F90	(revision 14623)
@@ -7,5 +7,5 @@
    !!   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.
+   !!            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  
@@ -14,28 +14,40 @@
    !!             -   ! 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
-   !!----------------------------------------------------------------------
-   USE par_oce        ! ocean dynamics and tracers   
+   !!   lbc_bdy_lnk   : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
    USE lib_mpp        ! distributed memory computing library
    USE lbcnfd         ! north fold
+   USE in_out_manager ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
 
    INTERFACE lbc_lnk
-      MODULE PROCEDURE   mpp_lnk_2d      , mpp_lnk_3d      , mpp_lnk_4d
+      MODULE PROCEDURE   mpp_lnk_2d_sp   , mpp_lnk_3d_sp   , mpp_lnk_4d_sp
+      MODULE PROCEDURE   mpp_lnk_2d_dp   , mpp_lnk_3d_dp   , mpp_lnk_4d_dp
    END INTERFACE
    INTERFACE lbc_lnk_ptr
-      MODULE PROCEDURE   mpp_lnk_2d_ptr  , mpp_lnk_3d_ptr  , mpp_lnk_4d_ptr
+      MODULE PROCEDURE   mpp_lnk_2d_ptr_sp , mpp_lnk_3d_ptr_sp , mpp_lnk_4d_ptr_sp
+      MODULE PROCEDURE   mpp_lnk_2d_ptr_dp , mpp_lnk_3d_ptr_dp , mpp_lnk_4d_ptr_dp
    END INTERFACE
    INTERFACE lbc_lnk_multi
-      MODULE PROCEDURE   lbc_lnk_2d_multi, lbc_lnk_3d_multi, lbc_lnk_4d_multi
+      MODULE PROCEDURE   lbc_lnk_2d_multi_sp , lbc_lnk_3d_multi_sp, lbc_lnk_4d_multi_sp
+      MODULE PROCEDURE   lbc_lnk_2d_multi_dp , lbc_lnk_3d_multi_dp, lbc_lnk_4d_multi_dp
    END INTERFACE
    !
    INTERFACE lbc_lnk_icb
-      MODULE PROCEDURE mpp_lnk_2d_icb
+      MODULE PROCEDURE mpp_lnk_2d_icb_dp, mpp_lnk_2d_icb_sp
+   END INTERFACE
+
+   INTERFACE mpp_nfd
+      MODULE PROCEDURE   mpp_nfd_2d_sp    , mpp_nfd_3d_sp    , mpp_nfd_4d_sp
+      MODULE PROCEDURE   mpp_nfd_2d_dp    , mpp_nfd_3d_dp    , mpp_nfd_4d_dp
+      MODULE PROCEDURE   mpp_nfd_2d_ptr_sp, mpp_nfd_3d_ptr_sp, mpp_nfd_4d_ptr_sp
+      MODULE PROCEDURE   mpp_nfd_2d_ptr_dp, mpp_nfd_3d_ptr_dp, mpp_nfd_4d_ptr_dp
+      
    END INTERFACE
 
@@ -44,140 +56,24 @@
    PUBLIC   lbc_lnk_icb   ! iceberg lateral boundary conditions
 
+#if   defined key_mpp_mpi
+!$AGRIF_DO_NOT_TREAT
+   INCLUDE 'mpif.h'
+!$AGRIF_END_DO_NOT_TREAT
+#endif
+
+   INTEGER, PUBLIC, PARAMETER ::   jpfillnothing = 1
+   INTEGER, PUBLIC, PARAMETER ::   jpfillcst     = 2
+   INTEGER, PUBLIC, PARAMETER ::   jpfillcopy    = 3
+   INTEGER, PUBLIC, PARAMETER ::   jpfillperio   = 4
+   INTEGER, PUBLIC, PARAMETER ::   jpfillmpi     = 5
+
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: lbclnk.F90 10425 2018-12-19 21:54:16Z smasson $
+   !! $Id: lbclnk.F90 13226 2020-07-02 14:24:31Z orioltp $
    !! 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
-   !!----------------------------------------------------------------------
-   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_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_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
-   !!======================================================================
-
-   !!----------------------------------------------------------------------
-
-!!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
-   !!======================================================================
 
    !!----------------------------------------------------------------------
@@ -202,31 +98,314 @@
    !!----------------------------------------------------------------------
 
-#  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
+   !!
+   !!   ----   SINGLE PRECISION VERSIONS
+   !!
+#  define SINGLE_PRECISION
+#  define DIM_2d
+#     define ROUTINE_LOAD           load_ptr_2d_sp
+#     define ROUTINE_MULTI          lbc_lnk_2d_multi_sp
+#     include "lbc_lnk_multi_generic.h90"
+#     undef ROUTINE_MULTI
+#     undef ROUTINE_LOAD
+#  undef DIM_2d
+
+#  define DIM_3d
+#     define ROUTINE_LOAD           load_ptr_3d_sp
+#     define ROUTINE_MULTI          lbc_lnk_3d_multi_sp
+#     include "lbc_lnk_multi_generic.h90"
+#     undef ROUTINE_MULTI
+#     undef ROUTINE_LOAD
+#  undef DIM_3d
+
+#  define DIM_4d
+#     define ROUTINE_LOAD           load_ptr_4d_sp
+#     define ROUTINE_MULTI          lbc_lnk_4d_multi_sp
+#     include "lbc_lnk_multi_generic.h90"
+#     undef ROUTINE_MULTI
+#     undef ROUTINE_LOAD
+#  undef DIM_4d
+#  undef SINGLE_PRECISION
+   !!
+   !!   ----   DOUBLE PRECISION VERSIONS
+   !!
+
+#  define DIM_2d
+#     define ROUTINE_LOAD           load_ptr_2d_dp
+#     define ROUTINE_MULTI          lbc_lnk_2d_multi_dp
+#     include "lbc_lnk_multi_generic.h90"
+#     undef ROUTINE_MULTI
+#     undef ROUTINE_LOAD
+#  undef DIM_2d
+
+#  define DIM_3d
+#     define ROUTINE_LOAD           load_ptr_3d_dp
+#     define ROUTINE_MULTI          lbc_lnk_3d_multi_dp
+#     include "lbc_lnk_multi_generic.h90"
+#     undef ROUTINE_MULTI
+#     undef ROUTINE_LOAD
+#  undef DIM_3d
+
+#  define DIM_4d
+#     define ROUTINE_LOAD           load_ptr_4d_dp
+#     define ROUTINE_MULTI          lbc_lnk_4d_multi_dp
+#     include "lbc_lnk_multi_generic.h90"
+#     undef ROUTINE_MULTI
+#     undef ROUTINE_LOAD
+#  undef DIM_4d
+
+   !!----------------------------------------------------------------------
+   !!                   ***  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
+   !!                kfillmode :   optional, method to be use to fill the halos (see jpfill* variables)
+   !!                pfillval  :   optional, background value (used with jpfillcopy)
+   !!----------------------------------------------------------------------
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+   !!
+   !!   ----   SINGLE PRECISION VERSIONS
+   !!
+# define SINGLE_PRECISION
+#  define DIM_2d
+#     define ROUTINE_LNK           mpp_lnk_2d_sp
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           mpp_lnk_2d_ptr_sp
+#     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_sp
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           mpp_lnk_3d_ptr_sp
+#     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_sp
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           mpp_lnk_4d_ptr_sp
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     undef MULTI
+#  undef DIM_4d
+# undef SINGLE_PRECISION
+
+   !!
+   !!   ----   DOUBLE PRECISION VERSIONS
+   !!
+#  define DIM_2d
+#     define ROUTINE_LNK           mpp_lnk_2d_dp
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           mpp_lnk_2d_ptr_dp
+#     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_dp
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           mpp_lnk_3d_ptr_dp
+#     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_dp
+#     include "mpp_lnk_generic.h90"
+#     undef ROUTINE_LNK
+#     define MULTI
+#     define ROUTINE_LNK           mpp_lnk_4d_ptr_dp
+#     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
+   !!                kfillmode :   optional, method to be use to fill the halos (see jpfill* variables)
+   !!                pfillval  :   optional, background value (used with jpfillcopy)
+   !!----------------------------------------------------------------------
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+   !!
+   !!   ----   SINGLE PRECISION VERSIONS
+   !!
+#  define SINGLE_PRECISION
+#  define DIM_2d
+#     define ROUTINE_NFD           mpp_nfd_2d_sp
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           mpp_nfd_2d_ptr_sp
+#     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_sp
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           mpp_nfd_3d_ptr_sp
+#     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_sp
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           mpp_nfd_4d_ptr_sp
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
+#  undef DIM_4d
+#  undef SINGLE_PRECISION
+
+   !!
+   !!   ----   DOUBLE PRECISION VERSIONS
+   !!
+#  define DIM_2d
+#     define ROUTINE_NFD           mpp_nfd_2d_dp
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           mpp_nfd_2d_ptr_dp
+#     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_dp
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           mpp_nfd_3d_ptr_dp
+#     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_dp
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           mpp_nfd_4d_ptr_dp
+#     include "mpp_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     undef MULTI
 #  undef DIM_4d
 
    !!======================================================================
+
+
+   !!======================================================================
+     !!---------------------------------------------------------------------
+      !!                   ***  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.
+      !!
+      !!----------------------------------------------------------------------
+#     define SINGLE_PRECISION
+#     define ROUTINE_LNK           mpp_lbc_north_icb_sp
+#     include "mpp_lbc_north_icb_generic.h90"
+#     undef ROUTINE_LNK
+#     undef SINGLE_PRECISION
+#     define ROUTINE_LNK           mpp_lbc_north_icb_dp
+#     include "mpp_lbc_north_icb_generic.h90"
+#     undef ROUTINE_LNK
+ 
+
+      !!----------------------------------------------------------------------
+      !!                  ***  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
+      !!----------------------------------------------------------------------
+
+#     define SINGLE_PRECISION
+#     define ROUTINE_LNK           mpp_lnk_2d_icb_sp
+#     include "mpp_lnk_icb_generic.h90"
+#     undef ROUTINE_LNK
+#     undef SINGLE_PRECISION
+#     define ROUTINE_LNK           mpp_lnk_2d_icb_dp
+#     include "mpp_lnk_icb_generic.h90"
+#     undef ROUTINE_LNK
+  
 END MODULE lbclnk
 
Index: utils/tools/DOMAINcfg/src/lbcnfd.F90
===================================================================
--- utils/tools/DOMAINcfg/src/lbcnfd.F90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/lbcnfd.F90	(revision 14623)
@@ -20,4 +20,5 @@
    USE dom_oce        ! ocean space and time domain 
    USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
 
    IMPLICIT NONE
@@ -25,26 +26,43 @@
 
    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
+      MODULE PROCEDURE   lbc_nfd_2d_sp    , lbc_nfd_3d_sp    , lbc_nfd_4d_sp
+      MODULE PROCEDURE   lbc_nfd_2d_ptr_sp, lbc_nfd_3d_ptr_sp, lbc_nfd_4d_ptr_sp
+      MODULE PROCEDURE   lbc_nfd_2d_ext_sp
+      MODULE PROCEDURE   lbc_nfd_2d_dp    , lbc_nfd_3d_dp    , lbc_nfd_4d_dp
+      MODULE PROCEDURE   lbc_nfd_2d_ptr_dp, lbc_nfd_3d_ptr_dp, lbc_nfd_4d_ptr_dp
+      MODULE PROCEDURE   lbc_nfd_2d_ext_dp
    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_2d_sp    , lbc_nfd_nogather_3d_sp
+     MODULE PROCEDURE   lbc_nfd_nogather_4d_sp
+     MODULE PROCEDURE   lbc_nfd_nogather_2d_ptr_sp, lbc_nfd_nogather_3d_ptr_sp
+     MODULE PROCEDURE   lbc_nfd_nogather_2d_dp    , lbc_nfd_nogather_3d_dp
+     MODULE PROCEDURE   lbc_nfd_nogather_4d_dp
+     MODULE PROCEDURE   lbc_nfd_nogather_2d_ptr_dp, lbc_nfd_nogather_3d_ptr_dp
 !     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
+   TYPE, PUBLIC ::   PTR_2D_dp   !: array of 2D pointers (also used in lib_mpp)
+      REAL(dp), DIMENSION (:,:)    , POINTER ::   pt2d
+   END TYPE PTR_2D_dp
+   TYPE, PUBLIC ::   PTR_3D_dp   !: array of 3D pointers (also used in lib_mpp)
+      REAL(dp), DIMENSION (:,:,:)  , POINTER ::   pt3d
+   END TYPE PTR_3D_dp
+   TYPE, PUBLIC ::   PTR_4D_dp   !: array of 4D pointers (also used in lib_mpp)
+      REAL(dp), DIMENSION (:,:,:,:), POINTER ::   pt4d
+   END TYPE PTR_4D_dp
+
+   TYPE, PUBLIC ::   PTR_2D_sp   !: array of 2D pointers (also used in lib_mpp)
+      REAL(sp), DIMENSION (:,:)    , POINTER ::   pt2d
+   END TYPE PTR_2D_sp
+   TYPE, PUBLIC ::   PTR_3D_sp   !: array of 3D pointers (also used in lib_mpp)
+      REAL(sp), DIMENSION (:,:,:)  , POINTER ::   pt3d
+   END TYPE PTR_3D_sp
+   TYPE, PUBLIC ::   PTR_4D_sp   !: array of 4D pointers (also used in lib_mpp)
+      REAL(sp), DIMENSION (:,:,:,:), POINTER ::   pt4d
+   END TYPE PTR_4D_sp
+
 
    PUBLIC   lbc_nfd            ! north fold conditions
@@ -52,10 +70,11 @@
 
    INTEGER, PUBLIC, PARAMETER            ::   jpmaxngh = 3               !:
-   INTEGER, PUBLIC                       ::   nsndto, nfsloop, nfeloop   !:
+   INTEGER, PUBLIC                       ::   nsndto                     !:
    INTEGER, PUBLIC, DIMENSION (jpmaxngh) ::   isendto                    !: processes to which communicate
+   INTEGER, PUBLIC                       ::   ijpj
 
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: lbcnfd.F90 10425 2018-12-19 21:54:16Z smasson $
+   !! $Id: lbcnfd.F90 13286 2020-07-09 15:48:29Z smasson $
    !! Software governed by the CeCILL license (see ./LICENSE)
    !!----------------------------------------------------------------------
@@ -74,12 +93,16 @@
    !!----------------------------------------------------------------------
    !
-   !                       !==  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
+   !                       !==  SINGLE PRECISION VERSIONS
+   !
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+#  define SINGLE_PRECISION
+#  define DIM_2d
+#     define ROUTINE_NFD           lbc_nfd_2d_sp
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           lbc_nfd_2d_ptr_sp
 #     include "lbc_nfd_generic.h90"
 #     undef ROUTINE_NFD
@@ -90,5 +113,5 @@
    !
 #  define DIM_2d
-#     define ROUTINE_NFD           lbc_nfd_2d_ext
+#     define ROUTINE_NFD           lbc_nfd_2d_ext_sp
 #     include "lbc_nfd_ext_generic.h90"
 #     undef ROUTINE_NFD
@@ -98,22 +121,22 @@
    !
 #  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
+#     define ROUTINE_NFD           lbc_nfd_3d_sp
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           lbc_nfd_3d_ptr_sp
+#     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_sp
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           lbc_nfd_4d_ptr_sp
 #     include "lbc_nfd_generic.h90"
 #     undef ROUTINE_NFD
@@ -126,31 +149,31 @@
    !
 #  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
+#     define ROUTINE_NFD           lbc_nfd_nogather_2d_sp
+#     include "lbc_nfd_nogather_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           lbc_nfd_nogather_2d_ptr_sp
+#     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_sp
+#     include "lbc_nfd_nogather_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           lbc_nfd_nogather_3d_ptr_sp
+#     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_sp
 #     include "lbc_nfd_nogather_generic.h90"
 #     undef ROUTINE_NFD
@@ -161,6 +184,101 @@
 !#     undef MULTI
 #  undef DIM_4d
-
-   !!----------------------------------------------------------------------
+#  undef SINGLE_PRECISION
+
+   !!----------------------------------------------------------------------
+   !
+   !                       !==  DOUBLE PRECISION VERSIONS
+   !
+   !
+   !                       !==  2D array and array of 2D pointer  ==!
+   !
+#  define DIM_2d
+#     define ROUTINE_NFD           lbc_nfd_2d_dp
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           lbc_nfd_2d_ptr_dp
+#     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_dp
+#     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_dp
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           lbc_nfd_3d_ptr_dp
+#     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_dp
+#     include "lbc_nfd_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           lbc_nfd_4d_ptr_dp
+#     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_dp
+#     include "lbc_nfd_nogather_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           lbc_nfd_nogather_2d_ptr_dp
+#     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_dp
+#     include "lbc_nfd_nogather_generic.h90"
+#     undef ROUTINE_NFD
+#     define MULTI
+#     define ROUTINE_NFD           lbc_nfd_nogather_3d_ptr_dp
+#     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_dp
+#     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
+
+   !!----------------------------------------------------------------------
+
 
 
Index: utils/tools/DOMAINcfg/src/lib_fortran.F90
===================================================================
--- utils/tools/DOMAINcfg/src/lib_fortran.F90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/lib_fortran.F90	(revision 14623)
@@ -63,7 +63,9 @@
 #endif
 
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: lib_fortran.F90 10425 2018-12-19 21:54:16Z smasson $
+   !! $Id: lib_fortran.F90 13295 2020-07-10 18:24:21Z acc $
    !! Software governed by the CeCILL license (see ./LICENSE)
    !!----------------------------------------------------------------------
@@ -141,9 +143,9 @@
       !!----------------------------------------------------------------------
       REAL(wp),  INTENT(in   ) ::   ptab(:,:) ! array on which operation is applied
-      COMPLEX(wp)              ::  local_sum_2d
-      !
-      !!-----------------------------------------------------------------------
-      !
-      COMPLEX(wp)::   ctmp
+      COMPLEX(dp)              ::  local_sum_2d
+      !
+      !!-----------------------------------------------------------------------
+      !
+      COMPLEX(dp)::   ctmp
       REAL(wp)   ::   ztmp
       INTEGER    ::   ji, jj    ! dummy loop indices
@@ -159,5 +161,5 @@
          DO ji = 1, ipi
             ztmp =  ptab(ji,jj) * tmask_i(ji,jj)
-            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+            CALL DDPDD( CMPLX( ztmp, 0.e0, dp ), ctmp )
          END DO
       END DO
@@ -170,9 +172,9 @@
       !!----------------------------------------------------------------------
       REAL(wp),  INTENT(in   ) ::   ptab(:,:,:) ! array on which operation is applied
-      COMPLEX(wp)              ::  local_sum_3d
-      !
-      !!-----------------------------------------------------------------------
-      !
-      COMPLEX(wp)::   ctmp
+      COMPLEX(dp)              ::  local_sum_3d
+      !
+      !!-----------------------------------------------------------------------
+      !
+      COMPLEX(dp)::   ctmp
       REAL(wp)   ::   ztmp
       INTEGER    ::   ji, jj, jk   ! dummy loop indices
@@ -190,5 +192,5 @@
           DO ji = 1, ipi
              ztmp =  ptab(ji,jj,jk) * tmask_i(ji,jj)
-             CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+             CALL DDPDD( CMPLX( ztmp, 0.e0, dp ), ctmp )
           END DO
         END DO
@@ -215,66 +217,62 @@
       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 
+      DO_2D( 1, 1, 1, 1 )
+         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_2D
+      CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1.0_wp )
+      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.0_wp )
+
+   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_2D( 1, 1, 1, 1 )
             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))
+                  p3d(ji:ji2,jj:jj2,jn) = SUM(p3d(ji:ji2,jj:jj2,jn))
                ENDIF
             ENDIF
-         END DO
+         END_2D
       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. )
+      CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1.0_wp )
       IF( nbondi /= -1 ) THEN
          IF( MOD(mig(    1), 3) == 1 )   p3d(    1,:,:) = p3d(    2,:,:)
@@ -293,5 +291,5 @@
          IF( MOD(mjg(jpj-2), 3) == 0 )   p3d(:,jpj-1,:) = p3d(:,  jpj,:)
       ENDIF
-      CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1. )
+      CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1.0_wp )
 
    END SUBROUTINE sum3x3_3d
@@ -315,8 +313,8 @@
       !!              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
+      COMPLEX(dp), INTENT(in   ) ::   ydda
+      COMPLEX(dp), INTENT(inout) ::   yddb
+      !
+      REAL(dp) :: zerr, zt1, zt2  ! local work variables
       !!-----------------------------------------------------------------------
       !
Index: utils/tools/DOMAINcfg/src/lib_fortran_generic.h90
===================================================================
--- utils/tools/DOMAINcfg/src/lib_fortran_generic.h90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/lib_fortran_generic.h90	(revision 14623)
@@ -40,5 +40,5 @@
       REAL(wp)                              ::   FUNCTION_GLOB_OP   ! global sum
       !!
-      COMPLEX(wp)::   ctmp
+      COMPLEX(dp)::   ctmp
       REAL(wp)   ::   ztmp
       INTEGER    ::   ji, jj, jk   ! dummy loop indices
@@ -50,5 +50,5 @@
       ipk = K_SIZE(ptab)   ! 3rd dimension
       !
-      ctmp = CMPLX( 0.e0, 0.e0, wp )   ! warning ctmp is cumulated
+      ctmp = CMPLX( 0.e0, 0.e0, dp )   ! warning ctmp is cumulated
    
       DO jk = 1, ipk
@@ -56,5 +56,5 @@
           DO ji = 1, ipi
              ztmp =  ARRAY_IN(ji,jj,jk) * MASK_ARRAY(ji,jj)
-             CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+             CALL DDPDD( CMPLX( ztmp, 0.e0, dp ), ctmp )
           END DO
         END DO
@@ -109,5 +109,5 @@
       REAL(wp)                              ::   FUNCTION_GLOB_OP   ! global sum
       !!
-      COMPLEX(wp)::   ctmp
+      COMPLEX(dp)::   ctmp
       REAL(wp)   ::   ztmp
       INTEGER    ::   jk       ! dummy loop indices
@@ -117,7 +117,7 @@
       ipk = K_SIZE(ptab)   ! 3rd dimension
       !
-      ztmp = ARRAY_OPERATION( ARRAY_IN(:,:,1))
+      ztmp = ARRAY_OPERATION( ARRAY_IN(:,:,1)*tmask_i(:,:) )
       DO jk = 2, ipk
-         ztmp = SCALAR_OPERATION(ztmp, ARRAY_OPERATION( ARRAY_IN(:,:,jk)))
+         ztmp = SCALAR_OPERATION(ztmp, ARRAY_OPERATION( ARRAY_IN(:,:,jk)*tmask_i(:,:) ))
       ENDDO
 
Index: utils/tools/DOMAINcfg/src/lib_mpp.F90
===================================================================
--- utils/tools/DOMAINcfg/src/lib_mpp.F90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/lib_mpp.F90	(revision 14623)
@@ -19,4 +19,5 @@
    !!            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
@@ -31,12 +32,8 @@
    !!   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
+   !!   load_nml      : Read, condense and buffer namelist file into character array for use as an internal file
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   mpp_start     : get local communicator its size and rank
    !!   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)
@@ -54,31 +51,15 @@
    !!   mpp_ini_north : initialisation of north fold
    !!   mpp_lbc_north_icb : alternative to mpp_nfd for extra outer halo with icebergs
+   !!   mpp_bcast_nml : broadcast/receive namelist character buffer from reading process to all others
    !!----------------------------------------------------------------------
    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   ctl_stop, ctl_warn, ctl_opn, ctl_nam, load_nml
+   PUBLIC   mpp_start, 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
@@ -86,4 +67,12 @@
    PUBLIC   mpp_ini_znl
    PUBLIC   mppsend, mpprecv                          ! needed by TAM and ICB routines
+   PUBLIC   mppsend_sp, mpprecv_sp                          ! needed by TAM and ICB routines
+   PUBLIC   mppsend_dp, mpprecv_dp                          ! needed by TAM and ICB routines
+   PUBLIC   mpp_report
+   PUBLIC   mpp_bcast_nml
+   PUBLIC   tic_tac
+#if ! defined key_mpp_mpi
+   PUBLIC MPI_Wtime
+#endif
    
    !! * Interfaces
@@ -92,18 +81,26 @@
    !! 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
+      MODULE PROCEDURE mppmin_a_int, mppmin_int
+      MODULE PROCEDURE mppmin_a_real_sp, mppmin_real_sp
+      MODULE PROCEDURE mppmin_a_real_dp, mppmin_real_dp
    END INTERFACE
    INTERFACE mpp_max
-      MODULE PROCEDURE mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real
+      MODULE PROCEDURE mppmax_a_int, mppmax_int
+      MODULE PROCEDURE mppmax_a_real_sp, mppmax_real_sp
+      MODULE PROCEDURE mppmax_a_real_dp, mppmax_real_dp
    END INTERFACE
    INTERFACE mpp_sum
-      MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real,   &
-         &             mppsum_realdd, mppsum_a_realdd
+      MODULE PROCEDURE mppsum_a_int, mppsum_int
+      MODULE PROCEDURE mppsum_realdd, mppsum_a_realdd
+      MODULE PROCEDURE mppsum_a_real_sp, mppsum_real_sp
+      MODULE PROCEDURE mppsum_a_real_dp, mppsum_real_dp
    END INTERFACE
    INTERFACE mpp_minloc
-      MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d
+      MODULE PROCEDURE mpp_minloc2d_sp ,mpp_minloc3d_sp
+      MODULE PROCEDURE mpp_minloc2d_dp ,mpp_minloc3d_dp
    END INTERFACE
    INTERFACE mpp_maxloc
-      MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
+      MODULE PROCEDURE mpp_maxloc2d_sp ,mpp_maxloc3d_sp
+      MODULE PROCEDURE mpp_maxloc2d_dp ,mpp_maxloc3d_dp
    END INTERFACE
 
@@ -111,9 +108,14 @@
    !!  MPI  variable definition !!
    !! ========================= !!
+#if   defined key_mpp_mpi
 !$AGRIF_DO_NOT_TREAT
    INCLUDE 'mpif.h'
 !$AGRIF_END_DO_NOT_TREAT
-
    LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .TRUE.    !: mpp flag
+#else   
+   INTEGER, PUBLIC, PARAMETER ::   MPI_STATUS_SIZE = 1
+   INTEGER, PUBLIC, PARAMETER ::   MPI_DOUBLE_PRECISION = 8
+   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .FALSE.    !: mpp flag
+#endif
 
    INTEGER, PARAMETER         ::   nprocmax = 2**10   ! maximun dimension (required to be a power of 2)
@@ -144,19 +146,13 @@
    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
+   CHARACTER(len=lca), DIMENSION(:), ALLOCATABLE ::   crname_lbc                   !: names of lbc_lnk calling routines
+   CHARACTER(len=lca), DIMENSION(:), ALLOCATABLE ::   crname_glb                   !: names of global comm calling routines
+   CHARACTER(len=lca), 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, PARAMETER, PUBLIC                    ::   ncom_rec_max = 5000          !: max number of communication record
    INTEGER, PUBLIC                               ::   n_sequence_lbc = 0           !: # of communicated arraysvia lbc
    INTEGER, PUBLIC                               ::   n_sequence_glb = 0           !: # of global communications
@@ -172,120 +168,53 @@
    TYPE, PUBLIC ::   DELAYARR
       REAL(   wp), POINTER, DIMENSION(:) ::  z1d => NULL()
-      COMPLEX(wp), POINTER, DIMENSION(:) ::  y1d => NULL()
+      COMPLEX(dp), 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
-
+   TYPE( DELAYARR ), DIMENSION(nbdelay), PUBLIC, SAVE  ::   todelay         !: must have SAVE for default initialization of DELAYARR
+   INTEGER,          DIMENSION(nbdelay), PUBLIC        ::   ndelayid = -1   !: mpi request id of the delayed operations
+
+   ! timing summary report
+   REAL(dp), DIMENSION(2), PUBLIC ::  waiting_time = 0._dp
+   REAL(dp)              , PUBLIC ::  compute_time = 0._dp, elapsed_time = 0._dp
+   
    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
-
+   
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: lib_mpp.F90 10538 2019-01-17 10:41:10Z clem $
+   !! $Id: lib_mpp.F90 13286 2020-07-09 15:48:29Z smasson $
    !! 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
+   SUBROUTINE mpp_start( localComm )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_start  ***
+      !!
+      !! ** Purpose :   get mpi_comm_oce, mpprank and mppsize
+      !!----------------------------------------------------------------------
       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
-
+      INTEGER ::   ierr
+      LOGICAL ::   llmpi_init
+      !!----------------------------------------------------------------------
+#if defined key_mpp_mpi
+      !
+      CALL mpi_initialized ( llmpi_init, ierr )
+      IF( ierr /= MPI_SUCCESS ) CALL ctl_stop( 'STOP', ' lib_mpp: Error in routine mpi_initialized' )
+
+      IF( .NOT. llmpi_init ) THEN
+         IF( PRESENT(localComm) ) THEN
+            WRITE(ctmp1,*) ' lib_mpp: You cannot provide a local communicator '
+            WRITE(ctmp2,*) '          without calling MPI_Init before ! '
+            CALL ctl_stop( 'STOP', ctmp1, ctmp2 )
+         ENDIF
+         CALL mpi_init( ierr )
+         IF( ierr /= MPI_SUCCESS ) CALL ctl_stop( 'STOP', ' lib_mpp: Error in routine mpi_init' )
+      ENDIF
+       
       IF( PRESENT(localComm) ) THEN
          IF( Agrif_Root() ) THEN
@@ -293,16 +222,9 @@
          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
+         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_oce, ierr)
+         IF( ierr /= MPI_SUCCESS ) CALL ctl_stop( 'STOP', ' lib_mpp: Error in routine mpi_comm_dup' )
+      ENDIF
+
+# if defined key_agrif
       IF( Agrif_Root() ) THEN
          CALL Agrif_MPI_Init(mpi_comm_oce)
@@ -310,132 +232,17 @@
          CALL Agrif_MPI_set_grid_comm(mpi_comm_oce)
       ENDIF
-#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
-
-
-   !!----------------------------------------------------------------------
-   !!
-   !!   load_array  &   mpp_lnk_2d_9    à generaliser a 3D et 4D
-   
-   
-   !!    mpp_lnk_sum_2d et 3D   ====>>>>>>   à virer du code !!!!
-   
-   
-   !!----------------------------------------------------------------------
-
+#else
+      IF( PRESENT( localComm ) ) mpi_comm_oce = localComm
+      mppsize = 1
+      mpprank = 0
+#endif
+   END SUBROUTINE mpp_start
 
 
@@ -454,17 +261,63 @@
       !!
       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
+      INTEGER :: mpi_working_type
+      !!----------------------------------------------------------------------
+      !
+#if defined key_mpp_mpi
+      IF (wp == dp) THEN
+         mpi_working_type = mpi_double_precision
+      ELSE
+         mpi_working_type = mpi_real
+      END IF
+      CALL mpi_isend( pmess, kbytes, mpi_working_type, kdest , ktyp, mpi_comm_oce, md_req, iflag )
+#endif
       !
    END SUBROUTINE mppsend
+
+
+   SUBROUTINE mppsend_dp( ktyp, pmess, kbytes, kdest, md_req )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsend  ***
+      !!
+      !! ** Purpose :   Send messag passing array
+      !!
+      !!----------------------------------------------------------------------
+      REAL(dp), 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
+      !!----------------------------------------------------------------------
+      !
+#if defined key_mpp_mpi
+      CALL mpi_isend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_oce, md_req, iflag )
+#endif
+      !
+   END SUBROUTINE mppsend_dp
+
+
+   SUBROUTINE mppsend_sp( ktyp, pmess, kbytes, kdest, md_req )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsend  ***
+      !!
+      !! ** Purpose :   Send messag passing array
+      !!
+      !!----------------------------------------------------------------------
+      REAL(sp), 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
+      !!----------------------------------------------------------------------
+      !
+#if defined key_mpp_mpi
+      CALL mpi_isend( pmess, kbytes, mpi_real, kdest , ktyp, mpi_comm_oce, md_req, iflag )
+#endif
+      !
+   END SUBROUTINE mppsend_sp
 
 
@@ -484,6 +337,8 @@
       INTEGER :: iflag
       INTEGER :: use_source
-      !!----------------------------------------------------------------------
-      !
+      INTEGER :: mpi_working_type
+      !!----------------------------------------------------------------------
+      !
+#if defined key_mpp_mpi
       ! If a specific process number has been passed to the receive call,
       ! use that one. Default is to use mpi_any_source
@@ -491,7 +346,70 @@
       IF( PRESENT(ksource) )   use_source = ksource
       !
+      IF (wp == dp) THEN
+         mpi_working_type = mpi_double_precision
+      ELSE
+         mpi_working_type = mpi_real
+      END IF
+      CALL mpi_recv( pmess, kbytes, mpi_working_type, use_source, ktyp, mpi_comm_oce, istatus, iflag )
+#endif
+      !
+   END SUBROUTINE mpprecv
+
+   SUBROUTINE mpprecv_dp( ktyp, pmess, kbytes, ksource )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpprecv  ***
+      !!
+      !! ** Purpose :   Receive messag passing array
+      !!
+      !!----------------------------------------------------------------------
+      REAL(dp), 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 defined key_mpp_mpi
+      ! 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
+#endif
+      !
+   END SUBROUTINE mpprecv_dp
+
+
+   SUBROUTINE mpprecv_sp( ktyp, pmess, kbytes, ksource )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpprecv  ***
+      !!
+      !! ** Purpose :   Receive messag passing array
+      !!
+      !!----------------------------------------------------------------------
+      REAL(sp), 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 defined key_mpp_mpi
+      ! 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_real, use_source, ktyp, mpi_comm_oce, istatus, iflag )
+#endif
+      !
+   END SUBROUTINE mpprecv_sp
 
 
@@ -512,6 +430,10 @@
       !
       itaille = jpi * jpj
+#if defined key_mpp_mpi
       CALL mpi_gather( ptab, itaille, mpi_double_precision, pio, itaille     ,   &
          &                            mpi_double_precision, kp , mpi_comm_oce, ierror )
+#else
+      pio(:,:,1) = ptab(:,:)
+#endif
       !
    END SUBROUTINE mppgather
@@ -535,6 +457,10 @@
       itaille = jpi * jpj
       !
+#if defined key_mpp_mpi
       CALL mpi_scatter( pio, itaille, mpi_double_precision, ptab, itaille     ,   &
          &                            mpi_double_precision, kp  , mpi_comm_oce, ierror )
+#else
+      ptab(:,:) = pio(:,:,1)
+#endif
       !
    END SUBROUTINE mppscatter
@@ -550,5 +476,5 @@
       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
+      COMPLEX(dp),      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
@@ -558,6 +484,7 @@
       INTEGER ::   idvar
       INTEGER ::   ierr, ilocalcomm
-      COMPLEX(wp), ALLOCATABLE, DIMENSION(:) ::   ytmp
-      !!----------------------------------------------------------------------
+      COMPLEX(dp), ALLOCATABLE, DIMENSION(:) ::   ytmp
+      !!----------------------------------------------------------------------
+#if defined key_mpp_mpi
       ilocalcomm = mpi_comm_oce
       IF( PRESENT(kcom) )   ilocalcomm = kcom
@@ -598,8 +525,14 @@
 
       ! send y_in into todelay(idvar)%y1d with a non-blocking communication
-#if defined key_mpi2
-      CALL  mpi_allreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ndelayid(idvar), ierr )
+# 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, ierr )
+      ndelayid(idvar) = 1
+      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
 #else
-      CALL mpi_iallreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ndelayid(idvar), ierr )
+      pout(:) = REAL(y_in(:), wp)
 #endif
 
@@ -624,5 +557,17 @@
       INTEGER ::   idvar
       INTEGER ::   ierr, ilocalcomm
-      !!----------------------------------------------------------------------
+      INTEGER ::   MPI_TYPE
+      !!----------------------------------------------------------------------
+      
+#if defined key_mpp_mpi
+      if( wp == dp ) then
+         MPI_TYPE = MPI_DOUBLE_PRECISION
+      else if ( wp == sp ) then
+         MPI_TYPE = MPI_REAL
+      else
+        CALL ctl_stop( "Error defining type, wp is neither dp nor sp" )
+   
+      end if
+
       ilocalcomm = mpi_comm_oce
       IF( PRESENT(kcom) )   ilocalcomm = kcom
@@ -659,8 +604,13 @@
 
       ! send p_in into todelay(idvar)%z1d with a non-blocking communication
-#if defined key_mpi2
-      CALL  mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ndelayid(idvar), ierr )
+# if defined key_mpi2
+      IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.)
+      CALL  mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_TYPE, 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_TYPE, mpi_max, ilocalcomm, ndelayid(idvar), ierr )
+# endif
 #else
-      CALL mpi_iallreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ndelayid(idvar), ierr )
+      pout(:) = p_in(:)
 #endif
 
@@ -678,12 +628,41 @@
       INTEGER ::   ierr
       !!----------------------------------------------------------------------
+#if defined key_mpp_mpi
       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
+#endif
    END SUBROUTINE mpp_delay_rcv
+
+   SUBROUTINE mpp_bcast_nml( cdnambuff , kleng )
+      CHARACTER(LEN=:)    , ALLOCATABLE, INTENT(INOUT) :: cdnambuff
+      INTEGER                          , INTENT(INOUT) :: kleng
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_bcast_nml  ***
+      !!
+      !! ** Purpose :   broadcast namelist character buffer
+      !!
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER ::   iflag
+      !!----------------------------------------------------------------------
+      !
+#if defined key_mpp_mpi
+      call MPI_BCAST(kleng, 1, MPI_INT, 0, mpi_comm_oce, iflag)
+      call MPI_BARRIER(mpi_comm_oce, iflag)
+!$AGRIF_DO_NOT_TREAT
+      IF ( .NOT. ALLOCATED(cdnambuff) ) ALLOCATE( CHARACTER(LEN=kleng) :: cdnambuff )
+!$AGRIF_END_DO_NOT_TREAT
+      call MPI_BCAST(cdnambuff, kleng, MPI_CHARACTER, 0, mpi_comm_oce, iflag)
+      call MPI_BARRIER(mpi_comm_oce, iflag)
+#endif
+      !
+   END SUBROUTINE mpp_bcast_nml
 
    
@@ -707,12 +686,32 @@
 #  undef INTEGER_TYPE
 !
+   !!
+   !!   ----   SINGLE PRECISION VERSIONS
+   !!
+#  define SINGLE_PRECISION
 #  define REAL_TYPE
 #  define DIM_0d
-#     define ROUTINE_ALLREDUCE           mppmax_real
+#     define ROUTINE_ALLREDUCE           mppmax_real_sp
 #     include "mpp_allreduce_generic.h90"
 #     undef ROUTINE_ALLREDUCE
 #  undef DIM_0d
 #  define DIM_1d
-#     define ROUTINE_ALLREDUCE           mppmax_a_real
+#     define ROUTINE_ALLREDUCE           mppmax_a_real_sp
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef SINGLE_PRECISION
+   !!
+   !!
+   !!   ----   DOUBLE PRECISION VERSIONS
+   !!
+!
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppmax_real_dp
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppmax_a_real_dp
 #     include "mpp_allreduce_generic.h90"
 #     undef ROUTINE_ALLREDUCE
@@ -739,12 +738,31 @@
 #  undef INTEGER_TYPE
 !
+   !!
+   !!   ----   SINGLE PRECISION VERSIONS
+   !!
+#  define SINGLE_PRECISION
 #  define REAL_TYPE
 #  define DIM_0d
-#     define ROUTINE_ALLREDUCE           mppmin_real
+#     define ROUTINE_ALLREDUCE           mppmin_real_sp
 #     include "mpp_allreduce_generic.h90"
 #     undef ROUTINE_ALLREDUCE
 #  undef DIM_0d
 #  define DIM_1d
-#     define ROUTINE_ALLREDUCE           mppmin_a_real
+#     define ROUTINE_ALLREDUCE           mppmin_a_real_sp
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef SINGLE_PRECISION
+   !!
+   !!   ----   DOUBLE PRECISION VERSIONS
+   !!
+
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppmin_real_dp
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppmin_a_real_dp
 #     include "mpp_allreduce_generic.h90"
 #     undef ROUTINE_ALLREDUCE
@@ -772,13 +790,38 @@
 #  undef DIM_1d
 #  undef INTEGER_TYPE
-!
+
+   !!
+   !!   ----   SINGLE PRECISION VERSIONS
+   !!
+#  define OPERATION_SUM
+#  define SINGLE_PRECISION
 #  define REAL_TYPE
 #  define DIM_0d
-#     define ROUTINE_ALLREDUCE           mppsum_real
+#     define ROUTINE_ALLREDUCE           mppsum_real_sp
 #     include "mpp_allreduce_generic.h90"
 #     undef ROUTINE_ALLREDUCE
 #  undef DIM_0d
 #  define DIM_1d
-#     define ROUTINE_ALLREDUCE           mppsum_a_real
+#     define ROUTINE_ALLREDUCE           mppsum_a_real_sp
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_1d
+#  undef REAL_TYPE
+#  undef OPERATION_SUM
+
+#  undef SINGLE_PRECISION
+
+   !!
+   !!   ----   DOUBLE PRECISION VERSIONS
+   !!
+#  define OPERATION_SUM
+#  define REAL_TYPE
+#  define DIM_0d
+#     define ROUTINE_ALLREDUCE           mppsum_real_dp
+#     include "mpp_allreduce_generic.h90"
+#     undef ROUTINE_ALLREDUCE
+#  undef DIM_0d
+#  define DIM_1d
+#     define ROUTINE_ALLREDUCE           mppsum_a_real_dp
 #     include "mpp_allreduce_generic.h90"
 #     undef ROUTINE_ALLREDUCE
@@ -807,12 +850,16 @@
    !!----------------------------------------------------------------------
    !!
+   !!
+   !!   ----   SINGLE PRECISION VERSIONS
+   !!
+#  define SINGLE_PRECISION
 #  define OPERATION_MINLOC
 #  define DIM_2d
-#     define ROUTINE_LOC           mpp_minloc2d
+#     define ROUTINE_LOC           mpp_minloc2d_sp
 #     include "mpp_loc_generic.h90"
 #     undef ROUTINE_LOC
 #  undef DIM_2d
 #  define DIM_3d
-#     define ROUTINE_LOC           mpp_minloc3d
+#     define ROUTINE_LOC           mpp_minloc3d_sp
 #     include "mpp_loc_generic.h90"
 #     undef ROUTINE_LOC
@@ -822,14 +869,44 @@
 #  define OPERATION_MAXLOC
 #  define DIM_2d
-#     define ROUTINE_LOC           mpp_maxloc2d
+#     define ROUTINE_LOC           mpp_maxloc2d_sp
 #     include "mpp_loc_generic.h90"
 #     undef ROUTINE_LOC
 #  undef DIM_2d
 #  define DIM_3d
-#     define ROUTINE_LOC           mpp_maxloc3d
+#     define ROUTINE_LOC           mpp_maxloc3d_sp
 #     include "mpp_loc_generic.h90"
 #     undef ROUTINE_LOC
 #  undef DIM_3d
 #  undef OPERATION_MAXLOC
+#  undef SINGLE_PRECISION
+   !!
+   !!   ----   DOUBLE PRECISION VERSIONS
+   !!
+#  define OPERATION_MINLOC
+#  define DIM_2d
+#     define ROUTINE_LOC           mpp_minloc2d_dp
+#     include "mpp_loc_generic.h90"
+#     undef ROUTINE_LOC
+#  undef DIM_2d
+#  define DIM_3d
+#     define ROUTINE_LOC           mpp_minloc3d_dp
+#     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_dp
+#     include "mpp_loc_generic.h90"
+#     undef ROUTINE_LOC
+#  undef DIM_2d
+#  define DIM_3d
+#     define ROUTINE_LOC           mpp_maxloc3d_dp
+#     include "mpp_loc_generic.h90"
+#     undef ROUTINE_LOC
+#  undef DIM_3d
+#  undef OPERATION_MAXLOC
+
 
    SUBROUTINE mppsync()
@@ -843,10 +920,12 @@
       !!-----------------------------------------------------------------------
       !
+#if defined key_mpp_mpi
       CALL mpi_barrier( mpi_comm_oce, ierror )
+#endif
       !
    END SUBROUTINE mppsync
 
 
-   SUBROUTINE mppstop( ldfinal, ld_force_abort ) 
+   SUBROUTINE mppstop( ld_abort ) 
       !!----------------------------------------------------------------------
       !!                  ***  routine mppstop  ***
@@ -855,15 +934,13 @@
       !!
       !!----------------------------------------------------------------------
-      LOGICAL, OPTIONAL, INTENT(in) :: ldfinal    ! source process number
-      LOGICAL, OPTIONAL, INTENT(in) :: ld_force_abort    ! source process number
-      LOGICAL ::   llfinal, ll_force_abort
+      LOGICAL, OPTIONAL, INTENT(in) :: ld_abort    ! source process number
+      LOGICAL ::   ll_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
+      ll_abort = .FALSE.
+      IF( PRESENT(ld_abort) ) ll_abort = ld_abort
+      !
+#if defined key_mpp_mpi
+      IF(ll_abort) THEN
          CALL mpi_abort( MPI_COMM_WORLD )
       ELSE
@@ -871,5 +948,6 @@
          CALL mpi_finalize( info )
       ENDIF
-      IF( .NOT. llfinal ) STOP 123456
+#endif
+      IF( ll_abort ) STOP 123
       !
    END SUBROUTINE mppstop
@@ -883,5 +961,7 @@
       !!----------------------------------------------------------------------
       !
+#if defined key_mpp_mpi
       CALL MPI_COMM_FREE(kcom, ierr)
+#endif
       !
    END SUBROUTINE mpp_comm_free
@@ -913,4 +993,5 @@
       INTEGER, ALLOCATABLE, DIMENSION(:) ::   kwork
       !!----------------------------------------------------------------------
+#if defined key_mpp_mpi
       !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_world     : ', ngrp_world
       !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_world : ', mpi_comm_world
@@ -918,9 +999,5 @@
       !
       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( ierr /= 0 ) CALL ctl_stop( 'STOP', 'mpp_ini_znl : failed to allocate 1D array of length jpnij')
 
       IF( jpnj == 1 ) THEN
@@ -984,4 +1061,5 @@
 
       DEALLOCATE(kwork)
+#endif
 
    END SUBROUTINE mpp_ini_znl
@@ -1015,10 +1093,11 @@
       !!----------------------------------------------------------------------
       !
+#if defined key_mpp_mpi
       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
+      DO jjproc = 1, jpni
+         IF( nfproc(jjproc) /= -1 )   ndim_rank_north = ndim_rank_north + 1
       END DO
       !
@@ -1030,8 +1109,8 @@
       ! Note : the rank start at 0 in MPI
       ii = 0
-      DO ji = 1, jpnij
-         IF ( njmppt(ji) == njmppmax   ) THEN
+      DO ji = 1, jpni
+         IF ( nfproc(ji) /= -1   ) THEN
             ii=ii+1
-            nrank_north(ii)=ji-1
+            nrank_north(ii)=nfproc(ji)
          END IF
       END DO
@@ -1046,65 +1125,6 @@
       CALL MPI_COMM_CREATE( mpi_comm_oce, ngrp_north, ncomm_north, ierr )
       !
+#endif
    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
 
 
@@ -1117,8 +1137,8 @@
       !!---------------------------------------------------------------------
       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
+      COMPLEX(dp), DIMENSION(ilen), INTENT(in)    ::   ydda
+      COMPLEX(dp), DIMENSION(ilen), INTENT(inout) ::   yddb
+      !
+      REAL(dp) :: zerr, zt1, zt2    ! local work variables
       INTEGER  :: ji, ztmp           ! local scalar
       !!---------------------------------------------------------------------
@@ -1140,276 +1160,4 @@
 
 
-   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 )
-      !
-      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 )
-      !
-      !
-      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 )
-      !
-      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
-      !
-      !                           ! 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 )
-      !
-      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
-      !
-      !                           ! 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 )
       !!----------------------------------------------------------------------
@@ -1423,7 +1171,9 @@
       LOGICAL         , OPTIONAL, INTENT(in   ) ::   ld_lbc, ld_glb, ld_dlg
       !!
+      CHARACTER(len=128)                        ::   ccountname  ! name of a subroutine to count communications
       LOGICAL ::   ll_lbc, ll_glb, ll_dlg
-      INTEGER ::    ji,  jj,  jk,  jh, jf   ! dummy loop indices
-      !!----------------------------------------------------------------------
+      INTEGER ::    ji,  jj,  jk,  jh, jf, jcount   ! dummy loop indices
+      !!----------------------------------------------------------------------
+#if defined key_mpp_mpi
       !
       ll_lbc = .FALSE.
@@ -1435,5 +1185,4 @@
       !
       ! 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
       !
@@ -1481,13 +1230,21 @@
          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
+         DO ji = 1, n_sequence_lbc - 1
+            IF ( crname_lbc(ji) /= 'already counted' ) THEN
+               ccountname = crname_lbc(ji)
+               crname_lbc(ji) = 'already counted'
+               jcount = 1
+               DO jj = ji + 1, n_sequence_lbc
+                  IF ( ccountname ==  crname_lbc(jj) ) THEN
+                     jcount = jcount + 1
+                     crname_lbc(jj) = 'already counted'
+                  END IF
+               END DO
+               WRITE(numcom,'(A, I4, A, A)') ' - ', jcount,' times by subroutine ', TRIM(ccountname)
             END IF
-            jj = jj + 1 
          END DO
-         WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_lbc(n_sequence_lbc))
+         IF ( crname_lbc(n_sequence_lbc) /= 'already counted' ) THEN
+            WRITE(numcom,'(A, I4, A, A)') ' - ', 1,' times by subroutine ', TRIM(crname_lbc(ncom_rec_max))
+         END IF
          WRITE(numcom,*) ' '
          IF ( n_sequence_glb > 0 ) THEN
@@ -1528,256 +1285,51 @@
          DEALLOCATE(crname_lbc)
       ENDIF
+#endif
    END SUBROUTINE mpp_report
+
    
-#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 ::   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 tic_tac (ld_tic, ld_global)
+
+    LOGICAL,           INTENT(IN) :: ld_tic
+    LOGICAL, OPTIONAL, INTENT(IN) :: ld_global
+    REAL(dp), DIMENSION(2), SAVE :: tic_wt
+    REAL(dp),               SAVE :: tic_ct = 0._dp
+    INTEGER :: ii
+#if defined key_mpp_mpi
+
+    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_dp ) 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
+#endif
+    
+   END SUBROUTINE tic_tac
+
+#if ! defined key_mpp_mpi
+   SUBROUTINE mpi_wait(request, status, ierror)
+      INTEGER                            , INTENT(in   ) ::   request
+      INTEGER, DIMENSION(MPI_STATUS_SIZE), INTENT(  out) ::   status
+      INTEGER                            , INTENT(  out) ::   ierror
+   END SUBROUTINE mpi_wait
+
    
-   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
+   FUNCTION MPI_Wtime()
+      REAL(wp) ::  MPI_Wtime
+      MPI_Wtime = -1.
+   END FUNCTION MPI_Wtime
+#endif
+
+   !!----------------------------------------------------------------------
+   !!   ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam, load_nml   routines
    !!----------------------------------------------------------------------
 
@@ -1790,15 +1342,30 @@
       !!                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
+      CHARACTER(len=*), INTENT(in   )           ::   cd1
+      CHARACTER(len=*), INTENT(in   ), OPTIONAL ::        cd2, cd3, cd4, cd5
+      CHARACTER(len=*), INTENT(in   ), OPTIONAL ::   cd6, cd7, cd8, cd9, cd10
+      !
+      CHARACTER(LEN=8) ::   clfmt            ! writing format
+      INTEGER          ::   inum
       !!----------------------------------------------------------------------
       !
       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( cd1 == 'STOP' .AND. narea /= 1 ) THEN    ! Immediate stop: add an arror message in 'ocean.output' file
+         CALL ctl_opn( inum, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+         WRITE(inum,*)
+         WRITE(inum,*) ' ==>>>   Look for "E R R O R" messages in all existing *ocean.output* files'
+         CLOSE(inum)
+      ENDIF
+      IF( numout == 6 ) THEN                       ! force to open ocean.output file if not already opened
+         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea )
+      ENDIF
+      !
+                            WRITE(numout,*)
+                            WRITE(numout,*) ' ===>>> : E R R O R'
+                            WRITE(numout,*)
+                            WRITE(numout,*) '         ==========='
+                            WRITE(numout,*)
+                            WRITE(numout,*) TRIM(cd1)
       IF( PRESENT(cd2 ) )   WRITE(numout,*) TRIM(cd2)
       IF( PRESENT(cd3 ) )   WRITE(numout,*) TRIM(cd3)
@@ -1810,12 +1377,18 @@
       IF( PRESENT(cd9 ) )   WRITE(numout,*) TRIM(cd9)
       IF( PRESENT(cd10) )   WRITE(numout,*) TRIM(cd10)
-
+                            WRITE(numout,*)
+      !
                                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,*)  
          WRITE(numout,*)  'huge E-R-R-O-R : immediate stop'
-         CALL mppstop(ld_force_abort = .true.)
+         WRITE(numout,*)  
+         CALL FLUSH(numout)
+         CALL SLEEP(60)   ! make sure that all output and abort files are written by all cores. 60s should be enough...
+         CALL mppstop( ld_abort = .true. )
       ENDIF
       !
@@ -1836,16 +1409,22 @@
       !
       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)
+                               WRITE(numout,*)
+                               WRITE(numout,*) ' ===>>> : W A R N I N G'
+                               WRITE(numout,*)
+                               WRITE(numout,*) '         ==============='
+                               WRITE(numout,*)
+         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)
+                               WRITE(numout,*)
       ENDIF
       CALL FLUSH(numout)
@@ -1873,5 +1452,7 @@
       !
       CHARACTER(len=80) ::   clfile
+      CHARACTER(LEN=10) ::   clfmt            ! writing format
       INTEGER           ::   iost
+      INTEGER           ::   idg              ! number of digits
       !!----------------------------------------------------------------------
       !
@@ -1880,5 +1461,10 @@
       clfile = TRIM(cdfile)
       IF( PRESENT( karea ) ) THEN
-         IF( karea > 1 )   WRITE(clfile, "(a,'_',i4.4)") TRIM(clfile), karea-1
+         IF( karea > 1 ) THEN
+            ! Warning: jpnij is maybe not already defined when calling ctl_opn -> use mppsize instead of jpnij
+            idg = MAX( INT(LOG10(REAL(MAX(1,mppsize-1),wp))) + 1, 4 )      ! how many digits to we need to write? min=4, max=9
+            WRITE(clfmt, "('(a,a,i', i1, '.', i1, ')')") idg, idg          ! '(a,a,ix.x)'
+            WRITE(clfile, clfmt) TRIM(clfile), '_', karea-1
+         ENDIF
       ENDIF
 #if defined key_agrif
@@ -1890,6 +1476,5 @@
       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
+      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
@@ -1901,5 +1486,5 @@
          &  OPEN(UNIT=knum,FILE='NUL', FORM=cdform, ACCESS=cdacce, STATUS=cdstat                      , ERR=100, IOSTAT=iost )   
       IF( iost == 0 ) THEN
-         IF(ldwp) THEN
+         IF(ldwp .AND. kout > 0) THEN
             WRITE(kout,*) '     file   : ', TRIM(clfile),' open ok'
             WRITE(kout,*) '     unit   = ', knum
@@ -1912,29 +1497,13 @@
 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'
+         WRITE(ctmp1,*) ' ===>>>> : bad opening file: ', TRIM(clfile)
+         WRITE(ctmp2,*) ' =======   ===  '
+         WRITE(ctmp3,*) '           unit   = ', knum
+         WRITE(ctmp4,*) '           status = ', cdstat
+         WRITE(ctmp5,*) '           form   = ', cdform
+         WRITE(ctmp6,*) '           access = ', cdacce
+         WRITE(ctmp7,*) '           iostat = ', iost
+         WRITE(ctmp8,*) '           we stop. verify the file '
+         CALL ctl_stop( 'STOP', ctmp1, ctmp2, ctmp3, ctmp4, ctmp5, ctmp6, ctmp7, ctmp8 )
       ENDIF
       !
@@ -1942,5 +1511,5 @@
 
 
-   SUBROUTINE ctl_nam ( kios, cdnam, ldwp )
+   SUBROUTINE ctl_nam ( kios, cdnam )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE ctl_nam  ***
@@ -1950,8 +1519,8 @@
       !! ** 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
+      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
       !!----------------------------------------------------------------------
       !
@@ -1967,5 +1536,4 @@
       ENDIF
       kios = 0
-      RETURN
       !
    END SUBROUTINE ctl_nam
@@ -1988,10 +1556,91 @@
       END DO
       IF( (get_unit == 999) .AND. llopn ) THEN
-         CALL ctl_stop( 'get_unit: All logical units until 999 are used...' )
-         get_unit = -1
+         CALL ctl_stop( 'STOP', 'get_unit: All logical units until 999 are used...' )
       ENDIF
       !
    END FUNCTION get_unit
 
+   SUBROUTINE load_nml( cdnambuff , cdnamfile, kout, ldwp)
+      CHARACTER(LEN=:)    , ALLOCATABLE, INTENT(INOUT) :: cdnambuff
+      CHARACTER(LEN=*), INTENT(IN )                :: cdnamfile
+      CHARACTER(LEN=256)                           :: chline
+      CHARACTER(LEN=1)                             :: csp
+      INTEGER, INTENT(IN)                          :: kout
+      LOGICAL, INTENT(IN)                          :: ldwp  !: .true. only for the root broadcaster
+      INTEGER                                      :: itot, iun, iltc, inl, ios, itotsav
+      !
+      !csp = NEW_LINE('A')
+      ! a new line character is the best seperator but some systems (e.g.Cray)
+      ! seem to terminate namelist reads from internal files early if they 
+      ! encounter new-lines. Use a single space for safety.
+      csp = ' '
+      !
+      ! Check if the namelist buffer has already been allocated. Return if it has.
+      !
+      IF ( ALLOCATED( cdnambuff ) ) RETURN
+      IF( ldwp ) THEN
+         !
+         ! Open namelist file
+         !
+         CALL ctl_opn( iun, cdnamfile, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, kout, ldwp )
+         !
+         ! First pass: count characters excluding comments and trimable white space
+         !
+         itot=0
+     10  READ(iun,'(A256)',END=20,ERR=20) chline
+         iltc = LEN_TRIM(chline)
+         IF ( iltc.GT.0 ) THEN
+          inl = INDEX(chline, '!') 
+          IF( inl.eq.0 ) THEN
+           itot = itot + iltc + 1                                ! +1 for the newline character
+          ELSEIF( inl.GT.0 .AND. LEN_TRIM( chline(1:inl-1) ).GT.0 ) THEN
+           itot = itot + inl                                  !  includes +1 for the newline character
+          ENDIF
+         ENDIF
+         GOTO 10
+     20  CONTINUE
+         !
+         ! Allocate text cdnambuff for condensed namelist
+         !
+!$AGRIF_DO_NOT_TREAT
+         ALLOCATE( CHARACTER(LEN=itot) :: cdnambuff )
+!$AGRIF_END_DO_NOT_TREAT
+         itotsav = itot
+         !
+         ! Second pass: read and transfer pruned characters into cdnambuff
+         !
+         REWIND(iun)
+         itot=1
+     30  READ(iun,'(A256)',END=40,ERR=40) chline
+         iltc = LEN_TRIM(chline)
+         IF ( iltc.GT.0 ) THEN
+          inl = INDEX(chline, '!')
+          IF( inl.eq.0 ) THEN
+           inl = iltc
+          ELSE
+           inl = inl - 1
+          ENDIF
+          IF( inl.GT.0 .AND. LEN_TRIM( chline(1:inl) ).GT.0 ) THEN
+             cdnambuff(itot:itot+inl-1) = chline(1:inl)
+             WRITE( cdnambuff(itot+inl:itot+inl), '(a)' ) csp
+             itot = itot + inl + 1
+          ENDIF
+         ENDIF
+         GOTO 30
+     40  CONTINUE
+         itot = itot - 1
+         IF( itotsav .NE. itot ) WRITE(*,*) 'WARNING in load_nml. Allocated ',itotsav,' for read buffer; but used ',itot
+         !
+         ! Close namelist file
+         !
+         CLOSE(iun)
+         !write(*,'(32A)') cdnambuff
+      ENDIF
+#if defined key_mpp_mpi
+      CALL mpp_bcast_nml( cdnambuff, itot )
+#endif
+  END SUBROUTINE load_nml
+
+
    !!----------------------------------------------------------------------
 END MODULE lib_mpp
Index: utils/tools/DOMAINcfg/src/mpp_allreduce_generic.h90
===================================================================
--- utils/tools/DOMAINcfg/src/mpp_allreduce_generic.h90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/mpp_allreduce_generic.h90	(revision 14623)
@@ -1,7 +1,13 @@
 !                          !==  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
+#      if defined SINGLE_PRECISION
+#         define ARRAY_TYPE(i)    REAL(sp)         , INTENT(inout) ::   ARRAY_IN(i)
+#         define TMP_TYPE(i)      REAL(sp)         , ALLOCATABLE   ::   work(i)
+#         define MPI_TYPE mpi_real
+#      else
+#         define ARRAY_TYPE(i)    REAL(dp)         , INTENT(inout) ::   ARRAY_IN(i)
+#         define TMP_TYPE(i)      REAL(dp)         , ALLOCATABLE   ::   work(i)
+#         define MPI_TYPE mpi_double_precision
+#      endif 
 #   endif
 #   if defined INTEGER_TYPE
@@ -11,6 +17,6 @@
 #   endif
 #   if defined COMPLEX_TYPE
-#      define ARRAY_TYPE(i)    COMPLEX          , INTENT(inout) ::   ARRAY_IN(i)
-#      define TMP_TYPE(i)      COMPLEX          , ALLOCATABLE   ::   work(i)
+#      define ARRAY_TYPE(i)    COMPLEX(dp)       , INTENT(inout) ::   ARRAY_IN(i)
+#      define TMP_TYPE(i)      COMPLEX(dp)       , ALLOCATABLE   ::   work(i)
 #      define MPI_TYPE mpi_double_complex
 #   endif
@@ -61,5 +67,7 @@
       !
       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)
@@ -73,4 +81,5 @@
    END SUBROUTINE ROUTINE_ALLREDUCE
 
+#undef PRECISION
 #undef ARRAY_TYPE
 #undef ARRAY_IN
Index: utils/tools/DOMAINcfg/src/mpp_lbc_north_icb_generic.h90
===================================================================
--- utils/tools/DOMAINcfg/src/mpp_lbc_north_icb_generic.h90	(revision 14623)
+++ utils/tools/DOMAINcfg/src/mpp_lbc_north_icb_generic.h90	(revision 14623)
@@ -0,0 +1,112 @@
+# if defined SINGLE_PRECISION
+#    define PRECISION sp
+#    define SENDROUTINE mppsend_sp
+#    define RECVROUTINE mpprecv_sp
+#    define MPI_TYPE MPI_REAL
+# else
+#    define PRECISION dp
+#    define SENDROUTINE mppsend_dp
+#    define RECVROUTINE mpprecv_dp
+#    define MPI_TYPE MPI_DOUBLE_PRECISION
+# endif
+
+   SUBROUTINE ROUTINE_LNK( 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(PRECISION), 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
+      INTEGER ::   ipj, ij, iproc, ijnr, ii1, ipi, impp
+      !
+      REAL(PRECISION), DIMENSION(:,:)  , ALLOCATABLE  ::  ztab_e, znorthloc_e
+      REAL(PRECISION), DIMENSION(:,:,:), ALLOCATABLE  ::  znorthgloio_e
+      !!----------------------------------------------------------------------
+#if defined key_mpp_mpi
+      !
+      ipj=4
+      ALLOCATE(        ztab_e(jpiglo, 1-kextj:ipj+kextj)       ,       &
+     &            znorthloc_e(jpimax, 1-kextj:ipj+kextj)       ,       &
+     &          znorthgloio_e(jpimax, 1-kextj:ipj+kextj,ndim_rank_north)    )
+      !
+# if defined SINGLE_PRECISION
+      ztab_e(:,:)      = 0._sp
+      znorthloc_e(:,:) = 0._sp
+# else
+      ztab_e(:,:)      = 0._dp
+      znorthloc_e(:,:) = 0._dp
+# endif
+      !
+      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_TYPE,    &
+         &                znorthgloio_e(1,1-kextj,1), itaille, MPI_TYPE,    &
+         &                ncomm_north, ierr )
+      !
+      IF( ln_timing ) CALL tic_tac(.FALSE.)
+      !
+      ijnr = 0
+      DO jr = 1, ndim_rank_north            ! recover the global north array
+         iproc = nfproc(jr)
+         IF( iproc /= -1 ) THEN
+            impp = nfimpp(jr)
+            ipi  = nfjpi(jr)
+            ijnr = ijnr + 1
+            DO jj = 1-kextj, ipj+kextj
+               DO ji = 1, ipi
+                  ii1 = impp + ji - 1       ! corresponds to mig(ji) but for subdomain iproc
+                  ztab_e(ii1,jj) = znorthgloio_e(ji,jj,ijnr)
+               END DO
+            END DO
+         ENDIF
+      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 )
+      !
+#endif
+   END SUBROUTINE ROUTINE_LNK 
+
+#    undef PRECISION
+#    undef SENDROUTINE
+#    undef RECVROUTINE
+#    undef MPI_TYPE
Index: utils/tools/DOMAINcfg/src/mpp_lnk_generic.h90
===================================================================
--- utils/tools/DOMAINcfg/src/mpp_lnk_generic.h90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/mpp_lnk_generic.h90	(revision 14623)
@@ -5,5 +5,9 @@
 #   define OPT_K(k)                 ,ipf
 #   if defined DIM_2d
-#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D)                , INTENT(inout) ::   ptab(f)
+#      if defined SINGLE_PRECISION
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D_sp)                , INTENT(inout) ::   ptab(f)
+#      else
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D_dp)                , INTENT(inout) ::   ptab(f)
+#      endif
 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
 #      define K_SIZE(ptab)             1
@@ -11,5 +15,9 @@
 #   endif
 #   if defined DIM_3d
-#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D)                , INTENT(inout) ::   ptab(f)
+#      if defined SINGLE_PRECISION
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D_sp)                , INTENT(inout) ::   ptab(f)
+#      else
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D_dp)                , INTENT(inout) ::   ptab(f)
+#      endif
 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
 #      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3)
@@ -17,5 +25,9 @@
 #   endif
 #   if defined DIM_4d
-#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D)                , INTENT(inout) ::   ptab(f)
+#      if defined SINGLE_PRECISION
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D_sp)                , INTENT(inout) ::   ptab(f)
+#      else
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D_dp)                , INTENT(inout) ::   ptab(f)
+#      endif
 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
 #      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
@@ -23,5 +35,9 @@
 #   endif
 #else
-#   define ARRAY_TYPE(i,j,k,l,f)    REAL(wp)                    , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f)
+#   if defined SINGLE_PRECISION
+#      define ARRAY_TYPE(i,j,k,l,f)    REAL(sp)                    , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f)
+#   else
+#      define ARRAY_TYPE(i,j,k,l,f)    REAL(dp)                    , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f)
+#   endif
 #   define NAT_IN(k)                cd_nat
 #   define SGN_IN(k)                psgn
@@ -45,27 +61,46 @@
 #endif
 
+# if defined SINGLE_PRECISION
+#    define PRECISION sp
+#    define SENDROUTINE mppsend_sp
+#    define RECVROUTINE mpprecv_sp
+# else
+#    define PRECISION dp
+#    define SENDROUTINE mppsend_dp
+#    define RECVROUTINE mpprecv_dp
+# endif
+
 #if defined MULTI
-   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn, kfld, cd_mpp, pval )
-      INTEGER                     , INTENT(in   ) ::   kfld        ! number of pt3d arrays
+   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv )
+      INTEGER             , INTENT(in   ) ::   kfld        ! number of pt3d arrays
 #else
-   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn      , cd_mpp, pval )
+   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn      , kfillmode, pfillval, lsend, lrecv )
 #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
+      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
+      INTEGER ,             OPTIONAL, INTENT(in   ) ::   kfillmode   ! filling method for halo over land (default = constant)
+      REAL(wp),             OPTIONAL, INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries)
+      LOGICAL, DIMENSION(4),OPTIONAL, INTENT(in   ) ::   lsend, lrecv  ! communication with other 4 proc
+      !
+      INTEGER  ::    ji,  jj,  jk,  jl,  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  ::   isize, ishift, ishift2       ! local integers
+      INTEGER  ::   ireq_we, ireq_ea, ireq_so, ireq_no     ! mpi_request id
       INTEGER  ::   ierr
+      INTEGER  ::   ifill_we, ifill_ea, ifill_so, ifill_no
       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
+      INTEGER , DIMENSION(MPI_STATUS_SIZE)        ::   istat          ! for mpi_isend
+      REAL(PRECISION), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zsnd_we, zrcv_we, zsnd_ea, zrcv_ea   ! east -west  & west - east  halos
+      REAL(PRECISION), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zsnd_so, zrcv_so, zsnd_no, zrcv_no   ! north-south & south-north  halos
+      LOGICAL  ::   llsend_we, llsend_ea, llsend_no, llsend_so       ! communication send
+      LOGICAL  ::   llrecv_we, llrecv_ea, llrecv_no, llrecv_so       ! communication receive 
+      LOGICAL  ::   lldo_nfd                                     ! do north pole folding
       !!----------------------------------------------------------------------
+      !
+      ! ----------------------------------------- !
+      !     0. local variables initialization     !
+      ! ----------------------------------------- !
       !
       ipk = K_SIZE(ptab)   ! 3rd dimension
@@ -75,259 +110,285 @@
       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
+      IF     ( PRESENT(lsend) .AND. PRESENT(lrecv) ) THEN
+         llsend_we = lsend(1)   ;   llsend_ea = lsend(2)   ;   llsend_so = lsend(3)   ;   llsend_no = lsend(4)
+         llrecv_we = lrecv(1)   ;   llrecv_ea = lrecv(2)   ;   llrecv_so = lrecv(3)   ;   llrecv_no = lrecv(4)
+      ELSE IF( PRESENT(lsend) .OR.  PRESENT(lrecv) ) THEN
+         WRITE(ctmp1,*) ' E R R O R : Routine ', cdname, '  is calling lbc_lnk with only one of the two arguments lsend or lrecv'
+         WRITE(ctmp2,*) ' ========== '
+         CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' )
+      ELSE   ! send and receive with every neighbour
+         llsend_we = nbondi ==  1 .OR. nbondi == 0   ! keep for compatibility, should be defined in mppini
+         llsend_ea = nbondi == -1 .OR. nbondi == 0   ! keep for compatibility, should be defined in mppini
+         llsend_so = nbondj ==  1 .OR. nbondj == 0   ! keep for compatibility, should be defined in mppini
+         llsend_no = nbondj == -1 .OR. nbondj == 0   ! keep for compatibility, should be defined in mppini
+         llrecv_we = llsend_we   ;   llrecv_ea = llsend_ea   ;   llrecv_so = llsend_so   ;   llrecv_no = llsend_no
+      END IF
+         
+         
+      lldo_nfd = npolj /= 0                      ! keep for compatibility, should be defined in mppini
 
-      ! ------------------------------- !
-      !   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
+      zland = 0._wp                                     ! land filling value: zero by default
+      IF( PRESENT( pfillval ) )   zland = pfillval      ! set land value
 
-      ! ------------------------------- !
-      !      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
+      ! define the method we will use to fill the halos in each direction
+      IF(              llrecv_we ) THEN   ;   ifill_we = jpfillmpi
+      ELSEIF(           l_Iperio ) THEN   ;   ifill_we = jpfillperio
+      ELSEIF( PRESENT(kfillmode) ) THEN   ;   ifill_we = kfillmode
+      ELSE                                ;   ifill_we = jpfillcst
+      END IF
+      !
+      IF(              llrecv_ea ) THEN   ;   ifill_ea = jpfillmpi
+      ELSEIF(           l_Iperio ) THEN   ;   ifill_ea = jpfillperio
+      ELSEIF( PRESENT(kfillmode) ) THEN   ;   ifill_ea = kfillmode
+      ELSE                                ;   ifill_ea = jpfillcst
+      END IF
+      !
+      IF(              llrecv_so ) THEN   ;   ifill_so = jpfillmpi
+      ELSEIF(           l_Jperio ) THEN   ;   ifill_so = jpfillperio
+      ELSEIF( PRESENT(kfillmode) ) THEN   ;   ifill_so = kfillmode
+      ELSE                                ;   ifill_so = jpfillcst
+      END IF
+      !
+      IF(              llrecv_no ) THEN   ;   ifill_no = jpfillmpi
+      ELSEIF(           l_Jperio ) THEN   ;   ifill_no = jpfillperio
+      ELSEIF( PRESENT(kfillmode) ) THEN   ;   ifill_no = kfillmode
+      ELSE                                ;   ifill_no = jpfillcst
+      END IF
+      !
+#if defined PRINT_CAUTION
+      !
+      ! ================================================================================== !
+      ! CAUTION: semi-column notation is often impossible because of the cpp preprocessing !
+      ! ================================================================================== !
+      !
+#endif
+      !
+      ! -------------------------------------------------- !
+      !     1. Do east and west MPI exchange if needed     !
+      ! -------------------------------------------------- !
+      !
+      ! Must exchange the whole column (from 1 to jpj) to get the corners if we have no south/north neighbourg
+      isize = nn_hls * jpj * ipk * ipl * ipf      
+      !
+      ! Allocate local temporary arrays to be sent/received. Fill arrays to be sent
+      IF( llsend_we )   ALLOCATE( zsnd_we(nn_hls,jpj,ipk,ipl,ipf) )
+      IF( llsend_ea )   ALLOCATE( zsnd_ea(nn_hls,jpj,ipk,ipl,ipf) )
+      IF( llrecv_we )   ALLOCATE( zrcv_we(nn_hls,jpj,ipk,ipl,ipf) )
+      IF( llrecv_ea )   ALLOCATE( zrcv_ea(nn_hls,jpj,ipk,ipl,ipf) )
+      !
+      IF( llsend_we ) THEN   ! copy western side of the inner mpi domain in local temporary array to be sent by MPI
+         ishift = nn_hls
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
+            zsnd_we(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf)   ! nn_hls + 1 -> 2*nn_hls
+         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+      ENDIF
+      !
+      IF(llsend_ea  ) THEN   ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI
+         ishift = jpi - 2 * nn_hls
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
+            zsnd_ea(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf)   ! jpi - 2*nn_hls + 1 -> jpi - nn_hls
+         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+      ENDIF
+      !
+      IF( ln_timing ) CALL tic_tac(.TRUE.)
+      !
+      ! non-blocking send of the western/eastern side using local temporary arrays
+      IF( llsend_we )   CALL SENDROUTINE( 1, zsnd_we(1,1,1,1,1), isize, nowe, ireq_we )
+      IF( llsend_ea )   CALL SENDROUTINE( 2, zsnd_ea(1,1,1,1,1), isize, noea, ireq_ea )
+      ! blocking receive of the western/eastern halo in local temporary arrays
+      IF( llrecv_we )   CALL RECVROUTINE( 2, zrcv_we(1,1,1,1,1), isize, nowe )
+      IF( llrecv_ea )   CALL RECVROUTINE( 1, zrcv_ea(1,1,1,1,1), isize, noea )
+      !
+      IF( ln_timing ) CALL tic_tac(.FALSE.)
+      !
+      !
+      ! ----------------------------------- !
+      !     2. Fill east and west halos     !
+      ! ----------------------------------- !
+      !
+      ! 2.1 fill weastern halo
+      ! ----------------------
+      ! ishift = 0                         ! fill halo from ji = 1 to nn_hls
+      SELECT CASE ( ifill_we )
+      CASE ( jpfillnothing )               ! no filling 
+      CASE ( jpfillmpi   )                 ! use data received by MPI 
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
+            ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_we(ji,jj,jk,jl,jf)   ! 1 -> nn_hls
+         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+      CASE ( jpfillperio )                 ! use east-weast periodicity
+         ishift2 = jpi - 2 * nn_hls
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
+            ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf)
+         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+      CASE ( jpfillcopy  )                 ! filling with inner domain values
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
+            ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(nn_hls+1,jj,jk,jl,jf)
+         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+      CASE ( jpfillcst   )                 ! filling with constant value
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
+            ARRAY_IN(ji,jj,jk,jl,jf) = zland
+         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
       END SELECT
-      !                           ! Migrations
-      imigr = nn_hls * jpj * ipk * ipl * ipf      
-      !
-      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 )
+      !
+      ! 2.2 fill eastern halo
+      ! ---------------------
+      ishift = jpi - nn_hls                ! fill halo from ji = jpi-nn_hls+1 to jpi 
+      SELECT CASE ( ifill_ea )
+      CASE ( jpfillnothing )               ! no filling 
+      CASE ( jpfillmpi   )                 ! use data received by MPI 
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
+            ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zrcv_ea(ji,jj,jk,jl,jf)   ! jpi - nn_hls + 1 -> jpi
+         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+      CASE ( jpfillperio )                 ! use east-weast periodicity
+         ishift2 = nn_hls
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
+            ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf)
+         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+      CASE ( jpfillcopy  )                 ! filling with inner domain values
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
+            ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift,jj,jk,jl,jf)
+         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+      CASE ( jpfillcst   )                 ! filling with constant value
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls
+            ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zland
+         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
       END SELECT
-      !
-      !                           ! 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
+      !
+      IF( lldo_nfd .AND. ifill_no /= jpfillnothing ) 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.
+         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(:), ifill_no, zland 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
+         ifill_no = jpfillnothing  ! force to do nothing for the northern halo as we just done the north pole folding
+         !
+      ENDIF
+      !
+      ! ---------------------------------------------------- !
+      !     4. Do north and south MPI exchange if needed     !
+      ! ---------------------------------------------------- !
+      !
+      IF( llsend_so )   ALLOCATE( zsnd_so(jpi,nn_hls,ipk,ipl,ipf) )
+      IF( llsend_no )   ALLOCATE( zsnd_no(jpi,nn_hls,ipk,ipl,ipf) )
+      IF( llrecv_so )   ALLOCATE( zrcv_so(jpi,nn_hls,ipk,ipl,ipf) )
+      IF( llrecv_no )   ALLOCATE( zrcv_no(jpi,nn_hls,ipk,ipl,ipf) )
+      !
+      isize = jpi * nn_hls * ipk * ipl * ipf      
+
+      ! allocate local temporary arrays to be sent/received. Fill arrays to be sent
+      IF( llsend_so ) THEN   ! copy sourhern side of the inner mpi domain in local temporary array to be sent by MPI
+         ishift = nn_hls
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
+            zsnd_so(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf)   ! nn_hls+1 -> 2*nn_hls
+         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+      ENDIF
+      !
+      IF( llsend_no ) THEN   ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI
+         ishift = jpj - 2 * nn_hls
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
+            zsnd_no(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf)   ! jpj-2*nn_hls+1 -> jpj-nn_hls
+         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+      ENDIF
+      !
+      IF( ln_timing ) CALL tic_tac(.TRUE.)
+      !
+      ! non-blocking send of the southern/northern side
+      IF( llsend_so )   CALL SENDROUTINE( 3, zsnd_so(1,1,1,1,1), isize, noso, ireq_so )
+      IF( llsend_no )   CALL SENDROUTINE( 4, zsnd_no(1,1,1,1,1), isize, nono, ireq_no )
+      ! blocking receive of the southern/northern halo
+      IF( llrecv_so )   CALL RECVROUTINE( 4, zrcv_so(1,1,1,1,1), isize, noso )
+      IF( llrecv_no )   CALL RECVROUTINE( 3, zrcv_no(1,1,1,1,1), isize, nono )
+      !
+      IF( ln_timing ) CALL tic_tac(.FALSE.)
+      !
+      ! ------------------------------------- !
+      !     5. Fill south and north halos     !
+      ! ------------------------------------- !
+      !
+      ! 5.1 fill southern halo
+      ! ----------------------
+      ! ishift = 0                         ! fill halo from jj = 1 to nn_hls
+      SELECT CASE ( ifill_so )
+      CASE ( jpfillnothing )               ! no filling 
+      CASE ( jpfillmpi   )                 ! use data received by MPI 
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
+            ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_so(ji,jj,jk,jl,jf)   ! 1 -> nn_hls
+         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+      CASE ( jpfillperio )                 ! use north-south periodicity
+         ishift2 = jpj - 2 * nn_hls
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
+            ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf)
+         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+      CASE ( jpfillcopy  )                 ! filling with inner domain values
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
+            ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,nn_hls+1,jk,jl,jf)
+         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+      CASE ( jpfillcst   )                 ! filling with constant value
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
+            ARRAY_IN(ji,jj,jk,jl,jf) = zland
+         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
       END SELECT
       !
-      !                           ! Migrations
-      imigr = nn_hls * jpi * ipk * ipl * ipf
-      !
-      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 )
+      ! 5.2 fill northern halo
+      ! ----------------------
+      ishift = jpj - nn_hls                ! fill halo from jj = jpj-nn_hls+1 to jpj 
+      SELECT CASE ( ifill_no )
+      CASE ( jpfillnothing )               ! no filling 
+      CASE ( jpfillmpi   )                 ! use data received by MPI 
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
+            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zrcv_no(ji,jj,jk,jl,jf)   ! jpj-nn_hls+1 -> jpj
+         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+      CASE ( jpfillperio )                 ! use north-south periodicity
+         ishift2 = nn_hls
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
+            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf)
+         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+      CASE ( jpfillcopy  )                 ! filling with inner domain values
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
+            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift,jk,jl,jf)
+         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
+      CASE ( jpfillcst   )                 ! filling with constant value
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi
+            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zland
+         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
       END SELECT
       !
-      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 )
+      ! -------------------------------------------- !
+      !     6. deallocate local temporary arrays     !
+      ! -------------------------------------------- !
+      !
+      IF( llsend_we ) THEN
+         CALL mpi_wait(ireq_we, istat, ierr )
+         DEALLOCATE( zsnd_we )
+      ENDIF
+      IF( llsend_ea )  THEN
+         CALL mpi_wait(ireq_ea, istat, ierr )
+         DEALLOCATE( zsnd_ea )
+      ENDIF
+      IF( llsend_so ) THEN
+         CALL mpi_wait(ireq_so, istat, ierr )
+         DEALLOCATE( zsnd_so )
+      ENDIF
+      IF( llsend_no ) THEN
+         CALL mpi_wait(ireq_no, istat, ierr )
+         DEALLOCATE( zsnd_no )
+      ENDIF
+      !
+      IF( llrecv_we )   DEALLOCATE( zrcv_we )
+      IF( llrecv_ea )   DEALLOCATE( zrcv_ea )
+      IF( llrecv_so )   DEALLOCATE( zrcv_so )
+      IF( llrecv_no )   DEALLOCATE( zrcv_no )
       !
    END SUBROUTINE ROUTINE_LNK
-
+#undef PRECISION
+#undef SENDROUTINE
+#undef RECVROUTINE
 #undef ARRAY_TYPE
 #undef NAT_IN
Index: utils/tools/DOMAINcfg/src/mpp_lnk_icb_generic.h90
===================================================================
--- utils/tools/DOMAINcfg/src/mpp_lnk_icb_generic.h90	(revision 14623)
+++ utils/tools/DOMAINcfg/src/mpp_lnk_icb_generic.h90	(revision 14623)
@@ -0,0 +1,223 @@
+# if defined SINGLE_PRECISION
+#    define PRECISION sp
+#    define SENDROUTINE mppsend_sp
+#    define RECVROUTINE mpprecv_sp
+#    define LBCNORTH mpp_lbc_north_icb_sp
+# else
+#    define PRECISION dp
+#    define SENDROUTINE mppsend_dp
+#    define RECVROUTINE mpprecv_dp
+#    define LBCNORTH mpp_lbc_north_icb_dp
+# endif
+
+   SUBROUTINE ROUTINE_LNK( 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(PRECISION), 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(PRECISION), DIMENSION(1-kexti:jpi+kexti,nn_hls+kextj,2) ::   r2dns, r2dsn
+      REAL(PRECISION), 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 defined SINGLE_PRECISION
+         IF( .NOT. cd_type == 'F' )   pt2d(  1-kexti   :nn_hls   ,:) = 0._sp    ! east except at F-point
+                                      pt2d(jpi-nn_hls+1:jpi+kexti,:) = 0._sp    ! west
+# else
+         IF( .NOT. cd_type == 'F' )   pt2d(  1-kexti   :nn_hls   ,:) = 0._dp    ! east except at F-point
+                                      pt2d(jpi-nn_hls+1:jpi+kexti,:) = 0._dp    ! west
+# endif
+      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 defined SINGLE_PRECISION
+         IF( .NOT. cd_type == 'F' )   pt2d(:,  1-kextj   :nn_hls   ) = 0._sp    ! north except at F-point
+                                      pt2d(:,jpj-nn_hls+1:jpj+kextj) = 0._sp    ! south
+# else
+         IF( .NOT. cd_type == 'F' )   pt2d(:,  1-kextj   :nn_hls   ) = 0._dp    ! north except at F-point
+                                      pt2d(:,jpj-nn_hls+1:jpj+kextj) = 0._dp    ! south
+# endif
+      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 LBCNORTH        ( 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 - (2 * nn_hls) -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 )
+      !
+      !                           ! Migrations
+      imigr = ipreci * ( jpj + 2*kextj )
+      !
+      IF( ln_timing ) CALL tic_tac(.TRUE.)
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL SENDROUTINE( 2, r2dwe(1-kextj,1,1), imigr, noea, ml_req1 )
+         CALL RECVROUTINE( 1, r2dew(1-kextj,1,2), imigr, noea )
+         CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL SENDROUTINE( 1, r2dew(1-kextj,1,1), imigr, nowe, ml_req1 )
+         CALL SENDROUTINE( 2, r2dwe(1-kextj,1,1), imigr, noea, ml_req2 )
+         CALL RECVROUTINE( 1, r2dew(1-kextj,1,2), imigr, noea )
+         CALL RECVROUTINE( 2, r2dwe(1-kextj,1,2), imigr, nowe )
+         CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL SENDROUTINE( 1, r2dew(1-kextj,1,1), imigr, nowe, ml_req1 )
+         CALL RECVROUTINE( 2, r2dwe(1-kextj,1,2), imigr, nowe )
+         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 - (2 * nn_hls) - 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 SENDROUTINE( 4, r2dsn(1-kexti,1,1), imigr, nono, ml_req1 )
+         CALL RECVROUTINE( 3, r2dns(1-kexti,1,2), imigr, nono )
+         CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL SENDROUTINE( 3, r2dns(1-kexti,1,1), imigr, noso, ml_req1 )
+         CALL SENDROUTINE( 4, r2dsn(1-kexti,1,1), imigr, nono, ml_req2 )
+         CALL RECVROUTINE( 3, r2dns(1-kexti,1,2), imigr, nono )
+         CALL RECVROUTINE( 4, r2dsn(1-kexti,1,2), imigr, noso )
+         CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL SENDROUTINE( 3, r2dns(1-kexti,1,1), imigr, noso, ml_req1 )
+         CALL RECVROUTINE( 4, r2dsn(1-kexti,1,2), imigr, noso )
+         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 ROUTINE_LNK
+
+#    undef LBCNORTH
+#    undef PRECISION 
+#    undef SENDROUTINE 
+#    undef RECVROUTINE 
Index: utils/tools/DOMAINcfg/src/mpp_loc_generic.h90
===================================================================
--- utils/tools/DOMAINcfg/src/mpp_loc_generic.h90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/mpp_loc_generic.h90	(revision 14623)
@@ -1,5 +1,13 @@
                           !==  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 SINGLE_PRECISION
+#      define ARRAY_TYPE(i,j,k)    REAL(sp)        , INTENT(in   ) ::   ARRAY_IN(i,j,k)
+#      define MASK_TYPE(i,j,k)     REAL(sp)        , INTENT(in   ) ::   MASK_IN(i,j,k)
+#      define PRECISION sp
+#   else
+#      define ARRAY_TYPE(i,j,k)    REAL(dp)        , INTENT(in   ) ::   ARRAY_IN(i,j,k)
+#      define MASK_TYPE(i,j,k)     REAL(dp)        , INTENT(in   ) ::   MASK_IN(i,j,k)
+#      define PRECISION dp
+#   endif
+
 #   if defined DIM_2d
 #      define ARRAY_IN(i,j,k)   ptab(i,j)
@@ -17,8 +25,10 @@
 #      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
 
@@ -28,13 +38,12 @@
       ARRAY_TYPE(:,:,:)                            ! array on which loctrans operation is applied
       MASK_TYPE(:,:,:)                             ! local mask
-      REAL(wp)        , INTENT(  out) ::   pmin    ! Global minimum of ptab
+      REAL(PRECISION)        , 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
+      REAL(PRECISION) ::   zmin     ! local minimum
       INTEGER , DIMENSION(:), ALLOCATABLE  ::   ilocs
-      REAL(wp), DIMENSION(2,1) ::   zain, zaout
+      REAL(dp), DIMENSION(2,1) ::   zain, zaout
       !!-----------------------------------------------------------------------
       !
@@ -42,52 +51,63 @@
       !
       idim = SIZE(kindex)
-      ALLOCATE ( ilocs(idim) )
       !
-      ilocs = LOC_OPERATION( ARRAY_IN(:,:,:) , mask= MASK_IN(:,:,:) == 1._wp )
-      zmin  = ARRAY_IN(ilocs(1),ilocs(2),ilocs(3))
-      !
-      kindex(1) = ilocs(1) + nimpp - 1
-#  if defined DIM_2d || defined DIM_3d    /* avoid warning when kindex has 1 element */
-      kindex(2) = ilocs(2) + njmpp - 1
-#  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
+      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.)
+#if defined key_mpp_mpi
       CALL MPI_ALLREDUCE( zain, zaout, 1, MPI_2DOUBLE_PRECISION, MPI_OPERATION ,MPI_COMM_OCE, ierror)
+#else
+      zaout(:,:) = zain(:,:)
+#endif
+      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 */
+#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 */
+#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
+#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 PRECISION
 #undef ARRAY_TYPE
-#undef MAX_TYPE
+#undef MASK_TYPE
 #undef ARRAY_IN
 #undef MASK_IN
@@ -96,2 +116,3 @@
 #undef LOC_OPERATION
 #undef INDEX_TYPE
+#undef ERRVAL
Index: utils/tools/DOMAINcfg/src/mpp_nfd_generic.h90
===================================================================
--- utils/tools/DOMAINcfg/src/mpp_nfd_generic.h90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/mpp_nfd_generic.h90	(revision 14623)
@@ -5,5 +5,9 @@
 #   define LBC_ARG                  (jf)
 #   if defined DIM_2d
-#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D)     , INTENT(inout) ::   ptab(f)
+#      if defined SINGLE_PRECISION
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D_sp)     , INTENT(inout) ::   ptab(f)
+#      else
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D_dp)     , INTENT(inout) ::   ptab(f)
+#      endif
 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
 #      define K_SIZE(ptab)             1
@@ -11,5 +15,9 @@
 #   endif
 #   if defined DIM_3d
-#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D)     , INTENT(inout) ::   ptab(f)
+#      if defined SINGLE_PRECISION
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D_sp)     , INTENT(inout) ::   ptab(f)
+#      else
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D_dp)     , INTENT(inout) ::   ptab(f)
+#      endif
 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
 #      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3)
@@ -17,5 +25,9 @@
 #   endif
 #   if defined DIM_4d
-#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D)     , INTENT(inout) ::   ptab(f)
+#      if defined SINGLE_PRECISION
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D_sp)     , INTENT(inout) ::   ptab(f)
+#      else
+#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D_dp)     , INTENT(inout) ::   ptab(f)
+#      endif
 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
 #      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
@@ -24,5 +36,9 @@
 #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)
+#   if defined SINGLE_PRECISION
+#      define ARRAY_TYPE(i,j,k,l,f)    REAL(sp)         , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f)
+#   else
+#      define ARRAY_TYPE(i,j,k,l,f)    REAL(dp)         , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f)
+#   endif
 #   define NAT_IN(k)                cd_nat
 #   define SGN_IN(k)                psgn
@@ -46,28 +62,47 @@
 #endif
 
-   SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kfld )
+# if defined SINGLE_PRECISION
+#    define PRECISION sp
+#    define SENDROUTINE mppsend_sp
+#    define RECVROUTINE mpprecv_sp
+#    define MPI_TYPE MPI_REAL
+#    define HUGEVAL(x)   HUGE(x/**/_sp)
+# else
+#    define PRECISION dp
+#    define SENDROUTINE mppsend_dp
+#    define RECVROUTINE mpprecv_dp
+#    define MPI_TYPE MPI_DOUBLE_PRECISION
+#    define HUGEVAL(x)   HUGE(x/**/_dp)
+# endif
+
+   SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kfillmode, pfillval, 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          , INTENT(in   ) ::   kfillmode   ! filling method for halo over land 
+      REAL(wp)         , INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries)
       INTEGER, OPTIONAL, INTENT(in   ) ::   kfld        ! number of pt3d arrays
       !
+      LOGICAL  ::   ll_add_line
       INTEGER  ::   ji,  jj,  jk,  jl, jh, jf, jr   ! dummy loop indices
-      INTEGER  ::   ipi, ipj, ipk, ipl, ipf         ! dimension of the input array
+      INTEGER  ::   ipi, ipj, ipj2, 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  ::   ierr, ibuffsize, iis0, iie0, impp
+      INTEGER  ::   ii1, ii2, ij1, ij2
+      INTEGER  ::   ipimax, i0max
+      INTEGER  ::   ij, iproc, ipni, ijnr
       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
+      INTEGER                             ::   ipj_b       ! sum of lines for all multi fields
+      INTEGER                             ::   i012        ! 0, 1 or 2
+      INTEGER , DIMENSION(:,:)        , ALLOCATABLE ::   jj_s  ! position of sent lines
+      INTEGER , DIMENSION(:,:)        , ALLOCATABLE ::   jj_b  ! position of buffer lines
+      INTEGER , DIMENSION(:)          , ALLOCATABLE ::   ipj_s ! number of sent lines
+      REAL(PRECISION), DIMENSION(:,:,:,:)    , ALLOCATABLE ::   ztabb, ztabr, ztabw  ! buffer, receive and work arrays
+      REAL(PRECISION), DIMENSION(:,:,:,:,:)  , ALLOCATABLE ::   ztabglo, znorthloc
+      REAL(PRECISION), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   znorthglo
       !!----------------------------------------------------------------------
       !
@@ -76,218 +111,294 @@
       ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
       !
-      IF( l_north_nogather ) THEN      !==  ????  ==!
+      IF( l_north_nogather ) THEN      !==  no allgather exchanges  ==!
 
-         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 
-
+         !   ---   define number of exchanged lines   ---
+         !
+         ! In theory we should exchange only nn_hls lines.
+         !
+         ! However, some other points are duplicated in the north pole folding:
+         !  - jperio=[34], grid=T : half of the last line (jpiglo/2+2:jpiglo-nn_hls)
+         !  - jperio=[34], grid=U : half of the last line (jpiglo/2+1:jpiglo-nn_hls)
+         !  - jperio=[34], grid=V : all the last line nn_hls+1 and (nn_hls+2:jpiglo-nn_hls)
+         !  - jperio=[34], grid=F : all the last line (nn_hls+1:jpiglo-nn_hls)
+         !  - jperio=[56], grid=T : 2 points of the last line (jpiglo/2+1 and jpglo-nn_hls)
+         !  - jperio=[56], grid=U : no points are duplicated
+         !  - jperio=[56], grid=V : half of the last line (jpiglo/2+1:jpiglo-nn_hls)
+         !  - jperio=[56], grid=F : half of the last line (jpiglo/2+1:jpiglo-nn_hls-1)
+         ! The order of the calculations may differ for these duplicated points (as, for example jj+1 becomes jj-1)
+         ! This explain why these duplicated points may have different values even if they are at the exact same location.
+         ! In consequence, we may want to force the folding on these points by setting l_full_nf_update = .TRUE.
+         ! This is slightly slower but necessary to avoid different values on identical grid points!!
+         !
          !!!!!!!!!           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.
-
-         ipj_s(:) = 2
+         ! also force it if not restart during the first 2 steps (leap frog?)
+         ll_add_line = l_full_nf_update .OR. ( ncom_stp <= nit000+1 .AND. .NOT. ln_rstart )
+         
+         ALLOCATE(ipj_s(ipf))                ! how many lines do we exchange?
+         IF( ll_add_line ) THEN
+            DO jf = 1, ipf                      ! Loop over the number of arrays to be processed
+               ipj_s(jf) = nn_hls + COUNT( (/ npolj == 3 .OR. npolj == 4 .OR. NAT_IN(jf) == 'V' .OR. NAT_IN(jf) == 'F' /) ) 
+            END DO
+         ELSE
+            ipj_s(:) = nn_hls
+         ENDIF
+         
+         ipj   = MAXVAL(ipj_s(:))            ! Max 2nd dimension of message transfers
+         ipj_b = SUM(   ipj_s(:))            ! Total number of lines to be exchanged
+         ALLOCATE( jj_s(ipj, ipf), jj_b(ipj, ipf) )
 
          ! Index of modifying lines in input
+         ij1 = 0
          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
+               CASE ( 'T', 'W', 'U' )   ;   i012 = 1   ! T-, U-, W-point
+               CASE ( 'V', 'F'      )   ;   i012 = 2   ! V-, F-point
                END SELECT
-            !
-            CASE ( 5, 6 )                        ! *  North fold  F-point pivot
+            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
+               CASE ( 'T', 'W', 'U' )   ;   i012 = 0   ! T-, U-, W-point
+               CASE ( 'V', 'F'      )   ;   i012 = 1   ! V-, F-point
                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)
+               ij1 = ij1 + 1
+               jj_b(jj,jf) = ij1
+               jj_s(jj,jf) = jpj - 2*nn_hls + jj - i012
+            END DO
+            !
+         END DO
+         !
+         ALLOCATE( ztabb(jpimax,ipj_b,ipk,ipl) )   ! store all the data to be sent in a buffer array
+         ibuffsize = jpimax * ipj_b * ipk * ipl
+         !
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk
+            DO jj = 1, ipj_s(jf)
+               ij1 = jj_b(jj,jf)
+               ij2 = jj_s(jj,jf)
+               DO ji = 1, jpi
+                  ztabb(ji,ij1,jk,jl) = ARRAY_IN(ji,ij2,jk,jl,jf)
+               END DO
+               DO ji = jpi+1, jpimax
+                  ztabb(ji,ij1,jk,jl) = HUGEVAL(0.)   ! avoid sending uninitialized values (make sure we don't use it)
+               END DO
+            END DO
+         END DO   ;   END DO   ;   END DO
+         !
+         ! start waiting time measurement
+         IF( ln_timing ) CALL tic_tac(.TRUE.)
+         !
+         ! send the data as soon as possible
+         DO jr = 1, nsndto
+            iproc = nfproc(isendto(jr))
+            IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN
+               CALL SENDROUTINE( 5, ztabb, ibuffsize, iproc, ml_req_nf(jr) )
+            ENDIF
+         END DO
+         !
+         ipimax = jpimax * jpmaxngh
+         ALLOCATE( ztabw(jpimax,ipj_b,ipk,ipl), ztabr(ipimax,ipj_b,ipk,ipl) ) 
+         !
+         DO jr = 1, nsndto
+            !
+            ipni  = isendto(jr)
+            iproc = nfproc(ipni)
+            ipi   = nfjpi (ipni)
+            !
+            IF( ipni ==   1  ) THEN   ;   iis0 =   1            ! domain  left side: as e-w comm already done -> from 1st column
+            ELSE                      ;   iis0 =   1 + nn_hls   ! default: -> from inner domain 
+            ENDIF
+            IF( ipni == jpni ) THEN   ;   iie0 = ipi            ! domain right side: as e-w comm already done -> until last column
+            ELSE                      ;   iie0 = ipi - nn_hls   ! default: -> until inner domain 
+            ENDIF
+            impp = nfimpp(ipni) - nfimpp(isendto(1))
+            !
+            IF(           iproc == -1 ) THEN   ! No neighbour (land proc that was suppressed)
+               !
+               SELECT CASE ( kfillmode )
+               CASE ( jpfillnothing )               ! no filling 
+               CASE ( jpfillcopy    )               ! filling with inner domain values
+                  DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk
+                     DO jj = 1, ipj_s(jf)
+                        ij1 = jj_b(jj,jf)
+                        ij2 = jj_s(jj,jf)
+                        DO ji = iis0, iie0
+                           ztabr(impp+ji,ij1,jk,jl) = ARRAY_IN(Nis0,ij2,jk,jl,jf)   ! chose to take the 1st iner domain point
+                        END DO
+                     END DO
+                  END DO   ;   END DO   ;   END DO
+               CASE ( jpfillcst     )               ! filling with constant value
+                  DO jl = 1, ipl   ;   DO jk = 1, ipk
+                     DO jj = 1, ipj_b
+                        DO ji = iis0, iie0
+                           ztabr(impp+ji,jj,jk,jl) = pfillval
+                        END DO
+                     END DO
+                  END DO   ;   END DO
+               END SELECT
+               !
+            ELSE IF( iproc == narea-1 ) THEN   ! get data from myself!
+               !
+               DO jf = 1, ipf   ;   DO jl = 1, ipl  ;   DO jk = 1, ipk
+                  DO jj = 1, ipj_s(jf)
+                     ij1 = jj_b(jj,jf)
+                     ij2 = jj_s(jj,jf)
+                     DO ji = iis0, iie0
+                        ztabr(impp+ji,ij1,jk,jl) = ARRAY_IN(ji,ij2,jk,jl,jf)
+                     END DO
                   END DO
+               END DO   ;   END DO   ;   END DO
+               !
+            ELSE                               ! get data from a neighbour trough communication
+               !  
+               CALL RECVROUTINE(5, ztabw, ibuffsize, iproc)
+               DO jl = 1, ipl   ;   DO jk = 1, ipk
+                  DO jj = 1, ipj_b
+                     DO ji = iis0, iie0
+                        ztabr(impp+ji,jj,jk,jl) = ztabw(ji,jj,jk,jl)
+                     END DO
+                  END DO
+               END DO   ;   END DO
+               
+            ENDIF
+            !
+         END DO   ! nsndto
+         !
+         IF( ln_timing ) CALL tic_tac(.FALSE.)
+         !
+         ! North fold boundary condition
+         !
+         DO jf = 1, ipf
+            ij1 = jj_b(       1 ,jf)
+            ij2 = jj_b(ipj_s(jf),jf)
+            CALL lbc_nfd_nogather( ARRAY_IN(:,:,:,:,jf), ztabr(:,ij1:ij2,:,:), cd_nat LBC_ARG, psgn LBC_ARG )
+         END DO
+         !
+         DEALLOCATE( ztabr, ztabw, jj_s, jj_b, ipj_s )
+         !
+         DO jr = 1,nsndto
+            iproc = nfproc(isendto(jr))
+            IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN
+               CALL mpi_wait( ml_req_nf(jr), ml_stat, ml_err )   ! put the wait at the very end just before the deallocate
+            ENDIF
+         END DO
+         DEALLOCATE( ztabb )
+         !
+      ELSE                             !==  allgather exchanges  ==!
+         !
+         ! how many lines do we exchange at max? -> ipj    (no further optimizations in this case...)
+         ipj =      nn_hls + 2
+         ! how many lines do we     need at max? -> ipj2   (no further optimizations in this case...)
+         ipj2 = 2 * nn_hls + 2
+         !
+         i0max = jpimax - 2 * nn_hls
+         ibuffsize = i0max * ipj * ipk * ipl * ipf
+         ALLOCATE( znorthloc(i0max,ipj,ipk,ipl,ipf), znorthglo(i0max,ipj,ipk,ipl,ipf,ndim_rank_north) )
+         !
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk               ! put in znorthloc ipj j-lines of ptab
+            DO jj = 1, ipj
+               ij2 = jpj - ipj2 + jj                        ! the first ipj lines of the last ipj2 lines
+               DO ji = 1, Ni_0
+                  ii2 = Nis0 - 1 + ji                       ! inner domain: Nis0 to Nie0
+                  znorthloc(ji,jj,jk,jl,jf) = ARRAY_IN(ii2,ij2,jk,jl,jf)
+               END DO
+               DO ji = Ni_0+1, i0max
+                  znorthloc(ji,jj,jk,jl,jf) = HUGEVAL(0.)   ! avoid sending uninitialized values (make sure we don't use it)
                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
-         !
-         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
+         !
+         ! start waiting time measurement
+         IF( ln_timing ) CALL tic_tac(.TRUE.)
+         CALL MPI_ALLGATHER( znorthloc, ibuffsize, MPI_TYPE, znorthglo, ibuffsize, MPI_TYPE, ncomm_north, ierr )
+         ! stop waiting time measurement
+         IF( ln_timing ) CALL tic_tac(.FALSE.)
+         DEALLOCATE( znorthloc )
+         ALLOCATE( ztabglo(jpiglo,ipj2,ipk,ipl,ipf) )
+         !
+         ! need to fill only the first ipj lines of ztabglo as lbc_nfd don't use the last nn_hls lines
+         ijnr = 0
+         DO jr = 1, jpni                                                        ! recover the global north array
+            iproc = nfproc(jr)
+            impp  = nfimpp(jr)
+            ipi   = nfjpi( jr) - 2 * nn_hls                       ! corresponds to Ni_0 but for subdomain iproc
+            IF( iproc == -1 ) THEN   ! No neighbour (land proc that was suppressed)
+              !
+               SELECT CASE ( kfillmode )
+               CASE ( jpfillnothing )               ! no filling 
+               CASE ( jpfillcopy    )               ! filling with inner domain values
+                  DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk
+                     DO jj = 1, ipj
+                        ij2 = jpj - ipj2 + jj                    ! the first ipj lines of the last ipj2 lines
+                        DO ji = 1, ipi
+                           ii1 = impp + nn_hls + ji - 1          ! corresponds to mig(nn_hls + ji) but for subdomain iproc
+                           ztabglo(ii1,jj,jk,jl,jf) = ARRAY_IN(Nis0,ij2,jk,jl,jf)   ! chose to take the 1st iner domain point
                         END DO
                      END DO
+                  END DO   ;   END DO   ;   END DO
+               CASE ( jpfillcst     )               ! filling with constant value
+                  DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk
+                     DO jj = 1, ipj
+                        DO ji = 1, ipi
+                           ii1 = impp + nn_hls + ji - 1          ! corresponds to mig(nn_hls + ji) but for subdomain iproc
+                           ztabglo(ii1,jj,jk,jl,jf) = pfillval
+                        END DO
+                     END DO
+                 END DO   ;   END DO   ;   END DO
+               END SELECT
+               !
+            ELSE
+               ijnr = ijnr + 1
+               DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk
+                  DO jj = 1, ipj
+                     DO ji = 1, ipi
+                        ii1 = impp + nn_hls + ji - 1             ! corresponds to mig(nn_hls + ji) but for subdomain iproc
+                        ztabglo(ii1,jj,jk,jl,jf) = znorthglo(ji,jj,jk,jl,jf,ijnr)
+                     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   ;   END DO   ;   END DO
+            ENDIF
+            !
+         END DO   ! jpni
+         DEALLOCATE( znorthglo )
+         !
+         DO jf = 1, ipf
+            CALL lbc_nfd( ztabglo(:,:,:,:,jf), cd_nat LBC_ARG, psgn LBC_ARG )   ! North fold boundary condition
+            DO jl = 1, ipl   ;   DO jk = 1, ipk                  ! e-w periodicity
+               DO jj = 1, nn_hls + 1
+                  ij1 = ipj2 - (nn_hls + 1) + jj                 ! need only the last nn_hls + 1 lines until ipj2
+                  ztabglo(              1:nn_hls,ij1,jk,jl,jf) = ztabglo(jpiglo-2*nn_hls+1:jpiglo-nn_hls,ij1,jk,jl,jf)
+                  ztabglo(jpiglo-nn_hls+1:jpiglo,ij1,jk,jl,jf) = ztabglo(         nn_hls+1:     2*nn_hls,ij1,jk,jl,jf)
+               END DO
+            END DO   ;   END DO
+         END DO     
+         !
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk               ! Scatter back to ARRAY_IN
+            DO jj = 1, nn_hls + 1
+               ij1 = jpj  - (nn_hls + 1) + jj   ! last nn_hls + 1 lines until jpj
+               ij2 = ipj2 - (nn_hls + 1) + jj   ! last nn_hls + 1 lines until ipj2
+               DO ji= 1, jpi
+                  ii2 = mig(ji)
+                  ARRAY_IN(ji,ij1,jk,jl,jf) = ztabglo(ii2,ij2,jk,jl,jf)
+               END DO
             END DO
-         ENDIF
-         !
-         ! 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
-         !
-         CALL MPI_ALLGATHER( znorthloc  , ibuffsize, MPI_DOUBLE_PRECISION,                &
-            &                znorthgloio, ibuffsize, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
-         !
-         !
-         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 DO   ;   END DO   ;   END DO
+         !
+         DEALLOCATE( ztabglo )
+         !
+      ENDIF   ! l_north_nogather
       !
    END SUBROUTINE ROUTINE_NFD
 
+#undef PRECISION
+#undef MPI_TYPE
+#undef SENDROUTINE
+#undef RECVROUTINE
 #undef ARRAY_TYPE
 #undef NAT_IN
@@ -298,2 +409,3 @@
 #undef F_SIZE
 #undef LBC_ARG
+#undef HUGEVAL
Index: utils/tools/DOMAINcfg/src/mppini.F90
===================================================================
--- utils/tools/DOMAINcfg/src/mppini.F90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/mppini.F90	(revision 14623)
@@ -8,6 +8,6 @@
    !!            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 
+   !!            3.4  !  2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)  add init_nfdcom
+   !!            3.   !  2013-06  (I. Epicoco, S. Mocavero, CMCC)  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
@@ -15,13 +15,13 @@
 
    !!----------------------------------------------------------------------
-   !!  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_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
+   !!  mpp_init       : Lay out the global domain over processors with/without land processor elimination
+   !!      init_ioipsl: IOIPSL initialization in mpp 
+   !!      init_nfdcom: Setup for north fold exchanges with explicit point-to-point messaging
+   !!      init_doloop: set the starting/ending indices of DO-loop used in do_loop_substitute 
    !!----------------------------------------------------------------------
    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 lbcnfd  , ONLY : isendto, nsndto ! Setup of north fold exchanges 
    USE lib_mpp        ! distribued memory computing library
    USE iom            ! nemo I/O library 
@@ -32,11 +32,15 @@
    PRIVATE
 
-   PUBLIC mpp_init       ! called by opa.F90
-
-   INTEGER :: numbot = -1  ! 'bottom_level' local logical unit
+   PUBLIC   mpp_init       ! called by nemogcm.F90
+   PUBLIC   mpp_getnum     ! called by prtctl
+   PUBLIC   mpp_basesplit  ! called by prtctl
+   PUBLIC   mpp_is_ocean   ! called by prtctl
+   
+   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 $ 
+   !! $Id: mppini.F90 13305 2020-07-14 17:12:25Z acc $ 
    !! Software governed by the CeCILL license (see ./LICENSE)
    !!----------------------------------------------------------------------
@@ -58,4 +62,6 @@
       !!----------------------------------------------------------------------
       !
+      jpiglo = Ni0glo
+      jpjglo = Nj0glo
       jpimax = jpiglo
       jpjmax = jpjglo
@@ -63,22 +69,23 @@
       jpj    = jpjglo
       jpk    = jpkglo
-      jpim1  = jpi-1                                            ! inner domain indices
-      jpjm1  = jpj-1                                            !   "           "
-      jpkm1  = MAX( 1, jpk-1 )                                  !   "           "
+      jpim1  = jpi-1                         ! inner domain indices
+      jpjm1  = jpj-1                         !   "           "
+      jpkm1  = MAX( 1, jpk-1 )               !   "           "
+      !
+      CALL init_doloop                       ! set start/end indices or do-loop depending on the halo width value (nn_hls) 
+      !
       jpij   = jpi*jpj
       jpni   = 1
       jpnj   = 1
       jpnij  = jpni*jpnj
-      nimpp  = 1           ! 
+      nn_hls = 1
+      nimpp  = 1
       njmpp  = 1
-      nlci   = jpi
-      nlcj   = jpj
-      nldi   = 1
-      nldj   = 1
-      nlei   = jpi
-      nlej   = jpj
       nbondi = 2
       nbondj = 2
-      npolj = jperio
+      nidom  = FLIO_DOM_NONE
+      npolj = 0
+      IF( jperio == 3 .OR. jperio == 4 )   npolj = 3
+      IF( jperio == 5 .OR. jperio == 6 )   npolj = 5
       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)
@@ -95,32 +102,29 @@
          CALL ctl_stop( 'mpp_init: equality  jpni = jpnj = jpnij = 1 is not satisfied',   &
             &           'the domain is lay out for distributed memory computing!' )
-
+         !
 #if defined key_agrif
-     IF (.not.agrif_root()) THEN
-        CALL agrif_nemo_init
-     ENDIF
+      CALL agrif_nemo_init()
 
       IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90)
          print *,'nbcellsx = ',nbcellsx,nbghostcells_x
          print *,'nbcellsy = ',nbcellsy,nbghostcells_y_s,nbghostcells_y_n
-         IF( jpiglo /= nbcellsx + 2 + 2*nbghostcells_x ) THEN
+         IF( Ni0glo /= nbcellsx + 2 + 2*nbghostcells_x ) THEN
             IF(lwp) THEN
                WRITE(numout,*)
-               WRITE(numout,*) 'jpiglo should be: ', nbcellsx + 2 + 2*nbghostcells_x
+               WRITE(numout,*) 'Ni0glo should be: ', nbcellsx + 2 + 2*nbghostcells_x
             ENDIF        
-            CALL ctl_stop( 'STOP', 'mpp_init: Agrif children requires jpiglo == nbcellsx + 2 + 2*nbghostcells_x' )
+            CALL ctl_stop( 'STOP', 'mpp_init: Agrif children requires Ni0glo == nbcellsx + 2 + 2*nbghostcells_x' )
          ENDIF   
-         IF( jpjglo /= nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n ) THEN
+         IF( Nj0glo /= nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n ) THEN
             IF(lwp) THEN
                WRITE(numout,*)
-               WRITE(numout,*) 'jpjglo shoud be: ', nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n
+               WRITE(numout,*) 'Nj0glo shoud be: ', nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n
             ENDIF        
             CALL ctl_stop( 'STOP', &
-                'mpp_init: Agrif children requires jpjglo == nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n' )
+                'mpp_init: Agrif children requires Nj0glo == nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n' )
          ENDIF   
          IF( ln_use_jattr )   CALL ctl_stop( 'STOP', 'mpp_init:Agrif children requires ln_use_jattr = .false. ' )
-      ENDIF
+    ENDIF
 #endif
-         !
    END SUBROUTINE mpp_init
 
@@ -151,6 +155,4 @@
       !!                    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"
@@ -163,7 +165,6 @@
       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 ::   idir, ifreq                ! local integers
       INTEGER ::   ii, il1, ili, imil         !   -       -
       INTEGER ::   ij, il2, ilj, ijm1         !   -       -
@@ -173,39 +174,109 @@
       INTEGER ::   ierr, ios                  ! 
       INTEGER ::   inbi, inbj, iimax,  ijmax, icnt1, icnt2
-      LOGICAL ::   llbest
+      LOGICAL ::   llbest, llauto
       LOGICAL ::   llwrtlay
+      LOGICAL ::   ln_listonly
       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         !  -     -
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iimppt, ijpi, ibondi, ipproc   ! 2D workspace
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ijmppt, ijpj, ibondj, ipolj    !  -     -
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iie0, iis0, iono, ioea         !  -     -
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ije0, ijs0, ioso, iowe         !  -     -
       LOGICAL, ALLOCATABLE, DIMENSION(:,:) ::   llisoce                        !  -     -
-      !!----------------------------------------------------------------------
-
-      llwrtlay = lwp 
+!      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,                                     &
+!           &             ln_vol, nn_volctl, nn_rimwidth
+      NAMELIST/nammpp/ jpni, jpnj, nn_hls, ln_nnogather, ln_listonly
+      !!----------------------------------------------------------------------
+      !
+      llwrtlay = lwm .OR. sn_cfctl%l_layout
+      !
+      !  0. read namelists parameters
+      ! -----------------------------------
+      !
+      READ  ( numnam_ref, nammpp, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nammpp in reference namelist' )
+      READ  ( numnam_cfg, nammpp, IOSTAT = ios, ERR = 902 )
+902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nammpp in configuration namelist' )   
+      !
+      nn_hls = MAX(1, nn_hls)   ! nn_hls must be > 0
+      IF(lwp) THEN
+            WRITE(numout,*) '   Namelist nammpp'
+         IF( jpni < 1 .OR. jpnj < 1  ) THEN
+            WRITE(numout,*) '      jpni and jpnj will be calculated automatically'
+         ELSE
+            WRITE(numout,*) '      processor grid extent in i                            jpni = ', jpni
+            WRITE(numout,*) '      processor grid extent in j                            jpnj = ', jpnj
+         ENDIF
+            WRITE(numout,*) '      avoid use of mpi_allgather at the north fold  ln_nnogather = ', ln_nnogather
+            WRITE(numout,*) '      halo width (applies to both rows and columns)       nn_hls = ', nn_hls
+      ENDIF
+      !
+      IF(lwm)   WRITE( numond, nammpp )
+      !
+!!!------------------------------------
+!!!  nn_hls shloud be read in nammpp
+!!!------------------------------------
+      jpiglo = Ni0glo + 2 * nn_hls
+      jpjglo = Nj0glo + 2 * nn_hls
+      !
+      ! do we need to take into account bdy_msk?
+!      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903)
+!903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist (mppini)' )
+!      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 )
+!904   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist (mppini)' )
       !
       IF(               ln_read_cfg ) CALL iom_open( cn_domcfg,    numbot )
+!      IF( ln_bdy .AND. ln_mask_file ) CALL iom_open( cn_mask_file, numbdy )
+      !
+      IF( ln_listonly )   CALL bestpartition( MAX(mppsize,jpni*jpnj), ldlist = .TRUE. )   ! must be done by all core
       !
       !  1. Dimension arrays for subdomains
       ! -----------------------------------
       !
-      ! If dimensions of processor grid weren't specified in the namelist file
+      ! If dimensions of processors grid weren't specified in the namelist file
       ! then we calculate them here now that we have our communicator size
+      IF(lwp) THEN
+         WRITE(numout,*) 'mpp_init:'
+         WRITE(numout,*) '~~~~~~~~ '
+         WRITE(numout,*)
+      ENDIF
       IF( jpni < 1 .OR. jpnj < 1 ) THEN
-         CALL mpp_init_bestpartition( mppsize, jpni, jpnj )
+         CALL bestpartition( mppsize, jpni, jpnj )           ! best mpi decomposition for mppsize mpi processes
+         llauto = .TRUE.
          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
+         llauto = .FALSE.
+         CALL bestpartition( mppsize, inbi, inbj, icnt2 )    ! best mpi decomposition for mppsize mpi processes
+         ! largest subdomain size for mpi decoposition jpni*jpnj given in the namelist
+         CALL mpp_basesplit( jpiglo, jpjglo, nn_hls, jpni, jpnj, jpimax, jpjmax )
+         ! largest subdomain size for mpi decoposition inbi*inbj given by bestpartition
+         CALL mpp_basesplit( jpiglo, jpjglo, nn_hls, inbi, inbj,  iimax,  ijmax )
+         icnt1 = jpni*jpnj - mppsize   ! number of land subdomains that should be removed to use mppsize mpi processes
+         IF(lwp) THEN
+            WRITE(numout,9000) '   The chosen domain decomposition ', jpni, ' x ', jpnj, ' with ', icnt1, ' land subdomains'
+            WRITE(numout,9002) '      - uses a total of ',  mppsize,' mpi process'
+            WRITE(numout,9000) '      - has mpi subdomains with a maximum size of (jpi = ', jpimax, ', jpj = ', jpjmax,   &
+               &                                                                ', jpi*jpj = ', jpimax*jpjmax, ')'
+            WRITE(numout,9000) '   The best domain decompostion ', inbi, ' x ', inbj, ' with ', icnt2, ' land subdomains'
+            WRITE(numout,9002) '      - uses a total of ',  inbi*inbj-icnt2,' mpi process'
+            WRITE(numout,9000) '      - has mpi subdomains with a maximum size of (jpi = ',  iimax, ', jpj = ',  ijmax,   &
+               &                                                             ', jpi*jpj = ',  iimax* ijmax, ')'
+         ENDIF
+         IF( iimax*ijmax < jpimax*jpjmax ) THEN   ! chosen subdomain size is larger that the best subdomain size
             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... ---', ' ' )
+            IF ( inbi*inbj-icnt2 < mppsize ) THEN
+               WRITE(ctmp1,*) '   ==> You could therefore have smaller mpi subdomains with less mpi processes'
+            ELSE
+               WRITE(ctmp1,*) '   ==> You could therefore have smaller mpi subdomains with the same number of mpi processes'
+            ENDIF
+            CALL ctl_warn( ' ', ctmp1, ' ', '    ---   YOU ARE WASTING CPU...   ---', ' ' )
+         ELSE IF ( iimax*ijmax == jpimax*jpjmax .AND. (inbi*inbj-icnt2) <  mppsize) THEN
+            llbest = .FALSE.
+            WRITE(ctmp1,*) '   ==> You could therefore have the same mpi subdomains size with less mpi processes'
+            CALL ctl_warn( ' ', ctmp1, ' ', '    ---   YOU ARE WASTING CPU...   ---', ' ' )
          ELSE
             llbest = .TRUE.
@@ -215,25 +286,38 @@
       ! look for land mpi subdomains...
       ALLOCATE( llisoce(jpni,jpnj) )
-      CALL mpp_init_isoce( jpni, jpnj, llisoce )
+      CALL mpp_is_ocean( llisoce )
       inijmin = COUNT( llisoce )   ! number of oce subdomains
 
-      IF( mppsize < inijmin ) THEN
+      IF( mppsize < inijmin ) THEN   ! too many oce subdomains: can happen only if jpni and jpnj are prescribed...
          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' )
+         CALL ctl_stop( ctmp1, ctmp2, ctmp3, ' ', ctmp4, ' ' )
+         CALL bestpartition( mppsize, ldlist = .TRUE. )   ! must be done by all core
+      ENDIF
+
+      IF( mppsize > jpni*jpnj ) THEN   ! not enough mpi subdomains for the total number of mpi processes
+         IF(lwp) THEN
+            WRITE(numout,9003) '   The number of mpi processes: ', mppsize
+            WRITE(numout,9003) '   exceeds the maximum number of subdomains (ocean+land) = ', jpni*jpnj
+            WRITE(numout,9001) '   defined by the following domain decomposition: jpni = ', jpni, ' jpnj = ', jpnj
+            WRITE(numout,   *) '   You should: '
+           IF( llauto ) THEN
+               WRITE(numout,*) '     - either prescribe your domain decomposition with the namelist variables'
+               WRITE(numout,*) '       jpni and jpnj to match the number of mpi process you want to use, '
+               WRITE(numout,*) '       even IF it not the best choice...'
+               WRITE(numout,*) '     - or keep the automatic and optimal domain decomposition by picking up one'
+               WRITE(numout,*) '       of the number of mpi process proposed in the list bellow'
+            ELSE
+               WRITE(numout,*) '     - either properly prescribe your domain decomposition with jpni and jpnj'
+               WRITE(numout,*) '       in order to be consistent with the number of mpi process you want to use'
+               WRITE(numout,*) '       even IF it not the best choice...'
+               WRITE(numout,*) '     - or use the automatic and optimal domain decomposition and pick up one of'
+               WRITE(numout,*) '       the domain decomposition proposed in the list bellow'
+            ENDIF
+            WRITE(numout,*)
+         ENDIF
+         CALL bestpartition( mppsize, ldlist = .TRUE. )   ! must be done by all core
       ENDIF
 
@@ -244,9 +328,9 @@
          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... ---', ' ' )
+         CALL ctl_warn( 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,*) '~~~~~~~~ '
+            IF(llbest) WRITE(numout,*) '   ==> you use the best mpi decomposition'
+            WRITE(numout,*)
             WRITE(numout,9003) '   Number of mpi processes: ', mppsize
             WRITE(numout,9003) '   Number of ocean subdomains = ', inijmin
@@ -260,16 +344,14 @@
 9003  FORMAT (a, i5)
 
-      IF( numbot /= -1 )   CALL iom_close( numbot )
-    
-      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) ,    &
+      ALLOCATE(  nfimpp(jpni ) , nfproc(jpni ) ,   nfjpi(jpni ) ,                     &
+         &       nimppt(jpnij) , ibonit(jpnij) ,  jpiall(jpnij) ,  jpjall(jpnij) ,    &
+         &       njmppt(jpnij) , ibonjt(jpnij) , nis0all(jpnij) , njs0all(jpnij) ,    &
+         &                                       nie0all(jpnij) , nje0all(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),   &
+         &       iimppt(jpni,jpnj), ijpi(jpni,jpnj), ibondi(jpni,jpnj), ipproc(jpni,jpnj),   &
+         &       ijmppt(jpni,jpnj), ijpj(jpni,jpnj), ibondj(jpni,jpnj),  ipolj(jpni,jpnj),   &
+         &         iie0(jpni,jpnj), iis0(jpni,jpnj),   iono(jpni,jpnj),   ioea(jpni,jpnj),   &
+         &         ije0(jpni,jpnj), ijs0(jpni,jpnj),   ioso(jpni,jpnj),   iowe(jpni,jpnj),   &
          &       STAT=ierr )
       CALL mpp_sum( 'mppini', ierr )
@@ -277,20 +359,20 @@
       
 #if defined key_agrif
+      CALL agrif_nemo_init()
       IF( .NOT. Agrif_Root() ) THEN       ! AGRIF children: specific setting (cf. agrif_user.F90)
-         CALL agrif_nemo_init
-         IF( jpiglo /= nbcellsx + 2 + 2*nbghostcells_x ) THEN
+         IF( Ni0glo /= nbcellsx + 2 + 2*nbghostcells_x ) THEN
             IF(lwp) THEN
                WRITE(numout,*)
-               WRITE(numout,*) 'jpiglo should be: ', nbcellsx + 2 + 2*nbghostcells_x
+               WRITE(numout,*) 'Ni0glo should be: ', nbcellsx + 2 + 2*nbghostcells_x
             ENDIF        
-            CALL ctl_stop( 'STOP', 'mpp_init: Agrif children requires jpiglo == nbcellsx + 2 + 2*nbghostcells' )
+            CALL ctl_stop( 'STOP', 'mpp_init: Agrif children requires Ni0glo == nbcellsx + 2 + 2*nbghostcells_x' )
          ENDIF   
-         IF( jpjglo /= nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n ) THEN
+         IF( Nj0glo /= nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n ) THEN
             IF(lwp) THEN
                WRITE(numout,*)
-               WRITE(numout,*) 'jpjglo shoud be: ', nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n
+               WRITE(numout,*) 'Nj0glo shoud be: ', nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n
             ENDIF        
             CALL ctl_stop( 'STOP', &
-            	'mpp_init: Agrif children requires jpjglo == nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n' )
+            	'mpp_init: Agrif children requires Nj0glo == nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n' )
          ENDIF   
          IF( ln_use_jattr )   CALL ctl_stop( 'STOP', 'mpp_init:Agrif children requires ln_use_jattr = .false. ' )
@@ -301,9 +383,19 @@
       ! -----------------------------------
       !
-      nreci = 2 * nn_hls
-      nrecj = 2 * nn_hls
-      CALL mpp_basic_decomposition( jpni, jpnj, jpimax, jpjmax, iimppt, ijmppt, ilci, ilcj )
-      nfiimpp(:,:) = iimppt(:,:)
-      nfilcit(:,:) = ilci(:,:)
+
+      CALL mpp_basesplit( jpiglo, jpjglo, nn_hls, jpni, jpnj, jpimax, jpjmax, iimppt, ijmppt, ijpi, ijpj )
+      CALL mpp_getnum( llisoce, ipproc, iin, ijn )
+      !
+      !DO jn = 1, jpni
+      !   jproc = ipproc(jn,jpnj)
+      !   ii = iin(jproc+1)
+      !   ij = ijn(jproc+1)
+      !   nfproc(jn) = jproc
+      !   nfimpp(jn) = iimppt(ii,ij)
+      !   nfjpi (jn) =   ijpi(ii,ij)
+      !END DO
+      nfproc(:) = ipproc(:,jpnj) 
+      nfimpp(:) = iimppt(:,jpnj) 
+      nfjpi (:) =   ijpi(:,jpnj)
       !
       IF(lwp) THEN
@@ -314,7 +406,8 @@
          WRITE(numout,*) '      jpni = ', jpni  
          WRITE(numout,*) '      jpnj = ', jpnj
+         WRITE(numout,*) '     jpnij = ', jpnij
          WRITE(numout,*)
-         WRITE(numout,*) '      sum ilci(i,1) = ', sum(ilci(:,1)), ' jpiglo = ', jpiglo
-         WRITE(numout,*) '      sum ilcj(1,j) = ', sum(ilcj(1,:)), ' jpjglo = ', jpjglo
+         WRITE(numout,*) '      sum ijpi(i,1) = ', sum(ijpi(:,1)), ' jpiglo = ', jpiglo
+         WRITE(numout,*) '      sum ijpj(1,j) = ', sum(ijpj(1,:)), ' jpjglo = ', jpjglo
       ENDIF
      
@@ -331,6 +424,6 @@
          ii = 1 + MOD(iarea0,jpni)
          ij = 1 +     iarea0/jpni
-         ili = ilci(ii,ij)
-         ilj = ilcj(ii,ij)
+         ili = ijpi(ii,ij)
+         ilj = ijpj(ii,ij)
          ibondi(ii,ij) = 0                         ! default: has e-w neighbours
          IF( ii   ==    1 )   ibondi(ii,ij) = -1   ! first column, has only e neighbour
@@ -347,8 +440,8 @@
          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
+         iis0(ii,ij) =  1  + nn_hls
+         iie0(ii,ij) = ili - nn_hls
+         ijs0(ii,ij) =  1  + nn_hls
+         ije0(ii,ij) = ilj - nn_hls
 
          ! East-West periodicity: change ibondi, ioea, iowe
@@ -388,34 +481,4 @@
       ! ----------------------------
       !
-      ! 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
@@ -456,15 +519,4 @@
          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
@@ -479,5 +531,5 @@
             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,9402) jj, (ijpi(ji,jj),ijpj(ji,jj),ji=il1,il2)
                WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
                WRITE(numout,9403) ('   ',ji=il1,il2-1)
@@ -491,5 +543,5 @@
  9401    FORMAT('              '   ,20('   ',i3,'          ') )
  9402    FORMAT('       ',i3,' *  ',20(i3,'  x',i3,'   *   ') )
- 9404    FORMAT('           *  '   ,20('      ',i3,'   *   ') )
+ 9404    FORMAT('           *  '   ,20('     ' ,i4,'   *   ') )
       ENDIF
          
@@ -536,36 +588,31 @@
       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)
+      jpi    = ijpi(ii,ij)  
+!!$      Nis0  = iis0(ii,ij)
+!!$      Nie0  = iie0(ii,ij)
+      jpj    = ijpj(ii,ij)  
+!!$      Njs0  = ijs0(ii,ij)
+!!$      Nje0  = ije0(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
+      jpk = jpkglo                              ! third dim
+      !
+      CALL init_doloop                          ! set start/end indices of do-loop, depending on the halo width value (nn_hls) 
+      !
+      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)
+         jpiall (jproc) = ijpi(ii,ij)
+         nis0all(jproc) = iis0(ii,ij)
+         nie0all(jproc) = iie0(ii,ij)
+         jpjall (jproc) = ijpj(ii,ij)
+         njs0all(jproc) = ijs0(ii,ij)
+         nje0all(jproc) = ije0(ii,ij)
          ibonit(jproc) = ibondi(ii,ij)
          ibonjt(jproc) = ibondj(ii,ij)
@@ -581,10 +628,10 @@
          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 '
+         WRITE(inum,'(a)') 'nproc   jpi  jpj Nis0 Njs0 Nie0 Nje0 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),   &
+            WRITE(inum,'(13i5,2i7)')   jproc-1,  jpiall(jproc),  jpjall(jproc),   &
+               &                                nis0all(jproc), njs0all(jproc),   &
+               &                                nie0all(jproc), nje0all(jproc),   &
                &                                nimppt (jproc), njmppt (jproc),   & 
                &                                ii_nono(jproc), ii_noso(jproc),   &
@@ -620,11 +667,6 @@
          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
 
@@ -648,12 +690,12 @@
       ENDIF
       !
-      IF( ln_nnogather ) THEN
-         CALL mpp_init_nfdcom     ! northfold neighbour lists
+      CALL init_ioipsl       ! Prepare NetCDF output file (if necessary)
+      !      
+      IF (( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ).AND.( ln_nnogather )) THEN
+         CALL 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
@@ -665,5 +707,5 @@
       DEALLOCATE(iin, ijn, ii_nono, ii_noea, ii_noso, ii_nowe,    &
          &       iimppt, ijmppt, ibondi, ibondj, ipproc, ipolj,   &
-         &       ilci, ilcj, ilei, ilej, ildi, ildj,              &
+         &       ijpi, ijpj, iie0, ije0, iis0, ijs0,              &
          &       iono, ioea, ioso, iowe, llisoce)
       !
@@ -671,7 +713,7 @@
 
 
-    SUBROUTINE mpp_basic_decomposition( knbi, knbj, kimax, kjmax, kimppt, kjmppt, klci, klcj)
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE mpp_basic_decomposition  ***
+    SUBROUTINE mpp_basesplit( kiglo, kjglo, khls, knbi, knbj, kimax, kjmax, kimppt, kjmppt, klci, klcj)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_basesplit  ***
       !!                    
       !! ** Purpose :   Lay out the global domain over processors.
@@ -685,4 +727,6 @@
       !!                    klcj       : second dimension
       !!----------------------------------------------------------------------
+      INTEGER,                                 INTENT(in   ) ::   kiglo, kjglo
+      INTEGER,                                 INTENT(in   ) ::   khls
       INTEGER,                                 INTENT(in   ) ::   knbi, knbj
       INTEGER,                                 INTENT(  out) ::   kimax, kjmax
@@ -691,14 +735,15 @@
       !
       INTEGER ::   ji, jj
+      INTEGER ::   i2hls 
       INTEGER ::   iresti, irestj, irm, ijpjmin
-      INTEGER ::   ireci, irecj
-      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      i2hls = 2*khls
       !
 #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. 
+      kimax = ( nx_global+2-i2hls + (knbi-1) ) / knbi + i2hls    ! first  dim.
+      kjmax = ( ny_global+2-i2hls + (knbj-1) ) / knbj + i2hls    ! 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.
+      kimax = ( kiglo - i2hls + (knbi-1) ) / knbi + i2hls    ! first  dim.
+      kjmax = ( kjglo - i2hls + (knbj-1) ) / knbj + i2hls    ! second dim.
 #endif
       IF( .NOT. PRESENT(kimppt) ) RETURN
@@ -707,25 +752,23 @@
       ! -----------------------------------
       !  Computation of local domain sizes klci() klcj()
-      !  These dimensions depend on global sizes knbi,knbj and jpiglo,jpjglo
+      !  These dimensions depend on global sizes knbi,knbj and kiglo,kjglo
       !  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 )
+      iresti = 1 + MOD( kiglo - i2hls - 1 , knbi )
+      irestj = 1 + MOD( kjglo - i2hls - 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)
+      klci(1:knbi-1,:       ) = kimax
+      klci(  knbi  ,:       ) = kiglo - (knbi - 1) * (kimax - i2hls)
+      klcj(:       ,1:knbj-1) = kjmax
+      klcj(:       ,  knbj  ) = kjglo - (knbj - 1) * (kjmax - i2hls)
 #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'
+      IF( MINVAL(klci) < 2*i2hls ) THEN
+         WRITE(ctmp1,*) '   mpp_basesplit: minimum value of jpi must be >= ', 2*i2hls
          WRITE(ctmp2,*) '   We have ', MINVAL(klci)
         CALL ctl_stop( 'STOP', ctmp1, ctmp2 )
@@ -733,19 +776,17 @@
       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
+         IF( jperio == 3 .OR. jperio == 4 )   ijpjmin = 2+3*khls   ! V and F folding must be outside of southern halos
+         IF( jperio == 5 .OR. jperio == 6 )   ijpjmin = 1+3*khls   ! V and F folding must be outside of southern halos
+         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(:, 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
+         klcj(:, irestj+1:knbj  ) = kjmax-1
+      ENDIF
+      klcj(:,1:irestj) = kjmax
+      IF( MINVAL(klcj) < 2*i2hls ) THEN
+         WRITE(ctmp1,*) '   mpp_basesplit: minimum value of jpj must be >= ', 2*i2hls
          WRITE(ctmp2,*) '   We have ', MINVAL(klcj)
          CALL ctl_stop( 'STOP', ctmp1, ctmp2 )
@@ -761,5 +802,5 @@
          DO jj = 1, knbj
             DO ji = 2, knbi
-               kimppt(ji,jj) = kimppt(ji-1,jj) + klci(ji-1,jj) - ireci
+               kimppt(ji,jj) = kimppt(ji-1,jj) + klci(ji-1,jj) - i2hls
             END DO
          END DO
@@ -769,15 +810,15 @@
          DO jj = 2, knbj
             DO ji = 1, knbi
-               kjmppt(ji,jj) = kjmppt(ji,jj-1) + klcj(ji,jj-1) - irecj
+               kjmppt(ji,jj) = kjmppt(ji,jj-1) + klcj(ji,jj-1) - i2hls
             END DO
          END DO
       ENDIF
       
-   END SUBROUTINE mpp_basic_decomposition
-
-
-   SUBROUTINE mpp_init_bestpartition( knbij, knbi, knbj, knbcnt, ldlist )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE mpp_init_bestpartition  ***
+   END SUBROUTINE mpp_basesplit
+
+
+   SUBROUTINE bestpartition( knbij, knbi, knbj, knbcnt, ldlist )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE bestpartition  ***
       !!
       !! ** Purpose :
@@ -794,5 +835,5 @@
       INTEGER :: isziref, iszjref
       INTEGER :: inbij, iszij
-      INTEGER :: inbimax, inbjmax, inbijmax
+      INTEGER :: inbimax, inbjmax, inbijmax, inbijold
       INTEGER :: isz0, isz1
       INTEGER, DIMENSION(  :), ALLOCATABLE :: indexok
@@ -821,6 +862,6 @@
       inbimax = 0
       inbjmax = 0
-      isziref = jpiglo*jpjglo+1
-      iszjref = jpiglo*jpjglo+1
+      isziref = Ni0glo*Nj0glo+1
+      iszjref = Ni0glo*Nj0glo+1
       !
       ! get the list of knbi that gives a smaller jpimax than knbi-1
@@ -830,5 +871,5 @@
          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
+         iszitst = ( Ni0glo + (ji-1) ) / ji
 #endif
          IF( iszitst < isziref ) THEN
@@ -841,5 +882,5 @@
          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
+         iszjtst = ( Nj0glo + (ji-1) ) / ji
 #endif
          IF( iszjtst < iszjref ) THEN
@@ -881,6 +922,6 @@
       iszij1(:) = iszi1(:) * iszj1(:)
 
-      ! if therr is no land and no print
-      IF( .NOT. llist .AND. numbot == -1 ) THEN
+      ! if there 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)
@@ -896,5 +937,5 @@
       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
+      iszij = Ni0glo*Nj0glo+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
@@ -919,25 +960,37 @@
       DEALLOCATE( indexok, inbi1, inbj1, iszi1, iszj1 )
 
-      IF( llist ) THEN  ! we print about 21 best partitions
+      IF( llist ) THEN
          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,*) '                  For your information:'
+            WRITE(numout,*) '  list of the best partitions including land supression'
+            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)
+         ji = isz0   ! initialization with the largest value
+         ALLOCATE( llisoce(inbi0(ji), inbj0(ji)) )
+         CALL mpp_is_ocean( llisoce )   ! Warning: must be call by all cores (call mpp_sum)
+         inbijold = COUNT(llisoce)
+         DEALLOCATE( llisoce )
+         DO ji =isz0-1,1,-1
             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)
+            CALL mpp_is_ocean( 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),' )'
+            IF(lwp .AND. inbij < inbijold) THEN
+               WRITE(numout,'(a, i6, a, i6, a, f4.1, a, i9, a, i6, a, i6, a)')                                 &
+                  &   'nb_cores oce: ', inbij, ', land domains excluded: ', inbi0(ji)*inbj0(ji) - inbij,       &
+                  &   ' (', REAL(inbi0(ji)*inbj0(ji) - inbij,wp) / REAL(inbi0(ji)*inbj0(ji),wp) *100.,         &
+                  &   '%), largest oce domain: ', iszi0(ji)*iszj0(ji), ' ( ', iszi0(ji),' x ', iszj0(ji), ' )'
+               inbijold = inbij
+            END IF
          END DO
          DEALLOCATE( inbi0, inbj0, iszi0, iszj0 )
-         RETURN
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*)  '  -----------------------------------------------------------'
+         ENDIF
+         CALL mppsync
+         CALL mppstop( ld_abort = .TRUE. )
       ENDIF
       
@@ -948,5 +1001,5 @@
          ii = ii -1 
          ALLOCATE( llisoce(inbi0(ii), inbj0(ii)) )
-         CALL mpp_init_isoce( inbi0(ii), inbj0(ii), llisoce )            ! must be done by all core
+         CALL mpp_is_ocean( llisoce )            ! must be done by all core
          inbij = COUNT(llisoce)
          DEALLOCATE( llisoce )
@@ -957,5 +1010,5 @@
       DEALLOCATE( inbi0, inbj0 )
       !
-   END SUBROUTINE mpp_init_bestpartition
+   END SUBROUTINE bestpartition
    
    
@@ -966,5 +1019,5 @@
       !! ** 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
+      !! ** Method  : read iproc strips (of length Ni0glo) of the land-sea mask
       !!----------------------------------------------------------------------
       REAL(wp), INTENT(  out) :: propland    ! proportion of land points in the global domain (between 0 and 1)
@@ -977,5 +1030,5 @@
       !!----------------------------------------------------------------------
       ! do nothing if there is no land-sea mask
-      IF( numbot == -1 ) THEN
+      IF( numbot == -1 .and. numbdy == -1 ) THEN
          propland = 0.
          RETURN
@@ -983,5 +1036,5 @@
 
       ! 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
+      iproc = MINVAL( (/mppsize, Nj0glo/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
@@ -993,10 +1046,10 @@
       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 )
+         ijsz = Nj0glo / iproc                                               ! width of the stripe to read
+         IF( iarea < MOD(Nj0glo,iproc) ) ijsz = ijsz + 1
+         ijstr = iarea*(Nj0glo/iproc) + MIN(iarea, MOD(Nj0glo,iproc)) + 1    ! starting j position of the reading
+         !
+         ALLOCATE( lloce(Ni0glo, ijsz) )                                     ! allocate the strip
+         CALL readbot_strip( ijstr, ijsz, lloce )
          inboce = COUNT(lloce)                                               ! number of ocean point in the stripe
          DEALLOCATE(lloce)
@@ -1007,73 +1060,124 @@
       CALL mpp_sum( 'mppini', inboce )   ! total number of ocean points over the global domain
       !
-      propland = REAL( jpiglo*jpjglo - inboce, wp ) / REAL( jpiglo*jpjglo, wp ) 
+      propland = REAL( Ni0glo*Nj0glo - inboce, wp ) / REAL( Ni0glo*Nj0glo, 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
+   SUBROUTINE mpp_is_ocean( ldisoce )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_is_ocean  ***
+      !!
+      !! ** Purpose : Check for a mpi domain decomposition inbi x inbj which
+      !!              subdomains, including 1 halo (even if nn_hls>1), contain
+      !!              at least 1 ocean point.
+      !!              We must indeed ensure that each subdomain that is a neighbour
+      !!              of a land subdomain as only land points on its boundary
+      !!              (inside the inner subdomain) with the land subdomain.
+      !!              This is needed to get the proper bondary conditions on
+      !!              a subdomain with a closed boundary.
+      !!
+      !! ** Method  : read inbj strips (of length Ni0glo) of the land-sea mask
+      !!----------------------------------------------------------------------
+      LOGICAL, DIMENSION(:,:), INTENT(  out) ::   ldisoce        ! .true. if a sub domain constains 1 ocean point 
+      !
       INTEGER :: idiv, iimax, ijmax, iarea
+      INTEGER :: inbi, inbj, inx, iny, inry, isty
       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
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   inboce           ! number oce oce pint in each mpi subdomain
+      INTEGER, ALLOCATABLE, DIMENSION(:  ) ::   inboce_1d
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iimppt, ijpi
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ijmppt, ijpj
+      LOGICAL, ALLOCATABLE, DIMENSION(:,:) ::   lloce            ! lloce(i,j) = .true. if the point (i,j) is ocean 
       !!----------------------------------------------------------------------
       ! do nothing if there is no land-sea mask
-      IF( numbot == -1  ) THEN
+      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
+      !
+      inbi = SIZE( ldisoce, dim = 1 )
+      inbj = SIZE( ldisoce, dim = 2 )
+      !
+      ! we want to read inbj strips of the land-sea mask. -> pick up inbj processes every idiv processes starting at 1
+      IF           ( inbj == 1 ) THEN   ;   idiv = mppsize
+      ELSE IF ( mppsize < inbj ) THEN   ;   idiv = 1
+      ELSE                              ;   idiv = ( mppsize - 1 ) / ( inbj - 1 )
+      ENDIF
+      !
+      ALLOCATE( inboce(inbi,inbj), inboce_1d(inbi*inbj) )
       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
+      !
+      DO jn = 0, (inbj-1)/mppsize   ! if mppsize < inbj : more strips than mpi processes (because of potential land domains)
+         !
+         iarea = (narea-1)/idiv + jn * mppsize + 1                     ! involed process number (starting counting at 1)
+         IF( MOD( narea-1, idiv ) == 0 .AND. iarea <= inbj ) 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( iimppt(inbi,inbj), ijmppt(inbi,inbj), ijpi(inbi,inbj), ijpj(inbi,inbj) )
+            CALL mpp_basesplit( Ni0glo, Nj0glo, 0, inbi, inbj, iimax, ijmax, iimppt, ijmppt, ijpi, ijpj )
             !
-            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
+            inx = Ni0glo + 2   ;   iny = ijpj(1,iarea) + 2             ! strip size + 1 halo on each direction (even if nn_hls>1)
+            ALLOCATE( lloce(inx, iny) )                                ! allocate the strip
+            inry = iny - COUNT( (/ iarea == 1, iarea == inbj /) )      ! number of point to read in y-direction
+            isty = 1 + COUNT( (/ iarea == 1 /) )                       ! read from the first or the second line?
+            CALL readbot_strip( ijmppt(1,iarea) - 2 + isty, inry, lloce(2:inx-1, isty:inry+isty-1) )   ! read the strip
+            ! 
+            IF( iarea == 1    ) THEN                                   ! the first line was not read
+               IF( jperio == 2 .OR. jperio == 7 ) THEN                 !   north-south periodocity
+                  CALL readbot_strip( Nj0glo, 1, lloce(2:inx-1, 1) )   !   read the last line -> first line of lloce
+               ELSE
+                  lloce(2:inx-1,  1) = .FALSE.                         !   closed boundary
+               ENDIF
+            ENDIF
+            IF( iarea == inbj ) THEN                                   ! the last line was not read
+               IF( jperio == 2 .OR. jperio == 7 ) THEN                 !   north-south periodocity
+                  CALL readbot_strip( 1, 1, lloce(2:inx-1,iny) )       !      read the first line -> last line of lloce
+               ELSEIF( jperio == 3 .OR. jperio == 4 ) THEN             !   north-pole folding T-pivot, T-point 
+                  lloce(2,iny) = lloce(2,iny-2)                        !      here we have 1 halo (even if nn_hls>1)
+                  DO ji = 3,inx-1
+                     lloce(ji,iny  ) = lloce(inx-ji+2,iny-2)           !      ok, we have at least 3 lines
+                  END DO
+                  DO ji = inx/2+2,inx-1
+                     lloce(ji,iny-1) = lloce(inx-ji+2,iny-1)
+                  END DO
+               ELSEIF( jperio == 5 .OR. jperio == 6 ) THEN             !   north-pole folding F-pivot, T-point, 1 halo
+                  lloce(inx/2+1,iny-1) = lloce(inx/2,iny-1)            !      here we have 1 halo (even if nn_hls>1)
+                  lloce(inx  -1,iny-1) = lloce(2    ,iny-1)
+                  DO ji = 2,inx-1
+                     lloce(ji,iny) = lloce(inx-ji+1,iny-1)
+                  END DO
+               ELSE                                                    !   closed boundary
+                  lloce(2:inx-1,iny) = .FALSE.
+               ENDIF
+            ENDIF
+            !                                                          ! first and last column were not read
+            IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 ) THEN
+               lloce(1,:) = lloce(inx-1,:)   ;   lloce(inx,:) = lloce(2,:)   ! east-west periodocity
+            ELSE
+               lloce(1,:) = .FALSE.          ;   lloce(inx,:) = .FALSE.      ! closed boundary
+            ENDIF
+            !
+            DO  ji = 1, inbi
+               inboce(ji,iarea) = COUNT( lloce(iimppt(ji,1):iimppt(ji,1)+ijpi(ji,1)+1,:) )   ! lloce as 2 points more than Ni0glo
             END DO
             !
             DEALLOCATE(lloce)
-            DEALLOCATE(iimppt, ijmppt, ilci, ilcj)
+            DEALLOCATE(iimppt, ijmppt, ijpi, ijpj)
             !
          ENDIF
       END DO
    
-      inboce_1d = RESHAPE(inboce, (/ knbi*knbj /))
+      inboce_1d = RESHAPE(inboce, (/ inbi*inbj /))
       CALL mpp_sum( 'mppini', inboce_1d )
-      inboce = RESHAPE(inboce_1d, (/knbi, knbj/))
+      inboce = RESHAPE(inboce_1d, (/inbi, inbj/))
       ldisoce(:,:) = inboce(:,:) /= 0
-      !
-   END SUBROUTINE mpp_init_isoce
+      DEALLOCATE(inboce, inboce_1d)
+      !
+   END SUBROUTINE mpp_is_ocean
    
    
-   SUBROUTINE mpp_init_readbot_strip( kjstr, kjcnt, ldoce )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE mpp_init_readbot_strip  ***
+   SUBROUTINE readbot_strip( kjstr, kjcnt, ldoce )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE readbot_strip  ***
       !!
       !! ** Purpose : Read relevant bathymetric information in order to
@@ -1081,31 +1185,129 @@
       !!              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 
+      !! ** Method  : read stipe of size (Ni0glo,...)
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   kjstr       ! starting j position of the reading
+      INTEGER                         , INTENT(in   ) ::   kjcnt       ! number of lines to read
+      LOGICAL, DIMENSION(Ni0glo,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
+      REAL(wp), DIMENSION(Ni0glo,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/) )
+      IF( numbot /= -1 ) THEN   
+         CALL iom_get( numbot, jpdom_unknown, 'bottom_level', zbot, kstart = (/1,kjstr/), kcount = (/Ni0glo, kjcnt/) )
       ELSE
-         zbot(:,:) = 1.                         ! put a non-null value
-      ENDIF
-
-      !
-      ldoce(:,:) = zbot(:,:) > 0.
+         zbot(:,:) = 1._wp                      ! 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 = (/Ni0glo, kjcnt/) )
+         zbot(:,:) = zbot(:,:) * zbdy(:,:)
+      ENDIF
+      !
+      ldoce(:,:) = zbot(:,:) > 0._wp
       numout = inumsave
       !
-   END SUBROUTINE mpp_init_readbot_strip
-
-   SUBROUTINE mpp_init_nfdcom
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE  mpp_init_nfdcom  ***
+   END SUBROUTINE readbot_strip
+
+
+   SUBROUTINE mpp_getnum( ldisoce, kproc, kipos, kjpos )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_getnum  ***
+      !!
+      !! ** Purpose : give a number to each MPI subdomains (starting at 0)
+      !!
+      !! ** Method  : start from bottom left. First skip land subdomain, and finally use them if needed
+      !!----------------------------------------------------------------------
+      LOGICAL, DIMENSION(:,:), INTENT(in   ) ::   ldisoce     ! F if land process
+      INTEGER, DIMENSION(:,:), INTENT(  out) ::   kproc       ! subdomain number (-1 if supressed, starting at 0)
+      INTEGER, DIMENSION(  :), INTENT(  out) ::   kipos       ! i-position of the subdomain (from 1 to jpni)
+      INTEGER, DIMENSION(  :), INTENT(  out) ::   kjpos       ! j-position of the subdomain (from 1 to jpnj)
+      !
+      INTEGER :: ii, ij, jarea, iarea0
+      INTEGER :: icont, i2add , ini, inj, inij
+      !!----------------------------------------------------------------------
+      !
+      ini = SIZE(ldisoce, dim = 1)
+      inj = SIZE(ldisoce, dim = 2)
+      inij = SIZE(kipos)
+      !
+      ! specify which subdomains are oce subdomains; other are land subdomains
+      kproc(:,:) = -1
+      icont = -1
+      DO jarea = 1, ini*inj
+         iarea0 = jarea - 1
+         ii = 1 + MOD(iarea0,ini)
+         ij = 1 +     iarea0/ini
+         IF( ldisoce(ii,ij) ) THEN
+            icont = icont + 1
+            kproc(ii,ij) = icont
+            kipos(icont+1) = ii
+            kjpos(icont+1) = ij
+         ENDIF
+      END DO
+      ! if needed add some land subdomains to reach inij active subdomains
+      i2add = inij - COUNT( ldisoce )
+      DO jarea = 1, ini*inj
+         iarea0 = jarea - 1
+         ii = 1 + MOD(iarea0,ini)
+         ij = 1 +     iarea0/ini
+         IF( .NOT. ldisoce(ii,ij) .AND. i2add > 0 ) THEN
+            icont = icont + 1
+            kproc(ii,ij) = icont
+            kipos(icont+1) = ii
+            kjpos(icont+1) = ij
+            i2add = i2add - 1
+         ENDIF
+      END DO
+      !
+   END SUBROUTINE mpp_getnum
+
+
+   SUBROUTINE init_ioipsl
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE 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( :) = (/ Ni0glo, Nj0glo /)
+      iloc( :) = (/ Ni_0  , Nj_0   /)
+      iabsf(:) = (/ Nis0  , Njs0   /) + (/ nimpp, njmpp /) - 1 - nn_hls   ! corresponds to mig0(Nis0) but mig0 is not yet defined!
+      iabsl(:) = iabsf(:) + iloc(:) - 1
+      ihals(:) = (/ 0     , 0      /)
+      ihale(:) = (/ 0     , 0      /)
+      idid( :) = (/ 1     , 2      /)
+
+      IF(lwp) THEN
+          WRITE(numout,*)
+          WRITE(numout,*) 'mpp init_ioipsl :   iloc  = ', iloc
+          WRITE(numout,*) '~~~~~~~~~~~~~~~     iabsf = ', iabsf
+          WRITE(numout,*) '                    ihals = ', ihals
+          WRITE(numout,*) '                    ihale = ', ihale
+      ENDIF
+      !
+      CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom)
+      !
+   END SUBROUTINE init_ioipsl  
+
+
+   SUBROUTINE init_nfdcom
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE  init_nfdcom  ***
       !! ** Purpose :   Setup for north fold exchanges with explicit 
       !!                point-to-point messaging
@@ -1117,8 +1319,5 @@
       !!----------------------------------------------------------------------
       INTEGER  ::   sxM, dxM, sxT, dxT, jn
-      INTEGER  ::   njmppmax
-      !!----------------------------------------------------------------------
-      !
-      njmppmax = MAXVAL( njmppt )
+      !!----------------------------------------------------------------------
       !
       !initializes the north-fold communication variables
@@ -1126,8 +1325,8 @@
       nsndto     = 0
       !
-      IF ( njmpp == njmppmax ) THEN      ! if I am a process in the north
+      IF ( njmpp == MAXVAL( njmppt ) ) 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
+         sxM = jpiglo - nimppt(narea) - jpiall(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
@@ -1138,6 +1337,6 @@
          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
+            sxT = nfimpp(jn)                    ! sxT = 1st  point (in the global domain) of the jn process
+            dxT = nfimpp(jn) + nfjpi(jn) - 1    ! dxT = last point (in the global domain) of the jn process
             !
             IF    ( sxT < sxM  .AND.  sxM < dxT ) THEN
@@ -1153,21 +1352,47 @@
             !
          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
-
+   END SUBROUTINE init_nfdcom
 
 #endif
 
+   SUBROUTINE init_doloop
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE init_doloop  ***
+      !!
+      !! ** Purpose :   set the starting/ending indices of DO-loop
+      !!              These indices are used in do_loop_substitute.h90
+      !!----------------------------------------------------------------------
+      !
+      Nis0 =   1+nn_hls   ;   Nis1 = Nis0-1   ;   Nis2 = MAX(  1, Nis0-2)
+      Njs0 =   1+nn_hls   ;   Njs1 = Njs0-1   ;   Njs2 = MAX(  1, Njs0-2)  
+      !                                                 
+      Nie0 = jpi-nn_hls   ;   Nie1 = Nie0+1   ;   Nie2 = MIN(jpi, Nie0+2)
+      Nje0 = jpj-nn_hls   ;   Nje1 = Nje0+1   ;   Nje2 = MIN(jpj, Nje0+2)
+      !
+      IF( nn_hls == 1 ) THEN          !* halo size of 1
+         !
+         Nis1nxt2 = Nis0   ;   Njs1nxt2 = Njs0
+         Nie1nxt2 = Nie0   ;   Nje1nxt2 = Nje0
+         !
+      ELSE                            !* larger halo size... 
+         !
+         Nis1nxt2 = Nis1   ;   Njs1nxt2 = Njs1
+         Nie1nxt2 = Nie1   ;   Nje1nxt2 = Nje1
+         !
+      ENDIF
+      !
+      Ni_0 = Nie0 - Nis0 + 1
+      Nj_0 = Nje0 - Njs0 + 1
+      Ni_1 = Nie1 - Nis1 + 1
+      Nj_1 = Nje1 - Njs1 + 1
+      Ni_2 = Nie2 - Nis2 + 1
+      Nj_2 = Nje2 - Njs2 + 1
+      !
+   END SUBROUTINE init_doloop
+   
    !!======================================================================
 END MODULE mppini
Index: utils/tools/DOMAINcfg/src/nc4interface.f90
===================================================================
--- utils/tools/DOMAINcfg/src/nc4interface.f90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/nc4interface.f90	(revision 14623)
@@ -5,5 +5,5 @@
 ! See IOIPSL/IOIPSL_License_CeCILL.txt
 !---------------------------------------------------------------------
-
+#if ! defined key_netcdf4
       !!--------------------------------------------------------------------
       !! NOT 'key_netcdf4' Defines dummy routines for netcdf4
@@ -51,4 +51,73 @@
       SET_NF90_DEF_VAR_DEFLATE = -1
    END FUNCTION SET_NF90_DEF_VAR_DEFLATE
+#else
+      !!--------------------------------------------------------------------
+      !! 'key_netcdf4' Dummy module (usually defines dummy routines for netcdf4
+      !!               calls when compiling without netcdf4 libraries
+      !!--------------------------------------------------------------------
+
+   USE netcdf
+
+   !- netcdf4 chunking control structure
+   !- (optional on histbeg and histend calls)
+!$AGRIF_DO_NOT_TREAT
+   TYPE, PUBLIC :: snc4_ctl
+      SEQUENCE
+      INTEGER :: ni
+      INTEGER :: nj
+      INTEGER :: nk
+      LOGICAL :: luse
+   END TYPE snc4_ctl
+!$AGRIF_END_DO_NOT_TREAT
+
+CONTAINS
+   INTEGER FUNCTION SET_NF90_DEF_VAR_CHUNKING(nfid, nvid, ichunkalg, ichunksz)
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE NF90_DEF_VAR_CHUNKING  ***
+      !!
+      !! ** Purpose :   Interface NetCDF4 routine to enable compiling with NetCDF4 libraries
+      !!                but no key_netcdf4
+      !!--------------------------------------------------------------------
+      INTEGER,               INTENT(in) :: nfid
+      INTEGER,               INTENT(in) :: nvid
+      INTEGER,               INTENT(in) :: ichunkalg
+      INTEGER, DIMENSION(:), INTENT(in) :: ichunksz
+      !!
+      INTEGER                           :: iret
+      !!
+      iret = NF90_DEF_VAR_CHUNKING(nfid, nvid, ichunkalg, ichunksz)
+      SET_NF90_DEF_VAR_CHUNKING = iret
+   END FUNCTION SET_NF90_DEF_VAR_CHUNKING
+
+   INTEGER FUNCTION SET_NF90_DEF_VAR_DEFLATE(nfid, nvid, ishuffle, ideflate, ideflate_level)
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE NF90_DEF_VAR_DEFLATE  ***
+      !!
+      !! ** Purpose :   Interface NetCDF4 routine to enable compiling with NetCDF4 libraries
+      !!                but no key_netcdf4
+      !!--------------------------------------------------------------------
+      INTEGER,               INTENT(in) :: nfid
+      INTEGER,               INTENT(in) :: nvid
+      INTEGER,               INTENT(in) :: ishuffle
+      INTEGER,               INTENT(in) :: ideflate
+      INTEGER,               INTENT(in) :: ideflate_level
+      !!
+      INTEGER                           :: iret
+      !!
+      iret = NF90_DEF_VAR_DEFLATE(nfid, nvid, ishuffle, ideflate, ideflate_level)
+      SET_NF90_DEF_VAR_DEFLATE = iret
+   END FUNCTION SET_NF90_DEF_VAR_DEFLATE
+
+   SUBROUTINE GET_NF90_SYMBOL(sym_name, ivalue)
+      CHARACTER(len=*),      INTENT(in)  :: sym_name
+      INTEGER,               INTENT(out) :: ivalue
+      SELECT CASE (sym_name)
+         CASE ("NF90_HDF5")
+            ivalue = NF90_HDF5
+         CASE DEFAULT
+            WRITE(*,*) "Warning: unknown case in GET_NF90_SYMBOL"
+      END SELECT
+   END SUBROUTINE GET_NF90_SYMBOL
+#endif
 
 !------------------
Index: utils/tools/DOMAINcfg/src/nemogcm.F90
===================================================================
--- utils/tools/DOMAINcfg/src/nemogcm.F90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/nemogcm.F90	(revision 14623)
@@ -54,9 +54,10 @@
    USE lib_mpp        ! distributed memory computing
 
-   USE lbcnfd , ONLY  : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges 
 
    USE agrif_connect
    USE agrif_dom_update
    USE agrif_recompute_scales
+
+   USE halo_mng
 
    IMPLICIT NONE
@@ -106,5 +107,5 @@
       
       CALL Agrif_Step_Child_adj(agrif_update_all)
-      
+
       CALL Agrif_Step_Child(agrif_recompute_scalefactors)
       
@@ -122,7 +123,16 @@
       !                            !------------------------!
       !
-      IF( nstop /= 0 .AND. lwp ) THEN   ! error print
-         WRITE(numout,cform_err)
-         WRITE(numout,*) nstop, ' error have been found'
+      IF( nstop /= 0 .AND. lwp ) THEN        ! error print
+         ngrdstop = Agrif_Fixed()
+         WRITE(ctmp1,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found'
+         IF( ngrdstop > 0 ) THEN
+            WRITE(ctmp9,'(i2)') ngrdstop
+            WRITE(ctmp2,*) '           E R R O R detected in Agrif grid '//TRIM(ctmp9)
+            WRITE(ctmp3,*) '           Look for "E R R O R" messages in all existing '//TRIM(ctmp9)//'_ocean_output* files'
+            CALL ctl_stop( ' ', ctmp1, ' ', ctmp2, ' ', ctmp3 )
+         ELSE
+            WRITE(ctmp2,*) '           Look for "E R R O R" messages in all existing ocean_output* files'
+            CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 )
+         ENDIF
       ENDIF
       !
@@ -144,34 +154,69 @@
       CHARACTER(len=120), DIMENSION(60) ::   cltxt, cltxt2, clnam
       !!
+      NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl,                                &
+         &             nn_isplt,  nn_jsplt,  nn_ictls, nn_ictle, nn_jctls, nn_jctle  
       NAMELIST/namcfg/ ln_e3_dep,                                &
-         &             cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, &
-         &             jperio, ln_use_jattr, ln_domclo
-      !!----------------------------------------------------------------------
-      !
+         &             cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, Ni0glo, Nj0glo, &
+         &             jpkglo, jperio, ln_use_jattr, ln_domclo
+      !!----------------------------------------------------------------------
+      !
+
+      !
+      !                             !-------------------------------------------------!
+      !                             !     set communicator & select the local rank    !
+      !                             !  must be done as soon as possible to get narea  !
+      !                             !-------------------------------------------------!
+      !
+#if defined key_iomput
+      IF( Agrif_Root() ) THEN
+         IF( lk_oasis ) THEN
+            CALL cpl_init( "oceanx", ilocal_comm )                               ! nemo local communicator given by oasis
+            CALL xios_initialize( "not used"       , local_comm =ilocal_comm )   ! send nemo communicator to xios
+         ELSE
+            CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm )   ! nemo local communicator given by xios
+         ENDIF
+      ENDIF
+      CALL mpp_start( ilocal_comm )
+#else
+!      IF( lk_oasis ) THEN
+!         IF( Agrif_Root() ) THEN
+!            CALL cpl_init( "oceanx", ilocal_comm )          ! nemo local communicator given by oasis
+!         ENDIF
+!         CALL mpp_start( ilocal_comm )
+!      ELSE
+         CALL mpp_start( )
+!      ENDIF
+#endif
+      !
+      narea = mpprank + 1               ! mpprank: the rank of proc (0 --> mppsize -1 )
+      lwm = (narea == 1)                ! control of output namelists
+
       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 namcfg in reference namelist
+      !
+      !                             !---------------------------------------------------------------!
+      !                             ! Open output files, reference and configuration namelist files !
+      !                             !---------------------------------------------------------------!
+      !
+      ! open ocean.output as soon as possible to get all output prints (including errors messages)
+      IF( lwm )   CALL ctl_opn(     numout,        'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
+      ! open reference and configuration namelist files
+                  CALL load_nml( numnam_ref,        'namelist_ref',                                           -1, lwm )
+                  CALL load_nml( numnam_cfg,        'namelist_cfg',                                           -1, lwm )
+      IF( lwm )   CALL ctl_opn(     numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
+      ! open /dev/null file to be able to supress output write easily
+      IF( Agrif_Root() ) THEN
+                  CALL ctl_opn(     numnul,           '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
+#ifdef key_agrif
+      ELSE
+                  numnul = Agrif_Parent(numnul)   
+#endif
+      ENDIF
+
       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
+903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference 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
+904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist') 
+
       lwp = (narea == 1)                                    ! control of all listing output print
 
@@ -183,10 +228,26 @@
       ENDIF
 
-        IF(lwp) THEN                            ! open listing units
-         !
-         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+      !                             !--------------------!
+      !                             ! Open listing units !  -> need sn_cfctl from namctl to define lwp
+      !                             !--------------------!
+      !
+      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
+901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist' )
+      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
+902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist' )
+      !
+      ! finalize the definition of namctl variables
+      IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 )   &
+         &   CALL nemo_set_cfctl( sn_cfctl, .FALSE. )
+      !
+      lwp = (narea == 1) .OR. sn_cfctl%l_oceout    ! control of all listing output print
+      !
+      IF(lwp) THEN                      ! open listing units
+         !
+         IF( .NOT. lwm )   &            ! alreay opened for narea == 1
+            &            CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea )
          !
          WRITE(numout,*)
-         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC'
+         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC'
          WRITE(numout,*) '                       NEMO team'
          WRITE(numout,*) '            Ocean General Circulation Model'
@@ -204,25 +265,28 @@
          WRITE(numout,*) "       )  )       \) |`\ \)  '.   \      (   (   "
          WRITE(numout,*) "      (  (           \_/       '-._\      )   )  "
-         WRITE(numout,*) "       )  )                        `     (   (   "
+         WRITE(numout,*) "       )  ) jgs                     `    (   (   "
          WRITE(numout,*) "     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ "
          WRITE(numout,*)
          
-         DO ji = 1, SIZE(cltxt)
-            IF( TRIM(cltxt (ji)) /= '' )   WRITE(numout,*) TRIM(cltxt(ji))    ! control print of mynode
-         END DO
+         ! Print the working precision to ocean.output
+         IF (wp == dp) THEN
+            WRITE(numout,*) "Working precision = double-precision"
+         ELSE
+            WRITE(numout,*) "Working precision = single-precision"
+         ENDIF
          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(lwm) WRITE( numond, namctl )
+      !
+      !                             !-----------------------------------------!
+      !                             ! mpp parameters and domain decomposition !
+      !                             !-----------------------------------------!
+      CALL mpp_init
+      CALL halo_mng_init()
+      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
 
  !    IF( Agrif_Root() ) THEN
@@ -268,6 +332,4 @@
       !
       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( numout          /=  6 )   CLOSE( numout          )   ! standard model output file
@@ -299,4 +361,24 @@
    END SUBROUTINE nemo_alloc
 
+   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_set_cfctl  ***
+      !!
+      !! ** Purpose :   Set elements of the output control structure to setto.
+      !!
+      !! ** Method  :   Note this routine can be used to switch on/off some
+      !!                types of output for selected areas.
+      !!----------------------------------------------------------------------
+      TYPE(sn_ctl), INTENT(inout) :: sn_cfctl
+      LOGICAL     , INTENT(in   ) :: setto
+      !!----------------------------------------------------------------------
+      sn_cfctl%l_runstat = setto
+      sn_cfctl%l_trcstat = setto
+      sn_cfctl%l_oceout  = setto
+      sn_cfctl%l_layout  = setto
+      sn_cfctl%l_prtctl  = setto
+      sn_cfctl%l_prttrc  = setto
+      sn_cfctl%l_oasout  = setto
+   END SUBROUTINE nemo_set_cfctl
 
    SUBROUTINE nemo_partition( num_pes )
@@ -412,76 +494,4 @@
    END SUBROUTINE factorise
 
-
-   SUBROUTINE nemo_northcomms
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE  nemo_northcomms  ***
-      !! ** 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 I am a process in the north
-      IF ( njmpp == njmppmax ) THEN
-          !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 is the first point (in the global domain) of the jn
-                !process
-                sxT = nfiimpp(jn, jpnj)
-                !dxT is the last point (in the global domain) of the jn
-                !process
-                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1
-                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN
-                   nsndto = nsndto + 1
-                     isendto(nsndto) = jn
-                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN
-                   nsndto = nsndto + 1
-                     isendto(nsndto) = jn
-                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN
-                   nsndto = nsndto + 1
-                     isendto(nsndto) = jn
-                END IF
-          END DO
-          nfsloop = 1
-          nfeloop = nlci
-          DO jn = 2,jpni-1
-           IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN
-              IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN
-                 nfsloop = nldi
-              ENDIF
-              IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN
-                 nfeloop = nlei
-              ENDIF
-           ENDIF
-        END DO
-
-      ENDIF
-#if defined key_mpp_mpi
-      l_north_nogather = .TRUE.
-#endif
-   END SUBROUTINE nemo_northcomms
-
-
    !!======================================================================
 END MODULE nemogcm
Index: utils/tools/DOMAINcfg/src/par_kind.f90
===================================================================
--- utils/tools/DOMAINcfg/src/par_kind.f90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/par_kind.f90	(revision 14623)
@@ -24,5 +24,9 @@
    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)
+# if defined key_single
+   INTEGER, PUBLIC, PARAMETER ::   wp = sp                              !: working precision
+# else
    INTEGER, PUBLIC, PARAMETER ::   wp = dp                              !: working precision
+# endif
 
    !                                                                !!** Integer **
@@ -31,10 +35,11 @@
    
    !                                                                !!** Integer **
-   INTEGER, PUBLIC, PARAMETER ::   lc = 256                          !: Lenght of Character strings
+   INTEGER, PUBLIC, PARAMETER ::   lc  = 256                          !: Lenght of Character strings
+   INTEGER, PUBLIC, PARAMETER ::   lca = 400                          !: Lenght of Character arrays
 
    !!----------------------------------------------------------------------
-   !! 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)
+   !! NEMO 3.3 , NEMO Consortium (2018)
+   !! $Id: par_kind.F90 13226 2020-07-02 14:24:31Z orioltp $ 
+   !! Software governed by the CeCILL license (see ./LICENSE)
    !!----------------------------------------------------------------------
 END MODULE par_kind
Index: utils/tools/DOMAINcfg/src/par_oce.f90
===================================================================
--- utils/tools/DOMAINcfg/src/par_oce.f90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/par_oce.f90	(revision 14623)
@@ -28,5 +28,5 @@
    !!                   namcfg namelist parameters
    !!----------------------------------------------------------------------
-   LOGICAL       ::   ln_read_cfg = .FALSE.      !: (=T) read the domain configuration file or (=F) not
+   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
@@ -44,4 +44,8 @@
    !! Domain Matrix size 
    !!---------------------------------------------------------------------
+
+   ! time dimension
+   INTEGER, PUBLIC, PARAMETER :: jpt = 3    !: time dimension
+
    ! global domain size               !!! * total computational domain *
    INTEGER       ::   jpiglo           !: 1st dimension of global domain --> i-direction
@@ -85,6 +89,14 @@
    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)
 
+   ! halo with and starting/inding DO-loop indices
+   INTEGER, PUBLIC ::   nn_hls   !: halo width (applies to both rows and columns)
+   INTEGER, PUBLIC ::   Nis0, Nis1, Nis1nxt2, Nis2   !: start I-index (_0: without halo, _1 or _2: with 1 or 2 halos)
+   INTEGER, PUBLIC ::   Nie0, Nie1, Nie1nxt2, Nie2   !: end   I-index (_0: without halo, _1 or _2: with 1 or 2 halos)
+   INTEGER, PUBLIC ::   Njs0, Njs1, Njs1nxt2, Njs2   !: start J-index (_0: without halo, _1 or _2: with 1 or 2 halos)
+   INTEGER, PUBLIC ::   Nje0, Nje1, Nje1nxt2, Nje2   !: end   J-index (_0: without halo, _1 or _2: with 1 or 2 halos)
+   INTEGER, PUBLIC ::   Ni_0, Nj_0, Ni_1, Nj_1, Ni_2, Nj_2   !: domain size (_0: without halo, _1 or _2: with 1 or 2 halos)
+   INTEGER, PUBLIC ::   Ni0glo, Nj0glo
+   
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
Index: utils/tools/DOMAINcfg/src/restcom.f90
===================================================================
--- utils/tools/DOMAINcfg/src/restcom.f90	(revision 14623)
+++ utils/tools/DOMAINcfg/src/restcom.f90	(revision 14623)
@@ -0,0 +1,2548 @@
+MODULE restcom
+!$AGRIF_DO_NOT_TREAT
+!-
+!$Id: restcom.f90 2281 2010-10-15 14:21:13Z smasson $
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!-
+USE netcdf
+!-
+USE errioipsl, ONLY : ipslerr,ipsldbg
+USE stringop
+USE calendar
+USE mathelp
+USE fliocom,   ONLY : flio_dom_file,flio_dom_att
+!-
+IMPLICIT NONE
+!-
+PRIVATE
+!-
+PUBLIC :: &
+ &  restini, restget, restput, restclo, &
+ &  ioconf_setatt, ioget_vname, ioconf_expval, &
+ &  ioget_expval, ioget_vdim
+!-
+INTERFACE restput
+  MODULE PROCEDURE &
+ &  restput_r3d, restput_r2d, restput_r1d, &
+ &  restput_opp_r2d, restput_opp_r1d
+END INTERFACE
+!-
+INTERFACE restget
+  MODULE PROCEDURE &
+ &  restget_r3d,restget_r2d,restget_r1d, &
+ &  restget_opp_r2d,restget_opp_r1d
+END INTERFACE
+!-
+! We do not use allocatable arrays because these sizes are safe
+! and we do not know from start how many variables will be in
+! the out file.
+!-
+  INTEGER,PARAMETER :: &
+ &  max_var=500, max_file=50, max_dim=NF90_MAX_VAR_DIMS
+!-
+  CHARACTER(LEN=9),SAVE :: calend_str='unknown'
+!-
+! The IDs of the netCDF files are going in pairs.
+! The input one (netcdf_id(?,1)) and the output one (netcdf_id(?,2))
+!-
+  INTEGER,SAVE :: nb_fi = 0
+  INTEGER,DIMENSION(max_file,2),SAVE :: netcdf_id = -1
+!-
+! Description of the content of the 'in' files and the 'out' files.
+!   Number of variables   : nbvar_*
+!   Number of dimensions  : nbdim_*
+!   ID of the time axis   : tdimid_*
+!-
+  INTEGER,SAVE :: nbvar_in(max_file), nbvar_out(max_file)
+  INTEGER,SAVE :: tdimid_in(max_file), tdimid_out(max_file)
+!-
+! Variables for one or the other file
+!-
+! Number of dimensions in the input file               : nbdim_in
+! Number of variables read so far from the input file  : nbvar_read
+! Type of variable read from the input file            : vartyp_in
+!   (Could be used later to test if we have a restart file)
+!-
+  INTEGER,SAVE :: nbdim_in(max_file), nbvar_read(max_file)
+  INTEGER,SAVE :: vartyp_in(max_file, max_var)
+!-
+! Time step and time origine in the input file.
+!-
+  REAL,DIMENSION(max_file),SAVE :: deltat,timeorig
+!-
+! Description of the axes in the output file
+!-
+!   tstp_out  : Index on the tie axis currently beeing written
+!   itau_out  : Time step which is written on this index of the file
+!-
+  INTEGER,DIMENSION(max_file),SAVE :: tstp_out,itau_out
+!-
+! Description of the axes in the output file
+!-
+! For the ?ax_infs variable the following order is used :
+!   ?ax_infs (if,in,1) = size of axis
+!   ?ax_infs (if,in,2) = id of dimension
+! Number of x,y and z axes in the output file :
+!   ?ax_nb(if)
+!-
+  INTEGER,DIMENSION(max_file,max_dim,2),SAVE :: &
+ &  xax_infs,yax_infs,zax_infs
+  INTEGER,DIMENSION(max_file),SAVE :: &
+ &  xax_nb=0,yax_nb=0,zax_nb=0
+!-
+! Description of the time axes in the input and output files
+!-
+!   ID of the variable which contains the itaus :
+!     tind_varid_*
+!   ID of the variables which contains the seconds since date :
+!     tax_varid_*
+!   Size of the time axis in the input file :
+!     tax_size_in
+!-
+  INTEGER,SAVE :: tind_varid_in(max_file),  tax_varid_in(max_file), &
+ &                tind_varid_out(max_file), tax_varid_out(max_file)
+  INTEGER,SAVE :: tax_size_in(max_file)=1
+!-
+! The two time axes we have in the input file :
+!   t_index   : dates in itaus
+!               (thus the variable has a tstep_sec attribute)
+!   t_julian  : Julian days of the time axis
+!-
+  INTEGER,SAVE,ALLOCATABLE :: t_index(:,:)
+  REAL,SAVE,ALLOCATABLE :: t_julian(:,:)
+!-
+! Here we save a number of informations on the variables
+! in the files we are handling
+!-
+! Name of variables :                                    varname_*
+! ID of the variables :                                  varid_*
+! Number of dimensions of the variable :                 varnbdim_*
+! Dimensions which are used for the variable :           vardims_*
+! Number of attributes for a variables :                 varatt_*
+! A flag which markes the variables we have worked on :  touched_*
+!-
+  CHARACTER(LEN=20),DIMENSION(max_file,max_var),SAVE :: &
+ &  varname_in,varname_out
+  INTEGER,DIMENSION(max_file,max_var),SAVE :: &
+ &  varid_in,varid_out,varnbdim_in,varatt_in
+  INTEGER,DIMENSION(max_file,max_var,max_dim),SAVE :: &
+ &  vardims_in
+  LOGICAL,DIMENSION(max_file,max_var),SAVE :: &
+ &  touched_in,touched_out
+!-
+  CHARACTER(LEN=120),SAVE :: indchfun= 'scatter, fill, gather, coll'
+  REAL,PARAMETER :: missing_val=1.e20
+!                or HUGE(1.0) (maximum real number)
+!-
+! The default value we will use for variables
+! which are not present in the restart file
+!-
+  REAL,SAVE :: val_exp =  999999.
+  LOGICAL,SAVE :: lock_valexp = .FALSE.
+!-
+! Temporary variables in which we store the attributed which are going
+! to be given to a new variable which is going to be defined.
+!-
+  CHARACTER(LEN=80),SAVE :: rest_units='XXXXX',rest_lname='XXXXX'
+!-
+! For allocations
+!-
+  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: buff_tmp1,buff_tmp2
+!-
+!===
+CONTAINS
+!===
+!-
+SUBROUTINE restini &
+ & (fnamein,iim,jjm,lon,lat,llm,lev, &
+ &  fnameout,itau,date0,dt,fid,owrite_time_in,domain_id)
+!---------------------------------------------------------------------
+!- This subroutine sets up all the restart process.
+!- It will call the subroutine which opens the input
+!- and output files.
+!- The time step (itau), date of origine (date0) and time step are
+!- READ from the input file.
+!- A file ID, which is common to the input and output file is returned
+!-
+!- If fnamein = fnameout then the same file is used for the reading
+!- the restart conditions and writing the new restart.
+!-
+!- A special mode can be switched in with filename='NONE'.
+!- This means that no restart file is present.
+!- Usefull for creating the first restart file
+!- or to get elements in a file without creating an output file.
+!-
+!- A mode needs to be written in which itau, date0 and dt
+!- are given to the restart process and thus
+!- written into the output restart file.
+!-
+!- INPUT
+!-
+!- fnamein  : name of the file for the restart
+!- iim      : Dimension in x
+!- jjm      : Dimension in y
+!- lon      : Longitude in the x,y domain
+!- lat      : Latitude in the x,y domain
+!- llm      : Dimension in the vertical
+!- lev      : Positions of the levels
+!- fnameout :
+!-
+!- OUTPUT
+!-
+!- itau     : Time step of the restart file and at which the model
+!-            should restart
+!- date0    : Time at which itau = 0
+!- dt       : time step in seconds between two succesiv itaus
+!- fid      : File identification of the restart file
+!-
+!- Optional INPUT arguments
+!-
+!- owrite_time_in : logical  argument which allows to
+!-                  overwrite the time in the restart file
+!- domain_id      : Domain identifier
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: fnamein,fnameout
+  INTEGER :: iim,jjm,llm,fid,itau
+  REAL :: lon(iim,jjm),lat(iim,jjm),lev(llm)
+  REAL :: date0,dt
+  LOGICAL,OPTIONAL :: owrite_time_in
+  INTEGER,INTENT(IN),OPTIONAL :: domain_id
+!-
+  INTEGER :: ncfid
+  REAL :: dt_tmp,date0_tmp
+  LOGICAL :: l_fi,l_fo,l_rw
+  LOGICAL :: overwrite_time
+  CHARACTER(LEN=120) :: fname
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 0.0 Prepare the configuration before opening any files
+!-
+  IF (.NOT.PRESENT(owrite_time_in)) THEN
+    overwrite_time = .FALSE.
+  ELSE
+    overwrite_time = owrite_time_in
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'restini 0.0 : ',TRIM(fnamein),' , ',TRIM(fnameout)
+  ENDIF
+!-
+  nb_fi = nb_fi+1
+!-
+  IF (nb_fi > max_file) THEN
+    CALL ipslerr (3,'restini',&
+ &   'Too many restart files are used. The problem can be',&
+ &   'solved by increasing max_file in restcom.f90 ',&
+ &   'and recompiling ioipsl.')
+  ENDIF
+!-
+! 0.1 Define the open flags
+!-
+  l_fi = (TRIM(fnamein)  /= 'NONE')
+  l_fo = (TRIM(fnameout) /= 'NONE')
+  IF ((.NOT.l_fi).AND.(.NOT.l_fo)) THEN
+    CALL ipslerr (3,'restini',&
+ &   'Input and output file names are both to NONE.',&
+ &   'It is probably an error.','Verify your logic.')
+  ENDIF
+  l_rw = l_fi.AND.l_fo.AND.(TRIM(fnamein) == TRIM(fnameout))
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'restini 0.1 l_fi, l_fo, l_rw : ',l_fi,l_fo,l_rw
+  ENDIF
+!-
+! 1.0 Open the input file.
+!-
+  IF (l_fi) THEN
+!---
+    IF (l_dbg) WRITE(*,*) 'restini 1.0 : Open input file'
+!-- Add DOMAIN number and ".nc" suffix in file names if needed
+    fname = fnamein
+    CALL flio_dom_file (fname,domain_id)
+!-- Open the file
+    CALL restopenin (nb_fi,fname,l_rw,iim,jjm,lon,lat,llm,lev,ncfid)
+    netcdf_id(nb_fi,1) = ncfid
+!---
+!-- 1.3 Extract the time information
+!---
+    IF (overwrite_time) THEN
+       date0_tmp = date0
+    ENDIF
+    CALL restsett (dt_tmp,date0_tmp,itau,overwrite_time)
+    IF (.NOT.overwrite_time) THEN
+      dt = dt_tmp
+      date0 = date0_tmp
+    ENDIF
+!---
+  ELSE
+!---
+!-- 2.0 The case of a missing restart file is dealt with
+!---
+    IF (l_dbg) WRITE(*,*) 'restini 2.0'
+!---
+    IF (     (ALL(MINLOC(lon(:iim,:jjm)) == MAXLOC(lon(:iim,:jjm)))) &
+        .AND.(iim > 1) ) THEN
+      CALL ipslerr (3,'restini',&
+        & 'For creating a restart file the longitudes of the',&
+        & 'grid need to be provided to restini. This ',&
+        & 'information is needed for the restart files')
+    ENDIF
+    IF (     (ALL(MINLOC(lat(:iim,:jjm)) == MAXLOC(lat(:iim,:jjm)))) &
+        .AND.(jjm > 1) ) THEN
+      CALL ipslerr (3,'restini',&
+        & 'For creating a restart file the latitudes of the',&
+        & 'grid need to be provided to restini. This ',&
+        & 'information is needed for the restart files')
+    ENDIF
+    IF (     (ALL(MINLOC(lev(:llm)) == MAXLOC(lev(:llm)))) &
+        .AND.(llm > 1) ) THEN
+      CALL ipslerr (3,'restini',&
+        & 'For creating a restart file the levels of the',&
+        & 'grid need to be provided to restini. This',&
+        & 'information is needed for the restart files')
+    ENDIF
+!---
+!-- 2.2 Allocate the time axes and write the inputed variables
+!---
+    tax_size_in(nb_fi) = 1
+    CALL rest_atim (l_dbg,'restini')
+    t_index(nb_fi,1) = itau
+    t_julian(nb_fi,1) = date0
+  ENDIF
+!-
+  IF (l_fo.AND.(.NOT.l_rw)) THEN
+!-- Add DOMAIN number and ".nc" suffix in file names if needed
+    fname = fnameout
+    CALL flio_dom_file (fname,domain_id)
+!-- Open the file
+    CALL restopenout &
+      (nb_fi,fname,iim,jjm,lon,lat,llm,lev,dt,date0,ncfid,domain_id)
+    netcdf_id(nb_fi,2) = ncfid
+  ELSE IF (l_fi.AND.l_fo) THEN
+    netcdf_id(nb_fi,2) = netcdf_id(nb_fi,1)
+    varname_out(nb_fi,:) = varname_in(nb_fi,:)
+    nbvar_out(nb_fi) = nbvar_in(nb_fi)
+    tind_varid_out(nb_fi) = tind_varid_in(nb_fi)
+    tax_varid_out(nb_fi) = tax_varid_in(nb_fi)
+    varid_out(nb_fi,:) = varid_in(nb_fi,:)
+    touched_out(nb_fi,:) = .TRUE.
+  ENDIF
+!-
+! 2.3 Set the calendar for the run.
+!     This should not produce any error message if
+!     This does not mean any change in calendar
+!     (to be modified in ioconf_calendar)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'restini 2.3 : Configure calendar if needed : ', &
+                calend_str
+  ENDIF
+!-
+  IF (INDEX(calend_str,'unknown') < 1) THEN
+    CALL ioconf_calendar (calend_str)
+    IF (l_dbg) THEN
+      WRITE(*,*) 'restini 2.3b : new calendar : ',calend_str
+    ENDIF
+  ENDIF
+!-
+! Save some data in the module
+!-
+  deltat(nb_fi) = dt
+!-
+! Prepare the variables which will be returned
+!-
+  fid = nb_fi
+  IF (l_dbg) THEN
+    WRITE(*,*) 'SIZE of t_index :',SIZE(t_index), &
+               SIZE(t_index,dim=1),SIZE(t_index,dim=2)
+    WRITE(*,*) 't_index = ',t_index(fid,:)
+  ENDIF
+  itau = t_index(fid,1)
+!-
+  IF (l_dbg) WRITE(*,*) 'restini END'
+!---------------------
+END SUBROUTINE restini
+!===
+SUBROUTINE restopenin &
+  (fid,fname,l_rw,iim,jjm,lon,lat,llm,lev,ncfid)
+!---------------------------------------------------------------------
+!- Opens the restart file and checks that it belongsd to the model.
+!- This means that the coordinates of the model are compared to the
+!- ones in the file.
+!-
+!- The number and name of variable in the file are exctracted. Also
+!- the time details.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: fid,iim,jjm,llm
+  CHARACTER(LEN=*),INTENT(IN) :: fname
+  REAL :: lon(iim,jjm),lat(iim,jjm),lev(llm)
+  LOGICAL,INTENT(IN) :: l_rw
+  INTEGER,INTENT(OUT) :: ncfid
+!-
+  INTEGER,DIMENSION(max_dim) :: var_dims,dimlen
+  INTEGER :: nb_dim,nb_var,id_unl,id,iv
+  INTEGER :: iread,jread,lread,iret
+  INTEGER :: lon_vid,lat_vid
+  REAL :: lon_read(iim,jjm),lat_read(iim,jjm)
+  REAL :: lev_read(llm)
+  REAL :: mdlon,mdlat
+  CHARACTER(LEN=80) :: units
+  CHARACTER(LEN=NF90_max_name),DIMENSION(max_dim) :: dimname
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! If we reuse the same file for input and output
+! then we open it in write mode
+!-
+  IF (l_rw) THEN; id = NF90_WRITE; ELSE; id = NF90_NOWRITE; ENDIF
+  iret = NF90_OPEN(fname,id,ncfid)
+  IF (iret /= NF90_NOERR) THEN
+    CALL ipslerr (3,'restopenin','Could not open file :',fname,' ')
+  ENDIF
+!-
+  IF (l_dbg) WRITE (*,*) "restopenin 0.0 ",TRIM(fname)
+  iret = NF90_INQUIRE(ncfid,nDimensions=nb_dim, &
+ &         nVariables=nb_var,unlimitedDimId=id_unl)
+  tdimid_in(fid) = id_unl
+!-
+  IF (nb_dim > max_dim) THEN
+    CALL ipslerr (3,'restopenin',&
+      & 'More dimensions present in file that can be store',&
+      & 'Please increase max_dim in the global variables ',&
+      & 'in restcom.F90')
+  ENDIF
+  IF (nb_var > max_var) THEN
+    CALL ipslerr (3,'restopenin',&
+      & 'More variables present in file that can be store',&
+      & 'Please increase max_var in the global variables ',&
+      & 'in restcom.F90')
+  ENDIF
+!-
+  nbvar_in(fid) = nb_var
+  nbdim_in(fid) = nb_dim
+  iread = -1; jread = -1; lread = -1;
+  DO id=1,nb_dim
+    iret = NF90_INQUIRE_DIMENSION(ncfid,id, &
+ &           len=dimlen(id),name=dimname(id))
+    IF (l_dbg) THEN
+      WRITE (*,*) "restopenin 0.0 dimname",id,TRIM(dimname(id))
+    ENDIF
+    IF      (TRIM(dimname(id)) == 'x') THEN
+      iread = dimlen(id)
+      IF (l_dbg) WRITE (*,*) "iread",iread
+    ELSE IF (TRIM(dimname(id)) == 'y') THEN
+      jread = dimlen(id)
+      IF (l_dbg) WRITE (*,*) "jread",jread
+    ELSE IF (TRIM(dimname(id)) == 'z') THEN
+      lread = dimlen(id)
+      IF (l_dbg) WRITE (*,*) "lread",lread
+    ENDIF
+  ENDDO
+!-
+  IF (id_unl > 0) THEN
+!---
+!-- 0.1 If we are going to add values to this file
+!--     we need to know where it ends
+!--     We also need to have all the dimensions in the file
+!---
+    IF (l_rw) THEN
+      tstp_out(fid) = dimlen(id_unl)
+      itau_out(fid) = -1
+      tdimid_out(fid) =  tdimid_in(fid)
+      IF (l_dbg) THEN
+        WRITE (*,*) &
+ &       "restopenin 0.0 unlimited axis dimname", &
+ &       dimname(id_unl),tstp_out(fid)
+      ENDIF
+!-----
+      xax_nb(fid) = 0
+      yax_nb(fid) = 0
+      zax_nb(fid) = 0
+!-----
+      DO id=1,nb_dim
+        IF      (dimname(id)(1:1) == 'x') THEN
+          xax_nb(fid) = xax_nb(fid)+1
+          xax_infs(fid,xax_nb(fid),1) = dimlen(id)
+          xax_infs(fid,xax_nb(fid),2) = id
+        ELSE IF (dimname(id)(1:1) == 'y') THEN
+          yax_nb(fid) = yax_nb(fid)+1
+          yax_infs(fid,yax_nb(fid),1) = dimlen(id)
+          yax_infs(fid,yax_nb(fid),2) = id
+        ELSE IF (dimname(id)(1:1) == 'z') THEN
+          zax_nb(fid) = zax_nb(fid)+1
+          zax_infs(fid,zax_nb(fid),1) = dimlen(id)
+          zax_infs(fid,zax_nb(fid),2) = id
+        ENDIF
+      ENDDO
+    ENDIF
+  ELSE
+!---
+!-- Still need to find a method for dealing with this
+!---
+!  CALL ipslerr (3,'restopenin',&
+!    & ' We do not deal yet with files without time axis.',' ',' ')
+  ENDIF
+!-
+! 1.0 First let us check that we have the righ restart file
+!-
+  IF ((iread /= iim).OR.(jread /= jjm).OR.(lread /= llm)) THEN
+    CALL ipslerr (3,'restopenin',&
+ &    'The grid of the restart file does not correspond',&
+ &    'to that of the model',' ')
+  ENDIF
+!-
+! 2.0 Get the list of variables
+!-
+  IF (l_dbg) WRITE(*,*) 'restopenin 1.2'
+!-
+  lat_vid = -1
+  lon_vid = -1
+  tind_varid_in(fid) = -1
+  tax_varid_in(fid) = -1
+!-
+  DO iv=1,nb_var
+!---
+    varid_in(fid,iv) = iv
+    var_dims(:) = 0
+    iret = NF90_INQUIRE_VARIABLE(ncfid,iv, &
+ &           name=varname_in(fid,iv),xtype=vartyp_in(fid,iv), &
+ &           ndims=varnbdim_in(fid,iv),dimids=var_dims, &
+ &           nAtts=varatt_in(fid,iv))
+!---
+    DO id=1,varnbdim_in(fid,iv)
+      iret = NF90_INQUIRE_DIMENSION &
+ &             (ncfid,var_dims(id),len=vardims_in(fid,iv,id))
+    ENDDO
+!---
+!-- 2.1 Read the units of the variable
+!---
+    units=''
+    iret = NF90_GET_ATT(ncfid,iv,'units',units)
+    CALL strlowercase (units)
+    CALL cmpblank (units)
+!---
+!-- 2.2 Catch the time variables
+!---
+    IF (varnbdim_in(fid,iv) == 1) THEN
+      IF (     (INDEX(units,'timesteps since') > 0) &
+          .AND.(tind_varid_in(fid) < 0) ) THEN
+        tind_varid_in(fid) = iv
+        tax_size_in(fid) = vardims_in(fid,iv,1)
+      ENDIF
+      IF (     (INDEX(units,'seconds since') > 0) &
+          .AND.(tax_varid_in(fid) < 0) ) THEN
+        tax_varid_in(fid) = iv
+        tax_size_in(fid) = vardims_in(fid,iv,1)
+      ENDIF
+    ENDIF
+!---
+!-- 2.3 Catch longitude and latitude variables
+!---
+    IF      (INDEX(units,'degrees_nort') > 0) THEN
+      lat_vid = iv
+    ELSE IF (INDEX(units,'degrees_east') > 0) THEN
+      lon_vid = iv
+    ENDIF
+!---
+  ENDDO
+!-
+! 2.4 None of the variables was yet read
+!-
+  nbvar_read(fid) = 0
+  touched_in(fid,:) = .FALSE.
+!-
+! 3.0 Reading the coordinates from the input restart file
+!-
+  lon_read = missing_val
+  lat_read = missing_val
+!-
+  IF (lon_vid < 0 .OR. lat_vid < 0) THEN
+    CALL ipslerr (3,'restopenin',&
+      & ' No variables containing longitude or latitude were ',&
+      & ' found in the restart file.',' ')
+  ELSE
+    iret = NF90_GET_VAR(ncfid,lon_vid,lon_read)
+    iret = NF90_GET_VAR(ncfid,lat_vid,lat_read)
+!---
+    IF (  (ABS( MAXVAL(lon(:,:)) &
+ &             -MINVAL(lon(:,:))) < EPSILON(MAXVAL(lon(:,:)))) &
+ &   .AND.(ABS( MAXVAL(lat(:,:)) &
+ &             -MINVAL(lat(:,:))) < EPSILON(MAXVAL(lat(:,:)))) ) THEN
+!-----
+!---- 3.1 No longitude nor latitude are provided thus
+!---- they are taken from the restart file
+!-----
+      lon(:,:) = lon_read(:,:)
+      lat(:,:) = lat_read(:,:)
+    ELSE
+!-----
+!---- 3.2 We check that the longitudes and latitudes
+!----     in the file and the model are the same
+!-----
+      mdlon = MAXVAL(ABS(lon_read-lon))
+      mdlat = MAXVAL(ABS(lat_read-lat))
+!-----
+!---- We can not test against epsilon here as the longitude
+!---- can be stored at another precision in the netCDF file.
+!---- The test here does not need to be very precise.
+!-----
+      IF (mdlon > 1.e-4 .OR. mdlat > 1.e-4) THEN
+        CALL ipslerr (3,'restopenin',&
+          & ' The longitude or latitude found in the restart ',&
+          & ' file are not the same as the ones used in the model.',&
+          & ' ')
+      ENDIF
+    ENDIF
+  ENDIF
+!------------------------
+END SUBROUTINE restopenin
+!===
+SUBROUTINE restsett (timestep,date0,itau,owrite_time_in)
+!---------------------------------------------------------------------
+!- Here we get all the time information from the file.
+!-
+!- The time information can come in three forms :
+!- -global attributes which give the time origine and the
+!-  time step is taken from the input to restinit
+!- -A physical time exists and thus the julian date from the
+!-  input is used for positioning using the itau as input
+!- -A time-step axis exists and itau is positioned on it.
+!-
+!- What takes precedence : the model
+!-
+!- itau     : Time step of the model
+!-
+!- Optional INPUT arguments
+!-
+!- owrite_time_in : logical  argument which allows to
+!-                  overwrite the time in the restart file
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  REAL :: date0,timestep
+  INTEGER :: itau
+  LOGICAL,OPTIONAL :: owrite_time_in
+!-
+  INTEGER :: ncfid,iret,it,iax,iv
+  CHARACTER(LEN=80) :: itau_orig,tax_orig,calendar
+  CHARACTER(LEN=9) :: tmp_cal
+  INTEGER :: year0,month0,day0,hours0,minutes0,seci
+  REAL :: sec0,one_day,one_year,date0_ju,ttmp
+  CHARACTER :: strc
+  LOGICAL :: ow_time
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (PRESENT(owrite_time_in)) THEN
+    ow_time = owrite_time_in
+  ELSE
+    ow_time = .FALSE.
+  ENDIF
+!-
+  ncfid = netcdf_id(nb_fi,1)
+!-
+! Allocate the space we need for the time axes
+!-
+  CALL rest_atim (l_dbg,'restsett')
+!-
+! Get the calendar if possible. Else it will be gregorian.
+!-
+  IF (tax_size_in(nb_fi) > 0) THEN
+    calendar = ' '
+    iret = NF90_GET_ATT(ncfid,tax_varid_in(nb_fi),'calendar',calendar)
+    IF (iret == NF90_NOERR) THEN
+      CALL ioconf_calendar (calendar)
+      IF (l_dbg) THEN
+        WRITE(*,*) 'restsett : calendar of the restart ',calendar
+      ENDIF
+    ENDIF
+  ENDIF
+  CALL ioget_calendar (one_year,one_day)
+  IF (l_dbg) THEN
+    WRITE(*,*) 'one_year,one_day = ',one_year,one_day
+  ENDIF
+!-
+  itau_orig = 'XXXXX'
+  tax_orig  = 'XXXXX'
+!-
+! Get the time steps of the time axis if available on the restart file
+!-
+  IF (tind_varid_in(nb_fi) > 0) THEN
+    IF (ow_time) THEN
+      t_index(nb_fi,:) = itau
+      IF (l_dbg) THEN
+        WRITE(*,*) "nb_fi,t_index",nb_fi,t_index(nb_fi,:)
+      ENDIF
+      CALL ju2ymds (date0,year0,month0,day0,sec0)
+      hours0 = NINT(sec0/3600)
+      sec0 = sec0 - 3600 * hours0
+      minutes0 = NINT(sec0 / 60)
+      sec0 = sec0 - 60 * minutes0
+      seci = NINT(sec0)
+      strc=':'
+      IF (l_dbg) THEN
+        WRITE(*,*) date0
+        WRITE (UNIT=itau_orig,FMT='(I4.4,5(A,I2.2))') &
+ &       year0,'-',month0,'-',day0,' ',hours0,':',minutes0,':',seci
+        WRITE(*,*) "itau_orig : ",itau_orig
+      ENDIF
+    ELSE
+      iret = NF90_GET_VAR(ncfid,tind_varid_in(nb_fi),t_index(nb_fi,:))
+      IF (l_dbg) THEN
+        WRITE(*,*) "restsett, time axis : ",t_index(nb_fi,:)
+      ENDIF
+      iret = NF90_GET_ATT(ncfid,tind_varid_in(nb_fi),'units',itau_orig)
+      itau_orig = &
+ &      itau_orig(INDEX(itau_orig,'since')+6:LEN_TRIM(itau_orig))
+      iret = &
+ &      NF90_GET_ATT(ncfid,tind_varid_in(nb_fi),'tstep_sec',timestep)
+!-----
+!---- This time origin will dominate as it is linked to the time steps.
+!-----
+      READ (UNIT=itau_orig,FMT='(I4.4,5(A,I2.2))') &
+ &      year0,strc,month0,strc,day0,strc, &
+ &      hours0,strc,minutes0,strc,seci
+      sec0 = REAL(seci)
+      sec0 = hours0*3600.+minutes0*60.+sec0
+      CALL ymds2ju (year0,month0,day0,sec0,date0)
+    ENDIF
+  ENDIF
+!-
+! If a julian day time axis is available then we get it
+!-
+  IF (tax_varid_in(nb_fi) > 0) THEN
+    iret = NF90_GET_VAR(ncfid,tax_varid_in(nb_fi),t_julian(nb_fi,:))
+    iret = NF90_GET_ATT(ncfid,tax_varid_in(nb_fi),'units',tax_orig)
+    tax_orig = tax_orig(INDEX(tax_orig,'since')+6:LEN_TRIM(tax_orig))
+    tmp_cal = ' '
+    iret = NF90_GET_ATT(ncfid,tax_varid_in(nb_fi),'calendar',tmp_cal)
+    IF (l_dbg) THEN
+      WRITE(*,*) 'restsett : tmp_calendar of the restart ',tmp_cal
+    ENDIF
+!---
+    CALL strlowercase (tmp_cal)
+    IF (INDEX(calend_str,tmp_cal) < 1) THEN
+      IF (INDEX(calend_str,'unknown') > 0) THEN
+        calend_str = tmp_cal
+      ELSE
+        CALL ipslerr (2,'restsett', &
+ &       ' In the restart files two different calendars were found.', &
+ &       ' Please check the files you have used.',' ')
+      ENDIF
+    ENDIF
+!---
+!-- We need to transform that into julian days
+!-- to get ride of the intial date.
+!---
+    IF (l_dbg) WRITE(*,*) 'tax_orig : ',TRIM(tax_orig)
+    READ (UNIT=tax_orig,FMT='(I4.4,5(a,I2.2))') &
+      year0,strc,month0,strc,day0,strc, &
+      hours0,strc,minutes0,strc,seci
+    sec0 = REAL(seci)
+    sec0 = hours0*3600.+minutes0*60.+sec0
+    CALL ymds2ju (year0,month0,day0,sec0,date0_ju)
+    t_julian(nb_fi,:) = t_julian(nb_fi,:)/one_day+date0_ju
+  ENDIF
+!-
+  IF (     (INDEX(itau_orig,'XXXXX') > 0) &
+      .AND.(INDEX(tax_orig,'XXXXX')  < 1) ) THEN
+!!- Compute the t_itau from the date read and the timestep in the input
+  ENDIF
+!-
+  IF (     (INDEX(tax_orig,'XXXXX')  > 0) &
+      .AND.(INDEX(itau_orig,'XXXXX') < 1) ) THEN
+    DO it=1,tax_size_in(nb_fi)
+      t_julian(nb_fi,it) = itau2date(t_index(nb_fi,it),date0,timestep)
+    ENDDO
+  ENDIF
+!-
+! If neither the indices or time is present then get global attributes
+! This is for compatibility reasons and should not be used.
+!-
+  IF ((tax_varid_in(nb_fi) < 0).AND.(tind_varid_in(nb_fi) < 0)) THEN
+    iax = -1
+    DO iv=1,nbvar_in(nb_fi)
+      IF (    (INDEX(varname_in(nb_fi,iv),'tsteps') > 0) &
+ &        .OR.(INDEX(varname_in(nb_fi,iv),'time_steps') > 0)) THEN
+        iax = iv
+      ENDIF
+    ENDDO
+!---
+    IF (iax < 0) THEN
+      CALL ipslerr (3,'restsett',&
+        & 'No time axis was found in the restart file. Please check',&
+        & 'that it corresponds to the convention used in restsett',&
+        & ' ')
+    ELSE
+      iret = NF90_GET_VAR(ncfid,tind_varid_in(nb_fi),t_index(nb_fi,:))
+      iret = NF90_GET_ATT(ncfid,NF90_GLOBAL,'delta_tstep_sec',timestep)
+      iret = NF90_GET_ATT(ncfid,NF90_GLOBAL,'year0',ttmp)
+      year0 = NINT(ttmp)
+      iret = NF90_GET_ATT(ncfid,NF90_GLOBAL,'month0',ttmp)
+      month0 = NINT(ttmp)
+      iret = NF90_GET_ATT(ncfid,NF90_GLOBAL,'day0',ttmp)
+      day0 = NINT(ttmp)
+      iret = NF90_GET_ATT(ncfid,NF90_GLOBAL,'sec0',sec0)
+!---
+      CALL ymds2ju (year0,month0,day0,sec0,date0)
+      t_julian(nb_fi,1) = itau2date(t_index(nb_fi,1),date0,timestep)
+    ENDIF
+  ENDIF
+!----------------------
+END SUBROUTINE restsett
+!===
+SUBROUTINE restopenout &
+  (fid,fname,iim,jjm, &
+   lon,lat,llm,lev,timestep,date,ncfid,domain_id)
+!---------------------------------------------------------------------
+!- Opens the restart file for output.
+!- The longitude and time variables are written.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: fid,iim,jjm,llm
+  CHARACTER(LEN=*) :: fname
+  REAL :: date,timestep
+  REAL :: lon(iim,jjm),lat(iim,jjm),lev(llm)
+  INTEGER,INTENT(OUT) :: ncfid
+  INTEGER,INTENT(IN),OPTIONAL :: domain_id
+!-
+  INTEGER :: iret
+  CHARACTER(LEN=70) :: str_t
+  INTEGER :: x_id,y_id,z_id,itauid
+  INTEGER :: nlonid,nlatid,nlevid,timeid
+  INTEGER :: year,month,day,hours,minutes
+  REAL :: sec
+  CHARACTER(LEN=3),DIMENSION(12) :: &
+    cal = (/'JAN','FEB','MAR','APR','MAY','JUN', &
+            'JUL','AUG','SEP','OCT','NOV','DEC'/)
+  CHARACTER(LEN=30) :: timenow
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout 0.0 ",TRIM(fname)
+!-
+!  If we use the same file for input and output
+!- we will not even call restopenout
+!-
+  iret = NF90_CREATE(fname,NF90_NOCLOBBER,ncfid)
+  IF (iret == -35) THEN
+    CALL ipslerr (3,'restopenout',&
+      & ' The restart file aready exists on the disc. IOIPSL ',&
+      & ' will not overwrite it. You should remove the old one or ',&
+      & ' generate the new one with another name')
+  ENDIF
+!-
+  iret = NF90_DEF_DIM(ncfid,'x',iim,x_id)
+  xax_nb(fid) = xax_nb(fid)+1
+  xax_infs(fid,xax_nb(fid),1) = iim
+  xax_infs(fid,xax_nb(fid),2) = x_id
+!-
+  iret = NF90_DEF_DIM(ncfid,'y',jjm,y_id)
+  yax_nb(fid)  = yax_nb(fid)+1
+  yax_infs(fid,yax_nb(fid),1) = jjm
+  yax_infs(fid,yax_nb(fid),2) = y_id
+!-
+  iret = NF90_DEF_DIM(ncfid,'z',llm,z_id)
+  zax_nb(fid) = zax_nb(fid)+1
+  zax_infs(fid,zax_nb(fid),1) = llm
+  zax_infs(fid,zax_nb(fid),2) = z_id
+!-
+  iret = NF90_DEF_DIM(ncfid,'time',NF90_UNLIMITED,tdimid_out(fid))
+!-
+! 1.0 Longitude
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout 1.0"
+!-
+  iret = NF90_DEF_VAR(ncfid,"nav_lon",NF90_FLOAT,(/x_id,y_id/),nlonid)
+  iret = NF90_PUT_ATT(ncfid,nlonid,'units',"degrees_east")
+  iret = NF90_PUT_ATT(ncfid,nlonid,'valid_min',REAL(-180.,KIND=4))
+  iret = NF90_PUT_ATT(ncfid,nlonid,'valid_max',REAL( 180.,KIND=4))
+  iret = NF90_PUT_ATT(ncfid,nlonid,'long_name',"Longitude")
+!-
+! 2.0 Latitude
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout 2.0"
+!-
+  iret = NF90_DEF_VAR(ncfid,"nav_lat",NF90_FLOAT,(/x_id,y_id/),nlatid)
+  iret = NF90_PUT_ATT(ncfid,nlatid,'units',"degrees_north")
+  iret = NF90_PUT_ATT(ncfid,nlatid,'valid_min',REAL(-90.,KIND=4))
+  iret = NF90_PUT_ATT(ncfid,nlatid,'valid_max',REAL( 90.,KIND=4))
+  iret = NF90_PUT_ATT(ncfid,nlatid,'long_name',"Latitude")
+!-
+! 3.0 Levels
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout 3.0"
+!-
+  iret = NF90_DEF_VAR(ncfid,"nav_lev",NF90_FLOAT,z_id,nlevid)
+  iret = NF90_PUT_ATT(ncfid,nlevid,'units',"model_levels")
+  iret = NF90_PUT_ATT(ncfid,nlevid,'valid_min', &
+ &                     REAL(MINVAL(lev),KIND=4))
+  iret = NF90_PUT_ATT(ncfid,nlevid,'valid_max', &
+ &                     REAL(MAXVAL(lev),KIND=4))
+  iret = NF90_PUT_ATT(ncfid,nlevid,'long_name',"Model levels")
+!-
+! 4.0 Time axis, this is the seconds since axis
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout 4.0"
+!-
+  iret = NF90_DEF_VAR(ncfid,"time",NF90_FLOAT, &
+                       tdimid_out(fid),timeid)
+  tax_varid_out(fid) = timeid
+!-
+  timeorig(fid) = date
+  CALL ju2ymds (date,year,month,day,sec)
+  hours   = INT(sec/(60.*60.))
+  minutes = INT((sec-hours*60.*60.)/60.)
+  sec     = sec-(hours*60.*60.+minutes*60.)
+  WRITE (UNIT=str_t, &
+   FMT='("seconds since ",I4.4,2("-",I2.2)," ",I2.2,2(":",I2.2))') &
+ &  year,month,day,hours,minutes,INT(sec)
+  iret = NF90_PUT_ATT(ncfid,timeid,'units',TRIM(str_t))
+!-
+  CALL ioget_calendar (str_t)
+  iret = NF90_PUT_ATT(ncfid,timeid,'calendar',TRIM(str_t))
+  iret = NF90_PUT_ATT(ncfid,timeid,'title','Time')
+  iret = NF90_PUT_ATT(ncfid,timeid,'long_name','Time axis')
+!-
+  WRITE(UNIT=str_t, &
+   FMT='(" ",I4.4,"-",A3,"-",I2.2," ",I2.2,2(":",I2.2))') &
+ &  year,cal(month),day,hours,minutes,INT(sec)
+  iret = NF90_PUT_ATT(ncfid,timeid,'time_origin',TRIM(str_t))
+!-
+! 5.0 Time axis, this is the time steps since axis
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout 5.0"
+!-
+  iret = NF90_DEF_VAR(ncfid,"time_steps",NF90_INT, &
+ &                    tdimid_out(fid),itauid)
+  tind_varid_out(fid) = itauid
+!-
+  CALL ju2ymds (date,year,month,day,sec)
+!-
+  hours   = INT(sec/(60.*60.))
+  minutes = INT((sec-hours*60.*60.)/60.)
+  sec     = sec-(hours*60.*60.+minutes*60.)
+!-
+  WRITE (UNIT=str_t, &
+   FMT='("timesteps since ",I4.4,2("-",I2.2)," ",I2.2,2(":",I2.2))') &
+ &  year,month,day,hours,minutes,INT(sec)
+!-
+  iret = NF90_PUT_ATT(ncfid,itauid,'units',TRIM(str_t))
+  iret = NF90_PUT_ATT(ncfid,itauid,'title','Time steps')
+  iret = NF90_PUT_ATT(ncfid,itauid,'tstep_sec',REAL(timestep,KIND=4))
+  iret = NF90_PUT_ATT(ncfid,itauid,'long_name','Time step axis')
+!-
+  WRITE(UNIT=str_t, &
+   FMT='(" ",I4.4,"-",A3,"-",I2.2," ",I2.2,2(":",I2.2))') &
+ &  year,cal(month),day,hours,minutes,INT(sec)
+  iret = NF90_PUT_ATT(ncfid,itauid,'time_origin',TRIM(str_t))
+!-
+!  5.2 Write global attributes
+!-
+  iret = NF90_PUT_ATT(ncfid,NF90_GLOBAL,'Conventions',"CF-1.1")
+  iret = NF90_PUT_ATT(ncfid,NF90_GLOBAL,'file_name',TRIM(fname))
+!!  TO BE DONE LATER
+!!   iret = NF90_PUT_ATT(ncfid,NF90_GLOBAL, &
+!!                       'production',TRIM(model_name))
+!!   lock_modname = .TRUE.
+  CALL ioget_timestamp (timenow)
+  iret = NF90_PUT_ATT(ncfid,NF90_GLOBAL,'TimeStamp',TRIM(timenow))
+!-
+! Add DOMAIN attributes if needed
+!-
+  CALL flio_dom_att (ncfid,domain_id)
+!-
+! 6.0 The coordinates are written to the file
+!-
+  iret = NF90_ENDDEF(ncfid)
+!-
+  iret = NF90_PUT_VAR(ncfid,nlonid,lon)
+  iret = NF90_PUT_VAR(ncfid,nlatid,lat)
+  iret = NF90_PUT_VAR(ncfid,nlevid,lev)
+!-
+! 7.0 Set a few variables related to the out file
+!-
+  nbvar_out(fid) = 0
+  itau_out(fid) = -1
+  tstp_out(fid) = 0
+  touched_out(fid,:) = .FALSE.
+!-
+! 7.1 The file is put back in define mode.
+!     This will last until itau_out >= 0
+!-
+  iret = NF90_REDEF(ncfid)
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout END"
+!-------------------------
+END SUBROUTINE restopenout
+!===
+SUBROUTINE restget_opp_r1d &
+ & (fid,vname_q,iim,jjm,llm,itau,def_beha, &
+ &  var,MY_OPERATOR,nbindex,ijndex)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restget_real
+!-
+!- Should work as restput_opp_r1d but the other way around !
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  LOGICAL def_beha
+  REAL :: var(:)
+  CHARACTER(LEN=*) :: MY_OPERATOR
+  INTEGER :: nbindex,ijndex(nbindex)
+!-
+  INTEGER :: req_sz,siz1
+  REAL :: scal
+  CHARACTER(LEN=7) :: topp
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 0.0 What size should be the data in the file
+!-
+  req_sz = 1
+  IF (nbindex == iim .AND. jjm <= 1 .AND. llm <= 1) THEN
+    IF (xax_infs(fid,1,1) > 0) req_sz = req_sz*xax_infs(fid,1,1)
+    IF (yax_infs(fid,1,1) > 0) req_sz = req_sz*yax_infs(fid,1,1)
+    IF (zax_infs(fid,1,1) > 0) req_sz = req_sz*zax_infs(fid,1,1)
+  ELSE
+    CALL ipslerr (3,'resget_opp_r1d', &
+      'Unable to performe an operation on this variable as it has',&
+      'a second and third dimension',vname_q)
+  ENDIF
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var)
+  CALL rest_alloc (1,siz1,l_dbg,'restget_opp_r1d')
+  CALL rest_alloc (2,req_sz,l_dbg,'restget_opp_r1d')
+!-
+! 2.0 Here we get the variable from the restart file
+!-
+  CALL restget_real &
+    (fid,vname_q,xax_infs(fid,1,1),yax_infs(fid,1,1), &
+     zax_infs(fid,1,1),itau,def_beha,buff_tmp2)
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  topp = MY_OPERATOR(1:MIN(LEN_TRIM(MY_OPERATOR),7))
+!-
+  IF (INDEX(indchfun,topp(:LEN_TRIM(topp))) > 0) THEN
+    scal = missing_val
+    CALL mathop (topp,req_sz,buff_tmp2,missing_val, &
+ &               nbindex,ijndex,scal,siz1,buff_tmp1)
+    var(:) = buff_tmp1(1:siz1)
+  ELSE
+    CALL ipslerr (3,'resget_opp_r1d', &
+      'The operation you wish to do on the variable for the ',&
+      'restart file is not allowed.',topp)
+  ENDIF
+!-----------------------------
+END SUBROUTINE restget_opp_r1d
+!===
+SUBROUTINE restget_opp_r2d &
+ & (fid,vname_q,iim,jjm,llm,itau,def_beha, &
+ &  var,MY_OPERATOR,nbindex,ijndex)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restget_real
+!-
+!- Should work as restput_opp_r2d but the other way around !
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  LOGICAL def_beha
+  REAL :: var(:,:)
+  CHARACTER(LEN=*) :: MY_OPERATOR
+  INTEGER :: nbindex,ijndex(nbindex)
+!-
+  INTEGER :: jj,req_sz,ist,var_sz,siz1
+  REAL :: scal
+  CHARACTER(LEN=7) :: topp
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 0.0 What size should be the data in the file
+!-
+  req_sz = 1
+  IF (nbindex == iim  .AND. llm <= 1) THEN
+    IF (xax_infs(fid,1,1) > 0) req_sz = req_sz*xax_infs(fid,1,1)
+    IF (yax_infs(fid,1,1) > 0) req_sz = req_sz*yax_infs(fid,1,1)
+  ELSE
+    CALL ipslerr (3,'resget_opp_r2d', &
+      'Unable to performe an operation on this variable as it has', &
+      'a second and third dimension',vname_q)
+  ENDIF
+!-
+  IF (jjm < 1) THEN
+    CALL ipslerr (3,'resget_opp_r2d', &
+      'Please specify a second dimension which is the', &
+      'layer on which the operations are performed',vname_q)
+  ENDIF
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var,1)
+  CALL rest_alloc (1,siz1,l_dbg,'restget_opp_r2d')
+  CALL rest_alloc (2,req_sz*jjm,l_dbg,'restget_opp_r2d')
+!-
+! 2.0 Here we get the full variable from the restart file
+!-
+  CALL restget_real &
+ & (fid,vname_q,xax_infs(fid,1,1),yax_infs(fid,1,1), &
+ &  jjm,itau,def_beha,buff_tmp2)
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  topp = MY_OPERATOR(1:MIN(LEN_TRIM(MY_OPERATOR),7))
+!-
+  IF (INDEX(indchfun,topp(:LEN_TRIM(topp))) > 0) THEN
+    scal = missing_val
+    var_sz = siz1
+    DO jj = 1,jjm
+      ist = (jj-1)*req_sz+1
+      CALL mathop (topp,req_sz,buff_tmp2(ist:ist+req_sz-1), &
+ &      missing_val,nbindex,ijndex,scal,var_sz,buff_tmp1)
+      var(:,jj) = buff_tmp1(1:siz1)
+    ENDDO
+  ELSE
+    CALL ipslerr (3,'resget_opp_r2d', &
+      'The operation you wish to do on the variable for the ',&
+      'restart file is not allowed.',topp)
+  ENDIF
+!-----------------------------
+END SUBROUTINE restget_opp_r2d
+!===
+SUBROUTINE restget_r1d &
+ & (fid,vname_q,iim,jjm,llm,itau,def_beha,var)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restget_real
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  LOGICAL :: def_beha
+  REAL :: var(:)
+!-
+  INTEGER :: ji,jl,req_sz,var_sz,siz1
+  CHARACTER(LEN=70) :: str,str2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var)
+  var_sz = siz1
+  CALL rest_alloc (1,var_sz,l_dbg,'restget_r1d')
+!-
+! 2.0 Here we could check if the sizes specified agree
+!     with the size of the variable provided
+!-
+  req_sz = 1
+  IF (iim > 0) req_sz = req_sz*iim
+  IF (jjm > 0) req_sz = req_sz*jjm
+  IF (llm > 0) req_sz = req_sz*llm
+  IF (req_sz > var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable requested from file should be ",I6)') req_sz
+    WRITE(str2, &
+ &    '("but the provided variable can only hold ",I6)') var_sz
+    CALL ipslerr (3,'restget_r1d',str,str2,' ')
+  ENDIF
+  IF (req_sz < var_sz) THEN
+    WRITE(str, &
+ &    '("the size of variable requested from file is ",I6)') req_sz
+    WRITE(str2, &
+ &    '("but the provided variable can hold ",I6)') var_sz
+    CALL ipslerr (2,'restget_r1d', &
+      'There could be a problem here :',str,str2)
+  ENDIF
+!-
+  CALL restget_real &
+ & (fid,vname_q,iim,jjm,llm,itau,def_beha,buff_tmp1)
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  jl=0
+  DO ji=1,siz1
+    jl=jl+1
+    var(ji) = buff_tmp1(jl)
+  ENDDO
+!-------------------------
+END SUBROUTINE restget_r1d
+!===
+SUBROUTINE restget_r2d &
+ & (fid,vname_q,iim,jjm,llm,itau,def_beha,var)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restget_real
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  LOGICAL :: def_beha
+  REAL :: var(:,:)
+!-
+  INTEGER :: ji,jj,jl,req_sz,var_sz,siz1,siz2
+  CHARACTER(LEN=70) :: str,str2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var,1)
+  siz2 = SIZE(var,2)
+  var_sz = siz1*siz2
+  CALL rest_alloc (1,var_sz,l_dbg,'restget_r2d')
+!-
+! 2.0 Here we check if the sizes specified agree
+!     with the size of the variable provided
+!-
+  req_sz = 1
+  IF (iim > 0) req_sz = req_sz*iim
+  IF (jjm > 0) req_sz = req_sz*jjm
+  IF (llm > 0) req_sz = req_sz*llm
+  IF (req_sz > var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable ",A, &
+ &      //" requested from file should be ",I6)') TRIM(vname_q),req_sz
+    WRITE(str2, &
+ &    '("but the provided variable can only hold ",I6)') var_sz
+    CALL ipslerr (3,'restget_r2d',str,str2,' ')
+  ENDIF
+  IF (req_sz < var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable ",A, &
+ &      //" requested from file is ",I6)') TRIM(vname_q),req_sz
+    WRITE(str2,'("but the provided variable can hold ",I6)') var_sz
+    CALL ipslerr (2,'restget_r2d', &
+      'There could be a problem here :',str,str2)
+  ENDIF
+!-
+  CALL restget_real &
+ & (fid,vname_q,iim,jjm,llm,itau,def_beha,buff_tmp1)
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  jl=0
+  DO jj=1,siz2
+    DO ji=1,siz1
+      jl=jl+1
+      var(ji,jj) = buff_tmp1(jl)
+    ENDDO
+  ENDDO
+!-------------------------
+END SUBROUTINE restget_r2d
+!===
+SUBROUTINE restget_r3d &
+  (fid,vname_q,iim,jjm,llm,itau,def_beha,var)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restget_real
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  LOGICAL def_beha
+  REAL :: var(:,:,:)
+!-
+  INTEGER :: ji,jj,jk,jl,req_sz,var_sz,siz1,siz2,siz3
+  CHARACTER(LEN=70) :: str,str2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var,1)
+  siz2 = SIZE(var,2)
+  siz3 = SIZE(var,3)
+  var_sz = siz1*siz2*siz3
+  CALL rest_alloc (1,var_sz,l_dbg,'restget_r3d')
+!-
+! 2.0 Here we check if the sizes specified agree
+!     with the size of the variable provided
+!-
+  req_sz = 1
+  IF (iim > 0) req_sz = req_sz*iim
+  IF (jjm > 0) req_sz = req_sz*jjm
+  IF (llm > 0) req_sz = req_sz*llm
+  IF (req_sz > var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable ",A, &
+ &      //" requested from file should be ",I6)') TRIM(vname_q),req_sz
+    WRITE(str2, &
+ &    '("but the provided variable can only hold ",I6)') var_sz
+    CALL ipslerr (3,'restget_r3d',str,str2,' ')
+  ENDIF
+  IF (req_sz < var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable ",A, &
+ &      //" requested from file is ",I6)') TRIM(vname_q),req_sz
+    WRITE(str2,'("but the provided variable can hold ",I6)') var_sz
+    CALL ipslerr (2,'restget_r3d', &
+      'There could be a problem here :',str,str2)
+  ENDIF
+!-
+  CALL restget_real &
+    (fid,vname_q,iim,jjm,llm,itau,def_beha,buff_tmp1)
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  jl=0
+  DO jk=1,siz3
+    DO jj=1,siz2
+      DO ji=1,siz1
+        jl=jl+1
+        var(ji,jj,jk) = buff_tmp1(jl)
+      ENDDO
+    ENDDO
+  ENDDO
+!-------------------------
+END SUBROUTINE restget_r3d
+!===
+SUBROUTINE restget_real &
+  (fid,vname_q,iim,jjm,llm,itau,def_beha,var)
+!---------------------------------------------------------------------
+!- This subroutine is for getting a variable from the restart file.
+!- A number of verifications will be made :
+!- - Is this the first time we read this variable ?
+!- - Are the dimensions correct ?
+!- - Is the correct time step present in the file
+!- - is a default behaviour possible. If not the model is stoped.
+!- Default procedure is to write the content of val_exp on all values.
+!-
+!- INPUT
+!-
+!- fid            : Identification of the file
+!- vname_q        : Name of the variable to be read
+!- iim, jjm ,llm  : Dimensions of the variable that should be read
+!- itau           : Time step at whcih we are when we want
+!-                  to read the variable
+!- def_beha       : If the model can restart without this variable
+!-                  then some strange value is given.
+!-
+!- OUTPUT
+!-
+!- var            : Variable in which the data is put
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  LOGICAL :: def_beha
+  REAL :: var(:)
+!-
+  INTEGER :: vid,vnb,ncfid,iret,index,it,ndim,ia
+  CHARACTER(LEN=70) str,str2
+  CHARACTER(LEN=80) attname
+  INTEGER,DIMENSION(4) :: corner,edge
+!---------------------------------------------------------------------
+  ncfid = netcdf_id(fid,1)
+!-
+  CALL find_str (varname_in(fid,1:nbvar_in(fid)),vname_q,vnb)
+!-
+! 1.0 If the variable is not present then ERROR or filled up
+!     by default values if allowed
+!-
+  IF (vnb < 0) THEN
+    IF (def_beha) THEN
+!-----
+      lock_valexp = .TRUE.
+      var(:) = val_exp
+!----
+      str = 'Variable '//TRIM(vname_q) &
+          //' is not present in the restart file'
+      CALL ipslerr (1,'restget', &
+ &      str,'but default values are used to fill in',' ')
+!----
+      IF (nbvar_in(fid) >= max_var) THEN
+        CALL ipslerr (3,'restget', &
+         'Too many variables for the restcom module', &
+         'Please increase the value of max_var',' ')
+      ENDIF
+      nbvar_in(fid) = nbvar_in(fid)+1
+      vnb = nbvar_in(fid)
+      varname_in(fid,vnb) = vname_q
+      touched_in(fid,vnb) = .TRUE.
+!-----
+      CALL restdefv (fid,vname_q,iim,jjm,llm,.TRUE.)
+!-----
+    ELSE
+      str = 'Variable '//TRIM(vname_q) &
+          //' is not present in the restart file'
+      CALL ipslerr (3,'restget', &
+ &      str,'but it is need to restart the model',' ')
+    ENDIF
+!---
+  ELSE
+!---
+!--  2.0 Check if the variable has not yet been read
+!--      and that the time is OK
+!---
+    vid = varid_in(fid,vnb)
+!---
+    nbvar_read(fid) = nbvar_read(fid)+1
+!---
+    IF (touched_in(fid,vnb)) THEN
+      str = 'Variable '//TRIM(vname_q) &
+          //' has already been read from file'
+      CALL ipslerr (3,'restget',str,' ',' ')
+    ENDIF
+!---
+!-- 3.0 get the time step of the restart file
+!--     and check if it is correct
+!---
+    index = -1
+    DO it=1,tax_size_in(fid)
+      IF (t_index(fid,it) == itau)  index = it
+    ENDDO
+    IF (index < 0) THEN
+      str = 'The time step requested for variable '//TRIM(vname_q)
+      CALL ipslerr (3,'restget', &
+ &      str,'is not available in the current file',' ')
+    ENDIF
+!---
+!-- 4.0 Read the data. Note that the variables in the restart files
+!--     have no time axis is and thus we write -1
+!---
+    str='Incorrect dimension for '//TRIM(vname_q)
+    ndim = 0
+    IF (iim > 0) THEN
+      ndim = ndim+1
+      IF (vardims_in(fid,vnb,ndim) == iim) THEN
+        corner(ndim) = 1
+        edge(ndim) = iim
+      ELSE
+        WRITE (str2,'("Incompatibility for iim : ",I6,I6)') &
+             iim,vardims_in(fid,vnb,ndim)
+        CALL ipslerr (3,'restget',str,str2,' ')
+      ENDIF
+    ENDIF
+!---
+    IF (jjm > 0) THEN
+      ndim = ndim+1
+      IF (vardims_in(fid,vnb,ndim) == jjm) THEN
+        corner(ndim) = 1
+        edge(ndim) = jjm
+      ELSE
+        WRITE (str2,'("Incompatibility for jjm : ",I6,I6)') &
+             jjm,vardims_in(fid,vnb,ndim)
+        CALL ipslerr (3,'restget',str,str2,' ')
+      ENDIF
+    ENDIF
+!---
+    IF (llm > 0) THEN
+      ndim = ndim+1
+      IF (vardims_in(fid,vnb,ndim) == llm) THEN
+        corner(ndim) = 1
+        edge(ndim) = llm
+      ELSE
+        WRITE (str2,'("Incompatibility for llm : ",I6,I6)') &
+             llm,vardims_in(fid,vnb,ndim)
+        CALL ipslerr (3,'restget',str,str2,' ')
+      ENDIF
+    ENDIF
+!---
+!-- Time
+!---
+    ndim = ndim+1
+    corner(ndim) = index
+!!????? edge(ndim) = index
+    edge(ndim) = 1
+!---
+    iret = NF90_GET_VAR(ncfid,vid,var, &
+ &                      start=corner(1:ndim),count=edge(1:ndim))
+!---
+!-- 5.0 The variable we have just read is created
+!--      in the next restart file
+!---
+    IF (     (netcdf_id(fid,1) /= netcdf_id(fid,2))  &
+ &      .AND.(netcdf_id(fid,2) > 0) ) THEN
+!-----
+      CALL restdefv (fid,vname_q,iim,jjm,llm,.FALSE.)
+!-----
+      DO ia = 1,varatt_in(fid,vnb)
+        iret = NF90_INQ_ATTNAME(ncfid,vid,ia,attname)
+        iret = NF90_COPY_ATT(ncfid,vid,attname, &
+ &               netcdf_id(fid,2),varid_out(fid,nbvar_out(fid)))
+      ENDDO
+!-----
+      IF (itau_out(fid) >= 0) THEN
+        iret = NF90_ENDDEF(netcdf_id(fid,2))
+      ENDIF
+    ENDIF
+!---
+  ENDIF
+!--------------------------
+END SUBROUTINE restget_real
+!===
+SUBROUTINE restput_opp_r1d &
+ & (fid,vname_q,iim,jjm,llm,itau,var,MY_OPERATOR,nbindex,ijndex)
+!---------------------------------------------------------------------
+!- This subroutine is the interface to restput_real which allows
+!- to re-index data onto the original grid of the restart file.
+!- The logic we use is still fuzzy in my mind but that is probably
+!- only because I have not yet though through everything.
+!-
+!- In the case iim = nbindex it means that the user attempts
+!- to project a vector back onto the original 2D or 3D field.
+!- This requires that jjm and llm be equal to 1 or 0,
+!- else I would not know what it means.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  REAL :: var(:)
+  CHARACTER(LEN=*) :: MY_OPERATOR
+  INTEGER :: nbindex,ijndex(nbindex)
+!-
+  INTEGER :: req_sz,siz1
+  REAL :: scal
+  CHARACTER(LEN=7) :: topp
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 0.0 What size should be the data in the file
+!-
+  req_sz = 1
+  IF ( nbindex == iim .AND. jjm <= 1 .AND. llm <= 1) THEN
+    IF (xax_infs(fid,1,1) > 0) req_sz = req_sz*xax_infs(fid,1,1)
+    IF (yax_infs(fid,1,1) > 0) req_sz = req_sz*yax_infs(fid,1,1)
+    IF (zax_infs(fid,1,1) > 0) req_sz = req_sz*zax_infs(fid,1,1)
+  ELSE
+    CALL ipslerr (3,'restput_opp_r1d', &
+      'Unable to performe an operation on this variable as it has', &
+      'a second and third dimension',vname_q)
+  ENDIF
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var)
+  CALL rest_alloc (1,siz1,l_dbg,'restput_opp_r1d')
+  CALL rest_alloc (2,req_sz,l_dbg,'restput_opp_r1d')
+!-
+! 2.0 We do the operation needed.
+!     It can only be a re-indexing operation.
+!     You would not want to change the values in a restart file or ?
+!-
+  topp = MY_OPERATOR(1:MIN(LEN_TRIM(MY_OPERATOR),7))
+!-
+  IF (INDEX(indchfun,topp(:LEN_TRIM(topp))) > 0) THEN
+    scal = missing_val
+    buff_tmp1(1:siz1) = var(:)
+    CALL mathop &
+ &    (topp,siz1,buff_tmp1,missing_val,nbindex,ijndex, &
+ &     scal,req_sz,buff_tmp2)
+  ELSE
+    CALL ipslerr (3,'restput_opp_r1d', &
+ &    'The operation you wish to do on the variable for the ', &
+ &    'restart file is not allowed.',topp)
+  ENDIF
+!-
+  CALL restput_real &
+ & (fid,vname_q,xax_infs(fid,1,1),yax_infs(fid,1,1), &
+ &  zax_infs(fid,1,1),itau,buff_tmp2)
+!-----------------------------
+END SUBROUTINE restput_opp_r1d
+!===
+SUBROUTINE restput_opp_r2d &
+ & (fid,vname_q,iim,jjm,llm,itau,var,MY_OPERATOR,nbindex,ijndex)
+!---------------------------------------------------------------------
+!- This subroutine is the interface to restput_real which allows
+!- to re-index data onto the original grid of the restart file.
+!- The logic we use is still fuzzy in my mind but that is probably
+!- only because I have not yet though through everything.
+!-
+!- In the case iim = nbindex it means that the user attempts
+!- to project the first dimension of the matrix back onto a 3D field
+!- where jjm will be the third dimension.
+!- Here we do not allow for 4D data, thus we will take the first
+!- two dimensions in the file and require that llm = 1.
+!- These are pretty heavy constraints but I do not know how
+!- to make it more general. I need to think about it some more.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  REAL :: var(:,:)
+  CHARACTER(LEN=*) :: MY_OPERATOR
+  INTEGER :: nbindex,ijndex(nbindex)
+!-
+  INTEGER :: jj,req_sz,ist,siz1
+  REAL :: scal
+  CHARACTER(LEN=7) :: topp
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 0.0 What size should be the data in the file
+!-
+  req_sz = 1
+  IF ( nbindex == iim .AND. llm <= 1) THEN
+    IF (xax_infs(fid,1,1) > 0) req_sz = req_sz*xax_infs(fid,1,1)
+    IF (yax_infs(fid,1,1) > 0) req_sz = req_sz*yax_infs(fid,1,1)
+  ELSE
+    CALL ipslerr (3,'restput_opp_r2d', &
+      'Unable to performe an operation on this variable as it has', &
+      'a second and third dimension',vname_q)
+  ENDIF
+!-
+  IF (jjm < 1) THEN
+    CALL ipslerr (3,'restput_opp_r2d', &
+      'Please specify a second dimension which is the', &
+      'layer on which the operations are performed',vname_q)
+  ENDIF
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var,1)
+  CALL rest_alloc (1,siz1,l_dbg,'restput_opp_r2d')
+  CALL rest_alloc (2,req_sz*jjm,l_dbg,'restput_opp_r2d')
+!-
+! 2.0 We do the operation needed.
+!     It can only be a re-indexing operation.
+!     You would not want to change the values in a restart file or ?
+!-
+  topp = MY_OPERATOR(1:MIN(LEN_TRIM(MY_OPERATOR),7))
+!-
+  IF (INDEX(indchfun,topp(:LEN_TRIM(topp))) > 0) THEN
+    scal = missing_val
+    DO jj = 1,jjm
+      buff_tmp1(1:siz1) = var(:,jj)
+      ist = (jj-1)*req_sz+1
+      CALL mathop &
+ &      (topp,siz1,buff_tmp1,missing_val,nbindex,ijndex, &
+ &       scal,req_sz,buff_tmp2(ist:ist+req_sz-1))
+    ENDDO
+  ELSE
+    CALL ipslerr (3,'restput_opp_r2d', &
+ &    'The operation you wish to do on the variable for the ', &
+ &    'restart file is not allowed.',topp)
+  ENDIF
+!-
+  CALL restput_real &
+ & (fid,vname_q,xax_infs(fid,1,1),yax_infs(fid,1,1), &
+ &  jjm,itau,buff_tmp2)
+!-----------------------------
+END SUBROUTINE restput_opp_r2d
+!===
+SUBROUTINE restput_r1d (fid,vname_q,iim,jjm,llm,itau,var)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restput_real
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  REAL :: var(:)
+!-
+  INTEGER :: ji,jl,req_sz,var_sz,siz1
+  CHARACTER(LEN=70) :: str,str2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var)
+  var_sz = siz1
+  CALL rest_alloc (1,var_sz,l_dbg,'restput_r1d')
+!-
+! 2.0 Here we could check if the sizes specified agree
+!     with the size of the variable provided
+!-
+  req_sz = 1
+  IF (iim > 0) req_sz = req_sz*iim
+  IF (jjm > 0) req_sz = req_sz*jjm
+  IF (llm > 0) req_sz = req_sz*llm
+  IF (req_sz > var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable put to the file should be ",I6)') req_sz
+    WRITE(str2, &
+ &    '("but the provided variable is of size ",I6)') var_sz
+    CALL ipslerr (3,'restput_r1d',str,str2,' ')
+  ENDIF
+  IF (req_sz < var_sz) THEN
+    WRITE(str,'("the size of variable put to the file is ",I6)') req_sz
+    WRITE(str2,'("but the provided variable is larger ",I6)') var_sz
+    CALL ipslerr (2,'restput_r1d', &
+      'There could be a problem here :',str,str2)
+  ENDIF
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  jl=0
+  DO ji=1,siz1
+    jl=jl+1
+    buff_tmp1(jl) = var(ji)
+  ENDDO
+!-
+  CALL restput_real (fid,vname_q,iim,jjm,llm,itau,buff_tmp1)
+!-------------------------
+END SUBROUTINE restput_r1d
+!===
+SUBROUTINE restput_r2d (fid,vname_q,iim,jjm,llm,itau,var)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restput_real
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  REAL :: var(:,:)
+!-
+  INTEGER :: ji,jj,jl,req_sz,var_sz,siz1,siz2
+  CHARACTER(LEN=70) :: str,str2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var,1)
+  siz2 = SIZE(var,2)
+  var_sz = siz1*siz2
+  CALL rest_alloc (1,var_sz,l_dbg,'restput_r2d')
+!-
+! 2.0 Here we could check if the sizes specified agree
+!     with the size of the variable provided
+!-
+  req_sz = 1
+  IF (iim > 0) req_sz = req_sz*iim
+  IF (jjm > 0) req_sz = req_sz*jjm
+  IF (llm > 0) req_sz = req_sz*llm
+  IF (req_sz > var_sz) THEN
+    WRITE(str, &
+&         '("Size of variable put to the file should be ",I6)') req_sz
+    WRITE(str2,'("but the provided variable is of size  ",I6)') var_sz
+    CALL ipslerr (3,'restput_r2d',str,str2,' ')
+  ENDIF
+  IF (req_sz < var_sz) THEN
+    WRITE(str,'("the size of variable put to the file is ",I6)') req_sz
+    WRITE(str2,'("but the provided variable is larger ",I6)')  var_sz
+    CALL ipslerr (2,'restput_r2d', &
+      'There could be a problem here :',str,str2)
+  ENDIF
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  jl=0
+  DO jj=1,siz2
+    DO ji=1,siz1
+      jl=jl+1
+      buff_tmp1(jl) = var(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  CALL restput_real(fid,vname_q,iim,jjm,llm,itau,buff_tmp1)
+!-------------------------
+END SUBROUTINE restput_r2d
+!===
+SUBROUTINE restput_r3d (fid,vname_q,iim,jjm,llm,itau,var)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restput_real
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  REAL :: var(:,:,:)
+!-
+  INTEGER :: ji,jj,jk,jl,req_sz,var_sz,siz1,siz2,siz3
+  CHARACTER(LEN=70) :: str,str2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var,1)
+  siz2 = SIZE(var,2)
+  siz3 = SIZE(var,3)
+  var_sz = siz1*siz2*siz3
+  CALL rest_alloc (1,var_sz,l_dbg,'restput_r3d')
+!-
+! 2.0 Here we could check if the sizes specified agree
+!     with the size of the variable provided
+!-
+  req_sz = 1
+  IF (iim > 0) req_sz = req_sz*iim
+  IF (jjm > 0) req_sz = req_sz*jjm
+  IF (llm > 0) req_sz = req_sz*llm
+  IF (req_sz > var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable put to the file should be ",I6)') req_sz
+    WRITE(str2, &
+ &    '("but the provided variable is of size  ",I6)')  var_sz
+    CALL ipslerr (3,'restput_r3d',str,str2,' ')
+  ENDIF
+  IF (req_sz < var_sz) THEN
+    WRITE(str,'("the size of variable put to the file is ",I6)') req_sz
+    WRITE(str2,'("but the provided variable is larger ",I6)')  var_sz
+    CALL ipslerr (2,'restput_r3d', &
+      'There could be a problem here :',str,str2)
+  ENDIF
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  jl=0
+  DO jk=1,siz3
+    DO jj=1,siz2
+      DO ji=1,siz1
+        jl=jl+1
+        buff_tmp1(jl) = var(ji,jj,jk)
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  CALL restput_real(fid,vname_q,iim,jjm,llm,itau,buff_tmp1)
+!-------------------------
+END SUBROUTINE restput_r3d
+!===
+SUBROUTINE restput_real (fid,vname_q,iim,jjm,llm,itau,var)
+!---------------------------------------------------------------------
+!- This subroutine will put a variable into the restart file.
+!- But it will do a lot of other things if needed :
+!- - Open a file if non is opened for this time-step
+!-   and all variables were written.
+!- - Add an axis if needed
+!- - verify that the variable has the right time step for this file
+!- - If it is time for a new file then it is opened
+!-   and the old one closed
+!- This requires that variables read from the last restart file were all
+!- written
+!-
+!- INPUT
+!-
+!- fid         : Id of the file in which we will write the variable
+!- vname_q     : Name of the variable to be written
+!- iim,jjm,llm : Size in 3D of the variable
+!- itau        : Time step at which the variable is written
+!- var         : Variable
+!-
+!- OUTPUT
+!-
+!- NONE
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: fid,iim,jjm,llm,itau
+  REAL :: var(:)
+!-
+  INTEGER :: iret,vid,ncid,iv,vnb
+  INTEGER :: ierr
+  REAL :: secsince,one_day,one_year
+  INTEGER :: ndims
+  INTEGER,DIMENSION(4) :: corner,edge
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 0.0 Get some variables
+!-
+  ncid = netcdf_id(fid,2)
+  IF (netcdf_id(fid,2) < 0) THEN
+    CALL ipslerr (3,'restput', &
+ &    'The output restart file is undefined.',' ',' ')
+  ENDIF
+  CALL ioget_calendar (one_year,one_day)
+!-
+! 1.0 Check if the variable is already present
+!-
+  IF (l_dbg) WRITE(*,*) 'RESTPUT 1.0 : ',TRIM(vname_q)
+!-
+  CALL find_str (varname_out(fid,1:nbvar_out(fid)),vname_q,vnb)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'RESTPUT 1.1 : ',varname_out(fid,1:nbvar_out(fid)),vnb
+  ENDIF
+!-
+! 2.0 If variable is not present then declare it
+!     and add extra dimensions if needed.
+!-
+  IF (vnb <= 0) THEN
+    CALL restdefv (fid,vname_q,iim,jjm,llm,.TRUE.)
+    vnb = nbvar_out(fid)
+  ENDIF
+  vid = varid_out(fid,vnb)
+!-
+  IF (l_dbg) WRITE(*,*) 'RESTPUT 2.0 : ',vnb,vid
+!-
+! 2.1 Is this file already in write mode ?
+!     If itau_out is still negative then we have
+!     never written to it and we need to go into write mode.
+!-
+  IF (itau_out(fid) < 0) THEN
+    iret = NF90_ENDDEF(ncid)
+  ENDIF
+!-
+! 3.0 Is this itau already on the axis ?
+!     If not then check that all variables of previous time is OK.
+!-
+  IF (l_dbg) WRITE(*,*) 'RESTPUT 3.0 : ',itau,itau_out(fid)
+!-
+  IF (itau /= itau_out(fid)) THEN
+!---
+!-- If it is the first time step written on the restart
+!-- then we only check the number
+!-- Else we see if every variable was written
+!---
+    IF (tstp_out(fid) == 0) THEN
+      IF (nbvar_out(fid) < nbvar_read(fid)) THEN
+        WRITE(*,*) "ERROR :",tstp_out(fid), &
+                   nbvar_out(fid),nbvar_read(fid)
+        CALL ipslerr (1,'restput', &
+ &        'There are fewer variables read from the output file', &
+ &        'than written onto the input file.', &
+ &        'We trust you know what you are doing')
+      ENDIF
+    ELSE
+      ierr = 0
+      DO iv=1,nbvar_out(fid)
+        IF (.NOT.touched_out(fid,iv)) ierr = ierr+1
+      ENDDO
+      IF (ierr > 0) THEN
+        WRITE(*,*) "ERROR :",nbvar_out(fid)
+        CALL ipslerr (1,'restput', &
+ &        'There are fewer variables in the output file for this', &
+ &        'time step than for the previous one',' ')
+      ELSE
+        touched_out(fid,:) = .FALSE.
+      ENDIF
+    ENDIF
+!---
+    secsince = itau*deltat(fid)
+    corner(1) =  tstp_out(fid)+1
+    edge(1) = 1
+!---
+!-- 3.1 Here we add the values to the time axes
+!---
+    IF (l_dbg) THEN
+      WRITE(*,*) 'RESTPUT 3.1 : ',itau,secsince,corner(1),edge(1)
+    ENDIF
+!---
+    iret = NF90_PUT_VAR(ncid,tind_varid_out(fid),itau, &
+ &                      start=corner(1:1))
+    iret = NF90_PUT_VAR(ncid,tax_varid_out(fid),secsince, &
+ &                      start=corner(1:1))
+!---
+    tstp_out(fid) = tstp_out(fid)+1
+    itau_out(fid) = itau
+  ENDIF
+!-
+! 4.0 Variable and time step should be present
+!     now so we can dump variable
+!-
+  ndims = 0
+  IF (iim > 0) THEN
+    ndims = ndims+1
+    corner(ndims) = 1
+    edge(ndims) = iim
+  ENDIF
+  IF (jjm > 0) THEN
+    ndims = ndims+1
+    corner(ndims) = 1
+    edge(ndims) = jjm
+  ENDIF
+  IF (llm > 0) THEN
+    ndims = ndims+1
+    corner(ndims) = 1
+    edge(ndims) = llm
+  ENDIF
+  ndims = ndims+1
+  corner(ndims) = tstp_out(fid)
+  edge(ndims) = 1
+!-
+  iret = NF90_PUT_VAR(ncid,vid,var, &
+ &                    start=corner(1:ndims),count=edge(1:ndims))
+!-
+  IF (iret /= NF90_NOERR) THEN
+    CALL ipslerr (2,'restput_real',NF90_STRERROR(iret), &
+ &    'Bug in restput.',&
+ &    'Please, verify compatibility between get and put commands.')
+  ENDIF
+!-
+!  5.0 Note that the variables was treated
+!-
+  touched_out(fid,vnb) = .TRUE.
+!---------------------------
+END  SUBROUTINE restput_real
+!===
+SUBROUTINE restdefv (fid,varname,iim,jjm,llm,write_att)
+!---------------------------------------------------------------------
+! This subroutine adds a variable to the output file.
+! The attributes are either taken from.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER ::fid
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim,jjm,llm
+  LOGICAL :: write_att
+!-
+  INTEGER :: dims(4),ic,xloc,ndim,ncfid
+  INTEGER :: iret,ax_id
+  CHARACTER(LEN=3) :: str
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  ncfid = netcdf_id(fid,2)
+  IF (nbvar_out(fid) >= max_var) THEN
+    CALL ipslerr (3,'restdefv', &
+      'Too many variables for the restcom module', &
+      'Please increase the value of max_var',' ')
+  ENDIF
+  nbvar_out(fid) = nbvar_out(fid)+1
+  varname_out(fid,nbvar_out(fid)) = varname
+!-
+! 0.0 Put the file in define mode if needed
+!-
+  IF (itau_out(fid) >= 0) THEN
+    iret = NF90_REDEF(ncfid)
+  ENDIF
+!-
+! 1.0 Do we have all dimensions and can we go ahead
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'restdefv 1.0 :',TRIM(varname),nbvar_out(fid)
+  ENDIF
+!-
+  ndim = 0
+!-
+! 1.1 Work on x
+!-
+  IF (iim > 0) THEN
+    ndim = ndim+1
+    xloc = 0
+    DO ic=1,xax_nb(fid)
+      IF (xax_infs(fid,ic,1) == iim) xloc = ic
+    ENDDO
+!---
+    IF (xloc > 0) THEN
+      dims(ndim) = xax_infs(fid,xloc,2)
+    ELSE
+      str='x_'//CHAR(96+xax_nb(fid))
+      iret = NF90_DEF_DIM(ncfid,str,iim,ax_id)
+      xax_nb(fid) = xax_nb(fid)+1
+      xax_infs(fid,xax_nb(fid),1) = iim
+      xax_infs(fid,xax_nb(fid),2) = ax_id
+      dims(ndim) = ax_id
+    ENDIF
+  ENDIF
+!-
+! 1.2 Work on y
+!-
+  IF (jjm > 0) THEN
+    ndim = ndim+1
+    xloc = 0
+    DO ic=1,yax_nb(fid)
+      IF (yax_infs(fid,ic,1) == jjm) xloc = ic
+    ENDDO
+!---
+    IF (xloc > 0) THEN
+      dims(ndim) = yax_infs(fid,xloc,2)
+    ELSE
+      str='y_'//CHAR(96+yax_nb(fid))
+      iret = NF90_DEF_DIM(ncfid,str,jjm,ax_id)
+      yax_nb(fid) = yax_nb(fid)+1
+      yax_infs(fid,yax_nb(fid),1) = jjm
+      yax_infs(fid,yax_nb(fid),2) = ax_id
+      dims(ndim) = ax_id
+    ENDIF
+  ENDIF
+!-
+! 1.3 Work on z
+!-
+  IF (llm > 0) THEN
+    ndim = ndim+1
+    xloc = 0
+    DO ic=1,zax_nb(fid)
+      IF (zax_infs(fid,ic,1) == llm) xloc = ic
+    ENDDO
+!---
+    IF (xloc > 0) THEN
+      dims(ndim) = zax_infs(fid,xloc,2)
+    ELSE
+      str='z_'//CHAR(96+zax_nb(fid))
+      iret = NF90_DEF_DIM(ncfid,str,llm,ax_id)
+      zax_nb(fid) = zax_nb(fid)+1
+      zax_infs(fid,zax_nb(fid),1) = llm
+      zax_infs(fid,zax_nb(fid),2) = ax_id
+      dims(ndim) = ax_id
+    ENDIF
+  ENDIF
+!-
+! 1.4  Time needs to be added
+!-
+  ndim = ndim+1
+  dims(ndim) = tdimid_out(fid)
+!-
+! 2.0  Declare the variable
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'restdefv 2.0 :',ndim,' :: ',dims(1:ndim),tdimid_out(fid)
+  ENDIF
+!-
+  iret = NF90_DEF_VAR(ncfid,varname,NF90_DOUBLE,dims(1:ndim), &
+ &                    varid_out(fid,nbvar_out(fid)))
+  IF (iret /= NF90_NOERR) THEN
+    CALL ipslerr (3,'restdefv', &
+      'Could not define new variable in file', &
+      NF90_STRERROR(iret),varname)
+  ENDIF
+!-
+! 3.0 Add the attributes if requested
+!-
+  IF (write_att) THEN
+    IF (rest_units /= 'XXXXX') THEN
+      iret =  NF90_PUT_ATT(ncfid,varid_out(fid,nbvar_out(fid)), &
+ &                         'units',TRIM(rest_units))
+      rest_units = 'XXXXX'
+    ENDIF
+!---
+    IF (rest_lname /= 'XXXXX') THEN
+      iret =  NF90_PUT_ATT(ncfid,varid_out(fid,nbvar_out(fid)), &
+ &                         'long_name',TRIM(rest_lname))
+      rest_lname = 'XXXXX'
+    ENDIF
+!---
+    iret = NF90_PUT_ATT(ncfid,varid_out(fid,nbvar_out(fid)), &
+ &                      'missing_value',REAL(missing_val,KIND=4))
+!---
+    IF (itau_out(fid) >= 0) THEN
+      iret = NF90_ENDDEF(ncfid)
+    ENDIF
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) &
+ &    'restdefv 3.0 : LIST OF VARS ',varname_out(fid,1:nbvar_out(fid))
+  ENDIF
+!----------------------
+END SUBROUTINE restdefv
+!===
+SUBROUTINE rest_atim (l_msg,c_p)
+!---------------------------------------------------------------------
+! Called by "c_p", [re]allocate the time axes
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  LOGICAL,INTENT(IN) :: l_msg
+  CHARACTER(LEN=*),INTENT(IN) :: c_p
+!-
+  INTEGER :: i_err,tszij
+  INTEGER,ALLOCATABLE :: tmp_index(:,:)
+  REAL,ALLOCATABLE :: tmp_julian(:,:)
+!---------------------------------------------------------------------
+!-
+!  Allocate the space we need for the time axes
+!-
+  IF (.NOT.ALLOCATED(t_index) .AND. .NOT.ALLOCATED(t_julian)) THEN
+    IF (l_msg) THEN
+      WRITE(*,*) TRIM(c_p)//' : Allocate times axes at :', &
+ &               max_file,tax_size_in(nb_fi)
+    ENDIF
+!---
+    ALLOCATE(t_index(max_file,tax_size_in(nb_fi)),STAT=i_err)
+    IF (i_err/=0) THEN
+      WRITE(*,*) "ERROR IN ALLOCATION of t_index : ",i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &      'Problem in allocation of t_index','', &
+ &      '(you must increase memory)')
+    ENDIF
+    t_index (:,:) = 0
+!---
+    ALLOCATE(t_julian(max_file,tax_size_in(nb_fi)),STAT=i_err)
+    IF (i_err/=0) THEN
+      WRITE(*,*) "ERROR IN ALLOCATION of t_julian : ",i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &      'Problem in allocation of max_file,tax_size_in','', &
+ &      '(you must increase memory)')
+    ENDIF
+    t_julian (:,:) = 0.0
+  ELSE IF (    (SIZE(t_index,DIM=2)  < tax_size_in(nb_fi)) &
+ &         .OR.(SIZE(t_julian,DIM=2) < tax_size_in(nb_fi)) ) THEN
+    IF (l_msg) THEN
+      WRITE(*,*) TRIM(c_p)//' : Reallocate times axes at :', &
+ &               max_file,tax_size_in(nb_fi)
+    ENDIF
+!---
+    ALLOCATE (tmp_index(max_file,tax_size_in(nb_fi)),STAT=i_err)
+    IF (i_err/=0) THEN
+      WRITE(*,*) "ERROR IN ALLOCATION of tmp_index : ",i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &      'Problem in allocation of tmp_index','', &
+ &      '(you must increase memory)')
+    ENDIF
+    tszij = SIZE(t_index,DIM=2)
+    tmp_index(:,1:tszij) = t_index(:,1:tszij)
+    DEALLOCATE(t_index)
+    ALLOCATE (t_index(max_file,tax_size_in(nb_fi)),STAT=i_err)
+    IF (i_err/=0) THEN
+      WRITE(*,*) "ERROR IN ALLOCATION of t_index : ",i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &     'Problem in reallocation of t_index','', &
+ &     '(you must increase memory)')
+    ENDIF
+    t_index(:,1:tszij) = tmp_index(:,1:tszij)
+!---
+    ALLOCATE (tmp_julian(max_file,tax_size_in(nb_fi)),STAT=i_err)
+    IF (i_err/=0) THEN
+      WRITE(*,*) "ERROR IN ALLOCATION of tmp_julian : ",i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &     'Problem in allocation of tmp_julian','', &
+ &     '(you must increase memory)')
+    ENDIF
+    tszij = SIZE(t_julian,DIM=2)
+    tmp_julian(:,1:tszij) = t_julian(:,1:tszij)
+    DEALLOCATE(t_julian)
+    ALLOCATE (t_julian(max_file,tax_size_in(nb_fi)),STAT=i_err)
+    IF (i_err/=0) THEN
+      WRITE(*,*) "ERROR IN ALLOCATION of t_julian : ",i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &      'Problem in reallocation of t_julian','', &
+ &      '(you must increase memory)')
+    ENDIF
+    t_julian(:,1:tszij) = tmp_julian(:,1:tszij)
+  ENDIF
+!-----------------------
+END SUBROUTINE rest_atim
+!===
+SUBROUTINE rest_alloc (i_buff,i_qsz,l_msg,c_p)
+!---------------------------------------------------------------------
+! Called by "c_p", allocate a temporary buffer
+! (buff_tmp[1/2] depending on "i_buff" value) to the size "i_qsz".
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: i_buff,i_qsz
+  LOGICAL,INTENT(IN) :: l_msg
+  CHARACTER(LEN=*),INTENT(IN) :: c_p
+!-
+  INTEGER :: i_bsz,i_err
+  LOGICAL :: l_alloc1,l_alloc2
+  CHARACTER(LEN=9) :: cbn
+  CHARACTER(LEN=5) :: c_err
+!---------------------------------------------------------------------
+  IF      (i_buff == 1) THEN
+    IF (ALLOCATED(buff_tmp1)) THEN
+      i_bsz = SIZE(buff_tmp1)
+    ELSE
+      i_bsz = 0
+    ENDIF
+    l_alloc1 =    (.NOT.ALLOCATED(buff_tmp1)) &
+ &            .OR.((ALLOCATED(buff_tmp1)).AND.(i_qsz > i_bsz))
+    l_alloc2 = .FALSE.
+    cbn = 'buff_tmp1'
+  ELSE IF (i_buff == 2) THEN
+    IF (ALLOCATED(buff_tmp2)) THEN
+      i_bsz = SIZE(buff_tmp2)
+    ELSE
+      i_bsz = 0
+    ENDIF
+    l_alloc1 = .FALSE.
+    l_alloc2 =    (.NOT.ALLOCATED(buff_tmp2)) &
+ &            .OR.((ALLOCATED(buff_tmp2)).AND.(i_qsz > i_bsz))
+    cbn = 'buff_tmp2'
+  ELSE
+    CALL ipslerr (3,'rest_alloc', &
+ &    'Called by '//TRIM(c_p),'with a wrong value of i_buff','')
+  ENDIF
+!-
+!-
+  IF (l_alloc1.OR.l_alloc2) THEN
+    IF (l_msg) THEN
+      IF (    (l_alloc1.AND.ALLOCATED(buff_tmp1)) &
+ &        .OR.(l_alloc2.AND.ALLOCATED(buff_tmp2)) ) THEN
+        WRITE(*,*) TRIM(c_p)//" : re_allocate "//TRIM(cbn)//"=",i_qsz
+      ELSE
+        WRITE(*,*) TRIM(c_p)//" : allocate "//TRIM(cbn)//"=",i_qsz
+      ENDIF
+    ENDIF
+    IF (l_alloc1) THEN
+      IF (ALLOCATED(buff_tmp1)) THEN
+        DEALLOCATE(buff_tmp1)
+      ENDIF
+      ALLOCATE (buff_tmp1(i_qsz),STAT=i_err)
+    ELSE
+      IF (ALLOCATED(buff_tmp2)) THEN
+        DEALLOCATE(buff_tmp2)
+      ENDIF
+      ALLOCATE (buff_tmp2(i_qsz),STAT=i_err)
+    ENDIF
+    IF (i_err /= 0) THEN
+      WRITE (UNIT=c_err,FMT='(I5)') i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &      'Problem in allocation of',TRIM(cbn), &
+ &      'Error : '//TRIM(c_err)//' (you must increase memory)')
+    ENDIF
+  ENDIF
+!------------------------
+END SUBROUTINE rest_alloc
+!===
+SUBROUTINE ioconf_setatt (attname,value)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: attname,value
+!-
+  CHARACTER(LEN=LEN_TRIM(attname)) :: tmp_str
+!---------------------------------------------------------------------
+  tmp_str = attname
+  CALL strlowercase (tmp_str)
+!-
+  SELECT CASE(tmp_str)
+    CASE('units')
+      rest_units = value
+    CASE('long_name')
+      rest_lname = value
+    CASE DEFAULT
+      CALL ipslerr (2,'ioconf_restatt', &
+        'The attribute name provided is unknown',attname,' ')
+  END SELECT
+!---------------------------
+END SUBROUTINE ioconf_setatt
+!===
+SUBROUTINE ioget_vdim (fid,vname_q,varnbdim_max,varnbdim,vardims)
+!---------------------------------------------------------------------
+!- This routine allows the user to get the dimensions
+!- of a field in the restart file.
+!- This is the file which is read.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER,INTENT(IN) :: varnbdim_max
+  INTEGER,INTENT(OUT) ::  varnbdim
+  INTEGER,DIMENSION(varnbdim_max),INTENT(OUT) :: vardims
+!-
+  INTEGER :: vnb
+!---------------------------------------------------------------------
+! Find the index of the variable
+  CALL find_str (varname_in(fid,1:nbvar_in(fid)),vname_q,vnb)
+!-
+  IF (vnb > 0) THEN
+    varnbdim = varnbdim_in(fid,vnb)
+    IF (varnbdim_max < varnbdim) THEN
+      CALL ipslerr (3,'ioget_vdim', &
+        'The provided array for the variable dimensions is too small', &
+        '','')
+    ELSE
+      vardims(1:varnbdim) = vardims_in(fid,vnb,1:varnbdim)
+    ENDIF
+  ELSE
+    varnbdim = 0
+    CALL ipslerr (2,'ioget_vdim', &
+      'Variable '//TRIM(vname_q)//' not found','','')
+  ENDIF
+!------------------------
+END SUBROUTINE ioget_vdim
+!===
+SUBROUTINE ioget_vname (fid,nbvar,varnames)
+!---------------------------------------------------------------------
+!- This routine allows the user to extract the list
+!- of variables in an opened restart file.
+!- This is the file which is read
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: fid
+  INTEGER,INTENT(OUT) ::  nbvar
+  CHARACTER(LEN=*),INTENT(OUT) :: varnames(:)
+!---------------------------------------------------------------------
+  nbvar = nbvar_in(fid)
+!-
+  IF (SIZE(varnames) < nbvar) THEN
+    CALL ipslerr (3,'ioget_vname', &
+      'The provided array for the variable names is too small','','')
+  ELSE
+    varnames(1:nbvar) = varname_in(fid,1:nbvar)
+  ENDIF
+!-------------------------
+END SUBROUTINE ioget_vname
+!===
+SUBROUTINE ioconf_expval (new_exp_val)
+!---------------------------------------------------------------------
+!- The default value written into the variables which are not
+!- in the restart file can only be changed once.
+!- This avoids further complications.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  REAL :: new_exp_val
+!---------------------------------------------------------------------
+  IF (.NOT.lock_valexp) THEN
+    lock_valexp = .TRUE.
+    val_exp = new_exp_val
+  ELSE
+    CALL ipslerr (2,'ioconf_expval', &
+     'The default value for variable' &
+   //'not available in the restart file ', &
+     'has already been locked and can not be changed at this point', &
+     ' ')
+  ENDIF
+!---------------------------
+END SUBROUTINE ioconf_expval
+!===
+SUBROUTINE ioget_expval (get_exp_val)
+!---------------------------------------------------------------------
+!- Once the user has extracted the default value,
+!- we lock it so that it can not be changed anymore.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  REAL :: get_exp_val
+!---------------------------------------------------------------------
+  get_exp_val = val_exp
+  lock_valexp = .TRUE.
+!--------------------------
+END SUBROUTINE ioget_expval
+!===
+SUBROUTINE restclo (fid)
+!---------------------------------------------------------------------
+!- This subroutine closes one or any opened restart file.
+!-
+!- INPUT
+!-
+!- fid    : File ID in the restcom system (not the netCDF ID)(optional)
+!-
+!- OUTPUT
+!-
+!- NONE
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(in),OPTIONAL :: fid
+!-
+  INTEGER :: iret,ifnc
+  CHARACTER(LEN=6) :: n_e
+  CHARACTER(LEN=3) :: n_f
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (PRESENT(fid)) THEN
+!---
+    IF (l_dbg) THEN
+      WRITE(*,*) &
+        'restclo : Closing specified restart file number :', &
+        fid,netcdf_id(fid,1:2)
+    ENDIF
+!---
+    IF (netcdf_id(fid,1) > 0) THEN
+      iret = NF90_CLOSE(netcdf_id(fid,1))
+      IF (iret /= NF90_NOERR) THEN
+        WRITE (n_e,'(I6)') iret
+        WRITE (n_f,'(I3)') netcdf_id(fid,1)
+        CALL ipslerr (2,'restclo', &
+          "Error "//n_e//" in closing file : "//n_f,'',' ')
+      ENDIF
+      IF (netcdf_id(fid,1) == netcdf_id(fid,2)) THEN
+        netcdf_id(fid,2) = -1
+      ENDIF
+      netcdf_id(fid,1) = -1
+    ENDIF
+!---
+    IF (netcdf_id(fid,2) > 0)  THEN
+      iret = NF90_CLOSE(netcdf_id(fid,2))
+      IF (iret /= NF90_NOERR) THEN
+        WRITE (n_e,'(I6)') iret
+        WRITE (n_f,'(I3)') netcdf_id(fid,2)
+        CALL ipslerr (2,'restclo', &
+          "Error "//n_e//" in closing file : "//n_f,'',' ')
+      ENDIF
+      netcdf_id(fid,2) = -1
+    ENDIF
+!---
+  ELSE
+!---
+    IF (l_dbg) WRITE(*,*) 'restclo : Closing all files'
+!---
+    DO ifnc=1,nb_fi
+      IF (netcdf_id(ifnc,1) > 0) THEN
+        iret = NF90_CLOSE(netcdf_id(ifnc,1))
+        IF (iret /= NF90_NOERR) THEN
+          WRITE (n_e,'(I6)') iret
+          WRITE (n_f,'(I3)') netcdf_id(ifnc,1)
+          CALL ipslerr (2,'restclo', &
+            "Error "//n_e//" in closing file : "//n_f,'',' ')
+        ENDIF
+        IF (netcdf_id(ifnc,1) == netcdf_id(ifnc,2)) THEN
+          netcdf_id(ifnc,2) = -1
+        ENDIF
+        netcdf_id(ifnc,1) = -1
+      ENDIF
+!-----
+      IF (netcdf_id(ifnc,2) > 0) THEN
+        iret = NF90_CLOSE(netcdf_id(ifnc,2))
+        IF (iret /= NF90_NOERR) THEN
+          WRITE (n_e,'(I6)') iret
+          WRITE (n_f,'(I3)') netcdf_id(ifnc,2)
+          CALL ipslerr (2,'restclo', &
+            "Error "//n_e//" in closing file : "//n_f,'',' ')
+        END IF
+        netcdf_id(ifnc,2) = -1
+      ENDIF
+    ENDDO
+  ENDIF
+!---------------------
+END SUBROUTINE restclo
+!===
+!-----------------
+!$AGRIF_END_DO_NOT_TREAT
+END MODULE restcom
Index: utils/tools/DOMAINcfg/src/stringop.f90
===================================================================
--- utils/tools/DOMAINcfg/src/stringop.f90	(revision 14606)
+++ utils/tools/DOMAINcfg/src/stringop.f90	(revision 14623)
@@ -1,3 +1,4 @@
 MODULE stringop
+!$AGRIF_DO_NOT_TREAT
 !-
 !$Id: stringop.f90 2281 2010-10-15 14:21:13Z smasson $
@@ -183,3 +184,4 @@
 !===
 !------------------
+!$AGRIF_END_DO_NOT_TREAT
 END MODULE stringop
